From 3d8105fb39ed39dd49982246a514204d39596c8e Mon Sep 17 00:00:00 2001 From: Oliver Seidel Date: Tue, 5 Aug 1997 22:34:14 +0000 Subject: [PATCH] Fixed insertion routine with help from Trey Jackson ; added todo-ins-thresh; fixed keyboard layout to remove unwanted keys. --- lisp/calendar/todo-mode.el | 139 +++++++++++++++++++++---------------- 1 file changed, 80 insertions(+), 59 deletions(-) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 39f35a548fc..09998719a27 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -6,9 +6,13 @@ ;; please contact (address) O Seidel, Lessingstr 8, Eschborn, FRG ;; (e-mail ) Oliver.Seidel@cl.cam.ac.uk (2 Aug 1997) -;; $Id: todomode.el,v 1.5 1997/08/05 14:43:39 os10000 Exp os10000 $ +;; $Id: todomode.el,v 1.6 1997/08/05 16:47:01 os10000 Exp os10000 $ ;; ;; $Log: todomode.el,v $ +;; Revision 1.6 1997/08/05 16:47:01 os10000 +;; Incorporated menus for XEmacs from Allan.Cochrane@soton.sc.philips.com, +;; fixed TYPO, fixed todo-file-cmd, cleaned up rcs history. +;; ;; Revision 1.5 1997/08/05 14:43:39 os10000 ;; Added improvements from Ron Gut . ;; Added category management. @@ -84,6 +88,21 @@ ;; and use the #include command to include your todo list file as part ;; of your diary. ;; +;; Another nifty feature is the insertion accuracy. If you have 8 items +;; in your TODO list, then you may get asked 4 questions by the binary +;; insertion algorithm. However, you may not really have a need for such +;; accurate priorities amongst your TODO items. If you now think about +;; the binary insertion halfing the size of the window each time, then +;; the threshhold is the window size at which it will stop. If you set +;; the threshhold to zero, the upper and lower bound will coincide at the +;; end of the loop and you will insert your item just before that point. +;; If you set the threshhold to i.e. 8, it will stop as soon as the window +;; size drops below that amount and will insert the item in the approximate +;; centre of that window. I got the idea for this feature after reading +;; a very helpful e-mail reply from Trey Jackson +;; who corrected some of my awful coding and pointed me towards some good +;; reading. Thanks Trey! +;; ;; Enjoy this package and express your gratitude by sending valuables ;; to my parents' address as listed above!!! ;; @@ -97,24 +116,30 @@ (defvar todo-file-do "~/.todo-do" "TODO mode filename of list file") (defvar todo-file-done "~/.todo-done" "TODO mode filename of archive file") (defvar todo-mode-hook nil "Hooks invoked when the *TODO* buffer is created.") +(defvar todo-ins-thresh 0 "TODO mode insertion accuracy.") ;; --------------------------------------------------------------------------- (require 'time-stamp) -(defvar todo-mode-map (make-sparse-keymap) "TODO mode keymap. See `todo-mode'") -(define-key todo-mode-map "+" 'todo-cmd-forw) -(define-key todo-mode-map "-" 'todo-cmd-back) -(define-key todo-mode-map "e" 'todo-cmd-edit) -(define-key todo-mode-map "f" 'todo-cmd-file) -(define-key todo-mode-map "i" 'todo-cmd-inst) -(define-key todo-mode-map "k" 'todo-cmd-kill) -(define-key todo-mode-map "l" 'todo-cmd-lowr) -(define-key todo-mode-map "n" 'todo-cmd-next) -(define-key todo-mode-map "p" 'todo-cmd-prev) -(define-key todo-mode-map "q" 'todo-cmd-done) -(define-key todo-mode-map "r" 'todo-cmd-rais) -(define-key todo-mode-map "s" 'todo-cmd-save) +(defvar todo-mode-map nil "TODO mode keymap. See `todo-mode'") +(if todo-mode-map + nil + (let ((map (make-keymap))) + (suppress-keymap map t) + (define-key map "+" 'todo-cmd-forw) + (define-key map "-" 'todo-cmd-back) + (define-key map "e" 'todo-cmd-edit) + (define-key map "f" 'todo-cmd-file) + (define-key map "i" 'todo-cmd-inst) + (define-key map "k" 'todo-cmd-kill) + (define-key map "l" 'todo-cmd-lowr) + (define-key map "n" 'todo-cmd-next) + (define-key map "p" 'todo-cmd-prev) + (define-key map "q" 'todo-cmd-done) + (define-key map "r" 'todo-cmd-rais) + (define-key map "s" 'todo-cmd-save) + (setq todo-mode-map map))) (defun todo-cat-slct () (let ((todo-category-name (nth todo-category-number todo-cats))) @@ -190,17 +215,6 @@ (defvar todo-prv-lne 0 "previous line that I asked about.") (defvar todo-prv-ans 0 "previous answer that I got.") -(defun todo-ask (lne) "Ask whether entry is more important than at LNE." - (if (not (equal todo-prv-lne lne)) - (progn - (setq todo-prv-lne lne) - (goto-line todo-prv-lne) - (setq todo-prv-ans (y-or-n-p (concat "More important than '" (todo-line) "'? "))) - ) - ) - todo-prv-ans - ) - (defun todo-add-category (cat) "Add a new category to the TODO list." (interactive) (save-window-excursion @@ -219,49 +233,56 @@ 0 ) -(defun todo-cmd-inst () "Insert new TODO list entry." +(defun todo-cmd-inst () + "Insert new TODO list entry." (interactive) (beginning-of-line nil) (let* ((todo-entry (concat todo-prefix " " (read-from-minibuffer "New TODO entry: "))) - (temp-catgs todo-cats) - (todo-hstry (cons 'temp-catgs (+ todo-category-number 1)))) + (temp-catgs todo-cats) + (todo-hstry (cons 'temp-catgs (+ todo-category-number 1)))) (save-window-excursion (setq todo-category - (read-from-minibuffer "Category: " (nth todo-category-number todo-cats) nil nil todo-hstry)) - (let* ((ltrgt todo-category) - (lnmbr 0) - (ltext (car todo-cats)) - (lrest (cdr todo-cats))) - (setq ltext (car todo-cats)) - (while (not (or (null lrest) (string-equal ltext ltrgt))) - (setq ltext (car lrest)) - (setq lrest (cdr lrest)) - (setq lnmbr (+ 1 lnmbr)) - ) - (setq todo-category-number - (if (string-equal ltext todo-category) lnmbr (todo-add-category todo-category))) - ) + (read-from-minibuffer "Category: " + (nth todo-category-number todo-cats) + nil nil todo-hstry)) + + (let ((cat-exists (member todo-category todo-cats))) + (setq todo-category-number + (if cat-exists + (- (length todo-cats) (length cat-exists)) + (todo-add-category todo-category)))) (todo-show) (setq todo-prv-lne 0) - (let* ((todo-fst 1) - (todo-lst (+ 1 (count-lines (point-min) (point-max))))) - (while (< todo-fst todo-lst) - (let* ((todo-cur (/ (+ todo-fst todo-lst) 2)) - (todo-ans (if (< todo-cur todo-lst) (todo-ask todo-cur) nil))) - (if todo-ans - (setq todo-lst todo-cur) - (setq todo-fst (+ todo-cur 1))) - ) - ) - (goto-line todo-fst) - ) + + (let ((todo-fst 1) + (todo-lst (+ 1 (count-lines (point-min) (point-max))))) + (while (> (- todo-lst todo-fst) todo-ins-thresh) + (let* ((todo-cur (/ (+ todo-fst todo-lst) 2)) + (todo-ans (if (< todo-cur todo-lst) (todo-ask todo-cur) nil))) + (if todo-ans + (setq todo-lst todo-cur) + (setq todo-fst (+ todo-cur 1))))) + + (setq todo-fst (/ (+ todo-fst todo-lst) 2)) + ;; goto-line doesn't have the desired behavior in a narrowed buffer + (goto-char (point-min)) + (message (format "todo-fst=%d" todo-fst)) + (forward-line (- todo-fst 1))) + (insert (concat todo-entry "\n")) - (forward-line -1) - ) + (forward-line -1)) (beginning-of-line nil) - (message "") - ) - ) + (message ""))) + +(defun todo-ask (lne) + "Ask whether entry is more important than at LNE." + (if (not (equal todo-prv-lne lne)) + (progn + (setq todo-prv-lne lne) + (goto-char (point-min)) + (forward-line (- todo-prv-lne 1)) + (setq todo-prv-ans (y-or-n-p (concat "More important than '" (todo-line) "'? "))))) + todo-prv-ans) (defun todo-cmd-kill () "Delete current TODO list entry." (interactive) -- 2.39.2