Now on revision 113135. ------------------------------------------------------------ revno: 113135 committer: Juanma Barranquero branch nick: trunk timestamp: Sat 2013-06-22 04:41:14 +0200 message: .bzrignore: Add GNU idutils ID database file. diff: === modified file '.bzrignore' --- .bzrignore 2013-06-20 20:01:51 +0000 +++ .bzrignore 2013-06-22 02:41:14 +0000 @@ -33,6 +33,7 @@ GPATH GRTAGS GTAGS +ID makefile Makefile Makefile.c === modified file 'ChangeLog' --- ChangeLog 2013-06-21 01:03:23 +0000 +++ ChangeLog 2013-06-22 02:41:14 +0000 @@ -1,3 +1,7 @@ +2013-06-22 Juanma Barranquero + + * .bzrignore: Add GNU idutils ID database file. + 2013-06-21 YAMAMOTO Mitsuharu * configure.ac (HAVE_LIBXML2): Try built-in libxml2 on OS X 10.8 @@ -7,7 +11,7 @@ * .bzrignore: Don't unignore cl-loaddefs.el. -2013-06-20 RĂ¼diger Sonderfeld +2013-06-20 RĂ¼diger Sonderfeld * configure.ac (log2): Check for this function. ------------------------------------------------------------ revno: 113134 committer: Juanma Barranquero branch nick: trunk timestamp: Sat 2013-06-22 04:33:33 +0200 message: lisp/bs.el, emacs-lock.el: Use defvar-local, setq-local. * lisp/bs.el (bs-buffer-show-mark): Make defvar-local. (bs-mode): Use setq-local. * lisp/emacs-lock.el (emacs-lock-mode, emacs-lock--old-mode) (emacs-lock--try-unlocking): Make defvar-local. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-22 00:37:18 +0000 +++ lisp/ChangeLog 2013-06-22 02:33:33 +0000 @@ -1,3 +1,11 @@ +2013-06-22 Juanma Barranquero + + * bs.el (bs-buffer-show-mark): Make defvar-local. + (bs-mode): Use setq-local. + + * emacs-lock.el (emacs-lock-mode, emacs-lock--old-mode) + (emacs-lock--try-unlocking): Make defvar-local. + 2013-06-22 Glenn Morris * play/cookie1.el (cookie-apropos): Minor simplification. === modified file 'lisp/bs.el' --- lisp/bs.el 2013-01-01 09:11:05 +0000 +++ lisp/bs.el 2013-06-22 02:33:33 +0000 @@ -336,15 +336,13 @@ ;; Internal globals ;; ---------------------------------------------------------------------- -(defvar bs-buffer-show-mark nil +(defvar-local bs-buffer-show-mark nil "Flag for the current mode for showing this buffer. A value of nil means buffer will be shown depending on the current configuration. A value of `never' means to never show the buffer. A value of `always' means to show buffer regardless of the configuration.") -(make-variable-buffer-local 'bs-buffer-show-mark) - ;; Make face named region (for XEmacs) (unless (facep 'region) (make-face 'region) @@ -648,17 +646,14 @@ to show always. \\[bs-visit-tags-table] -- call `visit-tags-table' on current line's buffer. \\[bs-help] -- display this help text." - (make-local-variable 'font-lock-defaults) - (make-local-variable 'font-lock-verbose) - (make-local-variable 'font-lock-global-modes) (buffer-disable-undo) (setq buffer-read-only t truncate-lines t - show-trailing-whitespace nil - font-lock-global-modes '(not bs-mode) - font-lock-defaults '(bs-mode-font-lock-keywords t) - font-lock-verbose nil) - (set (make-local-variable 'revert-buffer-function) 'bs-refresh) + show-trailing-whitespace nil) + (setq-local font-lock-defaults '(bs-mode-font-lock-keywords t)) + (setq-local font-lock-verbose nil) + (setq-local font-lock-global-modes '(not bs-mode)) + (setq-local revert-buffer-function 'bs-refresh) (add-hook 'window-size-change-functions 'bs--track-window-changes) (add-hook 'kill-buffer-hook 'bs--remove-hooks nil t) (add-hook 'change-major-mode-hook 'bs--remove-hooks nil t)) === modified file 'lisp/emacs-lock.el' --- lisp/emacs-lock.el 2013-01-01 09:11:05 +0000 +++ lisp/emacs-lock.el 2013-06-22 02:33:33 +0000 @@ -27,7 +27,7 @@ ;; This package defines a minor mode Emacs Lock to mark a buffer as ;; protected against accidental killing, or exiting Emacs, or both. ;; Buffers associated with inferior modes, like shell or telnet, can -;; be treated specially, by auto-unlocking them if their interior +;; be treated specially, by auto-unlocking them if their inferior ;; processes are dead. ;;; Code: @@ -88,26 +88,23 @@ :group 'emacs-lock :version "24.3") -(defvar emacs-lock-mode nil +(defvar-local emacs-lock-mode nil "If non-nil, the current buffer is locked. It can be one of the following values: exit -- Emacs cannot exit while the buffer is locked kill -- the buffer cannot be killed, but Emacs can exit as usual all -- the buffer is locked against both actions nil -- the buffer is not locked") -(make-variable-buffer-local 'emacs-lock-mode) (put 'emacs-lock-mode 'permanent-local t) -(defvar emacs-lock--old-mode nil +(defvar-local emacs-lock--old-mode nil "Most recent locking mode set on the buffer. Internal use only.") -(make-variable-buffer-local 'emacs-lock--old-mode) (put 'emacs-lock--old-mode 'permanent-local t) -(defvar emacs-lock--try-unlocking nil +(defvar-local emacs-lock--try-unlocking nil "Non-nil if current buffer should be checked for auto-unlocking. Internal use only.") -(make-variable-buffer-local 'emacs-lock--try-unlocking) (put 'emacs-lock--try-unlocking 'permanent-local t) (defun emacs-lock-live-process-p (buffer-or-name) @@ -188,6 +185,7 @@ (define-obsolete-variable-alias 'emacs-lock-from-exiting 'emacs-lock-mode "24.1") + ;;;###autoload (define-minor-mode emacs-lock-mode "Toggle Emacs Lock mode in the current buffer. ------------------------------------------------------------ revno: 113133 committer: Glenn Morris branch nick: trunk timestamp: Fri 2013-06-21 20:37:18 -0400 message: * lisp/play/cookie1.el (cookie-apropos): Minor simplification. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-22 00:35:51 +0000 +++ lisp/ChangeLog 2013-06-22 00:37:18 +0000 @@ -1,5 +1,7 @@ 2013-06-22 Glenn Morris + * play/cookie1.el (cookie-apropos): Minor simplification. + * progmodes/gdb-mi.el (gdb-mapcar*): Remove, replace with cl-mapcar. 2013-06-22 Dmitry Gutov === modified file 'lisp/play/cookie1.el' --- lisp/play/cookie1.el 2013-06-21 16:00:00 +0000 +++ lisp/play/cookie1.el 2013-06-22 00:37:18 +0000 @@ -194,34 +194,28 @@ (if (or current-prefix-arg (not cookie-file)) (read-file-name "Cookie file: " nil cookie-file t cookie-file) - cookie-file))) + cookie-file) t)) (setq phrase-file (cookie-check-file phrase-file)) ;; Make sure phrases are loaded. (cookie phrase-file) (let* ((case-fold-search t) (cookie-table-symbol (intern phrase-file cookie-cache)) (string-table (symbol-value cookie-table-symbol)) - (matches nil) - (len (length string-table)) - (i 0)) - (save-match-data - (while (< i len) - (and (string-match regexp (aref string-table i)) - (setq matches (cons (aref string-table i) matches))) - (setq i (1+ i)))) - (and matches + (matches nil)) + (and (dotimes (i (length string-table) matches) + (and (string-match-p regexp (aref string-table i)) + (setq matches (cons (aref string-table i) matches)))) (setq matches (sort matches 'string-lessp))) - (and (or display (called-interactively-p 'interactive)) - (cond ((null matches) - (message "No matches found.")) - (t - (let ((l matches)) - (with-output-to-temp-buffer "*Cookie Apropos*" - (while l - (princ (car l)) - (setq l (cdr l)) - (and l (princ "\n\n"))) - (help-print-return-message)))))) + (and display + (if matches + (let ((l matches)) + (with-output-to-temp-buffer "*Cookie Apropos*" + (while l + (princ (car l)) + (setq l (cdr l)) + (and l (princ "\n\n"))) + (help-print-return-message))) + (message "No matches found."))) matches)) ------------------------------------------------------------ revno: 113132 committer: Glenn Morris branch nick: trunk timestamp: Fri 2013-06-21 20:35:51 -0400 message: * lisp/progmodes/gdb-mi.el (gdb-mapcar*): Remove, replace with cl-mapcar. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-22 00:11:24 +0000 +++ lisp/ChangeLog 2013-06-22 00:35:51 +0000 @@ -1,3 +1,7 @@ +2013-06-22 Glenn Morris + + * progmodes/gdb-mi.el (gdb-mapcar*): Remove, replace with cl-mapcar. + 2013-06-22 Dmitry Gutov * progmodes/ruby-mode.el (auto-mode-alist): Do not use === modified file 'lisp/progmodes/gdb-mi.el' --- lisp/progmodes/gdb-mi.el 2013-05-30 23:33:08 +0000 +++ lisp/progmodes/gdb-mi.el 2013-06-22 00:35:51 +0000 @@ -2642,20 +2642,6 @@ (row-properties nil) (right-align nil)) -(defun gdb-mapcar* (function &rest seqs) - "Apply FUNCTION to each element of SEQS, and make a list of the results. -If there are several SEQS, FUNCTION is called with that many -arguments, and mapping stops as soon as the shortest list runs -out." - (let ((shortest (apply #'min (mapcar #'length seqs)))) - (mapcar (lambda (i) - (apply function - (mapcar - (lambda (seq) - (nth i seq)) - seqs))) - (number-sequence 0 (1- shortest))))) - (defun gdb-table-add-row (table row &optional properties) "Add ROW of string to TABLE and recalculate column sizes. @@ -2673,7 +2659,7 @@ (setf (gdb-table-row-properties table) (append row-properties (list properties))) (setf (gdb-table-column-sizes table) - (gdb-mapcar* (lambda (x s) + (cl-mapcar (lambda (x s) (let ((new-x (max (abs x) (string-width (or s ""))))) (if right-align new-x (- new-x)))) @@ -2688,11 +2674,11 @@ (let ((column-sizes (gdb-table-column-sizes table))) (mapconcat 'identity - (gdb-mapcar* + (cl-mapcar (lambda (row properties) (apply 'propertize (mapconcat 'identity - (gdb-mapcar* (lambda (s x) (gdb-pad-string s x)) + (cl-mapcar (lambda (s x) (gdb-pad-string s x)) row column-sizes) sep) properties)) ------------------------------------------------------------ revno: 113131 committer: Dmitry Gutov branch nick: trunk timestamp: Sat 2013-06-22 04:11:24 +0400 message: * lisp/progmodes/ruby-mode.el (auto-mode-alist): Do not use `regexp-opt', it breaks the build during dumping. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 23:14:38 +0000 +++ lisp/ChangeLog 2013-06-22 00:11:24 +0000 @@ -1,3 +1,8 @@ +2013-06-22 Dmitry Gutov + + * progmodes/ruby-mode.el (auto-mode-alist): Do not use + `regexp-opt', it breaks the build during dumping. + 2013-06-21 Dmitry Gutov * progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2013-06-21 23:20:54 +0000 +++ lisp/progmodes/ruby-mode.el 2013-06-22 00:11:24 +0000 @@ -1869,12 +1869,11 @@ ;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy (concat "\\(?:\\." - (regexp-opt '("rb" "ru" "rake" "thor" - "jbuilder" "gemspec")) + "rb\\|ru\\|rake\\|thor" + "\\|jbuilder\\|gemspec" "\\|/" - (regexp-opt '("Gemfile" "Rakefile" - "Capfile" "Thorfile" - "Vagrantfile" "Guardfile")) + "\\(?:Gem\\|Rake\\|Cap\\|Thor" + "Vagrant\\|Guard\\)file" "\\)\\'")) 'ruby-mode)) ;;;###autoload ------------------------------------------------------------ revno: 113130 committer: Dmitry Gutov branch nick: trunk timestamp: Sat 2013-06-22 03:20:54 +0400 message: * progmodes/ruby-mode.el (auto-mode-alist): Forgot "Guardfile". diff: === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2013-06-21 23:14:38 +0000 +++ lisp/progmodes/ruby-mode.el 2013-06-21 23:20:54 +0000 @@ -1874,7 +1874,7 @@ "\\|/" (regexp-opt '("Gemfile" "Rakefile" "Capfile" "Thorfile" - "Vagrantfile")) + "Vagrantfile" "Guardfile")) "\\)\\'")) 'ruby-mode)) ;;;###autoload ------------------------------------------------------------ revno: 113129 committer: Dmitry Gutov branch nick: trunk timestamp: Sat 2013-06-22 03:14:38 +0400 message: * lisp/progmodes/ruby-mode.el (auto-mode-alist): Consolidate different entries into one regexp and add more *file-s. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 23:07:49 +0000 +++ lisp/ChangeLog 2013-06-21 23:14:38 +0000 @@ -3,6 +3,8 @@ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight keyword-like methods on Kernel and Module with font-lock-builtin-face. + (auto-mode-alist): Consolidate different entries into one regexp + and add more *file-s. 2013-06-21 Stephen Berman === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2013-06-21 23:07:49 +0000 +++ lisp/progmodes/ruby-mode.el 2013-06-21 23:14:38 +0000 @@ -1867,11 +1867,15 @@ ;;; Invoke ruby-mode when appropriate ;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "\\.rb\\'") 'ruby-mode)) -;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "Rakefile\\'") 'ruby-mode)) -;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "\\.gemspec\\'") 'ruby-mode)) +(add-to-list 'auto-mode-alist + (cons (purecopy (concat "\\(?:\\." + (regexp-opt '("rb" "ru" "rake" "thor" + "jbuilder" "gemspec")) + "\\|/" + (regexp-opt '("Gemfile" "Rakefile" + "Capfile" "Thorfile" + "Vagrantfile")) + "\\)\\'")) 'ruby-mode)) ;;;###autoload (dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) ------------------------------------------------------------ revno: 113128 committer: Dmitry Gutov branch nick: trunk timestamp: Sat 2013-06-22 03:07:49 +0400 message: * lisp/progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight keyword-like methods on Kernel and Module with font-lock-builtin-face. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 21:55:44 +0000 +++ lisp/ChangeLog 2013-06-21 23:07:49 +0000 @@ -1,3 +1,9 @@ +2013-06-21 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight + keyword-like methods on Kernel and Module with + font-lock-builtin-face. + 2013-06-21 Stephen Berman * obsolete/otodo-mode.el: Move and rename from calendar/todo-mode.el. === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2013-06-18 22:17:56 +0000 +++ lisp/progmodes/ruby-mode.el 2013-06-21 23:07:49 +0000 @@ -1726,12 +1726,11 @@ ;; functions '("^\\s *def\\s +\\([^( \t\n]+\\)" 1 font-lock-function-name-face) - ;; keywords - (cons (concat - "\\(^\\|[^.@$]\\|\\.\\.\\)\\_<\\(defined\\?\\|" + (list (concat + "\\(^\\|[^.@$]\\|\\.\\.\\)\\(" + ;; keywords (regexp-opt - '("alias_method" - "alias" + '("alias" "and" "begin" "break" @@ -1739,6 +1738,7 @@ "catch" "class" "def" + "defined?" "do" "elsif" "else" @@ -1748,21 +1748,15 @@ "end" "if" "in" - "module_function" "module" "next" "not" "or" - "public" - "private" - "protected" - "raise" "redo" "rescue" "retry" "return" "then" - "throw" "super" "unless" "undef" @@ -1770,10 +1764,26 @@ "when" "while" "yield") - t) - "\\)" - ruby-keyword-end-re) - 2) + 'symbols) + "\\|" + ;; keyword-like methods on Kernel and Module + (regexp-opt + '("alias_method" + "autoload" + "module_function" + "private" + "protected" + "public" + "raise" + "require" + "require_relative" + "throw") + 'symbols) + "\\)") + 2 + '(if (match-beginning 4) + font-lock-builtin-face + font-lock-keyword-face)) ;; here-doc beginnings `(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0)) 'font-lock-string-face)) ------------------------------------------------------------ revno: 113127 committer: Paul Eggert branch nick: trunk timestamp: Fri 2013-06-21 15:16:37 -0700 message: * process.c (create_process): Handle a couple more cases, i.e., work even if new_argv and wait_child_setup[i] are cached. Use Fcall_process's style for volatile vars. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-21 21:27:17 +0000 +++ src/ChangeLog 2013-06-21 22:16:37 +0000 @@ -1,3 +1,9 @@ +2013-06-21 Paul Eggert + + * process.c (create_process): Handle a couple more cases, + i.e., work even if new_argv and wait_child_setup[i] are cached. + Use Fcall_process's style for volatile vars. + 2013-06-21 Andreas Schwab * process.c (create_process): Mark PROCESS volatile. === modified file 'src/process.c' --- src/process.c 2013-06-21 21:27:17 +0000 +++ src/process.c 2013-06-21 22:16:37 +0000 @@ -1582,8 +1582,7 @@ static void -create_process (volatile Lisp_Object process, char **new_argv, - Lisp_Object current_dir) +create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) { int inchannel, outchannel; pid_t pid; @@ -1592,11 +1591,10 @@ int wait_child_setup[2]; #endif sigset_t blocked; - /* Use volatile to protect variables from being clobbered by vfork. */ - volatile int forkin, forkout; - volatile bool pty_flag = 0; - volatile Lisp_Object lisp_pty_name = Qnil; - volatile Lisp_Object encoded_current_dir; + int forkin, forkout; + bool pty_flag = 0; + Lisp_Object lisp_pty_name = Qnil; + Lisp_Object encoded_current_dir; inchannel = outchannel = -1; @@ -1695,7 +1693,31 @@ pthread_sigmask (SIG_BLOCK, &blocked, 0); #ifndef WINDOWSNT - pid = vfork (); + /* vfork, and prevent local vars from being clobbered by the vfork. */ + { + Lisp_Object volatile encoded_current_dir_volatile = encoded_current_dir; + Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name; + Lisp_Object volatile process_volatile = process; + bool volatile pty_flag_volatile = pty_flag; + char **volatile new_argv_volatile = new_argv; + int volatile forkin_volatile = forkin; + int volatile forkout_volatile = forkout; + int volatile wait_child_setup_0_volatile = wait_child_setup[0]; + int volatile wait_child_setup_1_volatile = wait_child_setup[1]; + + pid = vfork (); + + encoded_current_dir = encoded_current_dir_volatile; + lisp_pty_name = lisp_pty_name_volatile; + process = process_volatile; + pty_flag = pty_flag_volatile; + new_argv = new_argv_volatile; + forkin = forkin_volatile; + forkout = forkout_volatile; + wait_child_setup[0] = wait_child_setup_0_volatile; + wait_child_setup[1] = wait_child_setup_1_volatile; + } + if (pid == 0) #endif /* not WINDOWSNT */ { ------------------------------------------------------------ revno: 113126 [merge] committer: Stephen Berman branch nick: trunk timestamp: Fri 2013-06-21 23:58:09 +0200 message: New version of todo-mode.el. 2013-06-21 Stephen Berman * obsolete/otodo-mode.el: Move and rename from calendar/todo-mode.el. * calendar/diary-lib.el (diary-goto-entry-function): New variable. (diary-entry): Use it in the action of this button type instead of diary-goto-entry. * calendar/todo-mode.el: New version. (todo-add-category): Append new category to end of file and give it the highest number, instead of putting it at the beginning and giving it 0. Incorporate noninteractive functionality. (todo-forward-category): Adapt to 1-based category numbering. Allow skipping over archived categories. (todo-backward-category): Derive from todo-forward-category. (todo-backward-item, todo-forward-item): Make noninteractive and delegate interactive part to new commands. Make sensitive to done items. (todo-categories): Make value an alist of category names and vectors of item counts. (todo-category-beg): Make a defconst. (todo-category-number): Use 1 instead of 0 as initial value. (todo-category-select): Make sensitive to overlays, optional item highlighting and done items. (todo-delete-item): Make sensitive to overlays and marked and done items. (todo-edit-item): Make sensitive to overlays and editing of date/time header optional. Add format checks. (todo-edit-multiline): Rename to todo-edit-multiline-item. Make a no-op if point is not on an item. Advertise using todo-edit-quit. (todo-edit-mode): Make sensitive to new format, font-locking, and multiple todo files. (todo-insert-item, todo-insert-item-here): Derive from todo-basic-insert-item and extend functionality. (todo-item-end, todo-item-start): Make sensitive to done items. (todo-item-string): Don't return text properties. Restore point. (todo-jump-to-category): Make sensitive to multiple todo files and todo archives. Use extended category completion. (todo-lower-item, todo-raise-item): Rename to *-priority and derive from todo-set-item-priority. (todo-mode): Derive from special-mode. Make sensitive to new format, font-locking and multiple todo files. Make read-only. (todo-mode-map): Don't suppress digit keys, so they can supply prefix arguments. Add many new key bindings. (todo-prefix): Insert as an overlay instead of file text. Change semantics from diary date expression to purely visual mark. (todo-print): Rename to todo-print-buffer. Make buffer display features printable. Remove option to restrict number of items printed. Add option to print to file. (todo-print-function): Rename to todo-print-buffer-function. (todo-quit): Extend to handle exiting new todo modes. (todo-remove-item): Make sensitive to overlays. (todo-save): Extend to buffers of filtered items. (todo-show): Make sensitive to done items, multiple todo files and new todo modes. Offer to convert legacy todo file before creating first new todo file. (todo-show-priorities): Rename to todo-top-priorities. Change semantics of value 0. (todo-top-priorities): Rename to todo-filter-top-priorities, derive from todo-filter-items and extend functionality. (todo-save-top-priorities): Rename to todo-save-filtered-items-buffer and extend functionality to other types of filtered items. (todo-add-item-non-interactively, todo-ask-p, todo-cat-slct) (todo-category-end, todo-category-sep, todo-cats, todo-cmd-back) (todo-cmd-done, todo-cmd-edit, todo-cmd-forw, todo-cmd-inst) (todo-cmd-kill, todo-cmd-lowr, todo-cmd-next, todo-cmd-prev) (todo-cmd-rais, todo-cmd-save, todo-completing-read, todo-cp) (todo-edit-mode-hook, todo-entry-prefix-function) (todo-entry-timestamp-initials, todo-file-do, todo-file-done) (todo-file-item, todo-file-top, todo-header, todo-initial-setup) (todo-initials, todo-insert-threshold, todo-item-string-start) (todo-line-string, todo-menu, todo-mode-hook) (todo-more-important-p, todo-previous-answer, todo-previous-line) (todo-print-priorities, todo-remove-separator) (todo-save-top-priorities-too, todo-string-count-lines) (todo-string-multiline-p, todo-time-string-format) (todo-tmp-buffer-name): Remove. (todo-add-file, todo-archive-done-item, todo-choose-archive) (todo-convert-legacy-files, todo-copy-item, todo-delete-category) (todo-edit-category-diary-inclusion) (todo-edit-category-diary-nonmarking, todo-edit-done-item-comment) (todo-edit-file, todo-edit-item-date-day) (todo-edit-item-date-day-name, todo-edit-item-date-from-calendar) (todo-edit-item-date-month, todo-edit-item-date-to-today) (todo-edit-item-date-year, todo-edit-item-diary-inclusion) (todo-edit-item-diary-nonmarking, todo-edit-item-header) (todo-edit-item-time, todo-edit-quit, todo-filter-diary-items) (todo-filter-diary-items-multifile, todo-filter-regexp-items) (todo-filter-regexp-items-multifile, todo-filter-top-priorities) (todo-filter-top-priorities-multifile, todo-find-archive) (todo-find-filtered-items-file, todo-go-to-source-item) (todo-insert-item-from-calendar, todo-item-done, todo-item-undone) (todo-jump-to-archive-category, todo-lower-category) (todo-mark-category, todo-marked-item-p, todo-merge-category) (todo-move-category, todo-move-item, todo-next-button) (todo-next-item, todo-padded-string, todo-powerset) (todo-previous-button, todo-previous-item) (todo-print-buffer-to-file, todo-raise-category) (todo-rename-category, todo-repair-categories-sexp, todo-search) (todo-set-category-number, todo-set-item-priority) (todo-set-top-priorities-in-category) (todo-set-top-priorities-in-file, todo-show-categories-table) (todo-sort-categories-alphabetically-or-numerically) (todo-sort-categories-by-archived, todo-sort-categories-by-diary) (todo-sort-categories-by-done, todo-sort-categories-by-todo) (todo-toggle-item-header, todo-toggle-item-highlighting) (todo-toggle-mark-item, todo-toggle-prefix-numbers) (todo-toggle-view-done-items, todo-toggle-view-done-only) (todo-unarchive-items, todo-unmark-category): New commands. (todo-absolute-file-name, todo-add-to-buffer-list) (todo-adjusted-category-label-length, todo-basic-edit-item-header) (todo-basic-insert-item, todo-category-completions) (todo-category-number, todo-category-string-matcher-1) (todo-category-string-matcher-2, todo-check-filtered-items-file) (todo-check-format, todo-clear-matches) (todo-comment-string-matcher, todo-convert-legacy-date-time) (todo-current-category, todo-date-string-matcher) (todo-define-insertion-command, todo-diary-expired-matcher) (todo-diary-goto-entry, todo-diary-item-p) (todo-diary-nonmarking-matcher, todo-display-as-todo-file) (todo-display-categories, todo-display-sorted, todo-done-item-p) (todo-done-item-section-p, todo-done-separator) (todo-done-string-matcher, todo-files, todo-filter-items) (todo-filter-items-1, todo-filter-items-filename, todo-find-item) (todo-gen-arglists, todo-get-count, todo-get-overlay, todo-indent) (todo-insert-category-line, todo-insert-item-from-calendar) (todo-insert-sort-button, todo-insert-with-overlays) (todo-insertion-command-name, todo-insertion-key-bindings) (todo-label-to-key, todo-longest-category-name-length) (todo-make-categories-list, todo-mode-external-set) (todo-mode-line-control, todo-modes-set-1, todo-modes-set-2) (todo-modes-set-3, todo-multiple-filter-files) (todo-nondiary-marker-matcher, todo-prefix-overlays) (todo-read-category, todo-read-date, todo-read-dayname) (todo-read-file-name, todo-read-time) (todo-reevaluate-category-completions-files-defcustom) (todo-reevaluate-default-file-defcustom) (todo-reevaluate-filelist-defcustoms) (todo-reevaluate-filter-files-defcustom) (todo-reset-and-enable-done-separator, todo-reset-comment-string) (todo-reset-done-separator, todo-reset-done-separator-string) (todo-reset-done-string, todo-reset-global-current-todo-file) (todo-reset-highlight-item, todo-reset-nondiary-marker) (todo-reset-prefix, todo-set-categories) (todo-set-date-from-calendar, todo-set-show-current-file) (todo-set-top-priorities, todo-short-file-name) (todo-show-current-file, todo-sort, todo-time-string-matcher) (todo-total-item-counts, todo-update-buffer-list) (todo-update-categories-display, todo-update-categories-sexp) (todo-update-count, todo-validate-name, todo-y-or-n-p): New functions. (todo-archive-mode, todo-categories-mode, todo-filtered-items-mode): New major modes. (todo-categories, todo-display, todo-edit, todo-faces) (todo-filtered): New defgroups. (todo-archived-only, todo-button, todo-category-string, todo-date) (todo-diary-expired, todo-done, todo-done-sep, todo-comment) (todo-mark, todo-nondiary, todo-prefix-string, todo-search) (todo-sorted-column, todo-time, todo-top-priority): New deffaces. (todo-add-item-if-new-category, todo-always-add-time-string) (todo-categories-align, todo-categories-archived-label) (todo-categories-category-label, todo-categories-diary-label) (todo-categories-done-label, todo-categories-number-separator) (todo-categories-todo-label, todo-categories-totals-label) (todo-category-completions-files, todo-completion-ignore-case) (todo-default-todo-file, todo-diary-nonmarking, todo-directory) (todo-done-separator-string, todo-done-string) (todo-files-function, todo-filter-done-items, todo-filter-files) (todo-highlight-item, todo-include-in-diary, todo-indent-to-here) (todo-initial-category, todo-initial-file, todo-item-mark) (todo-legacy-date-time-regexp, todo-mode-line-function) (todo-nondiary-marker, todo-number-prefix) (todo-print-buffer-function, todo-show-current-file) (todo-show-done-only, todo-show-first, todo-show-with-done) (todo-skip-archived-categories, todo-top-priorities-overrides) (todo-undo-item-omit-comment, todo-use-only-highlighted-region) (todo-visit-files-commands, todo-wrap-lines, todo-y-with-space): New defcustoms. (todo-category-done, todo-date-pattern, todo-date-string-start) (todo-diary-items-buffer, todo-done-string-start) (todo-filtered-items-buffer, todo-item-start) (todo-month-abbrev-array, todo-month-name-array) (todo-nondiary-end, todo-nondiary-start, todo-regexp-items-buffer) (todo-top-priorities-buffer): New defconsts. (todo-archive-mode-map, todo-archives, todo-categories-mode-map) (todo-categories-with-marks, todo-category-string-face) (todo-comment-face, todo-comment-string, todo-current-todo-file) (todo-date-face, todo-date-from-calendar, todo-descending-counts) (todo-diary-expired-face, todo-done-face, todo-done-sep-face) (todo-done-separator, todo-edit-buffer, todo-edit-mode-map) (todo-file-buffers, todo-files, todo-filtered-items-mode-map) (todo-font-lock-keywords, todo-global-current-todo-file) (todo-insertion-commands, todo-insertion-commands-arg-key-list) (todo-insertion-commands-args) (todo-insertion-commands-args-genlist) (todo-insertion-commands-names, todo-insertion-map) (todo-key-bindings-t, todo-key-bindings-t+a) (todo-key-bindings-t+a+f, todo-key-bindings-t+f, todo-mode-map) (todo-multiple-filter-files, todo-multiple-filter-files-widget) (todo-nondiary-face, todo-print-buffer, todo-time-face) (todo-visited): New variables. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 16:00:00 +0000 +++ lisp/ChangeLog 2013-06-21 21:55:44 +0000 @@ -1,3 +1,203 @@ +2013-06-21 Stephen Berman + + * obsolete/otodo-mode.el: Move and rename from calendar/todo-mode.el. + + * calendar/diary-lib.el (diary-goto-entry-function): New variable. + (diary-entry): Use it in the action of this button type instead of + diary-goto-entry. + + * calendar/todo-mode.el: New version. + (todo-add-category): Append new category to end of file and give + it the highest number, instead of putting it at the beginning and + giving it 0. Incorporate noninteractive functionality. + (todo-forward-category): Adapt to 1-based category numbering. + Allow skipping over archived categories. + (todo-backward-category): Derive from todo-forward-category. + (todo-backward-item, todo-forward-item): Make noninteractive and + delegate interactive part to new commands. Make sensitive to done items. + (todo-categories): Make value an alist of category names and + vectors of item counts. + (todo-category-beg): Make a defconst. + (todo-category-number): Use 1 instead of 0 as initial value. + (todo-category-select): Make sensitive to overlays, optional item + highlighting and done items. + (todo-delete-item): Make sensitive to overlays and marked and done items. + (todo-edit-item): Make sensitive to overlays and editing of + date/time header optional. Add format checks. + (todo-edit-multiline): Rename to todo-edit-multiline-item. Make a + no-op if point is not on an item. Advertise using todo-edit-quit. + (todo-edit-mode): Make sensitive to new format, font-locking, and + multiple todo files. + (todo-insert-item, todo-insert-item-here): Derive from + todo-basic-insert-item and extend functionality. + (todo-item-end, todo-item-start): Make sensitive to done items. + (todo-item-string): Don't return text properties. Restore point. + (todo-jump-to-category): Make sensitive to multiple todo files and + todo archives. Use extended category completion. + (todo-lower-item, todo-raise-item): Rename to *-priority and + derive from todo-set-item-priority. + (todo-mode): Derive from special-mode. Make sensitive to new + format, font-locking and multiple todo files. Make read-only. + (todo-mode-map): Don't suppress digit keys, so they can supply + prefix arguments. Add many new key bindings. + (todo-prefix): Insert as an overlay instead of file text. + Change semantics from diary date expression to purely visual mark. + (todo-print): Rename to todo-print-buffer. Make buffer display + features printable. Remove option to restrict number of items + printed. Add option to print to file. + (todo-print-function): Rename to todo-print-buffer-function. + (todo-quit): Extend to handle exiting new todo modes. + (todo-remove-item): Make sensitive to overlays. + (todo-save): Extend to buffers of filtered items. + (todo-show): Make sensitive to done items, multiple todo files and + new todo modes. Offer to convert legacy todo file before creating + first new todo file. + (todo-show-priorities): Rename to todo-top-priorities. + Change semantics of value 0. + (todo-top-priorities): Rename to todo-filter-top-priorities, + derive from todo-filter-items and extend functionality. + (todo-save-top-priorities): Rename to todo-save-filtered-items-buffer + and extend functionality to other types of filtered items. + (todo-add-item-non-interactively, todo-ask-p, todo-cat-slct) + (todo-category-end, todo-category-sep, todo-cats, todo-cmd-back) + (todo-cmd-done, todo-cmd-edit, todo-cmd-forw, todo-cmd-inst) + (todo-cmd-kill, todo-cmd-lowr, todo-cmd-next, todo-cmd-prev) + (todo-cmd-rais, todo-cmd-save, todo-completing-read, todo-cp) + (todo-edit-mode-hook, todo-entry-prefix-function) + (todo-entry-timestamp-initials, todo-file-do, todo-file-done) + (todo-file-item, todo-file-top, todo-header, todo-initial-setup) + (todo-initials, todo-insert-threshold, todo-item-string-start) + (todo-line-string, todo-menu, todo-mode-hook) + (todo-more-important-p, todo-previous-answer, todo-previous-line) + (todo-print-priorities, todo-remove-separator) + (todo-save-top-priorities-too, todo-string-count-lines) + (todo-string-multiline-p, todo-time-string-format) + (todo-tmp-buffer-name): Remove. + (todo-add-file, todo-archive-done-item, todo-choose-archive) + (todo-convert-legacy-files, todo-copy-item, todo-delete-category) + (todo-edit-category-diary-inclusion) + (todo-edit-category-diary-nonmarking, todo-edit-done-item-comment) + (todo-edit-file, todo-edit-item-date-day) + (todo-edit-item-date-day-name, todo-edit-item-date-from-calendar) + (todo-edit-item-date-month, todo-edit-item-date-to-today) + (todo-edit-item-date-year, todo-edit-item-diary-inclusion) + (todo-edit-item-diary-nonmarking, todo-edit-item-header) + (todo-edit-item-time, todo-edit-quit, todo-filter-diary-items) + (todo-filter-diary-items-multifile, todo-filter-regexp-items) + (todo-filter-regexp-items-multifile, todo-filter-top-priorities) + (todo-filter-top-priorities-multifile, todo-find-archive) + (todo-find-filtered-items-file, todo-go-to-source-item) + (todo-insert-item-from-calendar, todo-item-done, todo-item-undone) + (todo-jump-to-archive-category, todo-lower-category) + (todo-mark-category, todo-marked-item-p, todo-merge-category) + (todo-move-category, todo-move-item, todo-next-button) + (todo-next-item, todo-padded-string, todo-powerset) + (todo-previous-button, todo-previous-item) + (todo-print-buffer-to-file, todo-raise-category) + (todo-rename-category, todo-repair-categories-sexp, todo-search) + (todo-set-category-number, todo-set-item-priority) + (todo-set-top-priorities-in-category) + (todo-set-top-priorities-in-file, todo-show-categories-table) + (todo-sort-categories-alphabetically-or-numerically) + (todo-sort-categories-by-archived, todo-sort-categories-by-diary) + (todo-sort-categories-by-done, todo-sort-categories-by-todo) + (todo-toggle-item-header, todo-toggle-item-highlighting) + (todo-toggle-mark-item, todo-toggle-prefix-numbers) + (todo-toggle-view-done-items, todo-toggle-view-done-only) + (todo-unarchive-items, todo-unmark-category): New commands. + (todo-absolute-file-name, todo-add-to-buffer-list) + (todo-adjusted-category-label-length, todo-basic-edit-item-header) + (todo-basic-insert-item, todo-category-completions) + (todo-category-number, todo-category-string-matcher-1) + (todo-category-string-matcher-2, todo-check-filtered-items-file) + (todo-check-format, todo-clear-matches) + (todo-comment-string-matcher, todo-convert-legacy-date-time) + (todo-current-category, todo-date-string-matcher) + (todo-define-insertion-command, todo-diary-expired-matcher) + (todo-diary-goto-entry, todo-diary-item-p) + (todo-diary-nonmarking-matcher, todo-display-as-todo-file) + (todo-display-categories, todo-display-sorted, todo-done-item-p) + (todo-done-item-section-p, todo-done-separator) + (todo-done-string-matcher, todo-files, todo-filter-items) + (todo-filter-items-1, todo-filter-items-filename, todo-find-item) + (todo-gen-arglists, todo-get-count, todo-get-overlay, todo-indent) + (todo-insert-category-line, todo-insert-item-from-calendar) + (todo-insert-sort-button, todo-insert-with-overlays) + (todo-insertion-command-name, todo-insertion-key-bindings) + (todo-label-to-key, todo-longest-category-name-length) + (todo-make-categories-list, todo-mode-external-set) + (todo-mode-line-control, todo-modes-set-1, todo-modes-set-2) + (todo-modes-set-3, todo-multiple-filter-files) + (todo-nondiary-marker-matcher, todo-prefix-overlays) + (todo-read-category, todo-read-date, todo-read-dayname) + (todo-read-file-name, todo-read-time) + (todo-reevaluate-category-completions-files-defcustom) + (todo-reevaluate-default-file-defcustom) + (todo-reevaluate-filelist-defcustoms) + (todo-reevaluate-filter-files-defcustom) + (todo-reset-and-enable-done-separator, todo-reset-comment-string) + (todo-reset-done-separator, todo-reset-done-separator-string) + (todo-reset-done-string, todo-reset-global-current-todo-file) + (todo-reset-highlight-item, todo-reset-nondiary-marker) + (todo-reset-prefix, todo-set-categories) + (todo-set-date-from-calendar, todo-set-show-current-file) + (todo-set-top-priorities, todo-short-file-name) + (todo-show-current-file, todo-sort, todo-time-string-matcher) + (todo-total-item-counts, todo-update-buffer-list) + (todo-update-categories-display, todo-update-categories-sexp) + (todo-update-count, todo-validate-name, todo-y-or-n-p): + New functions. + (todo-archive-mode, todo-categories-mode, todo-filtered-items-mode): + New major modes. + (todo-categories, todo-display, todo-edit, todo-faces) + (todo-filtered): New defgroups. + (todo-archived-only, todo-button, todo-category-string, todo-date) + (todo-diary-expired, todo-done, todo-done-sep, todo-comment) + (todo-mark, todo-nondiary, todo-prefix-string, todo-search) + (todo-sorted-column, todo-time, todo-top-priority): New deffaces. + (todo-add-item-if-new-category, todo-always-add-time-string) + (todo-categories-align, todo-categories-archived-label) + (todo-categories-category-label, todo-categories-diary-label) + (todo-categories-done-label, todo-categories-number-separator) + (todo-categories-todo-label, todo-categories-totals-label) + (todo-category-completions-files, todo-completion-ignore-case) + (todo-default-todo-file, todo-diary-nonmarking, todo-directory) + (todo-done-separator-string, todo-done-string) + (todo-files-function, todo-filter-done-items, todo-filter-files) + (todo-highlight-item, todo-include-in-diary, todo-indent-to-here) + (todo-initial-category, todo-initial-file, todo-item-mark) + (todo-legacy-date-time-regexp, todo-mode-line-function) + (todo-nondiary-marker, todo-number-prefix) + (todo-print-buffer-function, todo-show-current-file) + (todo-show-done-only, todo-show-first, todo-show-with-done) + (todo-skip-archived-categories, todo-top-priorities-overrides) + (todo-undo-item-omit-comment, todo-use-only-highlighted-region) + (todo-visit-files-commands, todo-wrap-lines, todo-y-with-space): + New defcustoms. + (todo-category-done, todo-date-pattern, todo-date-string-start) + (todo-diary-items-buffer, todo-done-string-start) + (todo-filtered-items-buffer, todo-item-start) + (todo-month-abbrev-array, todo-month-name-array) + (todo-nondiary-end, todo-nondiary-start, todo-regexp-items-buffer) + (todo-top-priorities-buffer): New defconsts. + (todo-archive-mode-map, todo-archives, todo-categories-mode-map) + (todo-categories-with-marks, todo-category-string-face) + (todo-comment-face, todo-comment-string, todo-current-todo-file) + (todo-date-face, todo-date-from-calendar, todo-descending-counts) + (todo-diary-expired-face, todo-done-face, todo-done-sep-face) + (todo-done-separator, todo-edit-buffer, todo-edit-mode-map) + (todo-file-buffers, todo-files, todo-filtered-items-mode-map) + (todo-font-lock-keywords, todo-global-current-todo-file) + (todo-insertion-commands, todo-insertion-commands-arg-key-list) + (todo-insertion-commands-args) + (todo-insertion-commands-args-genlist) + (todo-insertion-commands-names, todo-insertion-map) + (todo-key-bindings-t, todo-key-bindings-t+a) + (todo-key-bindings-t+a+f, todo-key-bindings-t+f, todo-mode-map) + (todo-multiple-filter-files, todo-multiple-filter-files-widget) + (todo-nondiary-face, todo-print-buffer, todo-time-face) + (todo-visited): New variables. + 2013-06-21 Glenn Morris * play/cookie1.el (cookie-apropos): Add optional display argument. === modified file 'lisp/calendar/diary-lib.el' --- lisp/calendar/diary-lib.el 2013-05-12 01:34:30 +0000 +++ lisp/calendar/diary-lib.el 2013-06-18 16:05:01 +0000 @@ -1032,7 +1032,14 @@ (define-obsolete-function-alias 'simple-diary-display 'diary-simple-display "23.1") -(define-button-type 'diary-entry 'action #'diary-goto-entry +(defvar diary-goto-entry-function 'diary-goto-entry + "Function called to jump to a diary entry. +Modes that require special handling of the included file +containing the diary entry can assign a suitable function to this +variable.") + +(define-button-type 'diary-entry + 'action (lambda (button) (funcall diary-goto-entry-function button)) 'face 'diary-button 'help-echo "Find this diary entry" 'follow-link t) === added file 'lisp/calendar/todo-mode.el' --- lisp/calendar/todo-mode.el 1970-01-01 00:00:00 +0000 +++ lisp/calendar/todo-mode.el 2013-06-21 14:07:46 +0000 @@ -0,0 +1,6390 @@ +;;; todo-mode.el --- facilities for making and maintaining todo lists + +;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc. + +;; Author: Oliver Seidel +;; Stephen Berman +;; Maintainer: Stephen Berman +;; Keywords: calendar, todo + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This package provides facilities for making, displaying, navigating +;; and editing todo lists, which are prioritized lists of todo items. +;; Todo lists are identified with named categories, so you can group +;; together and separately prioritize thematically related todo items. +;; Each category is stored in a file, which thus provides a further +;; level of organization. You can create as many todo files, and in +;; each as many categories, as you want. + +;; With Todo mode you can navigate among the items of a category, and +;; between categories in the same and in different todo files. You +;; can edit todo items, reprioritize them within their category, move +;; them to another category, delete them, or mark items as done and +;; store them separately from the not yet done items in a category. +;; You can add new todo files and categories, rename categories, move +;; them to another file or delete them. You can also display summary +;; tables of the categories in a file and the types of items they +;; contain. And you can build cross-categorial lists of items that +;; satisfy various criteria. + +;; To get started, load this package and type `M-x todo-show'. This +;; will prompt you for the name of the first todo file, its first +;; category and the category's first item, create these and display +;; them in Todo mode. Now you can insert further items into the list +;; (i.e., the category) and assign them priorities by typing `i i'. + +;; You will probably find it convenient to give `todo-show' a global +;; key binding in your init file, since it is one of the entry points +;; to Todo mode; a good choice is `C-c t', since `todo-show' is +;; bound to `t' in Todo mode. + +;; To see a list of all Todo mode commands and their key bindings, +;; including other entry points, type `C-h m' in Todo mode. Consult +;; the documentation strings of the commands for details of their use. +;; The `todo' customization group and its subgroups list the options +;; you can set to alter the behavior of many commands and various +;; aspects of the display. + +;; This package is a new version of Oliver Seidel's todo-mode.el. +;; While it retains the same basic organization and handling of todo +;; lists and the basic UI, it significantly extends these and adds +;; many features. This required also making changes to the internals, +;; including the file format. If you have a todo file in old format, +;; then the first time you invoke `todo-show' (i.e., before you have +;; created any todo file in the current format), it will ask you +;; whether to convert that file and show it. If you choose not to +;; convert the old-style file at this time, you can do so later by +;; calling the command `todo-convert-legacy-files'. + +;;; Code: + +(require 'diary-lib) +;; For cl-remove-duplicates (in todo-insertion-commands-args) and +;; cl-oddp. +(require 'cl-lib) + +;; ----------------------------------------------------------------------------- +;;; Setting up todo files, categories, and items +;; ----------------------------------------------------------------------------- + +(defcustom todo-directory (locate-user-emacs-file "todo/") + "Directory where user's todo files are saved." + :type 'directory + :group 'todo) + +(defun todo-files (&optional archives) + "Default value of `todo-files-function'. +This returns the case-insensitive alphabetically sorted list of +file truenames in `todo-directory' with the extension +\".todo\". With non-nil ARCHIVES return the list of archive file +truenames (those with the extension \".toda\")." + (let ((files (if (file-exists-p todo-directory) + (mapcar 'file-truename + (directory-files todo-directory t + (if archives "\.toda$" "\.todo$") t))))) + (sort files (lambda (s1 s2) (let ((cis1 (upcase s1)) + (cis2 (upcase s2))) + (string< cis1 cis2)))))) + +(defcustom todo-files-function 'todo-files + "Function returning the value of the variable `todo-files'. +This function should take an optional argument that, if non-nil, +makes it return the value of the variable `todo-archives'." + :type 'function + :group 'todo) + +(defvar todo-files (funcall todo-files-function) + "List of truenames of user's todo files.") + +(defvar todo-archives (funcall todo-files-function t) + "List of truenames of user's todo archives.") + +(defvar todo-visited nil + "List of todo files visited in this session by `todo-show'. +Used to determine initial display according to the value of +`todo-show-first'.") + +(defvar todo-file-buffers nil + "List of file names of live Todo mode buffers.") + +(defvar todo-global-current-todo-file nil + "Variable holding name of current todo file. +Used by functions called from outside of Todo mode to visit the +current todo file rather than the default todo file (i.e. when +users option `todo-show-current-file' is non-nil).") + +(defvar todo-current-todo-file nil + "Variable holding the name of the currently active todo file.") + +(defvar todo-categories nil + "Alist of categories in the current todo file. +The elements are cons cells whose car is a category name and +whose cdr is a vector of the category's item counts. These are, +in order, the numbers of todo items, of todo items included in +the Diary, of done items and of archived items.") + +(defvar todo-category-number 1 + "Variable holding the number of the current todo category. +Todo categories are numbered starting from 1.") + +(defvar todo-categories-with-marks nil + "Alist of categories and number of marked items they contain.") + +(defconst todo-category-beg "--==-- " + "String marking beginning of category (inserted with its name).") + +(defconst todo-category-done "==--== DONE " + "String marking beginning of category's done items.") + +(defcustom todo-done-separator-string "=" + "String determining the value of variable `todo-done-separator'. +If the string consists of a single character, +`todo-done-separator' will be the string made by repeating this +character for the width of the window, and the length is +automatically recalculated when the window width changes. If the +string consists of more (or less) than one character, it will be +the value of `todo-done-separator'." + :type 'string + :initialize 'custom-initialize-default + :set 'todo-reset-done-separator-string + :group 'todo-display) + +(defun todo-done-separator () + "Return string used as value of variable `todo-done-separator'." + (let ((sep todo-done-separator-string)) + (propertize (if (= 1 (length sep)) + ;; Until bug#2749 is fixed, if separator's length + ;; is window-width and todo-wrap-lines is + ;; non-nil, an indented empty line appears between + ;; the separator and the first done item. + ;; (make-string (window-width) (string-to-char sep)) + (make-string (1- (window-width)) (string-to-char sep)) + todo-done-separator-string) + 'face 'todo-done-sep))) + +(defvar todo-done-separator (todo-done-separator) + "String used to visually separate done from not done items. +Displayed as an overlay instead of `todo-category-done' when +done items are shown. Its value is determined by user option +`todo-done-separator-string'.") + +(defvar todo-show-done-only nil + "If non-nil display only done items in current category. +Set by the command `todo-toggle-view-done-only' and used by +`todo-category-select'.") + +(defcustom todo-nondiary-marker '("[" "]") + "List of strings surrounding item date to block diary inclusion. +The first string is inserted before the item date and must be a +non-empty string that does not match a diary date in order to +have its intended effect. The second string is inserted after +the diary date." + :type '(list string string) + :group 'todo-edit + :initialize 'custom-initialize-default + :set 'todo-reset-nondiary-marker) + +(defconst todo-nondiary-start (nth 0 todo-nondiary-marker) + "String inserted before item date to block diary inclusion.") + +(defconst todo-nondiary-end (nth 1 todo-nondiary-marker) + "String inserted after item date matching `todo-nondiary-start'.") + +(defconst todo-month-name-array + (vconcat calendar-month-name-array (vector "*")) + "Array of month names, in order. +The final element is \"*\", indicating an unspecified month.") + +(defconst todo-month-abbrev-array + (vconcat calendar-month-abbrev-array (vector "*")) + "Array of abbreviated month names, in order. +The final element is \"*\", indicating an unspecified month.") + +(defconst todo-date-pattern + (let ((dayname (diary-name-pattern calendar-day-name-array nil t))) + (concat "\\(?4:\\(?5:" dayname "\\)\\|" + (let ((dayname) + (monthname (format "\\(?6:%s\\)" (diary-name-pattern + todo-month-name-array + todo-month-abbrev-array))) + (month "\\(?7:[0-9]+\\|\\*\\)") + (day "\\(?8:[0-9]+\\|\\*\\)") + (year "-?\\(?9:[0-9]+\\|\\*\\)")) + (mapconcat 'eval calendar-date-display-form "")) + "\\)")) + "Regular expression matching a todo item date header.") + +;; By itself this matches anything, because of the `?'; however, it's only +;; used in the context of `todo-date-pattern' (but Emacs Lisp lacks +;; lookahead). +(defconst todo-date-string-start + (concat "^\\(" (regexp-quote todo-nondiary-start) "\\|" + (regexp-quote diary-nonmarking-symbol) "\\)?") + "Regular expression matching part of item header before the date.") + +(defcustom todo-done-string "DONE " + "Identifying string appended to the front of done todo items." + :type 'string + :initialize 'custom-initialize-default + :set 'todo-reset-done-string + :group 'todo-edit) + +(defconst todo-done-string-start + (concat "^\\[" (regexp-quote todo-done-string)) + "Regular expression matching start of done item.") + +(defconst todo-item-start (concat "\\(" todo-date-string-start "\\|" + todo-done-string-start "\\)" + todo-date-pattern) + "String identifying start of a todo item.") + +;; ----------------------------------------------------------------------------- +;;; Todo mode display options +;; ----------------------------------------------------------------------------- + +(defcustom todo-prefix "" + "String prefixed to todo items for visual distinction." + :type '(string :validate + (lambda (widget) + (when (string= (widget-value widget) todo-item-mark) + (widget-put + widget :error + "Invalid value: must be distinct from `todo-item-mark'") + widget))) + :initialize 'custom-initialize-default + :set 'todo-reset-prefix + :group 'todo-display) + +(defcustom todo-number-prefix t + "Non-nil to prefix items with consecutively increasing integers. +These reflect the priorities of the items in each category." + :type 'boolean + :initialize 'custom-initialize-default + :set 'todo-reset-prefix + :group 'todo-display) + +(defun todo-mode-line-control (cat) + "Return a mode line control for todo or archive file buffers. +Argument CAT is the name of the current todo category. +This function is the value of the user variable +`todo-mode-line-function'." + (let ((file (todo-short-file-name todo-current-todo-file))) + (format "%s category %d: %s" file todo-category-number cat))) + +(defcustom todo-mode-line-function 'todo-mode-line-control + "Function that returns a mode line control for Todo mode buffers. +The function expects one argument holding the name of the current +todo category. The resulting control becomes the local value of +`mode-line-buffer-identification' in each Todo mode buffer." + :type 'function + :group 'todo-display) + +(defcustom todo-highlight-item nil + "Non-nil means highlight items at point." + :type 'boolean + :initialize 'custom-initialize-default + :set 'todo-reset-highlight-item + :group 'todo-display) + +(defcustom todo-wrap-lines t + "Non-nil to activate Visual Line mode and use wrap prefix." + :type 'boolean + :group 'todo-display) + +(defcustom todo-indent-to-here 3 + "Number of spaces to indent continuation lines of items. +This must be a positive number to ensure such items are fully +shown in the Fancy Diary display." + :type '(integer :validate + (lambda (widget) + (unless (> (widget-value widget) 0) + (widget-put widget :error + "Invalid value: must be a positive integer") + widget))) + :group 'todo-display) + +(defun todo-indent () + "Indent from point to `todo-indent-to-here'." + (indent-to todo-indent-to-here todo-indent-to-here)) + +(defcustom todo-show-with-done nil + "Non-nil to display done items in all categories." + :type 'boolean + :group 'todo-display) + +;; ----------------------------------------------------------------------------- +;;; Faces +;; ----------------------------------------------------------------------------- + +(defface todo-mark + ;; '((t :inherit font-lock-warning-face)) + '((((class color) + (min-colors 88) + (background light)) + (:weight bold :foreground "Red1")) + (((class color) + (min-colors 88) + (background dark)) + (:weight bold :foreground "Pink")) + (((class color) + (min-colors 16) + (background light)) + (:weight bold :foreground "Red1")) + (((class color) + (min-colors 16) + (background dark)) + (:weight bold :foreground "Pink")) + (((class color) + (min-colors 8)) + (:foreground "red")) + (t + (:weight bold :inverse-video t))) + "Face for marks on marked items." + :group 'todo-faces) + +(defface todo-prefix-string + ;; '((t :inherit font-lock-constant-face)) + '((((class grayscale) (background light)) + (:foreground "LightGray" :weight bold :underline t)) + (((class grayscale) (background dark)) + (:foreground "Gray50" :weight bold :underline t)) + (((class color) (min-colors 88) (background light)) (:foreground "dark cyan")) + (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine")) + (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) + (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) + (((class color) (min-colors 8)) (:foreground "magenta")) + (t (:weight bold :underline t))) + "Face for todo item prefix or numerical priority string." + :group 'todo-faces) + +(defface todo-top-priority + ;; bold font-lock-comment-face + '((default :weight bold) + (((class grayscale) (background light)) :foreground "DimGray" :slant italic) + (((class grayscale) (background dark)) :foreground "LightGray" :slant italic) + (((class color) (min-colors 88) (background light)) :foreground "Firebrick") + (((class color) (min-colors 88) (background dark)) :foreground "chocolate1") + (((class color) (min-colors 16) (background light)) :foreground "red") + (((class color) (min-colors 16) (background dark)) :foreground "red1") + (((class color) (min-colors 8) (background light)) :foreground "red") + (((class color) (min-colors 8) (background dark)) :foreground "yellow") + (t :slant italic)) + "Face for top priority todo item numerical priority string. +The item's priority number string has this face if the number is +less than or equal the category's top priority setting." + :group 'todo-faces) + +(defface todo-nondiary + ;; '((t :inherit font-lock-type-face)) + '((((class grayscale) (background light)) :foreground "Gray90" :weight bold) + (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "ForestGreen") + (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen") + (((class color) (min-colors 16) (background light)) :foreground "ForestGreen") + (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen") + (((class color) (min-colors 8)) :foreground "green") + (t :weight bold :underline t)) + "Face for non-diary markers around todo item date/time header." + :group 'todo-faces) + +(defface todo-date + '((t :inherit diary)) + "Face for the date string of a todo item." + :group 'todo-faces) + +(defface todo-time + '((t :inherit diary-time)) + "Face for the time string of a todo item." + :group 'todo-faces) + +(defface todo-diary-expired + ;; Doesn't contrast enough with todo-date (= diary) face. + ;; ;; '((t :inherit warning)) + ;; '((default :weight bold) + ;; (((class color) (min-colors 16)) :foreground "DarkOrange") + ;; (((class color)) :foreground "yellow")) + ;; bold font-lock-function-name-face + '((default :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "Blue1") + (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue") + (((class color) (min-colors 16) (background light)) :foreground "Blue") + (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue") + (((class color) (min-colors 8)) :foreground "blue") + (t :inverse-video t)) + "Face for expired dates of diary items." + :group 'todo-faces) + +(defface todo-done-sep + ;; '((t :inherit font-lock-builtin-face)) + '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) + (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "dark slate blue") + (((class color) (min-colors 88) (background dark)) :foreground "LightSteelBlue") + (((class color) (min-colors 16) (background light)) :foreground "Orchid") + (((class color) (min-colors 16) (background dark)) :foreground "LightSteelBlue") + (((class color) (min-colors 8)) :foreground "blue" :weight bold) + (t :weight bold)) + "Face for separator string bewteen done and not done todo items." + :group 'todo-faces) + +(defface todo-done + ;; '((t :inherit font-lock-keyword-face)) + '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) + (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "Purple") + (((class color) (min-colors 88) (background dark)) :foreground "Cyan1") + (((class color) (min-colors 16) (background light)) :foreground "Purple") + (((class color) (min-colors 16) (background dark)) :foreground "Cyan") + (((class color) (min-colors 8)) :foreground "cyan" :weight bold) + (t :weight bold)) + "Face for done todo item header string." + :group 'todo-faces) + +(defface todo-comment + ;; '((t :inherit font-lock-comment-face)) + '((((class grayscale) (background light)) + :foreground "DimGray" :weight bold :slant italic) + (((class grayscale) (background dark)) + :foreground "LightGray" :weight bold :slant italic) + (((class color) (min-colors 88) (background light)) + :foreground "Firebrick") + (((class color) (min-colors 88) (background dark)) + :foreground "chocolate1") + (((class color) (min-colors 16) (background light)) + :foreground "red") + (((class color) (min-colors 16) (background dark)) + :foreground "red1") + (((class color) (min-colors 8) (background light)) + :foreground "red") + (((class color) (min-colors 8) (background dark)) + :foreground "yellow") + (t :weight bold :slant italic)) + "Face for comments appended to done todo items." + :group 'todo-faces) + +(defface todo-search + ;; '((t :inherit match)) + '((((class color) + (min-colors 88) + (background light)) + (:background "yellow1")) + (((class color) + (min-colors 88) + (background dark)) + (:background "RoyalBlue3")) + (((class color) + (min-colors 8) + (background light)) + (:foreground "black" :background "yellow")) + (((class color) + (min-colors 8) + (background dark)) + (:foreground "white" :background "blue")) + (((type tty) + (class mono)) + (:inverse-video t)) + (t + (:background "gray"))) + "Face for matches found by `todo-search'." + :group 'todo-faces) + +(defface todo-button + ;; '((t :inherit widget-field)) + '((((type tty)) + (:foreground "black" :background "yellow3")) + (((class grayscale color) + (background light)) + (:background "gray85")) + (((class grayscale color) + (background dark)) + (:background "dim gray")) + (t + (:slant italic))) + "Face for buttons in table of categories." + :group 'todo-faces) + +(defface todo-sorted-column + '((((type tty)) + (:inverse-video t)) + (((class color) + (background light)) + (:background "grey85")) + (((class color) + (background dark)) + (:background "grey85" :foreground "grey10")) + (t + (:background "gray"))) + "Face for sorted column in table of categories." + :group 'todo-faces) + +(defface todo-archived-only + ;; '((t (:inherit (shadow)))) + '((((class color) + (background light)) + (:foreground "grey50")) + (((class color) + (background dark)) + (:foreground "grey70")) + (t + (:foreground "gray"))) + "Face for archived-only category names in table of categories." + :group 'todo-faces) + +(defface todo-category-string + ;; '((t :inherit font-lock-type-face)) + '((((class grayscale) (background light)) :foreground "Gray90" :weight bold) + (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) + (((class color) (min-colors 88) (background light)) :foreground "ForestGreen") + (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen") + (((class color) (min-colors 16) (background light)) :foreground "ForestGreen") + (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen") + (((class color) (min-colors 8)) :foreground "green") + (t :weight bold :underline t)) + "Face for category-file header in Todo Filtered Items mode." + :group 'todo-faces) + +;; ----------------------------------------------------------------------------- +;;; Entering and exiting +;; ----------------------------------------------------------------------------- + +(defcustom todo-visit-files-commands (list 'find-file 'dired-find-file) + "List of file finding commands for `todo-display-as-todo-file'. +Invoking these commands to visit a todo file or todo archive file +calls `todo-show' or `todo-find-archive', so that the file is +displayed correctly." + :type '(repeat function) + :group 'todo) + +(defun todo-short-file-name (file) + "Return the short form of todo file FILE's name. +This lacks the extension and directory components." + (when (stringp file) + (file-name-sans-extension (file-name-nondirectory file)))) + +(defcustom todo-default-todo-file (todo-short-file-name + (car (funcall todo-files-function))) + "Todo file visited by first session invocation of `todo-show'." + :type `(radio ,@(mapcar (lambda (f) (list 'const f)) + (mapcar 'todo-short-file-name + (funcall todo-files-function)))) + :group 'todo) + +(defcustom todo-show-current-file t + "Non-nil to make `todo-show' visit the current todo file. +Otherwise, `todo-show' always visits `todo-default-todo-file'." + :type 'boolean + :initialize 'custom-initialize-default + :set 'todo-set-show-current-file + :group 'todo) + +(defcustom todo-show-first 'first + "What action to take on first use of `todo-show' on a file." + :type '(choice (const :tag "Show first category" first) + (const :tag "Show table of categories" table) + (const :tag "Show top priorities" top) + (const :tag "Show diary items" diary) + (const :tag "Show regexp items" regexp)) + :group 'todo) + +(defcustom todo-add-item-if-new-category t + "Non-nil to prompt for an item after adding a new category." + :type 'boolean + :group 'todo-edit) + +(defcustom todo-initial-file "Todo" + "Default file name offered on adding first todo file." + :type 'string + :group 'todo) + +(defcustom todo-initial-category "Todo" + "Default category name offered on initializing a new todo file." + :type 'string + :group 'todo) + +(defcustom todo-category-completions-files nil + "List of files for building `todo-read-category' completions." + :type `(set ,@(mapcar (lambda (f) (list 'const f)) + (mapcar 'todo-short-file-name + (funcall todo-files-function)))) + :group 'todo) + +(defcustom todo-completion-ignore-case nil + "Non-nil means case is ignored by `todo-read-*' functions." + :type 'boolean + :group 'todo) + +;;;###autoload +(defun todo-show (&optional solicit-file) + "Visit a todo file and display one of its categories. + +When invoked in Todo mode, prompt for which todo file to visit. +When invoked outside of Todo mode with non-nil prefix argument +SOLICIT-FILE prompt for which todo file to visit; otherwise visit +`todo-default-todo-file'. Subsequent invocations from outside +of Todo mode revisit this file or, with option +`todo-show-current-file' non-nil (the default), whichever todo +file was last visited. + +If you call this command before you have created any todo file in +the current format, and you have an todo file in old format, it +will ask you whether to convert that file and show it. +Otherwise, calling this command before any todo file exists +prompts for a file name and an initial category (defaulting to +`todo-initial-file' and `todo-initial-category'), creates both of +these, visits the file and displays the category, and if option +`todo-add-item-if-new-category' is non-nil (the default), prompts +for the first item. + +The first invocation of this command on an existing todo file +interacts with the option `todo-show-first': if its value is +`first' (the default), show the first category in the file; if +its value is `table', show the table of categories in the file; +if its value is one of `top', `diary' or `regexp', show the +corresponding saved top priorities, diary items, or regexp items +file, if any. Subsequent invocations always show the file's +current (i.e., last displayed) category. + +In Todo mode just the category's unfinished todo items are shown +by default. The done items are hidden, but typing +`\\[todo-toggle-view-done-items]' displays them below the todo +items. With non-nil user option `todo-show-with-done' both todo +and done items are always shown on visiting a category. + +Invoking this command in Todo Archive mode visits the +corresponding todo file, displaying the corresponding category." + (interactive "P") + (catch 'shown + ;; If there is a legacy todo file but no todo file in the current + ;; format, offer to convert the legacy file and show it. + (unless todo-default-todo-file + (let ((legacy-todo-file (if (boundp 'todo-file-do) + todo-file-do + (locate-user-emacs-file "todo-do" ".todo-do")))) + (when (and (file-exists-p legacy-todo-file) + (y-or-n-p (concat "Do you want to convert a copy of your " + "old todo file to the new format? "))) + (when (todo-convert-legacy-files) + (throw 'shown nil))))) + (let* ((cat) + (show-first todo-show-first) + (file (cond ((or solicit-file + (and (called-interactively-p 'any) + (memq major-mode '(todo-mode + todo-archive-mode + todo-filtered-items-mode)))) + (if (funcall todo-files-function) + (todo-read-file-name "Choose a todo file to visit: " + nil t) + (user-error "There are no todo files"))) + ((and (eq major-mode 'todo-archive-mode) + ;; Called noninteractively via todo-quit + ;; to jump to corresponding category in + ;; todo file. + (not (called-interactively-p 'any))) + (setq cat (todo-current-category)) + (concat (file-name-sans-extension + todo-current-todo-file) ".todo")) + (t + (or todo-current-todo-file + (and todo-show-current-file + todo-global-current-todo-file) + (todo-absolute-file-name todo-default-todo-file) + (todo-add-file))))) + add-item first-file) + (unless todo-default-todo-file + ;; We just initialized the first todo file, so make it the default. + (setq todo-default-todo-file (todo-short-file-name file) + first-file t) + (todo-reevaluate-default-file-defcustom)) + (unless (member file todo-visited) + ;; Can't setq t-c-t-f here, otherwise wrong file shown when + ;; todo-show is called from todo-show-categories-table. + (let ((todo-current-todo-file file)) + (cond ((eq todo-show-first 'table) + (todo-show-categories-table)) + ((memq todo-show-first '(top diary regexp)) + (let* ((shortf (todo-short-file-name file)) + (fi-file (todo-absolute-file-name + shortf todo-show-first))) + (when (eq todo-show-first 'regexp) + (let ((rxfiles (directory-files todo-directory t + ".*\\.todr$" t))) + (when (and rxfiles (> (length rxfiles) 1)) + (let ((rxf (mapcar 'todo-short-file-name rxfiles))) + (setq fi-file (todo-absolute-file-name + (completing-read + "Choose a regexp items file: " + rxf) 'regexp)))))) + (if (file-exists-p fi-file) + (set-window-buffer + (selected-window) + (set-buffer (find-file-noselect fi-file 'nowarn))) + (message "There is no %s file for %s" + (cond ((eq todo-show-first 'top) + "top priorities") + ((eq todo-show-first 'diary) + "diary items") + ((eq todo-show-first 'regexp) + "regexp items")) + shortf) + (setq todo-show-first 'first))))))) + (when (or (member file todo-visited) + (eq todo-show-first 'first)) + (set-window-buffer (selected-window) + (set-buffer (find-file-noselect file 'nowarn))) + ;; When quitting an archive file, show the corresponding + ;; category in the corresponding todo file, if it exists. + (when (assoc cat todo-categories) + (setq todo-category-number (todo-category-number cat))) + ;; If this is a new todo file, add its first category. + (when (zerop (buffer-size)) + (let (cat-added) + (unwind-protect + (setq todo-category-number + (todo-add-category todo-current-todo-file "") + add-item todo-add-item-if-new-category + cat-added t) + (if cat-added + ;; If the category was added, save the file now, so we + ;; don't risk having an empty todo file, which would + ;; signal an error if we tried to visit it later, + ;; since doing that looks for category boundaries. + (save-buffer 0) + ;; If user cancels before adding the category, clean up + ;; and exit, so we have a fresh slate the next time. + (delete-file file) + (setq todo-files (delete file todo-files)) + (when first-file + (setq todo-default-todo-file nil + todo-current-todo-file nil)) + (kill-buffer) + (keyboard-quit))))) + (save-excursion (todo-category-select)) + (when add-item (todo-basic-insert-item))) + (setq todo-show-first show-first) + (add-to-list 'todo-visited file)))) + +(defun todo-save () + "Save the current todo file." + (interactive) + (cond ((eq major-mode 'todo-filtered-items-mode) + (todo-check-filtered-items-file) + (todo-save-filtered-items-buffer)) + (t + (save-buffer)))) + +(defvar todo-descending-counts) + +(defun todo-quit () + "Exit the current Todo-related buffer. +Depending on the specific mode, this either kills the buffer or +buries it and restores state as needed." + (interactive) + (let ((buf (current-buffer))) + (cond ((eq major-mode 'todo-categories-mode) + ;; Postpone killing buffer till after calling todo-show, to + ;; prevent killing todo-mode buffer. + (setq todo-descending-counts nil) + ;; Ensure todo-show calls todo-show-categories-table only on + ;; first invocation per file. + (when (eq todo-show-first 'table) + (add-to-list 'todo-visited todo-current-todo-file)) + (todo-show) + (kill-buffer buf)) + ((eq major-mode 'todo-filtered-items-mode) + (kill-buffer) + (unless (eq major-mode 'todo-mode) (todo-show))) + ((eq major-mode 'todo-archive-mode) + ;; Have to write a newly created archive to file to avoid + ;; subsequent errors. + (todo-save) + (todo-show) + (bury-buffer buf)) + ((eq major-mode 'todo-mode) + (todo-save) + ;; If we just quit archive mode, just burying the buffer + ;; in todo-mode would return to archive. + (set-window-buffer (selected-window) + (set-buffer (other-buffer))) + (bury-buffer buf))))) + +;; ----------------------------------------------------------------------------- +;;; Navigation between and within categories +;; ----------------------------------------------------------------------------- + +(defcustom todo-skip-archived-categories nil + "Non-nil to handle categories with only archived items specially. + +Sequential category navigation using \\[todo-forward-category] +or \\[todo-backward-category] skips categories that contain only +archived items. Other commands still recognize these categories. +In Todo Categories mode (\\[todo-show-categories-table]) these +categories shown in `todo-archived-only' face and pressing the +category button visits the category in the archive instead of the +todo file." + :type 'boolean + :group 'todo-display) + +(defun todo-forward-category (&optional back) + "Visit the numerically next category in this todo file. +If the current category is the highest numbered, visit the first +category. With non-nil argument BACK, visit the numerically +previous category (the highest numbered one, if the current +category is the first)." + (interactive) + (setq todo-category-number + (1+ (mod (- todo-category-number (if back 2 0)) + (length todo-categories)))) + (when todo-skip-archived-categories + (while (and (zerop (todo-get-count 'todo)) + (zerop (todo-get-count 'done)) + (not (zerop (todo-get-count 'archived)))) + (setq todo-category-number + (apply (if back '1- '1+) (list todo-category-number))))) + (todo-category-select) + (goto-char (point-min))) + +(defun todo-backward-category () + "Visit the numerically previous category in this todo file. +If the current category is the highest numbered, visit the first +category." + (interactive) + (todo-forward-category t)) + +(defvar todo-categories-buffer) + +(defun todo-jump-to-category (&optional file where) + "Prompt for a category in a todo file and jump to it. + +With non-nil FILE (interactively a prefix argument), prompt for a +specific todo file and choose (with TAB completion) a category +in it to jump to; otherwise, choose and jump to any category in +either the current todo file or a file in +`todo-category-completions-files'. + +Also accept a non-existing category name and ask whether to add a +new category by that name; on confirmation, add it and jump to +that category, and if option `todo-add-item-if-new-category' is +non-nil (the default), then prompt for the first item. + +In noninteractive calls non-nil WHERE specifies either the goal +category or its file. If its value is `archive', the choice of +categories is restricted to the current archive file or the +archive you were prompted to choose; this is used by +`todo-jump-to-archive-category'. If its value is the name of a +category, jump directly to that category; this is used in Todo +Categories mode." + (interactive "P") + ;; If invoked outside of Todo mode and there is not yet any Todo + ;; file, initialize one. + (if (null todo-files) + (todo-show) + (let* ((archive (eq where 'archive)) + (cat (unless archive where)) + (file0 (when cat ; We're in Todo Categories mode. + ;; With non-nil `todo-skip-archived-categories' + ;; jump to archive file of a category with only + ;; archived items. + (if (and todo-skip-archived-categories + (zerop (todo-get-count 'todo cat)) + (zerop (todo-get-count 'done cat)) + (not (zerop (todo-get-count 'archived cat)))) + (concat (file-name-sans-extension + todo-current-todo-file) ".toda") + ;; Otherwise, jump to current todo file. + todo-current-todo-file))) + (len (length todo-categories)) + (cat+file (unless cat + (todo-read-category "Jump to category: " + (if archive 'archive) file))) + (add-item (and todo-add-item-if-new-category + (> (length todo-categories) len))) + (category (or cat (car cat+file)))) + (unless cat (setq file0 (cdr cat+file))) + (with-current-buffer (find-file-noselect file0 'nowarn) + (setq todo-current-todo-file file0) + ;; If called from Todo Categories mode, clean up before jumping. + (if (string= (buffer-name) todo-categories-buffer) + (kill-buffer)) + (set-window-buffer (selected-window) + (set-buffer (find-buffer-visiting file0))) + (unless todo-global-current-todo-file + (setq todo-global-current-todo-file todo-current-todo-file)) + (todo-category-number category) + (todo-category-select) + (goto-char (point-min)) + (when add-item (todo-basic-insert-item)))))) + +(defun todo-next-item (&optional count) + "Move point down to the beginning of the next item. +With positive numerical prefix COUNT, move point COUNT items +downward. + +If the category's done items are hidden, this command also moves +point to the empty line below the last todo item from any higher +item in the category, i.e., when invoked with or without a prefix +argument. If the category's done items are visible, this command +called with a prefix argument only moves point to a lower item, +e.g., with point on the last todo item and called with prefix 1, +it moves point to the first done item; but if called with point +on the last todo item without a prefix argument, it moves point +the the empty line above the done items separator." + (interactive "p") + ;; It's not worth the trouble to allow prefix arg value < 1, since + ;; we have the corresponding command. + (cond ((and current-prefix-arg (< count 1)) + (user-error "The prefix argument must be a positive number")) + (current-prefix-arg + (todo-forward-item count)) + (t + (todo-forward-item)))) + +(defun todo-previous-item (&optional count) + "Move point up to start of item with next higher priority. +With positive numerical prefix COUNT, move point COUNT items +upward. + +If the category's done items are visible, this command called +with a prefix argument only moves point to a higher item, e.g., +with point on the first done item and called with prefix 1, it +moves to the last todo item; but if called with point on the +first done item without a prefix argument, it moves point the the +empty line above the done items separator." + (interactive "p") + ;; Avoid moving to bob if on the first item but not at bob. + (when (> (line-number-at-pos) 1) + ;; It's not worth the trouble to allow prefix arg value < 1, since + ;; we have the corresponding command. + (cond ((and current-prefix-arg (< count 1)) + (user-error "The prefix argument must be a positive number")) + (current-prefix-arg + (todo-backward-item count)) + (t + (todo-backward-item))))) + +;; ----------------------------------------------------------------------------- +;;; Display toggle commands +;; ----------------------------------------------------------------------------- + +(defun todo-toggle-prefix-numbers () + "Hide item numbering if shown, show if hidden." + (interactive) + (save-excursion + (save-restriction + (goto-char (point-min)) + (let* ((ov (todo-get-overlay 'prefix)) + (show-done (re-search-forward todo-done-string-start nil t)) + (todo-show-with-done show-done) + (todo-number-prefix (not (equal (overlay-get ov 'before-string) + "1 ")))) + (if (eq major-mode 'todo-filtered-items-mode) + (todo-prefix-overlays) + (todo-category-select)))))) + +(defun todo-toggle-view-done-items () + "Show hidden or hide visible done items in current category." + (interactive) + (if (zerop (todo-get-count 'done (todo-current-category))) + (message "There are no done items in this category.") + (let ((opoint (point))) + (goto-char (point-min)) + (let* ((shown (re-search-forward todo-done-string-start nil t)) + (todo-show-with-done (not shown))) + (todo-category-select) + (goto-char opoint) + ;; If start of done items sections is below the bottom of the + ;; window, make it visible. + (unless shown + (setq shown (progn + (goto-char (point-min)) + (re-search-forward todo-done-string-start nil t))) + (if (not (pos-visible-in-window-p shown)) + (recenter) + (goto-char opoint))))))) + +(defun todo-toggle-view-done-only () + "Switch between displaying only done or only todo items." + (interactive) + (setq todo-show-done-only (not todo-show-done-only)) + (todo-category-select)) + +(defun todo-toggle-item-highlighting () + "Highlight or unhighlight the todo item the cursor is on." + (interactive) + (eval-when-compile (require 'hl-line)) + (when (memq major-mode + '(todo-mode todo-archive-mode todo-filtered-items-mode)) + (if hl-line-mode + (hl-line-mode -1) + (hl-line-mode 1)))) + +(defun todo-toggle-item-header () + "Hide or show item date-time headers in the current file. +With done items, this hides only the done date-time string, not +the the original date-time string." + (interactive) + (save-excursion + (save-restriction + (goto-char (point-min)) + (let ((ov (todo-get-overlay 'header))) + (if ov + (remove-overlays 1 (1+ (buffer-size)) 'todo 'header) + (widen) + (goto-char (point-min)) + (while (not (eobp)) + (when (re-search-forward + (concat todo-item-start + "\\( " diary-time-regexp "\\)?" + (regexp-quote todo-nondiary-end) "? ") + nil t) + (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t)) + (overlay-put ov 'todo 'header) + (overlay-put ov 'display "")) + (todo-forward-item))))))) + +;; ----------------------------------------------------------------------------- +;;; File and category editing +;; ----------------------------------------------------------------------------- + +(defun todo-add-file () + "Name and initialize a new todo file. +Interactively, prompt for a category and display it, and if +option `todo-add-item-if-new-category' is non-nil (the default), +prompt for the first item. +Noninteractively, return the name of the new file." + (interactive) + (let ((prompt (concat "Enter name of new todo file " + "(TAB or SPC to see current names): ")) + file) + (setq file (todo-read-file-name prompt)) + (with-current-buffer (get-buffer-create file) + (erase-buffer) + (write-region (point-min) (point-max) file nil 'nomessage nil t) + (kill-buffer file)) + (setq todo-files (funcall todo-files-function)) + (todo-reevaluate-filelist-defcustoms) + (if (called-interactively-p 'any) + (progn + (set-window-buffer (selected-window) + (set-buffer (find-file-noselect file))) + (setq todo-current-todo-file file) + (todo-show)) + file))) + +(defvar todo-edit-buffer "*Todo Edit*" + "Name of current buffer in Todo Edit mode.") + +(defun todo-edit-file () + "Put current buffer in `todo-edit-mode'. +This makes the entire file visible and the buffer writeable and +you can use the self-insertion keys and standard Emacs editing +commands to make changes. To return to Todo mode, type +\\[todo-edit-quit]. This runs a file format check, signalling +an error if the format has become invalid. However, this check +cannot tell if the number of items changed, which could result in +the file containing inconsistent information. For this reason +this command should be used with caution." + (interactive) + (widen) + (todo-edit-mode) + (remove-overlays) + (message "%s" (substitute-command-keys + (concat "Type \\[todo-edit-quit] to check file format " + "validity and return to Todo mode.\n")))) + +(defun todo-add-category (&optional file cat) + "Add a new category to a todo file. + +Called interactively with prefix argument FILE, prompt for a file +and then for a new category to add to that file, otherwise prompt +just for a category to add to the current todo file. After +adding the category, visit it in Todo mode and if option +`todo-add-item-if-new-category' is non-nil (the default), prompt +for the first item. + +Non-interactively, add category CAT to file FILE; if FILE is nil, +add CAT to the current todo file. After adding the category, +return the new category number." + (interactive "P") + (let (catfil file0) + ;; If cat is passed from caller, don't prompt, unless it is "", + ;; which means the file was just added and has no category yet. + (if (and cat (> (length cat) 0)) + (setq file0 (or (and (stringp file) file) + todo-current-todo-file)) + (setq catfil (todo-read-category "Enter a new category name: " + 'add (when (called-interactively-p 'any) + file)) + cat (car catfil) + file0 (if (called-interactively-p 'any) + (cdr catfil) + file))) + (find-file file0) + (let ((counts (make-vector 4 0)) ; [todo diary done archived] + (num (1+ (length todo-categories))) + (buffer-read-only nil)) + (setq todo-current-todo-file file0) + (setq todo-categories (append todo-categories + (list (cons cat counts)))) + (widen) + (goto-char (point-max)) + (save-excursion ; Save point for todo-category-select. + (insert todo-category-beg cat "\n\n" todo-category-done "\n")) + (todo-update-categories-sexp) + ;; If invoked by user, display the newly added category, if + ;; called programmatically return the category number to the + ;; caller. + (if (called-interactively-p 'any) + (progn + (setq todo-category-number num) + (todo-category-select) + (when todo-add-item-if-new-category + (todo-basic-insert-item))) + num)))) + +(defun todo-rename-category () + "Rename current todo category. +If this file has an archive containing this category, rename the +category there as well." + (interactive) + (let* ((cat (todo-current-category)) + (new (read-from-minibuffer + (format "Rename category \"%s\" to: " cat)))) + (setq new (todo-validate-name new 'category)) + (let* ((ofile todo-current-todo-file) + (archive (concat (file-name-sans-extension ofile) ".toda")) + (buffers (append (list ofile) + (unless (zerop (todo-get-count 'archived cat)) + (list archive))))) + (dolist (buf buffers) + (with-current-buffer (find-file-noselect buf) + (let (buffer-read-only) + (setq todo-categories (todo-set-categories)) + (save-excursion + (save-restriction + (setcar (assoc cat todo-categories) new) + (widen) + (goto-char (point-min)) + (todo-update-categories-sexp) + (re-search-forward (concat (regexp-quote todo-category-beg) + "\\(" (regexp-quote cat) "\\)\n") + nil t) + (replace-match new t t nil 1))))))) + (force-mode-line-update)) + (save-excursion (todo-category-select))) + +(defun todo-delete-category (&optional arg) + "Delete current todo category provided it is empty. +With ARG non-nil delete the category unconditionally, +i.e. including all existing todo and done items." + (interactive "P") + (let* ((file todo-current-todo-file) + (cat (todo-current-category)) + (todo (todo-get-count 'todo cat)) + (done (todo-get-count 'done cat)) + (archived (todo-get-count 'archived cat))) + (if (and (not arg) + (or (> todo 0) (> done 0))) + (message "%s" (substitute-command-keys + (concat "To delete a non-empty category, " + "type C-u \\[todo-delete-category]."))) + (when (cond ((= (length todo-categories) 1) + (todo-y-or-n-p + (concat "This is the only category in this file; " + "deleting it will also delete the file.\n" + "Do you want to proceed? "))) + ((> archived 0) + (todo-y-or-n-p (concat "This category has archived items; " + "the archived category will remain\n" + "after deleting the todo category. " + "Do you still want to delete it\n" + "(see `todo-skip-archived-categories' " + "for another option)? "))) + (t + (todo-y-or-n-p (concat "Permanently remove category \"" cat + "\"" (and arg " and all its entries") + "? ")))) + (widen) + (let ((buffer-read-only) + (beg (re-search-backward + (concat "^" (regexp-quote (concat todo-category-beg cat)) + "\n") nil t)) + (end (if (re-search-forward + (concat "\n\\(" (regexp-quote todo-category-beg) + ".*\n\\)") nil t) + (match-beginning 1) + (point-max)))) + (remove-overlays beg end) + (delete-region beg end) + (if (= (length todo-categories) 1) + ;; If deleted category was the only one, delete the file. + (progn + (todo-reevaluate-filelist-defcustoms) + ;; Skip confirming killing the archive buffer if it has been + ;; modified and not saved. + (set-buffer-modified-p nil) + (delete-file file) + (kill-buffer) + (message "Deleted todo file %s." file)) + (setq todo-categories (delete (assoc cat todo-categories) + todo-categories)) + (todo-update-categories-sexp) + (setq todo-category-number + (1+ (mod todo-category-number (length todo-categories)))) + (todo-category-select) + (goto-char (point-min)) + (message "Deleted category %s." cat))))))) + +(defun todo-move-category () + "Move current category to a different todo file. +If current category has archived items, also move those to the +archive of the file moved to, creating it if it does not exist." + (interactive) + (when (or (> (length todo-categories) 1) + (todo-y-or-n-p (concat "This is the only category in this file; " + "moving it will also delete the file.\n" + "Do you want to proceed? "))) + (let* ((ofile todo-current-todo-file) + (cat (todo-current-category)) + (nfile (todo-read-file-name + "Choose a todo file to move this category to: " nil t)) + (archive (concat (file-name-sans-extension ofile) ".toda")) + (buffers (append (list ofile) + (unless (zerop (todo-get-count 'archived cat)) + (list archive)))) + new) + (while (equal (file-truename nfile) (file-truename ofile)) + (setq nfile (todo-read-file-name + "Choose a file distinct from this file: " nil t))) + (dolist (buf buffers) + (with-current-buffer (find-file-noselect buf) + (widen) + (goto-char (point-max)) + (let* ((beg (re-search-backward + (concat "^" + (regexp-quote (concat todo-category-beg cat)) + "$") + nil t)) + (end (if (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) + nil t 2) + (match-beginning 0) + (point-max))) + (content (buffer-substring-no-properties beg end)) + (counts (cdr (assoc cat todo-categories))) + buffer-read-only) + ;; Move the category to the new file. Also update or create + ;; archive file if necessary. + (with-current-buffer + (find-file-noselect + ;; Regenerate todo-archives in case there + ;; is a newly created archive. + (if (member buf (funcall todo-files-function t)) + (concat (file-name-sans-extension nfile) ".toda") + nfile)) + (let* ((nfile-short (todo-short-file-name nfile)) + (prompt (concat + (format "Todo file \"%s\" already has " + nfile-short) + (format "the category \"%s\";\n" cat) + "enter a new category name: ")) + buffer-read-only) + (widen) + (goto-char (point-max)) + (insert content) + ;; If the file moved to has a category with the same + ;; name, rename the moved category. + (when (assoc cat todo-categories) + (unless (member (file-truename (buffer-file-name)) + (funcall todo-files-function t)) + (setq new (read-from-minibuffer prompt)) + (setq new (todo-validate-name new 'category)))) + ;; Replace old with new name in todo and archive files. + (when new + (goto-char (point-max)) + (re-search-backward + (concat "^" (regexp-quote todo-category-beg) + "\\(" (regexp-quote cat) "\\)$") nil t) + (replace-match new nil nil nil 1))) + (setq todo-categories + (append todo-categories (list (cons new counts)))) + (todo-update-categories-sexp) + ;; If archive was just created, save it to avoid "File + ;; no longer exists!" message on invoking + ;; `todo-view-archived-items'. + (unless (file-exists-p (buffer-file-name)) + (save-buffer)) + (todo-category-number (or new cat)) + (todo-category-select)) + ;; Delete the category from the old file, and if that was the + ;; last category, delete the file. Also handle archive file + ;; if necessary. + (remove-overlays beg end) + (delete-region beg end) + (goto-char (point-min)) + ;; Put point after todo-categories sexp. + (forward-line) + (if (eobp) ; Aside from sexp, file is empty. + (progn + ;; Skip confirming killing the archive buffer. + (set-buffer-modified-p nil) + (delete-file todo-current-todo-file) + (kill-buffer) + (when (member todo-current-todo-file todo-files) + (todo-reevaluate-filelist-defcustoms))) + (setq todo-categories (delete (assoc cat todo-categories) + todo-categories)) + (todo-update-categories-sexp) + (todo-category-select))))) + (set-window-buffer (selected-window) + (set-buffer (find-file-noselect nfile))) + (todo-category-number (or new cat)) + (todo-category-select)))) + +(defun todo-merge-category (&optional file) + "Merge current category into another existing category. + +With prefix argument FILE, prompt for a specific todo file and +choose (with TAB completion) a category in it to merge into; +otherwise, choose and merge into a category in either the +current todo file or a file in `todo-category-completions-files'. + +After merging, the current category's todo and done items are +appended to the chosen goal category's todo and done items, +respectively. The goal category becomes the current category, +and the previous current category is deleted. + +If both the first and goal categories also have archived items, +the former are merged to the latter. If only the first category +has archived items, the archived category is renamed to the goal +category." + (interactive "P") + (let* ((tfile todo-current-todo-file) + (cat (todo-current-category)) + (cat+file (todo-read-category "Merge into category: " 'todo file)) + (goal (car cat+file)) + (gfile (cdr cat+file)) + (archive (concat (file-name-sans-extension (if file gfile tfile)) + ".toda")) + archived-count here) + ;; Merge in todo file. + (with-current-buffer (get-buffer (find-file-noselect tfile)) + (widen) + (let* ((buffer-read-only nil) + (cbeg (progn + (re-search-backward + (concat "^" (regexp-quote todo-category-beg)) nil t) + (point-marker))) + (tbeg (progn (forward-line) (point-marker))) + (dbeg (progn + (re-search-forward + (concat "^" (regexp-quote todo-category-done)) nil t) + (forward-line) (point-marker))) + ;; Omit empty line between todo and done items. + (tend (progn (forward-line -2) (point-marker))) + (cend (progn + (if (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) nil t) + (progn + (goto-char (match-beginning 0)) + (point-marker)) + (point-max-marker)))) + (todo (buffer-substring-no-properties tbeg tend)) + (done (buffer-substring-no-properties dbeg cend))) + (goto-char (point-min)) + ;; Merge any todo items. + (unless (zerop (length todo)) + (re-search-forward + (concat "^" (regexp-quote (concat todo-category-beg goal)) "$") + nil t) + (re-search-forward + (concat "^" (regexp-quote todo-category-done)) nil t) + (forward-line -1) + (setq here (point-marker)) + (insert todo) + (todo-update-count 'todo (todo-get-count 'todo cat) goal)) + ;; Merge any done items. + (unless (zerop (length done)) + (goto-char (if (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) nil t) + (match-beginning 0) + (point-max))) + (when (zerop (length todo)) (setq here (point-marker))) + (insert done) + (todo-update-count 'done (todo-get-count 'done cat) goal)) + (remove-overlays cbeg cend) + (delete-region cbeg cend) + (setq todo-categories (delete (assoc cat todo-categories) + todo-categories)) + (todo-update-categories-sexp) + (mapc (lambda (m) (set-marker m nil)) (list cbeg tbeg dbeg tend cend)))) + (when (file-exists-p archive) + ;; Merge in archive file. + (with-current-buffer (get-buffer (find-file-noselect archive)) + (widen) + (goto-char (point-min)) + (let ((buffer-read-only nil) + (cbeg (save-excursion + (when (re-search-forward + (concat "^" (regexp-quote + (concat todo-category-beg cat)) "$") + nil t) + (goto-char (match-beginning 0)) + (point-marker)))) + (gbeg (save-excursion + (when (re-search-forward + (concat "^" (regexp-quote + (concat todo-category-beg goal)) "$") + nil t) + (goto-char (match-beginning 0)) + (point-marker)))) + cend carch) + (when cbeg + (setq archived-count (todo-get-count 'done cat)) + (setq cend (save-excursion + (if (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) + nil t) + (match-beginning 0) + (point-max)))) + (setq carch (save-excursion (goto-char cbeg) (forward-line) + (buffer-substring-no-properties (point) cend))) + ;; If both categories of the merge have archived items, merge the + ;; source items to the goal items, else "merge" by renaming the + ;; source category to goal. + (if gbeg + (progn + (goto-char (if (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) + nil t) + (match-beginning 0) + (point-max))) + (insert carch) + (remove-overlays cbeg cend) + (delete-region cbeg cend)) + (goto-char cbeg) + (search-forward cat) + (replace-match goal)) + (setq todo-categories (todo-make-categories-list t)) + (todo-update-categories-sexp))))) + (with-current-buffer (get-file-buffer tfile) + (when archived-count + (unless (zerop archived-count) + (todo-update-count 'archived archived-count goal) + (todo-update-categories-sexp))) + (todo-category-number goal) + ;; If there are only merged done items, show them. + (let ((todo-show-with-done (zerop (todo-get-count 'todo goal)))) + (todo-category-select) + ;; Put point on the first merged item. + (goto-char here))) + (set-marker here nil))) + +;; ----------------------------------------------------------------------------- +;;; Item editing +;; ----------------------------------------------------------------------------- + +(defcustom todo-include-in-diary nil + "Non-nil to allow new todo items to be included in the diary." + :type 'boolean + :group 'todo-edit) + +(defcustom todo-diary-nonmarking nil + "Non-nil to insert new todo diary items as nonmarking by default. +This appends `diary-nonmarking-symbol' to the front of an item on +insertion provided it doesn't begin with `todo-nondiary-marker'." + :type 'boolean + :group 'todo-edit) + +(defcustom todo-always-add-time-string nil + "Non-nil adds current time to a new item's date header by default. +When the todo insertion commands have a non-nil \"maybe-notime\" +argument, this reverses the effect of +`todo-always-add-time-string': if t, these commands omit the +current time, if nil, they include it." + :type 'boolean + :group 'todo-edit) + +(defcustom todo-use-only-highlighted-region t + "Non-nil to enable inserting only highlighted region as new item." + :type 'boolean + :group 'todo-edit) + +(defcustom todo-item-mark "*" + "String used to mark items. +To ensure item marking works, change the value of this option +only when no items are marked." + :type '(string :validate + (lambda (widget) + (when (string= (widget-value widget) todo-prefix) + (widget-put + widget :error + "Invalid value: must be distinct from `todo-prefix'") + widget))) + :set (lambda (symbol value) + (custom-set-default symbol (propertize value 'face 'todo-mark))) + :group 'todo-edit) + +(defcustom todo-comment-string "COMMENT" + "String inserted before optional comment appended to done item." + :type 'string + :initialize 'custom-initialize-default + :set 'todo-reset-comment-string + :group 'todo-edit) + +(defcustom todo-undo-item-omit-comment 'ask + "Whether to omit done item comment on undoing the item. +Nil means never omit the comment, t means always omit it, `ask' +means prompt user and omit comment only on confirmation." + :type '(choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Ask" ask)) + :group 'todo-edit) + +(defun todo-toggle-mark-item (&optional n) + "Mark item with `todo-item-mark' if unmarked, otherwise unmark it. +With a positive numerical prefix argument N, change the +marking of the next N items." + (interactive "p") + (when (todo-item-string) + (unless (> n 1) (setq n 1)) + (dotimes (i n) + (let* ((cat (todo-current-category)) + (marks (assoc cat todo-categories-with-marks)) + (ov (progn + (unless (looking-at todo-item-start) + (todo-item-start)) + (todo-get-overlay 'prefix))) + (pref (overlay-get ov 'before-string))) + (if (todo-marked-item-p) + (progn + (overlay-put ov 'before-string (substring pref 1)) + (if (= (cdr marks) 1) ; Deleted last mark in this category. + (setq todo-categories-with-marks + (assq-delete-all cat todo-categories-with-marks)) + (setcdr marks (1- (cdr marks))))) + (overlay-put ov 'before-string (concat todo-item-mark pref)) + (if marks + (setcdr marks (1+ (cdr marks))) + (push (cons cat 1) todo-categories-with-marks)))) + (todo-forward-item)))) + +(defun todo-mark-category () + "Mark all visiblw items in this category with `todo-item-mark'." + (interactive) + (let* ((cat (todo-current-category)) + (marks (assoc cat todo-categories-with-marks))) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let* ((ov (todo-get-overlay 'prefix)) + (pref (overlay-get ov 'before-string))) + (unless (todo-marked-item-p) + (overlay-put ov 'before-string (concat todo-item-mark pref)) + (if marks + (setcdr marks (1+ (cdr marks))) + (push (cons cat 1) todo-categories-with-marks)))) + (todo-forward-item))))) + +(defun todo-unmark-category () + "Remove `todo-item-mark' from all visible items in this category." + (interactive) + (let* ((cat (todo-current-category)) + (marks (assoc cat todo-categories-with-marks))) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let* ((ov (todo-get-overlay 'prefix)) + ;; No overlay on empty line between todo and done items. + (pref (when ov (overlay-get ov 'before-string)))) + (when (todo-marked-item-p) + (overlay-put ov 'before-string (substring pref 1))) + (todo-forward-item)))) + (setq todo-categories-with-marks + (delq marks todo-categories-with-marks)))) + +(defvar todo-date-from-calendar nil + "Helper variable for setting item date from the Emacs Calendar.") + +(defun todo-basic-insert-item (&optional arg diary nonmarking date-type time + region-or-here) + "Insert a new todo item into a category. +This is the function from which the generated Todo mode item +insertion commands derive. + +The generated commands have mnenomic key bindings based on the +arguments' values and their order in the command's argument list, +as follows: (1) for DIARY `d', (2) for NONMARKING `k', (3) for +DATE-TYPE either `c' for calendar or `d' for date or `n' for +weekday name, (4) for TIME `t', (5) for REGION-OR-HERE either `r' +for region or `h' for here. Sequences of these keys are appended +to the insertion prefix key `i'. Keys that allow a following +key (i.e., any but `r' or `h') must be doubled when used finally. +For example, the command bound to the key sequence `i y h' will +insert a new item with today's date, marked according to the +DIARY argument described below, and with priority according to +the HERE argument; `i y y' does the same except that the priority +is not given by HERE but by prompting. + +In command invocations, ARG is passed as a prefix argument as +follows. With no prefix argument, add the item to the current +category; with one prefix argument (`C-u'), prompt for a category +from the current todo file; with two prefix arguments (`C-u C-u'), +first prompt for a todo file, then a category in that file. If +a non-existing category is entered, ask whether to add it to the +todo file; if answered affirmatively, add the category and +insert the item there. + +The remaining arguments are set or left nil by the generated item +insertion commands; their meanings are described in the follows +paragraphs. + +When argument DIARY is non-nil, this overrides the intent of the +user option `todo-include-in-diary' for this item: if +`todo-include-in-diary' is nil, include the item in the Fancy +Diary display, and if it is non-nil, exclude the item from the +Fancy Diary display. When DIARY is nil, `todo-include-in-diary' +has its intended effect. + +When the item is included in the Fancy Diary display and the +argument NONMARKING is non-nil, this overrides the intent of the +user option `todo-diary-nonmarking' for this item: if +`todo-diary-nonmarking' is nil, append `diary-nonmarking-symbol' +to the item, and if it is non-nil, omit `diary-nonmarking-symbol'. + +The argument DATE-TYPE determines the content of the item's +mandatory date header string and how it is added: +- If DATE-TYPE is the symbol `calendar', the Calendar pops up and + when the user puts the cursor on a date and hits RET, that + date, in the format set by `calendar-date-display-form', + becomes the date in the header. +- If DATE-TYPE is a string matching the regexp + `todo-date-pattern', that string becomes the date in the + header. This case is for the command + `todo-insert-item-from-calendar' which is called from the + Calendar. +- If DATE-TYPE is the symbol `date', the header contains the date + in the format set by `calendar-date-display-form', with year, + month and day individually prompted for (month with tab + completion). +- If DATE-TYPE is the symbol `dayname' the header contains a + weekday name instead of a date, prompted for with tab + completion. +- If DATE-TYPE has any other value (including nil or none) the + header contains the current date (in the format set by + `calendar-date-display-form'). + +With non-nil argument TIME prompt for a time string, which must +match `diary-time-regexp'. Typing `' at the prompt +returns the current time, if the user option +`todo-always-add-time-string' is non-nil, otherwise the empty +string (i.e., no time string). If TIME is absent or nil, add or +omit the current time string according as +`todo-always-add-time-string' is non-nil or nil, respectively. + +The argument REGION-OR-HERE determines the source and location of +the new item: +- If the REGION-OR-HERE is the symbol `here', prompt for the text of + the new item and, if the command was invoked with point in the todo + items section of the current category, give the new item the + priority of the item at point, lowering the latter's priority and + the priority of the remaining items. If point is in the done items + section of the category, insert the new item as the first todo item + in the category. Likewise, if the command with `here' is invoked + outside of the current category, jump to the chosen category and + insert the new item as the first item in the category. +- If REGION-OR-HERE is the symbol `region', use the region of the + current buffer as the text of the new item, depending on the + value of user option `todo-use-only-highlighted-region': if + this is non-nil, then use the region only when it is + highlighted; otherwise, use the region regardless of + highlighting. An error is signalled if there is no region in + the current buffer. Prompt for the item's priority in the + category (an integer between 1 and one more than the number of + items in the category), and insert the item accordingly. +- If REGION-OR-HERE has any other value (in particular, nil or + none), prompt for the text and the item's priority, and insert + the item accordingly." + ;; If invoked outside of Todo mode and there is not yet any Todo + ;; file, initialize one. + (if (null todo-files) + (todo-show) + (let ((region (eq region-or-here 'region)) + (here (eq region-or-here 'here))) + (when region + (let (use-empty-active-region) + (unless (and todo-use-only-highlighted-region (use-region-p)) + (user-error "There is no active region")))) + (let* ((obuf (current-buffer)) + (ocat (todo-current-category)) + (opoint (point)) + (todo-mm (eq major-mode 'todo-mode)) + (cat+file (cond ((equal arg '(4)) + (todo-read-category "Insert in category: ")) + ((equal arg '(16)) + (todo-read-category "Insert in category: " + nil 'file)) + (t + (cons (todo-current-category) + (or todo-current-todo-file + (and todo-show-current-file + todo-global-current-todo-file) + (todo-absolute-file-name + todo-default-todo-file)))))) + (cat (car cat+file)) + (file (cdr cat+file)) + (new-item (if region + (buffer-substring-no-properties + (region-beginning) (region-end)) + (read-from-minibuffer "Todo item: "))) + (date-string (cond + ((eq date-type 'date) + (todo-read-date)) + ((eq date-type 'dayname) + (todo-read-dayname)) + ((eq date-type 'calendar) + (setq todo-date-from-calendar t) + (or (todo-set-date-from-calendar) + ;; If user exits Calendar before choosing + ;; a date, cancel item insertion. + (keyboard-quit))) + ((and (stringp date-type) + (string-match todo-date-pattern date-type)) + (setq todo-date-from-calendar date-type) + (todo-set-date-from-calendar)) + (t + (calendar-date-string + (calendar-current-date) t t)))) + (time-string (or (and time (todo-read-time)) + (and todo-always-add-time-string + (substring (current-time-string) 11 16))))) + (setq todo-date-from-calendar nil) + (find-file-noselect file 'nowarn) + (set-window-buffer (selected-window) + (set-buffer (find-buffer-visiting file))) + ;; If this command was invoked outside of a Todo mode buffer, + ;; the call to todo-current-category above returned nil. If + ;; we just entered Todo mode now, then cat was set to the + ;; file's first category, but if todo-mode was already + ;; enabled, cat did not get set, so we have to do that. + (unless cat + (setq cat (todo-current-category))) + (setq todo-current-todo-file file) + (unless todo-global-current-todo-file + (setq todo-global-current-todo-file todo-current-todo-file)) + (let ((buffer-read-only nil) + (called-from-outside (not (and todo-mm (equal cat ocat)))) + done-only item-added) + (setq new-item + ;; Add date, time and diary marking as required. + (concat (if (not (and diary (not todo-include-in-diary))) + todo-nondiary-start + (when (and nonmarking (not todo-diary-nonmarking)) + diary-nonmarking-symbol)) + date-string (when (and time-string ; Can be empty. + (not (zerop (length + time-string)))) + (concat " " time-string)) + (when (not (and diary (not todo-include-in-diary))) + todo-nondiary-end) + " " new-item)) + ;; Indent newlines inserted by C-q C-j if nonspace char follows. + (setq new-item (replace-regexp-in-string "\\(\n\\)[^[:blank:]]" + "\n\t" new-item nil nil 1)) + (unwind-protect + (progn + ;; Make sure the correct category is selected. There + ;; are two cases: (i) we just visited the file, so no + ;; category is selected yet, or (ii) we invoked + ;; insertion "here" from outside the category we want + ;; to insert in (with priority insertion, category + ;; selection is done by todo-set-item-priority). + (when (or (= (- (point-max) (point-min)) (buffer-size)) + (and here called-from-outside)) + (todo-category-number cat) + (todo-category-select)) + ;; If only done items are displayed in category, + ;; toggle to todo items before inserting new item. + (when (save-excursion + (goto-char (point-min)) + (looking-at todo-done-string-start)) + (setq done-only t) + (todo-toggle-view-done-only)) + (if here + (progn + ;; If command was invoked with point in done + ;; items section or outside of the current + ;; category, can't insert "here", so to be + ;; useful give new item top priority. + (when (or (todo-done-item-section-p) + called-from-outside + done-only) + (goto-char (point-min))) + (todo-insert-with-overlays new-item)) + (todo-set-item-priority new-item cat t)) + (setq item-added t)) + ;; If user cancels before setting priority, restore + ;; display. + (unless item-added + (if ocat + (progn + (unless (equal cat ocat) + (todo-category-number ocat) + (todo-category-select)) + (and done-only (todo-toggle-view-done-only))) + (set-window-buffer (selected-window) (set-buffer obuf))) + (goto-char opoint)) + ;; If the todo items section is not visible when the + ;; insertion command is called (either because only done + ;; items were shown or because the category was not in the + ;; current buffer), then if the item is inserted at the + ;; end of the category, point is at eob and eob at + ;; window-start, so that higher priority todo items are + ;; out of view. So we recenter to make sure the todo + ;; items are displayed in the window. + (when item-added (recenter))) + (todo-update-count 'todo 1) + (if (or diary todo-include-in-diary) (todo-update-count 'diary 1)) + (todo-update-categories-sexp)))))) + +(defun todo-set-date-from-calendar () + "Return string of date chosen from Calendar." + (cond ((and (stringp todo-date-from-calendar) + (string-match todo-date-pattern todo-date-from-calendar)) + todo-date-from-calendar) + (todo-date-from-calendar + (let (calendar-view-diary-initially-flag) + (calendar)) ; *Calendar* is now current buffer. + (define-key calendar-mode-map [remap newline] 'exit-recursive-edit) + ;; If user exits Calendar before choosing a date, clean up properly. + (define-key calendar-mode-map + [remap calendar-exit] (lambda () + (interactive) + (progn + (calendar-exit) + (exit-recursive-edit)))) + (message "Put cursor on a date and type to set it.") + (recursive-edit) + (unwind-protect + (when (equal (buffer-name) calendar-buffer) + (setq todo-date-from-calendar + (calendar-date-string (calendar-cursor-to-date t) t t)) + (calendar-exit) + todo-date-from-calendar) + (define-key calendar-mode-map [remap newline] nil) + (define-key calendar-mode-map [remap calendar-exit] nil) + (unless (zerop (recursion-depth)) (exit-recursive-edit)) + (when (stringp todo-date-from-calendar) + todo-date-from-calendar))))) + +(defun todo-insert-item-from-calendar (&optional arg) + "Prompt for and insert a new item with date selected from calendar. +Invoked without prefix argument ARG, insert the item into the +current category, without one prefix argument, prompt for the +category from the current todo file or from one listed in +`todo-category-completions-files'; with two prefix arguments, +prompt for a todo file and then for a category in it." + (interactive "P") + (setq todo-date-from-calendar + (calendar-date-string (calendar-cursor-to-date t) t t)) + (calendar-exit) + (todo-basic-insert-item arg nil nil todo-date-from-calendar)) + +(define-key calendar-mode-map "it" 'todo-insert-item-from-calendar) + +(defun todo-copy-item () + "Copy item at point and insert the copy as a new item." + (interactive) + (unless (or (todo-done-item-p) (looking-at "^$")) + (let ((copy (todo-item-string)) + (diary-item (todo-diary-item-p))) + (todo-set-item-priority copy (todo-current-category) t) + (todo-update-count 'todo 1) + (when diary-item (todo-update-count 'diary 1)) + (todo-update-categories-sexp)))) + +(defun todo-delete-item () + "Delete at least one item in this category. +If there are marked items, delete all of these; otherwise, delete +the item at point." + (interactive) + (let (ov) + (unwind-protect + (let* ((cat (todo-current-category)) + (marked (assoc cat todo-categories-with-marks)) + (item (unless marked (todo-item-string))) + (answer (if marked + (todo-y-or-n-p + "Permanently delete all marked items? ") + (when item + (setq ov (make-overlay + (save-excursion (todo-item-start)) + (save-excursion (todo-item-end)))) + (overlay-put ov 'face 'todo-search) + (todo-y-or-n-p "Permanently delete this item? ")))) + buffer-read-only) + (when answer + (and marked (goto-char (point-min))) + (catch 'done + (while (not (eobp)) + (if (or (and marked (todo-marked-item-p)) item) + (progn + (if (todo-done-item-p) + (todo-update-count 'done -1) + (todo-update-count 'todo -1 cat) + (and (todo-diary-item-p) + (todo-update-count 'diary -1))) + (if ov (delete-overlay ov)) + (todo-remove-item) + ;; Don't leave point below last item. + (and item (bolp) (eolp) (< (point-min) (point-max)) + (todo-backward-item)) + (when item + (throw 'done (setq item nil)))) + (todo-forward-item)))) + (when marked + (setq todo-categories-with-marks + (assq-delete-all cat todo-categories-with-marks))) + (todo-update-categories-sexp) + (todo-prefix-overlays))) + (if ov (delete-overlay ov))))) + +(defun todo-edit-item (&optional arg) + "Edit the todo item at point. +With non-nil prefix argument ARG, include the item's date/time +header, making it also editable; otherwise, include only the item +content. + +If the item consists of only one logical line, edit it in the +minibuffer; otherwise, edit it in Todo Edit mode." + (interactive "P") + (when (todo-item-string) + (let* ((opoint (point)) + (start (todo-item-start)) + (item-beg (progn + (re-search-forward + (concat todo-date-string-start todo-date-pattern + "\\( " diary-time-regexp "\\)?" + (regexp-quote todo-nondiary-end) "?") + (line-end-position) t) + (1+ (- (point) start)))) + (header (substring (todo-item-string) 0 item-beg)) + (item (if arg (todo-item-string) + (substring (todo-item-string) item-beg))) + (multiline (> (length (split-string item "\n")) 1)) + (buffer-read-only nil)) + (if multiline + (todo-edit-multiline-item) + (let ((new (concat (if arg "" header) + (read-string "Edit: " (if arg + (cons item item-beg) + (cons item 0)))))) + (when arg + (while (not (string-match (concat todo-date-string-start + todo-date-pattern) new)) + (setq new (read-from-minibuffer + "Item must start with a date: " new)))) + ;; Ensure lines following hard newlines are indented. + (setq new (replace-regexp-in-string "\\(\n\\)[^[:blank:]]" + "\n\t" new nil nil 1)) + ;; If user moved point during editing, make sure it moves back. + (goto-char opoint) + (todo-remove-item) + (todo-insert-with-overlays new) + (move-to-column item-beg)))))) + +(defun todo-edit-multiline-item () + "Edit current todo item in Todo Edit mode. +Use of newlines invokes `todo-indent' to insure compliance with +the format of Diary entries." + (interactive) + (when (todo-item-string) + (let ((buf todo-edit-buffer)) + (set-window-buffer (selected-window) + (set-buffer (make-indirect-buffer (buffer-name) buf))) + (narrow-to-region (todo-item-start) (todo-item-end)) + (todo-edit-mode) + (message "%s" (substitute-command-keys + (concat "Type \\[todo-edit-quit] " + "to return to Todo mode.\n")))))) + +(defun todo-edit-quit () + "Return from Todo Edit mode to Todo mode. +If the item contains hard line breaks, make sure the following +lines are indented by `todo-indent-to-here' to conform to diary +format. + +If the whole file was in Todo Edit mode, check before returning +whether the file is still a valid todo file and if so, also +recalculate the todo file's categories sexp, in case changes were +made in the number or names of categories." + (interactive) + (if (> (buffer-size) (- (point-max) (point-min))) + ;; We got here via `e m'. + (let ((item (buffer-string)) + (regex "\\(\n\\)[^[:blank:]]") + (buf (buffer-base-buffer))) + (while (not (string-match (concat todo-date-string-start + todo-date-pattern) item)) + (setq item (read-from-minibuffer + "Item must start with a date: " item))) + ;; Ensure lines following hard newlines are indented. + (when (string-match regex (buffer-string)) + (setq item (replace-regexp-in-string regex "\n\t" item nil nil 1)) + (delete-region (point-min) (point-max)) + (insert item)) + (kill-buffer) + (unless (eq (current-buffer) buf) + (set-window-buffer (selected-window) (set-buffer buf)))) + ;; We got here via `F e'. + (when (todo-check-format) + ;; FIXME: separate out sexp check? + ;; If manual editing makes e.g. item counts change, have to + ;; call this to update todo-categories, but it restores + ;; category order to list order. + ;; (todo-repair-categories-sexp) + ;; Compare (todo-make-categories-list t) with sexp and if + ;; different ask (todo-update-categories-sexp) ? + (todo-mode) + (let* ((cat-beg (concat "^" (regexp-quote todo-category-beg) + "\\(.*\\)$")) + (curline (buffer-substring-no-properties + (line-beginning-position) (line-end-position))) + (cat (cond ((string-match cat-beg curline) + (match-string-no-properties 1 curline)) + ((or (re-search-backward cat-beg nil t) + (re-search-forward cat-beg nil t)) + (match-string-no-properties 1))))) + (todo-category-number cat) + (todo-category-select) + (goto-char (point-min)))))) + +(defun todo-basic-edit-item-header (what &optional inc) + "Function underlying commands to edit item date/time header. + +The argument WHAT (passed by invoking commands) specifies what +part of the header to edit; possible values are these symbols: +`date', to edit the year, month, and day of the date string; +`time', to edit just the time string; `calendar', to select the +date from the Calendar; `today', to set the date to today's date; +`dayname', to set the date string to the name of a day or to +change the day name; and `year', `month' or `day', to edit only +these respective parts of the date string (`day' is the number of +the given day of the month, and `month' is either the name of the +given month or its number, depending on the value of +`calendar-date-display-form'). + +The optional argument INC is a positive or negative integer +\(passed by invoking commands as a numerical prefix argument) +that in conjunction with the WHAT values `year', `month' or +`day', increments or decrements the specified date string +component by the specified number of suitable units, i.e., years, +months, or days, with automatic adjustment of the other date +string components as necessary. + +If there are marked items, apply the same edit to all of these; +otherwise, edit just the item at point." + (let* ((cat (todo-current-category)) + (marked (assoc cat todo-categories-with-marks)) + (first t) + (todo-date-from-calendar t) + (buffer-read-only nil) + ndate ntime year monthname month day + dayname) ; Needed by calendar-date-display-form. + (save-excursion + (or (and marked (goto-char (point-min))) (todo-item-start)) + (catch 'end + (while (not (eobp)) + (and marked + (while (not (todo-marked-item-p)) + (todo-forward-item) + (and (eobp) (throw 'end nil)))) + (re-search-forward (concat todo-date-string-start "\\(?1:" + todo-date-pattern + "\\)\\(?2: " diary-time-regexp "\\)?" + (regexp-quote todo-nondiary-end) "?") + (line-end-position) t) + (let* ((odate (match-string-no-properties 1)) + (otime (match-string-no-properties 2)) + (odayname (match-string-no-properties 5)) + (omonthname (match-string-no-properties 6)) + (omonth (match-string-no-properties 7)) + (oday (match-string-no-properties 8)) + (oyear (match-string-no-properties 9)) + (tmn-array todo-month-name-array) + (mlist (append tmn-array nil)) + (tma-array todo-month-abbrev-array) + (mablist (append tma-array nil)) + (yy (and oyear (unless (string= oyear "*") + (string-to-number oyear)))) + (mm (or (and omonth (unless (string= omonth "*") + (string-to-number omonth))) + (1+ (- (length mlist) + (length (or (member omonthname mlist) + (member omonthname mablist))))))) + (dd (and oday (unless (string= oday "*") + (string-to-number oday))))) + ;; If there are marked items, use only the first to set + ;; header changes, and apply these to all marked items. + (when first + (cond + ((eq what 'date) + (setq ndate (todo-read-date))) + ((eq what 'calendar) + (setq ndate (save-match-data (todo-set-date-from-calendar)))) + ((eq what 'today) + (setq ndate (calendar-date-string (calendar-current-date) t t))) + ((eq what 'dayname) + (setq ndate (todo-read-dayname))) + ((eq what 'time) + (setq ntime (save-match-data (todo-read-time))) + (when (> (length ntime) 0) + (setq ntime (concat " " ntime)))) + ;; When date string consists only of a day name, + ;; passing other date components is a noop. + ((and odayname (memq what '(year month day)))) + ((eq what 'year) + (setq day oday + monthname omonthname + month omonth + year (cond ((not current-prefix-arg) + (todo-read-date 'year)) + ((string= oyear "*") + (user-error "Cannot increment *")) + (t + (number-to-string (+ yy inc)))))) + ((eq what 'month) + (setf day oday + year oyear + (if (memq 'month calendar-date-display-form) + month + monthname) + (cond ((not current-prefix-arg) + (todo-read-date 'month)) + ((or (string= omonth "*") (= mm 13)) + (user-error "Cannot increment *")) + (t + (let ((mminc (+ mm inc))) + ;; Increment or decrement month by INC + ;; modulo 12. + (setq mm (% mminc 12)) + ;; If result is 0, make month December. + (setq mm (if (= mm 0) 12 (abs mm))) + ;; Adjust year if necessary. + (setq year (or (and (cond ((> mminc 12) + (+ yy (/ mminc 12))) + ((< mminc 1) + (- yy (/ mminc 12) 1)) + (t yy)) + (number-to-string yy)) + oyear))) + ;; Return the changed numerical month as + ;; a string or the corresponding month name. + (if omonth + (number-to-string mm) + (aref tma-array (1- mm)))))) + (let ((yy (string-to-number year)) ; 0 if year is "*". + ;; When mm is 13 (corresponding to "*" as value + ;; of month), this raises an args-out-of-range + ;; error in calendar-last-day-of-month, so use 1 + ;; (corresponding to January) to get 31 days. + (mm (if (= mm 13) 1 mm))) + (if (> (string-to-number day) + (calendar-last-day-of-month mm yy)) + (user-error "%s %s does not have %s days" + (aref tmn-array (1- mm)) + (if (= mm 2) yy "") day)))) + ((eq what 'day) + (setq year oyear + month omonth + monthname omonthname + day (cond + ((not current-prefix-arg) + (todo-read-date 'day mm oyear)) + ((string= oday "*") + (user-error "Cannot increment *")) + ((or (string= omonth "*") (string= omonthname "*")) + (setq dd (+ dd inc)) + (if (> dd 31) + (user-error "A month cannot have more than 31 days") + (number-to-string dd))) + ;; Increment or decrement day by INC, + ;; adjusting month and year if necessary + ;; (if year is "*" assume current year to + ;; calculate adjustment). + (t + (let* ((yy (or yy (calendar-extract-year + (calendar-current-date)))) + (date (calendar-gregorian-from-absolute + (+ (calendar-absolute-from-gregorian + (list mm dd yy)) inc))) + (adjmm (nth 0 date))) + ;; Set year and month(name) to adjusted values. + (unless (string= year "*") + (setq year (number-to-string (nth 2 date)))) + (if month + (setq month (number-to-string adjmm)) + (setq monthname (aref tma-array (1- adjmm)))) + ;; Return changed numerical day as a string. + (number-to-string (nth 1 date))))))))) + (unless odayname + ;; If year, month or day date string components were + ;; changed, rebuild the date string. + (when (memq what '(year month day)) + (setq ndate (mapconcat 'eval calendar-date-display-form "")))) + (when ndate (replace-match ndate nil nil nil 1)) + ;; Add new time string to the header, if it was supplied. + (when ntime + (if otime + (replace-match ntime nil nil nil 2) + (goto-char (match-end 1)) + (insert ntime))) + (setq todo-date-from-calendar nil) + (setq first nil)) + ;; Apply the changes to the first marked item header to the + ;; remaining marked items. If there are no marked items, + ;; we're finished. + (if marked + (todo-forward-item) + (goto-char (point-max)))))))) + +(defun todo-edit-item-header () + "Interactively edit at least the date of item's date/time header. +If user option `todo-always-add-time-string' is non-nil, also +edit item's time string." + (interactive) + (todo-basic-edit-item-header 'date) + (when todo-always-add-time-string + (todo-edit-item-time))) + +(defun todo-edit-item-time () + "Interactively edit the time string of item's date/time header." + (interactive) + (todo-basic-edit-item-header 'time)) + +(defun todo-edit-item-date-from-calendar () + "Interactively edit item's date using the Calendar." + (interactive) + (todo-basic-edit-item-header 'calendar)) + +(defun todo-edit-item-date-to-today () + "Set item's date to today's date." + (interactive) + (todo-basic-edit-item-header 'today)) + +(defun todo-edit-item-date-day-name () + "Replace item's date with the name of a day of the week." + (interactive) + (todo-basic-edit-item-header 'dayname)) + +(defun todo-edit-item-date-year (&optional inc) + "Interactively edit the year of item's date string. +With prefix argument INC a positive or negative integer, +increment or decrement the year by INC." + (interactive "p") + (todo-basic-edit-item-header 'year inc)) + +(defun todo-edit-item-date-month (&optional inc) + "Interactively edit the month of item's date string. +With prefix argument INC a positive or negative integer, +increment or decrement the month by INC." + (interactive "p") + (todo-basic-edit-item-header 'month inc)) + +(defun todo-edit-item-date-day (&optional inc) + "Interactively edit the day of the month of item's date string. +With prefix argument INC a positive or negative integer, +increment or decrement the day by INC." + (interactive "p") + (todo-basic-edit-item-header 'day inc)) + +(defun todo-edit-item-diary-inclusion () + "Change diary status of one or more todo items in this category. +That is, insert `todo-nondiary-marker' if the candidate items +lack this marking; otherwise, remove it. + +If there are marked todo items, change the diary status of all +and only these, otherwise change the diary status of the item at +point." + (interactive) + (let ((buffer-read-only) + (marked (assoc (todo-current-category) + todo-categories-with-marks))) + (catch 'stop + (save-excursion + (when marked (goto-char (point-min))) + (while (not (eobp)) + (if (todo-done-item-p) + (throw 'stop (message "Done items cannot be edited")) + (unless (and marked (not (todo-marked-item-p))) + (let* ((beg (todo-item-start)) + (lim (save-excursion (todo-item-end))) + (end (save-excursion + (or (todo-time-string-matcher lim) + (todo-date-string-matcher lim))))) + (if (looking-at (regexp-quote todo-nondiary-start)) + (progn + (replace-match "") + (search-forward todo-nondiary-end (1+ end) t) + (replace-match "") + (todo-update-count 'diary 1)) + (when end + (insert todo-nondiary-start) + (goto-char (1+ end)) + (insert todo-nondiary-end) + (todo-update-count 'diary -1))))) + (unless marked (throw 'stop nil)) + (todo-forward-item))))) + (todo-update-categories-sexp))) + +(defun todo-edit-category-diary-inclusion (arg) + "Make all items in this category diary items. +With prefix ARG, make all items in this category non-diary +items." + (interactive "P") + (save-excursion + (goto-char (point-min)) + (let ((todo-count (todo-get-count 'todo)) + (diary-count (todo-get-count 'diary)) + (buffer-read-only)) + (catch 'stop + (while (not (eobp)) + (if (todo-done-item-p) ; We've gone too far. + (throw 'stop nil) + (let* ((beg (todo-item-start)) + (lim (save-excursion (todo-item-end))) + (end (save-excursion + (or (todo-time-string-matcher lim) + (todo-date-string-matcher lim))))) + (if arg + (unless (looking-at (regexp-quote todo-nondiary-start)) + (insert todo-nondiary-start) + (goto-char (1+ end)) + (insert todo-nondiary-end)) + (when (looking-at (regexp-quote todo-nondiary-start)) + (replace-match "") + (search-forward todo-nondiary-end (1+ end) t) + (replace-match ""))))) + (todo-forward-item)) + (unless (if arg (zerop diary-count) (= diary-count todo-count)) + (todo-update-count 'diary (if arg + (- diary-count) + (- todo-count diary-count)))) + (todo-update-categories-sexp))))) + +(defun todo-edit-item-diary-nonmarking () + "Change non-marking of one or more diary items in this category. +That is, insert `diary-nonmarking-symbol' if the candidate items +lack this marking; otherwise, remove it. + +If there are marked todo items, change the non-marking status of +all and only these, otherwise change the non-marking status of +the item at point." + (interactive) + (let ((buffer-read-only) + (marked (assoc (todo-current-category) + todo-categories-with-marks))) + (catch 'stop + (save-excursion + (when marked (goto-char (point-min))) + (while (not (eobp)) + (if (todo-done-item-p) + (throw 'stop (message "Done items cannot be edited")) + (unless (and marked (not (todo-marked-item-p))) + (todo-item-start) + (unless (looking-at (regexp-quote todo-nondiary-start)) + (if (looking-at (regexp-quote diary-nonmarking-symbol)) + (replace-match "") + (insert diary-nonmarking-symbol)))) + (unless marked (throw 'stop nil)) + (todo-forward-item))))))) + +(defun todo-edit-category-diary-nonmarking (arg) + "Add `diary-nonmarking-symbol' to all diary items in this category. +With prefix ARG, remove `diary-nonmarking-symbol' from all diary +items in this category." + (interactive "P") + (save-excursion + (goto-char (point-min)) + (let (buffer-read-only) + (catch 'stop + (while (not (eobp)) + (if (todo-done-item-p) ; We've gone too far. + (throw 'stop nil) + (unless (looking-at (regexp-quote todo-nondiary-start)) + (if arg + (when (looking-at (regexp-quote diary-nonmarking-symbol)) + (replace-match "")) + (unless (looking-at (regexp-quote diary-nonmarking-symbol)) + (insert diary-nonmarking-symbol)))) + (todo-forward-item))))))) + +(defun todo-set-item-priority (&optional item cat new arg) + "Prompt for and set ITEM's priority in CATegory. + +Interactively, ITEM is the todo item at point, CAT is the current +category, and the priority is a number between 1 and the number +of items in the category. Non-interactively, non-nil NEW means +ITEM is a new item and the lowest priority is one more than the +number of items in CAT. + +The new priority is set either interactively by prompt or by a +numerical prefix argument, or noninteractively by argument ARG, +whose value can be either of the symbols `raise' or `lower', +meaning to raise or lower the item's priority by one." + (interactive) + (unless (and (called-interactively-p 'any) + (or (todo-done-item-p) (looking-at "^$"))) + (let* ((item (or item (todo-item-string))) + (marked (todo-marked-item-p)) + (cat (or cat (cond ((eq major-mode 'todo-mode) + (todo-current-category)) + ((eq major-mode 'todo-filtered-items-mode) + (let* ((regexp1 + (concat todo-date-string-start + todo-date-pattern + "\\( " diary-time-regexp "\\)?" + (regexp-quote todo-nondiary-end) + "?\\(?1: \\[\\(.+:\\)?.+\\]\\)"))) + (save-excursion + (re-search-forward regexp1 nil t) + (match-string-no-properties 1))))))) + curnum + (todo (cond ((or (eq arg 'raise) (eq arg 'lower) + (eq major-mode 'todo-filtered-items-mode)) + (save-excursion + (let ((curstart (todo-item-start)) + (count 0)) + (goto-char (point-min)) + (while (looking-at todo-item-start) + (setq count (1+ count)) + (when (= (point) curstart) (setq curnum count)) + (todo-forward-item)) + count))) + ((eq major-mode 'todo-mode) + (todo-get-count 'todo cat)))) + (maxnum (if new (1+ todo) todo)) + (prompt (format "Set item priority (1-%d): " maxnum)) + (priority (cond ((and (not arg) (numberp current-prefix-arg)) + current-prefix-arg) + ((and (eq arg 'raise) (>= curnum 1)) + (1- curnum)) + ((and (eq arg 'lower) (<= curnum maxnum)) + (1+ curnum)))) + candidate + buffer-read-only) + (unless (and priority + (or (and (eq arg 'raise) (zerop priority)) + (and (eq arg 'lower) (> priority maxnum)))) + ;; When moving item to another category, show the category before + ;; prompting for its priority. + (unless (or arg (called-interactively-p 'any)) + (todo-category-number cat) + ;; If done items in category are visible, keep them visible. + (let ((done todo-show-with-done)) + (when (> (buffer-size) (- (point-max) (point-min))) + (save-excursion + (goto-char (point-min)) + (setq done (re-search-forward todo-done-string-start nil t)))) + (let ((todo-show-with-done done)) + (todo-category-select) + ;; Keep top of category in view while setting priority. + (goto-char (point-min))))) + ;; Prompt for priority only when the category has at least one + ;; todo item. + (when (> maxnum 1) + (while (not priority) + (setq candidate (read-number prompt)) + (setq prompt (when (or (< candidate 1) (> candidate maxnum)) + (format "Priority must be an integer between 1 and %d.\n" + maxnum))) + (unless prompt (setq priority candidate)))) + ;; In Top Priorities buffer, an item's priority can be changed + ;; wrt items in another category, but not wrt items in the same + ;; category. + (when (eq major-mode 'todo-filtered-items-mode) + (let* ((regexp2 (concat todo-date-string-start todo-date-pattern + "\\( " diary-time-regexp "\\)?" + (regexp-quote todo-nondiary-end) + "?\\(?1:" (regexp-quote cat) "\\)")) + (end (cond ((< curnum priority) + (save-excursion (todo-item-end))) + ((> curnum priority) + (save-excursion (todo-item-start))))) + (match (save-excursion + (cond ((< curnum priority) + (todo-forward-item (1+ (- priority curnum))) + (when (re-search-backward regexp2 end t) + (match-string-no-properties 1))) + ((> curnum priority) + (todo-backward-item (- curnum priority)) + (when (re-search-forward regexp2 end t) + (match-string-no-properties 1))))))) + (when match + (user-error (concat "Cannot reprioritize items from the same " + "category in this mode, only in Todo mode"))))) + ;; Interactively or with non-nil ARG, relocate the item within its + ;; category. + (when (or arg (called-interactively-p 'any)) + (todo-remove-item)) + (goto-char (point-min)) + (when priority + (unless (= priority 1) + (todo-forward-item (1- priority)) + ;; When called from todo-item-undone and the highest priority + ;; is chosen, this advances point to the first done item, so + ;; move it up to the empty line above the done items + ;; separator. + (when (looking-back (concat "^" + (regexp-quote todo-category-done) + "\n")) + (todo-backward-item)))) + (todo-insert-with-overlays item) + ;; If item was marked, restore the mark. + (and marked + (let* ((ov (todo-get-overlay 'prefix)) + (pref (overlay-get ov 'before-string))) + (overlay-put ov 'before-string + (concat todo-item-mark pref)))))))) + +(defun todo-raise-item-priority () + "Raise priority of current item by moving it up by one item." + (interactive) + (todo-set-item-priority nil nil nil 'raise)) + +(defun todo-lower-item-priority () + "Lower priority of current item by moving it down by one item." + (interactive) + (todo-set-item-priority nil nil nil 'lower)) + +(defun todo-move-item (&optional file) + "Move at least one todo or done item to another category. +If there are marked items, move all of these; otherwise, move +the item at point. + +With prefix argument FILE, prompt for a specific todo file and +choose (with TAB completion) a category in it to move the item or +items to; otherwise, choose and move to any category in either +the current todo file or one of the files in +`todo-category-completions-files'. If the chosen category is +not an existing categories, then it is created and the item(s) +become(s) the first entry/entries in that category. + +With moved todo items, prompt to set the priority in the category +moved to (with multiple todo items, the one that had the highest +priority in the category moved from gets the new priority and the +rest of the moved todo items are inserted in sequence below it). +Moved done items are appended to the top of the done items +section in the category moved to." + (interactive "P") + (let* ((cat1 (todo-current-category)) + (marked (assoc cat1 todo-categories-with-marks))) + ;; Noop if point is not on an item and there are no marked items. + (unless (and (looking-at "^$") + (not marked)) + (let* ((buffer-read-only) + (file1 todo-current-todo-file) + (num todo-category-number) + (item (todo-item-string)) + (diary-item (todo-diary-item-p)) + (done-item (and (todo-done-item-p) (concat item "\n"))) + (omark (save-excursion (todo-item-start) (point-marker))) + (todo 0) + (diary 0) + (done 0) + ov cat2 file2 moved nmark todo-items done-items) + (unwind-protect + (progn + (unless marked + (setq ov (make-overlay (save-excursion (todo-item-start)) + (save-excursion (todo-item-end)))) + (overlay-put ov 'face 'todo-search)) + (let* ((pl (if (and marked (> (cdr marked) 1)) "s" "")) + (cat+file (todo-read-category (concat "Move item" pl + " to category: ") + nil file))) + (while (and (equal (car cat+file) cat1) + (equal (cdr cat+file) file1)) + (setq cat+file (todo-read-category + "Choose a different category: "))) + (setq cat2 (car cat+file) + file2 (cdr cat+file)))) + (if ov (delete-overlay ov))) + (set-buffer (find-buffer-visiting file1)) + (if marked + (progn + (goto-char (point-min)) + (while (not (eobp)) + (when (todo-marked-item-p) + (if (todo-done-item-p) + (setq done-items (concat done-items + (todo-item-string) "\n") + done (1+ done)) + (setq todo-items (concat todo-items + (todo-item-string) "\n") + todo (1+ todo)) + (when (todo-diary-item-p) + (setq diary (1+ diary))))) + (todo-forward-item)) + ;; Chop off last newline of multiple todo item string, + ;; since it will be reinserted when setting priority + ;; (but with done items priority is not set, so keep + ;; last newline). + (and todo-items + (setq todo-items (substring todo-items 0 -1)))) + (if (todo-done-item-p) + (setq done 1) + (setq todo 1) + (when (todo-diary-item-p) (setq diary 1)))) + (set-window-buffer (selected-window) + (set-buffer (find-file-noselect file2 'nowarn))) + (unwind-protect + (progn + (when (or todo-items (and item (not done-item))) + (todo-set-item-priority (or todo-items item) cat2 t)) + ;; Move done items en bloc to top of done items section. + (when (or done-items done-item) + (todo-category-number cat2) + (widen) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote (concat todo-category-beg cat2)) + "$") nil t) + (re-search-forward + (concat "^" (regexp-quote todo-category-done)) nil t) + (forward-line) + (insert (or done-items done-item))) + (setq moved t)) + (cond + ;; Move succeeded, so remove item from starting category, + ;; update item counts and display the category containing + ;; the moved item. + (moved + (setq nmark (point-marker)) + (when todo (todo-update-count 'todo todo)) + (when diary (todo-update-count 'diary diary)) + (when done (todo-update-count 'done done)) + (todo-update-categories-sexp) + (with-current-buffer (find-buffer-visiting file1) + (save-excursion + (save-restriction + (widen) + (goto-char omark) + (if marked + (let (beg end) + (setq item nil) + (re-search-backward + (concat "^" (regexp-quote todo-category-beg)) nil t) + (forward-line) + (setq beg (point)) + (setq end (if (re-search-forward + (concat "^" (regexp-quote + todo-category-beg)) nil t) + (match-beginning 0) + (point-max))) + (goto-char beg) + (while (< (point) end) + (if (todo-marked-item-p) + (todo-remove-item) + (todo-forward-item))) + (setq todo-categories-with-marks + (assq-delete-all cat1 todo-categories-with-marks))) + (if ov (delete-overlay ov)) + (todo-remove-item)))) + (when todo (todo-update-count 'todo (- todo) cat1)) + (when diary (todo-update-count 'diary (- diary) cat1)) + (when done (todo-update-count 'done (- done) cat1)) + (todo-update-categories-sexp)) + (set-window-buffer (selected-window) + (set-buffer (find-file-noselect file2 'nowarn))) + (setq todo-category-number (todo-category-number cat2)) + (let ((todo-show-with-done (or done-items done-item))) + (todo-category-select)) + (goto-char nmark) + ;; If item is moved to end of (just first?) category, make + ;; sure the items above it are displayed in the window. + (recenter)) + ;; User quit before setting priority of todo item(s), so + ;; return to starting category. + (t + (set-window-buffer (selected-window) + (set-buffer (find-file-noselect file1 'nowarn))) + (todo-category-number cat1) + (todo-category-select) + (goto-char omark)))))))) + +(defun todo-item-done (&optional arg) + "Tag a todo item in this category as done and relocate it. + +With prefix argument ARG prompt for a comment and append it to +the done item; this is only possible if there are no marked +items. If there are marked items, tag all of these with +`todo-done-string' plus the current date and, if +`todo-always-add-time-string' is non-nil, the current time; +otherwise, just tag the item at point. Items tagged as done are +relocated to the category's (by default hidden) done section. If +done items are visible on invoking this command, they remain +visible." + (interactive "P") + (let* ((cat (todo-current-category)) + (marked (assoc cat todo-categories-with-marks))) + (when marked + (save-excursion + (save-restriction + (goto-char (point-max)) + (todo-backward-item) + (unless (todo-done-item-p) + (widen) + (unless (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) nil t) + (goto-char (point-max))) + (forward-line -1)) + (while (todo-done-item-p) + (when (todo-marked-item-p) + (user-error "This command does not apply to done items")) + (todo-backward-item))))) + (unless (and (not marked) + (or (todo-done-item-p) + ;; Point is between todo and done items. + (looking-at "^$"))) + (let* ((date-string (calendar-date-string (calendar-current-date) t t)) + (time-string (if todo-always-add-time-string + (concat " " (substring (current-time-string) + 11 16)) + "")) + (done-prefix (concat "[" todo-done-string date-string time-string + "] ")) + (comment (and arg (read-string "Enter a comment: "))) + (item-count 0) + (diary-count 0) + (show-done (save-excursion + (goto-char (point-min)) + (re-search-forward todo-done-string-start nil t))) + (buffer-read-only nil) + item done-item opoint) + ;; Don't add empty comment to done item. + (setq comment (unless (zerop (length comment)) + (concat " [" todo-comment-string ": " comment "]"))) + (and marked (goto-char (point-min))) + (catch 'done + ;; Stop looping when we hit the empty line below the last + ;; todo item (this is eobp if only done items are hidden). + (while (not (looking-at "^$")) + (if (or (not marked) (and marked (todo-marked-item-p))) + (progn + (setq item (todo-item-string)) + (setq done-item (concat done-item done-prefix item + comment (and marked "\n"))) + (setq item-count (1+ item-count)) + (when (todo-diary-item-p) + (setq diary-count (1+ diary-count))) + (todo-remove-item) + (unless marked (throw 'done nil))) + (todo-forward-item)))) + (when marked + ;; Chop off last newline of done item string. + (setq done-item (substring done-item 0 -1)) + (setq todo-categories-with-marks + (assq-delete-all cat todo-categories-with-marks))) + (save-excursion + (widen) + (re-search-forward + (concat "^" (regexp-quote todo-category-done)) nil t) + (forward-char) + (when show-done (setq opoint (point))) + (insert done-item "\n")) + (todo-update-count 'todo (- item-count)) + (todo-update-count 'done item-count) + (todo-update-count 'diary (- diary-count)) + (todo-update-categories-sexp) + (let ((todo-show-with-done show-done)) + (todo-category-select) + ;; When done items are shown, put cursor on first just done item. + (when opoint (goto-char opoint))))))) + +(defun todo-edit-done-item-comment (&optional arg) + "Add a comment to this done item or edit an existing comment. +With prefix ARG delete an existing comment." + (interactive "P") + (when (todo-done-item-p) + (let ((item (todo-item-string)) + (opoint (point)) + (end (save-excursion (todo-item-end))) + comment buffer-read-only) + (save-excursion + (todo-item-start) + (if (re-search-forward (concat " \\[" + (regexp-quote todo-comment-string) + ": \\([^]]+\\)\\]") end t) + (if arg + (when (todo-y-or-n-p "Delete comment? ") + (delete-region (match-beginning 0) (match-end 0))) + (setq comment (read-string "Edit comment: " + (cons (match-string 1) 1))) + (replace-match comment nil nil nil 1)) + (setq comment (read-string "Enter a comment: ")) + ;; If user moved point during editing, make sure it moves back. + (goto-char opoint) + (todo-item-end) + (insert " [" todo-comment-string ": " comment "]")))))) + +(defun todo-item-undone () + "Restore at least one done item to this category's todo section. +Prompt for the new priority. If there are marked items, undo all +of these, giving the first undone item the new priority and the +rest following directly in sequence; otherwise, undo just the +item at point. + +If the done item has a comment, ask whether to omit the comment +from the restored item. With multiple marked done items with +comments, only ask once, and if affirmed, omit subsequent +comments without asking." + (interactive) + (let* ((cat (todo-current-category)) + (marked (assoc cat todo-categories-with-marks)) + (pl (if (and marked (> (cdr marked) 1)) "s" ""))) + (when (or marked (todo-done-item-p)) + (let ((buffer-read-only) + (opoint (point)) + (omark (point-marker)) + (first 'first) + (item-count 0) + (diary-count 0) + start end item ov npoint undone) + (and marked (goto-char (point-min))) + (catch 'done + (while (not (eobp)) + (when (or (not marked) (and marked (todo-marked-item-p))) + (if (not (todo-done-item-p)) + (user-error "Only done items can be undone") + (todo-item-start) + (unless marked + (setq ov (make-overlay (save-excursion (todo-item-start)) + (save-excursion (todo-item-end)))) + (overlay-put ov 'face 'todo-search)) + ;; Find the end of the date string added upon tagging item as + ;; done. + (setq start (search-forward "] ")) + (setq item-count (1+ item-count)) + (unless (looking-at (regexp-quote todo-nondiary-start)) + (setq diary-count (1+ diary-count))) + (setq end (save-excursion (todo-item-end))) + ;; Ask (once) whether to omit done item's comment. If + ;; affirmed, omit subsequent comments without asking. + (when (re-search-forward + (concat " \\[" (regexp-quote todo-comment-string) + ": [^]]+\\]") end t) + (unwind-protect + (if (eq first 'first) + (setq first + (if (eq todo-undo-item-omit-comment 'ask) + (when (todo-y-or-n-p + (concat "Omit comment" pl + " from restored item" + pl "? ")) + 'omit) + (when todo-undo-item-omit-comment 'omit))) + t) + (when (and (eq first 'first) ov) (delete-overlay ov))) + (when (eq first 'omit) + (setq end (match-beginning 0)))) + (setq item (concat item + (buffer-substring-no-properties start end) + (when marked "\n"))) + (unless marked (throw 'done nil)))) + (todo-forward-item))) + (unwind-protect + (progn + ;; Chop off last newline of multiple items string, since + ;; it will be reinserted on setting priority. + (and marked (setq item (substring item 0 -1))) + (todo-set-item-priority item cat t) + (setq npoint (point)) + (setq undone t)) + (when ov (delete-overlay ov)) + (if (not undone) + (goto-char opoint) + (if marked + (progn + (setq item nil) + (re-search-forward + (concat "^" (regexp-quote todo-category-done)) nil t) + (while (not (eobp)) + (if (todo-marked-item-p) + (todo-remove-item) + (todo-forward-item))) + (setq todo-categories-with-marks + (assq-delete-all cat todo-categories-with-marks))) + (goto-char omark) + (todo-remove-item)) + (todo-update-count 'todo item-count) + (todo-update-count 'done (- item-count)) + (when diary-count (todo-update-count 'diary diary-count)) + (todo-update-categories-sexp) + (let ((todo-show-with-done (> (todo-get-count 'done) 0))) + (todo-category-select)) + ;; Put cursor on undone item. + (goto-char npoint))) + (set-marker omark nil))))) + +;; ----------------------------------------------------------------------------- +;;; Done item archives +;; ----------------------------------------------------------------------------- + +(defun todo-find-archive (&optional ask) + "Visit the archive of the current todo category, if it exists. +If the category has no archived items, prompt to visit the +archive anyway. If there is no archive for this file or with +non-nil argument ASK, prompt to visit another archive. + +The buffer showing the archive is in Todo Archive mode. The +first visit in a session displays the first category in the +archive, subsequent visits return to the last category +displayed." + (interactive) + (let* ((cat (todo-current-category)) + (count (todo-get-count 'archived cat)) + (archive (concat (file-name-sans-extension todo-current-todo-file) + ".toda")) + place) + (setq place (cond (ask 'other-archive) + ((file-exists-p archive) 'this-archive) + (t (when (todo-y-or-n-p + (concat "This file has no archive; " + "visit another archive? ")) + 'other-archive)))) + (when (eq place 'other-archive) + (setq archive (todo-read-file-name "Choose a todo archive: " t t))) + (when (and (eq place 'this-archive) (zerop count)) + (setq place (when (todo-y-or-n-p + (concat "This category has no archived items;" + " visit archive anyway? ")) + 'other-cat))) + (when place + (set-window-buffer (selected-window) + (set-buffer (find-file-noselect archive))) + (if (member place '(other-archive other-cat)) + (setq todo-category-number 1) + (todo-category-number cat)) + (todo-category-select)))) + +(defun todo-choose-archive () + "Choose an archive and visit it." + (interactive) + (todo-find-archive t)) + +(defun todo-archive-done-item (&optional all) + "Archive at least one done item in this category. + +With prefix argument ALL, prompt whether to archive all done +items in this category and on confirmation archive them. +Otherwise, if there are marked done items (and no marked todo +items), archive all of these; otherwise, archive the done item at +point. + +If the archive of this file does not exist, it is created. If +this category does not exist in the archive, it is created." + (interactive "P") + (when (eq major-mode 'todo-mode) + (if (and all (zerop (todo-get-count 'done))) + (message "No done items in this category") + (catch 'end + (let* ((cat (todo-current-category)) + (tbuf (current-buffer)) + (marked (assoc cat todo-categories-with-marks)) + (afile (concat (file-name-sans-extension + todo-current-todo-file) ".toda")) + (archive (if (file-exists-p afile) + (find-file-noselect afile t) + (get-buffer-create afile))) + (item (and (todo-done-item-p) + (concat (todo-item-string) "\n"))) + (count 0) + (opoint (unless (todo-done-item-p) (point))) + marked-items beg end all-done + buffer-read-only) + (cond + (all + (if (todo-y-or-n-p "Archive all done items in this category? ") + (save-excursion + (save-restriction + (goto-char (point-min)) + (widen) + (setq beg (progn + (re-search-forward todo-done-string-start + nil t) + (match-beginning 0)) + end (if (re-search-forward + (concat "^" + (regexp-quote todo-category-beg)) + nil t) + (match-beginning 0) + (point-max)) + all-done (buffer-substring-no-properties beg end) + count (todo-get-count 'done)) + ;; Restore starting point, unless it was on a done + ;; item, since they will all be deleted. + (when opoint (goto-char opoint)))) + (throw 'end nil))) + (marked + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (todo-marked-item-p) + (if (not (todo-done-item-p)) + (throw 'end (message "Only done items can be archived")) + (setq marked-items + (concat marked-items (todo-item-string) "\n")) + (setq count (1+ count)))) + (todo-forward-item))))) + (if (not (or marked all item)) + (throw 'end (message "Only done items can be archived")) + (with-current-buffer archive + (unless buffer-file-name (erase-buffer)) + (let (buffer-read-only) + (widen) + (goto-char (point-min)) + (if (and (re-search-forward + (concat "^" (regexp-quote + (concat todo-category-beg cat)) "$") + nil t) + (re-search-forward (regexp-quote todo-category-done) + nil t)) + ;; Start of done items section in existing category. + (forward-char) + (todo-add-category nil cat) + ;; Start of done items section in new category. + (goto-char (point-max))) + (insert (cond (marked marked-items) + (all all-done) + (item))) + (todo-update-count 'done (if (or marked all) count 1) cat) + (todo-update-categories-sexp) + ;; If archive is new, save to file now (using write-region in + ;; order not to get prompted for file to save to), to let + ;; auto-mode-alist take effect below. + (unless buffer-file-name + (write-region nil nil afile) + (kill-buffer)))) + (with-current-buffer tbuf + (cond + (all + (save-excursion + (save-restriction + ;; Make sure done items are accessible. + (widen) + (remove-overlays beg end) + (delete-region beg end) + (todo-update-count 'done (- count)) + (todo-update-count 'archived count)))) + ((or marked + ;; If we're archiving all done items, can't + ;; first archive item point was on, since + ;; that will short-circuit the rest. + (and item (not all))) + (and marked (goto-char (point-min))) + (catch 'done + (while (not (eobp)) + (if (or (and marked (todo-marked-item-p)) item) + (progn + (todo-remove-item) + (todo-update-count 'done -1) + (todo-update-count 'archived 1) + ;; Don't leave point below last item. + (and item (bolp) (eolp) (< (point-min) (point-max)) + (todo-backward-item)) + (when item + (throw 'done (setq item nil)))) + (todo-forward-item)))))) + (when marked + (setq todo-categories-with-marks + (assq-delete-all cat todo-categories-with-marks))) + (todo-update-categories-sexp) + (todo-prefix-overlays))) + (find-file afile) + (todo-category-number cat) + (todo-category-select) + (split-window-below) + (set-window-buffer (selected-window) tbuf) + ;; Make todo file current to select category. + (find-file (buffer-file-name tbuf)) + ;; Make sure done item separator is hidden (if done items + ;; were initially visible). + (let (todo-show-with-done) (todo-category-select))))))) + +(defun todo-unarchive-items () + "Unarchive at least one item in this archive category. +If there are marked items, unarchive all of these; otherwise, +unarchive the item at point. + +Unarchived items are restored as done items to the corresponding +category in the todo file, inserted at the top of done items +section. If all items in the archive category have been +restored, the category is deleted from the archive. If this was +the only category in the archive, the archive file is deleted." + (interactive) + (when (eq major-mode 'todo-archive-mode) + (let* ((cat (todo-current-category)) + (tbuf (find-file-noselect + (concat (file-name-sans-extension todo-current-todo-file) + ".todo") t)) + (marked (assoc cat todo-categories-with-marks)) + (item (concat (todo-item-string) "\n")) + (marked-count 0) + marked-items + buffer-read-only) + (when marked + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (todo-marked-item-p) + (setq marked-items (concat marked-items (todo-item-string) "\n")) + (setq marked-count (1+ marked-count))) + (todo-forward-item)))) + ;; Restore items to top of category's done section and update counts. + (with-current-buffer tbuf + (let (buffer-read-only newcat) + (widen) + (goto-char (point-min)) + ;; Find the corresponding todo category, or if there isn't + ;; one, add it. + (unless (re-search-forward + (concat "^" (regexp-quote (concat todo-category-beg cat)) + "$") nil t) + (todo-add-category nil cat) + (setq newcat t)) + ;; Go to top of category's done section. + (re-search-forward + (concat "^" (regexp-quote todo-category-done)) nil t) + (forward-line) + (cond (marked + (insert marked-items) + (todo-update-count 'done marked-count cat) + (unless newcat ; Newly added category has no archive. + (todo-update-count 'archived (- marked-count) cat))) + (t + (insert item) + (todo-update-count 'done 1 cat) + (unless newcat ; Newly added category has no archive. + (todo-update-count 'archived -1 cat)))) + (todo-update-categories-sexp))) + ;; Delete restored items from archive. + (when marked + (setq item nil) + (goto-char (point-min))) + (catch 'done + (while (not (eobp)) + (if (or (todo-marked-item-p) item) + (progn + (todo-remove-item) + (when item + (throw 'done (setq item nil)))) + (todo-forward-item)))) + (todo-update-count 'done (if marked (- marked-count) -1) cat) + ;; If that was the last category in the archive, delete the whole file. + (if (= (length todo-categories) 1) + (progn + (delete-file todo-current-todo-file) + ;; Kill the archive buffer silently. + (set-buffer-modified-p nil) + (kill-buffer)) + ;; Otherwise, if the archive category is now empty, delete it. + (when (eq (point-min) (point-max)) + (widen) + (let ((beg (re-search-backward + (concat "^" (regexp-quote todo-category-beg) cat "$") + nil t)) + (end (if (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) + nil t 2) + (match-beginning 0) + (point-max)))) + (remove-overlays beg end) + (delete-region beg end) + (setq todo-categories (delete (assoc cat todo-categories) + todo-categories)) + (todo-update-categories-sexp)))) + ;; Visit category in todo file and show restored done items. + (let ((tfile (buffer-file-name tbuf)) + (todo-show-with-done t)) + (set-window-buffer (selected-window) + (set-buffer (find-file-noselect tfile))) + (todo-category-number cat) + (todo-category-select) + (message "Items unarchived."))))) + +(defun todo-jump-to-archive-category (&optional file) + "Prompt for a category in a todo archive and jump to it. +With prefix argument FILE, prompt for an archive and choose (with +TAB completion) a category in it to jump to; otherwise, choose +and jump to any category in the current archive." + (interactive "P") + (todo-jump-to-category file 'archive)) + +;; ----------------------------------------------------------------------------- +;;; Displaying and sorting tables of categories +;; ----------------------------------------------------------------------------- + +(defcustom todo-categories-category-label "Category" + "Category button label in Todo Categories mode." + :type 'string + :group 'todo-categories) + +(defcustom todo-categories-todo-label "Todo" + "Todo button label in Todo Categories mode." + :type 'string + :group 'todo-categories) + +(defcustom todo-categories-diary-label "Diary" + "Diary button label in Todo Categories mode." + :type 'string + :group 'todo-categories) + +(defcustom todo-categories-done-label "Done" + "Done button label in Todo Categories mode." + :type 'string + :group 'todo-categories) + +(defcustom todo-categories-archived-label "Archived" + "Archived button label in Todo Categories mode." + :type 'string + :group 'todo-categories) + +(defcustom todo-categories-totals-label "Totals" + "String to label total item counts in Todo Categories mode." + :type 'string + :group 'todo-categories) + +(defcustom todo-categories-number-separator " | " + "String between number and category in Todo Categories mode. +This separates the number from the category name in the default +categories display according to priority." + :type 'string + :group 'todo-categories) + +(defcustom todo-categories-align 'center + "Alignment of category names in Todo Categories mode." + :type '(radio (const left) (const center) (const right)) + :group 'todo-categories) + +(defun todo-show-categories-table () + "Display a table of the current file's categories and item counts. + +In the initial display the categories are numbered, indicating +their current order for navigating by \\[todo-forward-category] +and \\[todo-backward-category]. You can persistantly change the +order of the category at point by typing +\\[todo-set-category-number], \\[todo-raise-category] or +\\[todo-lower-category]. + +The labels above the category names and item counts are buttons, +and clicking these changes the display: sorted by category name +or by the respective item counts (alternately descending or +ascending). In these displays the categories are not numbered +and \\[todo-set-category-number], \\[todo-raise-category] and +\\[todo-lower-category] are disabled. (Programmatically, the +sorting is triggered by passing a non-nil SORTKEY argument.) + +In addition, the lines with the category names and item counts +are buttonized, and pressing one of these button jumps to the +category in Todo mode (or Todo Archive mode, for categories +containing only archived items, provided user option +`todo-skip-archived-categories' is non-nil. These categories +are shown in `todo-archived-only' face." + (interactive) + (todo-display-categories) + (let (sortkey) + (todo-update-categories-display sortkey))) + +(defun todo-next-button (n) + "Move point to the Nth next button in the table of categories." + (interactive "p") + (forward-button n 'wrap 'display-message) + (and (bolp) (button-at (point)) + ;; Align with beginning of category label. + (forward-char (+ 4 (length todo-categories-number-separator))))) + +(defun todo-previous-button (n) + "Move point to the Nth previous button in the table of categories." + (interactive "p") + (backward-button n 'wrap 'display-message) + (and (bolp) (button-at (point)) + ;; Align with beginning of category label. + (forward-char (+ 4 (length todo-categories-number-separator))))) + +(defun todo-set-category-number (&optional arg) + "Change number of category at point in the table of categories. + +With ARG nil, prompt for the new number. Alternatively, the +enter the new number with numerical prefix ARG. Otherwise, if +ARG is either of the symbols `raise' or `lower', raise or lower +the category line in the table by one, respectively, thereby +decreasing or increasing its number." + (interactive "P") + (let ((curnum (save-excursion + ;; Get the number representing the priority of the category + ;; on the current line. + (forward-line 0) (skip-chars-forward " ") (number-at-point)))) + (when curnum ; Do nothing if we're not on a category line. + (let* ((maxnum (length todo-categories)) + (prompt (format "Set category priority (1-%d): " maxnum)) + (col (current-column)) + (buffer-read-only nil) + (priority (cond ((and (eq arg 'raise) (> curnum 1)) + (1- curnum)) + ((and (eq arg 'lower) (< curnum maxnum)) + (1+ curnum)))) + candidate) + (while (not priority) + (setq candidate (or arg (read-number prompt))) + (setq arg nil) + (setq prompt + (cond ((or (< candidate 1) (> candidate maxnum)) + (format "Priority must be an integer between 1 and %d: " + maxnum)) + ((= candidate curnum) + "Choose a different priority than the current one: "))) + (unless prompt (setq priority candidate))) + (let* ((lower (< curnum priority)) ; Priority is being lowered. + (head (butlast todo-categories + (apply (if lower 'identity '1+) + (list (- maxnum priority))))) + (tail (nthcdr (apply (if lower 'identity '1-) (list priority)) + todo-categories)) + ;; Category's name and items counts list. + (catcons (nth (1- curnum) todo-categories)) + (todo-categories (nconc head (list catcons) tail)) + newcats) + (when lower (setq todo-categories (nreverse todo-categories))) + (setq todo-categories (delete-dups todo-categories)) + (when lower (setq todo-categories (nreverse todo-categories))) + (setq newcats todo-categories) + (kill-buffer) + (with-current-buffer (find-buffer-visiting todo-current-todo-file) + (setq todo-categories newcats) + (todo-update-categories-sexp)) + (todo-show-categories-table) + (forward-line (1+ priority)) + (forward-char col)))))) + +(defun todo-raise-category () + "Raise priority of category at point in the table of categories." + (interactive) + (todo-set-category-number 'raise)) + +(defun todo-lower-category () + "Lower priority of category at point in the table of categories." + (interactive) + (todo-set-category-number 'lower)) + +(defun todo-sort-categories-alphabetically-or-numerically () + "Sort table of categories alphabetically or numerically." + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (if (member 'alpha todo-descending-counts) + (progn + (todo-update-categories-display nil) + (setq todo-descending-counts + (delete 'alpha todo-descending-counts))) + (todo-update-categories-display 'alpha)))) + +(defun todo-sort-categories-by-todo () + "Sort table of categories by number of todo items." + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (todo-update-categories-display 'todo))) + +(defun todo-sort-categories-by-diary () + "Sort table of categories by number of diary items." + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (todo-update-categories-display 'diary))) + +(defun todo-sort-categories-by-done () + "Sort table of categories by number of non-archived done items." + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (todo-update-categories-display 'done))) + +(defun todo-sort-categories-by-archived () + "Sort table of categories by number of archived items." + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (todo-update-categories-display 'archived))) + +(defvar todo-categories-buffer "*Todo Categories*" + "Name of buffer in Todo Categories mode.") + +(defun todo-longest-category-name-length (categories) + "Return the length of the longest name in list CATEGORIES." + (let ((longest 0)) + (dolist (c categories longest) + (setq longest (max longest (length c)))))) + +(defun todo-adjusted-category-label-length () + "Return adjusted length of category label button. +The adjustment ensures proper tabular alignment in Todo +Categories mode." + (let* ((categories (mapcar 'car todo-categories)) + (longest (todo-longest-category-name-length categories)) + (catlablen (length todo-categories-category-label)) + (lc-diff (- longest catlablen))) + (if (and (natnump lc-diff) (cl-oddp lc-diff)) + (1+ longest) + (max longest catlablen)))) + +(defun todo-padded-string (str) + "Return category name or label string STR padded with spaces. +The placement of the padding is determined by the value of user +option `todo-categories-align'." + (let* ((len (todo-adjusted-category-label-length)) + (strlen (length str)) + (strlen-odd (eq (logand strlen 1) 1)) + (padding (max 0 (/ (- len strlen) 2))) + (padding-left (cond ((eq todo-categories-align 'left) 0) + ((eq todo-categories-align 'center) padding) + ((eq todo-categories-align 'right) + (if strlen-odd (1+ (* padding 2)) (* padding 2))))) + (padding-right (cond ((eq todo-categories-align 'left) + (if strlen-odd (1+ (* padding 2)) (* padding 2))) + ((eq todo-categories-align 'center) + (if strlen-odd (1+ padding) padding)) + ((eq todo-categories-align 'right) 0)))) + (concat (make-string padding-left 32) str (make-string padding-right 32)))) + +(defvar todo-descending-counts nil + "List of keys for category counts sorted in descending order.") + +(defun todo-sort (list &optional key) + "Return a copy of LIST, possibly sorted according to KEY." + (let* ((l (copy-sequence list)) + (fn (if (eq key 'alpha) + (lambda (x) (upcase x)) ; Alphabetize case insensitively. + (lambda (x) (todo-get-count key x)))) + ;; Keep track of whether the last sort by key was descending or + ;; ascending. + (descending (member key todo-descending-counts)) + (cmp (if (eq key 'alpha) + 'string< + (if descending '< '>))) + (pred (lambda (s1 s2) (let ((t1 (funcall fn (car s1))) + (t2 (funcall fn (car s2)))) + (funcall cmp t1 t2))))) + (when key + (setq l (sort l pred)) + ;; Switch between descending and ascending sort order. + (if descending + (setq todo-descending-counts + (delete key todo-descending-counts)) + (push key todo-descending-counts))) + l)) + +(defun todo-display-sorted (type) + "Keep point on the TYPE count sorting button just clicked." + (let ((opoint (point))) + (todo-update-categories-display type) + (goto-char opoint))) + +(defun todo-label-to-key (label) + "Return symbol for sort key associated with LABEL." + (let (key) + (cond ((string= label todo-categories-category-label) + (setq key 'alpha)) + ((string= label todo-categories-todo-label) + (setq key 'todo)) + ((string= label todo-categories-diary-label) + (setq key 'diary)) + ((string= label todo-categories-done-label) + (setq key 'done)) + ((string= label todo-categories-archived-label) + (setq key 'archived))) + key)) + +(defun todo-insert-sort-button (label) + "Insert button for displaying categories sorted by item counts. +LABEL determines which type of count is sorted." + (let* ((str (if (string= label todo-categories-category-label) + (todo-padded-string label) + label)) + (beg (point)) + (end (+ beg (length str))) + ov) + (insert-button str 'face nil + 'action + `(lambda (button) + (let ((key (todo-label-to-key ,label))) + (if (and (member key todo-descending-counts) + (eq key 'alpha)) + (progn + ;; If display is alphabetical, switch back to + ;; category priority order. + (todo-display-sorted nil) + (setq todo-descending-counts + (delete key todo-descending-counts))) + (todo-display-sorted key))))) + (setq ov (make-overlay beg end)) + (overlay-put ov 'face 'todo-button))) + +(defun todo-total-item-counts () + "Return a list of total item counts for the current file." + (mapcar (lambda (i) (apply '+ (mapcar (lambda (l) (aref l i)) + (mapcar 'cdr todo-categories)))) + (list 0 1 2 3))) + +(defvar todo-categories-category-number 0 + "Variable for numbering categories in Todo Categories mode.") + +(defun todo-insert-category-line (cat &optional nonum) + "Insert button with category CAT's name and item counts. +With non-nil argument NONUM show only these; otherwise, insert a +number in front of the button indicating the category's priority. +The number and the category name are separated by the string +which is the value of the user option +`todo-categories-number-separator'." + (let ((archive (member todo-current-todo-file todo-archives)) + (num todo-categories-category-number) + (str (todo-padded-string cat)) + (opoint (point))) + (setq num (1+ num) todo-categories-category-number num) + (insert-button + (concat (if nonum + (make-string (+ 4 (length todo-categories-number-separator)) + 32) + (format " %3d%s" num todo-categories-number-separator)) + str + (mapconcat (lambda (elt) + (concat + (make-string (1+ (/ (length (car elt)) 2)) 32) ; label + (format "%3d" (todo-get-count (cdr elt) cat)) ; count + ;; Add an extra space if label length is odd. + (when (cl-oddp (length (car elt))) " "))) + (if archive + (list (cons todo-categories-done-label 'done)) + (list (cons todo-categories-todo-label 'todo) + (cons todo-categories-diary-label 'diary) + (cons todo-categories-done-label 'done) + (cons todo-categories-archived-label + 'archived))) + "") + " ") ; Make highlighting on last column look better. + 'face (if (and todo-skip-archived-categories + (zerop (todo-get-count 'todo cat)) + (zerop (todo-get-count 'done cat)) + (not (zerop (todo-get-count 'archived cat)))) + 'todo-archived-only + nil) + 'action `(lambda (button) (let ((buf (current-buffer))) + (todo-jump-to-category nil ,cat) + (kill-buffer buf)))) + ;; Highlight the sorted count column. + (let* ((beg (+ opoint 7 (length str))) + end ovl) + (cond ((eq nonum 'todo) + (setq beg (+ beg 1 (/ (length todo-categories-todo-label) 2)))) + ((eq nonum 'diary) + (setq beg (+ beg 1 (length todo-categories-todo-label) + 2 (/ (length todo-categories-diary-label) 2)))) + ((eq nonum 'done) + (setq beg (+ beg 1 (length todo-categories-todo-label) + 2 (length todo-categories-diary-label) + 2 (/ (length todo-categories-done-label) 2)))) + ((eq nonum 'archived) + (setq beg (+ beg 1 (length todo-categories-todo-label) + 2 (length todo-categories-diary-label) + 2 (length todo-categories-done-label) + 2 (/ (length todo-categories-archived-label) 2))))) + (unless (= beg (+ opoint 7 (length str))) ; Don't highlight categories. + (setq end (+ beg 4)) + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'face 'todo-sorted-column))) + (newline))) + +(defun todo-display-categories () + "Prepare buffer for displaying table of categories and item counts." + (unless (eq major-mode 'todo-categories-mode) + (setq todo-global-current-todo-file + (or todo-current-todo-file + (todo-absolute-file-name todo-default-todo-file))) + (set-window-buffer (selected-window) + (set-buffer (get-buffer-create todo-categories-buffer))) + (kill-all-local-variables) + (todo-categories-mode) + (let ((archive (member todo-current-todo-file todo-archives)) + buffer-read-only) + (erase-buffer) + (insert (format (concat "Category counts for todo " + (if archive "archive" "file") + " \"%s\".") + (todo-short-file-name todo-current-todo-file))) + (newline 2) + ;; Make space for the column of category numbers. + (insert (make-string (+ 4 (length todo-categories-number-separator)) 32)) + ;; Add the category and item count buttons (if this is the list of + ;; categories in an archive, show only done item counts). + (todo-insert-sort-button todo-categories-category-label) + (if archive + (progn + (insert (make-string 3 32)) + (todo-insert-sort-button todo-categories-done-label)) + (insert (make-string 3 32)) + (todo-insert-sort-button todo-categories-todo-label) + (insert (make-string 2 32)) + (todo-insert-sort-button todo-categories-diary-label) + (insert (make-string 2 32)) + (todo-insert-sort-button todo-categories-done-label) + (insert (make-string 2 32)) + (todo-insert-sort-button todo-categories-archived-label)) + (newline 2)))) + +(defun todo-update-categories-display (sortkey) + "Populate table of categories and sort by SORTKEY." + (let* ((cats0 todo-categories) + (cats (todo-sort cats0 sortkey)) + (archive (member todo-current-todo-file todo-archives)) + (todo-categories-category-number 0) + ;; Find start of Category button if we just entered Todo Categories + ;; mode. + (pt (if (eq (point) (point-max)) + (save-excursion + (forward-line -2) + (goto-char (next-single-char-property-change + (point) 'face nil (line-end-position)))))) + (buffer-read-only)) + (forward-line 2) + (delete-region (point) (point-max)) + ;; Fill in the table with buttonized lines, each showing a category and + ;; its item counts. + (mapc (lambda (cat) (todo-insert-category-line cat sortkey)) + (mapcar 'car cats)) + (newline) + ;; Add a line showing item count totals. + (insert (make-string (+ 4 (length todo-categories-number-separator)) 32) + (todo-padded-string todo-categories-totals-label) + (mapconcat + (lambda (elt) + (concat + (make-string (1+ (/ (length (car elt)) 2)) 32) + (format "%3d" (nth (cdr elt) (todo-total-item-counts))) + ;; Add an extra space if label length is odd. + (when (cl-oddp (length (car elt))) " "))) + (if archive + (list (cons todo-categories-done-label 2)) + (list (cons todo-categories-todo-label 0) + (cons todo-categories-diary-label 1) + (cons todo-categories-done-label 2) + (cons todo-categories-archived-label 3))) + "")) + ;; Put cursor on Category button initially. + (if pt (goto-char pt)) + (setq buffer-read-only t))) + +;; ----------------------------------------------------------------------------- +;;; Searching and item filtering +;; ----------------------------------------------------------------------------- + +(defun todo-search () + "Search for a regular expression in this todo file. +The search runs through the whole file and encompasses all and +only todo and done items; it excludes category names. Multiple +matches are shown sequentially, highlighted in `todo-search' +face." + (interactive) + (let ((regex (read-from-minibuffer "Enter a search string (regexp): ")) + (opoint (point)) + matches match cat in-done ov mlen msg) + (widen) + (goto-char (point-min)) + (while (not (eobp)) + (setq match (re-search-forward regex nil t)) + (goto-char (line-beginning-position)) + (unless (or (equal (point) 1) + (looking-at (concat "^" (regexp-quote todo-category-beg)))) + (if match (push match matches))) + (forward-line)) + (setq matches (reverse matches)) + (if matches + (catch 'stop + (while matches + (setq match (pop matches)) + (goto-char match) + (todo-item-start) + (when (looking-at todo-done-string-start) + (setq in-done t)) + (re-search-backward (concat "^" (regexp-quote todo-category-beg) + "\\(.*\\)\n") nil t) + (setq cat (match-string-no-properties 1)) + (todo-category-number cat) + (todo-category-select) + (if in-done + (unless todo-show-with-done (todo-toggle-view-done-items))) + (goto-char match) + (setq ov (make-overlay (- (point) (length regex)) (point))) + (overlay-put ov 'face 'todo-search) + (when matches + (setq mlen (length matches)) + (if (todo-y-or-n-p + (if (> mlen 1) + (format "There are %d more matches; go to next match? " + mlen) + "There is one more match; go to it? ")) + (widen) + (throw 'stop (setq msg (if (> mlen 1) + (format "There are %d more matches." + mlen) + "There is one more match.")))))) + (setq msg "There are no more matches.")) + (todo-category-select) + (goto-char opoint) + (message "No match for \"%s\"" regex)) + (when msg + (if (todo-y-or-n-p (concat msg "\nUnhighlight matches? ")) + (todo-clear-matches) + (message "You can unhighlight the matches later by typing %s" + (key-description (car (where-is-internal + 'todo-clear-matches)))))))) + +(defun todo-clear-matches () + "Remove highlighting on matches found by todo-search." + (interactive) + (remove-overlays 1 (1+ (buffer-size)) 'face 'todo-search)) + +(defcustom todo-top-priorities-overrides nil + "List of rules specifying number of top priority items to show. +These rules override `todo-top-priorities' on invocations of +`\\[todo-filter-top-priorities]' and +`\\[todo-filter-top-priorities-multifile]'. Each rule is a list +of the form (FILE NUM ALIST), where FILE is a member of +`todo-files', NUM is a number specifying the default number of +top priority items for each category in that file, and ALIST, +when non-nil, consists of conses of a category name in FILE and a +number specifying the default number of top priority items in +that category, which overrides NUM. + +This variable should be set interactively by +`\\[todo-set-top-priorities-in-file]' or +`\\[todo-set-top-priorities-in-category]'." + :type 'sexp + :group 'todo-filtered) + +(defcustom todo-top-priorities 1 + "Default number of top priorities shown by `todo-filter-top-priorities'." + :type 'integer + :group 'todo-filtered) + +(defcustom todo-filter-files nil + "List of default files for multifile item filtering." + :type `(set ,@(mapcar (lambda (f) (list 'const f)) + (mapcar 'todo-short-file-name + (funcall todo-files-function)))) + :group 'todo-filtered) + +(defcustom todo-filter-done-items nil + "Non-nil to include done items when processing regexp filters. +Done items from corresponding archive files are also included." + :type 'boolean + :group 'todo-filtered) + +(defun todo-set-top-priorities-in-file () + "Set number of top priorities for this file. +See `todo-set-top-priorities' for more details." + (interactive) + (todo-set-top-priorities)) + +(defun todo-set-top-priorities-in-category () + "Set number of top priorities for this category. +See `todo-set-top-priorities' for more details." + (interactive) + (todo-set-top-priorities t)) + +(defun todo-filter-top-priorities (&optional arg) + "Display a list of top priority items from different categories. +The categories can be any of those in the current todo file. + +With numerical prefix ARG show at most ARG top priority items +from each category. With `C-u' as prefix argument show the +numbers of top priority items specified by category in +`todo-top-priorities-overrides', if this has an entry for the file(s); +otherwise show `todo-top-priorities' items per category in the +file(s). With no prefix argument, if a top priorities file for +the current todo file has previously been saved (see +`todo-save-filtered-items-buffer'), visit this file; if there is +no such file, build the list as with prefix argument `C-u'. + + The prefix ARG regulates how many top priorities from +each category to show, as described above." + (interactive "P") + (todo-filter-items 'top arg)) + +(defun todo-filter-top-priorities-multifile (&optional arg) + "Display a list of top priority items from different categories. +The categories are a subset of the categories in the files listed +in `todo-filter-files', or if this nil, in the files chosen from +a file selection dialog that pops up in this case. + +With numerical prefix ARG show at most ARG top priority items +from each category in each file. With `C-u' as prefix argument +show the numbers of top priority items specified in +`todo-top-priorities-overrides', if this is non-nil; otherwise show +`todo-top-priorities' items per category. With no prefix +argument, if a top priorities file for the chosen todo files +exists (see `todo-save-filtered-items-buffer'), visit this file; +if there is no such file, do the same as with prefix argument +`C-u'." + (interactive "P") + (todo-filter-items 'top arg t)) + +(defun todo-filter-diary-items (&optional arg) + "Display a list of todo diary items from different categories. +The categories can be any of those in the current todo file. + +Called with no prefix ARG, if a diary items file for the current +todo file has previously been saved (see +`todo-save-filtered-items-buffer'), visit this file; if there is +no such file, build the list of diary items. Called with a +prefix argument, build the list even if there is a saved file of +diary items." + (interactive "P") + (todo-filter-items 'diary arg)) + +(defun todo-filter-diary-items-multifile (&optional arg) + "Display a list of todo diary items from different categories. +The categories are a subset of the categories in the files listed +in `todo-filter-files', or if this nil, in the files chosen from +a file selection dialog that pops up in this case. + +Called with no prefix ARG, if a diary items file for the chosen +todo files has previously been saved (see +`todo-save-filtered-items-buffer'), visit this file; if there is +no such file, build the list of diary items. Called with a +prefix argument, build the list even if there is a saved file of +diary items." + (interactive "P") + (todo-filter-items 'diary arg t)) + +(defun todo-filter-regexp-items (&optional arg) + "Prompt for a regular expression and display items that match it. +The matches can be from any categories in the current todo file +and with non-nil option `todo-filter-done-items', can include +not only todo items but also done items, including those in +Archive files. + +Called with no prefix ARG, if a regexp items file for the current +todo file has previously been saved (see +`todo-save-filtered-items-buffer'), visit this file; if there is +no such file, build the list of regexp items. Called with a +prefix argument, build the list even if there is a saved file of +regexp items." + (interactive "P") + (todo-filter-items 'regexp arg)) + +(defun todo-filter-regexp-items-multifile (&optional arg) + "Prompt for a regular expression and display items that match it. +The matches can be from any categories in the files listed in +`todo-filter-files', or if this nil, in the files chosen from a +file selection dialog that pops up in this case. With non-nil +option `todo-filter-done-items', the matches can include not +only todo items but also done items, including those in Archive +files. + +Called with no prefix ARG, if a regexp items file for the current +todo file has previously been saved (see +`todo-save-filtered-items-buffer'), visit this file; if there is +no such file, build the list of regexp items. Called with a +prefix argument, build the list even if there is a saved file of +regexp items." + (interactive "P") + (todo-filter-items 'regexp arg t)) + +(defun todo-find-filtered-items-file () + "Choose a filtered items file and visit it." + (interactive) + (let ((files (directory-files todo-directory t "\.tod[rty]$" t)) + falist file) + (dolist (f files) + (let ((type (cond ((equal (file-name-extension f) "todr") "regexp") + ((equal (file-name-extension f) "todt") "top") + ((equal (file-name-extension f) "tody") "diary")))) + (push (cons (concat (todo-short-file-name f) " (" type ")") f) + falist))) + (setq file (completing-read "Choose a filtered items file: " + falist nil t nil nil (car falist))) + (setq file (cdr (assoc-string file falist))) + (find-file file))) + +(defun todo-go-to-source-item () + "Display the file and category of the filtered item at point." + (interactive) + (let* ((str (todo-item-string)) + (buf (current-buffer)) + (res (todo-find-item str)) + (found (nth 0 res)) + (file (nth 1 res)) + (cat (nth 2 res))) + (if (not found) + (message "Category %s does not contain this item." cat) + (kill-buffer buf) + (set-window-buffer (selected-window) + (set-buffer (find-buffer-visiting file))) + (setq todo-current-todo-file file) + (setq todo-category-number (todo-category-number cat)) + (let ((todo-show-with-done (if (or todo-filter-done-items + (eq (cdr found) 'done)) + t + todo-show-with-done))) + (todo-category-select)) + (goto-char (car found))))) + +(defvar todo-multiple-filter-files nil + "List of files selected from `todo-multiple-filter-files' widget.") + +(defvar todo-multiple-filter-files-widget nil + "Variable holding widget created by `todo-multiple-filter-files'.") + +(defun todo-multiple-filter-files () + "Pop to a buffer with a widget for choosing multiple filter files." + (require 'widget) + (eval-when-compile + (require 'wid-edit)) + (with-current-buffer (get-buffer-create "*Todo Filter Files*") + (pop-to-buffer (current-buffer)) + (erase-buffer) + (kill-all-local-variables) + (widget-insert "Select files for generating the top priorities list.\n\n") + (setq todo-multiple-filter-files-widget + (widget-create + `(set ,@(mapcar (lambda (x) (list 'const x)) + (mapcar 'todo-short-file-name + (funcall todo-files-function)))))) + (widget-insert "\n") + (widget-create 'push-button + :notify (lambda (widget &rest ignore) + (setq todo-multiple-filter-files 'quit) + (quit-window t) + (exit-recursive-edit)) + "Cancel") + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (setq todo-multiple-filter-files + (mapcar (lambda (f) + (file-truename + (concat todo-directory + f ".todo"))) + (widget-value + todo-multiple-filter-files-widget))) + (quit-window t) + (exit-recursive-edit)) + "Apply") + (use-local-map widget-keymap) + (widget-setup)) + (message "Click \"Apply\" after selecting files.") + (recursive-edit)) + +(defconst todo-filtered-items-buffer "Todo filtered items" + "Initial name of buffer in Todo Filter Items mode.") + +(defconst todo-top-priorities-buffer "Todo top priorities" + "Buffer type string for `todo-filter-items'.") + +(defconst todo-diary-items-buffer "Todo diary items" + "Buffer type string for `todo-filter-items'.") + +(defconst todo-regexp-items-buffer "Todo regexp items" + "Buffer type string for `todo-filter-items'.") + +(defun todo-filter-items (filter &optional new multifile) + "Display a cross-categorial list of items filtered by FILTER. +The values of FILTER can be `top' for top priority items, a cons +of `top' and a number passed by the caller, `diary' for diary +items, or `regexp' for items matching a regular expresion entered +by the user. The items can be from any categories in the current +todo file or, with non-nil MULTIFILE, from several files. If NEW +is nil, visit an appropriate file containing the list of filtered +items; if there is no such file, or with non-nil NEW, build the +list and display it. + +See the documentation strings of the commands +`todo-filter-top-priorities', `todo-filter-diary-items', +`todo-filter-regexp-items', and those of the corresponding +multifile commands for further details." + (let* ((top (eq filter 'top)) + (diary (eq filter 'diary)) + (regexp (eq filter 'regexp)) + (buf (cond (top todo-top-priorities-buffer) + (diary todo-diary-items-buffer) + (regexp todo-regexp-items-buffer))) + (flist (if multifile + (or todo-filter-files + (progn (todo-multiple-filter-files) + todo-multiple-filter-files)) + (list todo-current-todo-file))) + (multi (> (length flist) 1)) + (fname (if (equal flist 'quit) + ;; Pressed `cancel' in t-m-f-f file selection dialog. + (keyboard-quit) + (concat todo-directory + (mapconcat 'todo-short-file-name flist "-") + (cond (top ".todt") + (diary ".tody") + (regexp ".todr"))))) + (rxfiles (when regexp + (directory-files todo-directory t ".*\\.todr$" t))) + (file-exists (or (file-exists-p fname) rxfiles))) + (cond ((and top new (natnump new)) + (todo-filter-items-1 (cons 'top new) flist)) + ((and (not new) file-exists) + (when (and rxfiles (> (length rxfiles) 1)) + (let ((rxf (mapcar 'todo-short-file-name rxfiles))) + (setq fname (todo-absolute-file-name + (completing-read "Choose a regexp items file: " + rxf) 'regexp)))) + (find-file fname) + (todo-prefix-overlays) + (todo-check-filtered-items-file)) + (t + (todo-filter-items-1 filter flist))) + (setq fname (replace-regexp-in-string "-" ", " + (todo-short-file-name fname))) + (rename-buffer (format (concat "%s for file" (if multi "s" "") + " \"%s\"") buf fname)))) + +(defun todo-filter-items-1 (filter file-list) + "Build a list of items by applying FILTER to FILE-LIST. +Internal subroutine called by `todo-filter-items', which passes +the values of FILTER and FILE-LIST." + (let ((num (if (consp filter) (cdr filter) todo-top-priorities)) + (buf (get-buffer-create todo-filtered-items-buffer)) + (multifile (> (length file-list) 1)) + regexp fname bufstr cat beg end done) + (if (null file-list) + (user-error "No files have been chosen for filtering") + (with-current-buffer buf + (erase-buffer) + (kill-all-local-variables) + (todo-filtered-items-mode)) + (when (eq filter 'regexp) + (setq regexp (read-string "Enter a regular expression: "))) + (save-current-buffer + (dolist (f file-list) + ;; Before inserting file contents into temp buffer, save a modified + ;; buffer visiting it. + (let ((bf (find-buffer-visiting f))) + (when (buffer-modified-p bf) + (with-current-buffer bf (save-buffer)))) + (setq fname (todo-short-file-name f)) + (with-temp-buffer + (when (and todo-filter-done-items (eq filter 'regexp)) + ;; If there is a corresponding archive file for the + ;; todo file, insert it first and add identifiers for + ;; todo-go-to-source-item. + (let ((arch (concat (file-name-sans-extension f) ".toda"))) + (when (file-exists-p arch) + (insert-file-contents arch) + ;; Delete todo archive file's categories sexp. + (delete-region (line-beginning-position) + (1+ (line-end-position))) + (save-excursion + (while (not (eobp)) + (when (re-search-forward + (concat (if todo-filter-done-items + (concat "\\(?:" todo-done-string-start + "\\|" todo-date-string-start + "\\)") + todo-date-string-start) + todo-date-pattern "\\(?: " + diary-time-regexp "\\)?" + (if todo-filter-done-items + "\\]" + (regexp-quote todo-nondiary-end)) "?") + nil t) + (insert "(archive) ")) + (forward-line)))))) + (insert-file-contents f) + ;; Delete todo file's categories sexp. + (delete-region (line-beginning-position) (1+ (line-end-position))) + (let (fnum) + ;; Unless the number of top priorities to show was + ;; passed by the caller, the file-wide value from + ;; `todo-top-priorities-overrides', if non-nil, overrides + ;; `todo-top-priorities'. + (unless (consp filter) + (setq fnum (or (nth 1 (assoc f todo-top-priorities-overrides)) + todo-top-priorities))) + (while (re-search-forward + (concat "^" (regexp-quote todo-category-beg) + "\\(.+\\)\n") nil t) + (setq cat (match-string 1)) + (let (cnum) + ;; Unless the number of top priorities to show was + ;; passed by the caller, the category-wide value + ;; from `todo-top-priorities-overrides', if non-nil, + ;; overrides a non-nil file-wide value from + ;; `todo-top-priorities-overrides' as well as + ;; `todo-top-priorities'. + (unless (consp filter) + (let ((cats (nth 2 (assoc f todo-top-priorities-overrides)))) + (setq cnum (or (cdr (assoc cat cats)) fnum)))) + (delete-region (match-beginning 0) (match-end 0)) + (setq beg (point)) ; First item in the current category. + (setq end (if (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) + nil t) + (match-beginning 0) + (point-max))) + (goto-char beg) + (setq done + (if (re-search-forward + (concat "\n" (regexp-quote todo-category-done)) + end t) + (match-beginning 0) + end)) + (unless (and todo-filter-done-items (eq filter 'regexp)) + ;; Leave done items. + (delete-region done end) + (setq end done)) + (narrow-to-region beg end) ; Process only current category. + (goto-char (point-min)) + ;; Apply the filter. + (cond ((eq filter 'diary) + (while (not (eobp)) + (if (looking-at (regexp-quote todo-nondiary-start)) + (todo-remove-item) + (todo-forward-item)))) + ((eq filter 'regexp) + (while (not (eobp)) + (if (looking-at todo-item-start) + (if (string-match regexp (todo-item-string)) + (todo-forward-item) + (todo-remove-item)) + ;; Kill lines that aren't part of a todo or done + ;; item (empty or todo-category-done). + (delete-region (line-beginning-position) + (1+ (line-end-position)))) + ;; If last todo item in file matches regexp and + ;; there are no following done items, + ;; todo-category-done string is left dangling, + ;; because todo-forward-item jumps over it. + (if (and (eobp) + (looking-back + (concat (regexp-quote todo-done-string) + "\n"))) + (delete-region (point) (progn + (forward-line -2) + (point)))))) + (t ; Filter top priority items. + (setq num (or cnum fnum num)) + (unless (zerop num) + (todo-forward-item num)))) + (setq beg (point)) + ;; Delete non-top-priority items. + (unless (member filter '(diary regexp)) + (delete-region beg end)) + (goto-char (point-min)) + ;; Add file (if using multiple files) and category tags to + ;; item. + (while (not (eobp)) + (when (re-search-forward + (concat (if todo-filter-done-items + (concat "\\(?:" todo-done-string-start + "\\|" todo-date-string-start + "\\)") + todo-date-string-start) + todo-date-pattern "\\(?: " diary-time-regexp + "\\)?" (if todo-filter-done-items + "\\]" + (regexp-quote todo-nondiary-end)) + "?") + nil t) + (insert " [") + (when (looking-at "(archive) ") (goto-char (match-end 0))) + (insert (if multifile (concat fname ":") "") cat "]")) + (forward-line)) + (widen))) + (setq bufstr (buffer-string)) + (with-current-buffer buf + (let (buffer-read-only) + (insert bufstr))))))) + (set-window-buffer (selected-window) (set-buffer buf)) + (todo-prefix-overlays) + (goto-char (point-min))))) + +(defun todo-set-top-priorities (&optional arg) + "Set number of top priorities shown by `todo-filter-top-priorities'. +With non-nil ARG, set the number only for the current Todo +category; otherwise, set the number for all categories in the +current todo file. + +Calling this function via either of the commands +`todo-set-top-priorities-in-file' or +`todo-set-top-priorities-in-category' is the recommended way to +set the user customizable option `todo-top-priorities-overrides'." + (let* ((cat (todo-current-category)) + (file todo-current-todo-file) + (rules todo-top-priorities-overrides) + (frule (assoc-string file rules)) + (crule (assoc-string cat (nth 2 frule))) + (crules (nth 2 frule)) + (cur (or (if arg (cdr crule) (nth 1 frule)) + todo-top-priorities)) + (prompt (if arg (concat "Number of top priorities in this category" + " (currently %d): ") + (concat "Default number of top priorities per category" + " in this file (currently %d): "))) + (new -1) + nrule) + (while (< new 0) + (let ((cur0 cur)) + (setq new (read-number (format prompt cur0)) + prompt "Enter a non-negative number: " + cur0 nil))) + (setq nrule (if arg + (append (delete crule crules) (list (cons cat new))) + (append (list file new) (list crules)))) + (setq rules (cons (if arg + (list file cur nrule) + nrule) + (delete frule rules))) + (customize-save-variable 'todo-top-priorities-overrides rules) + (todo-prefix-overlays))) + +(defun todo-find-item (str) + "Search for filtered item STR in its saved todo file. +Return the list (FOUND FILE CAT), where CAT and FILE are the +item's category and file, and FOUND is a cons cell if the search +succeeds, whose car is the start of the item in FILE and whose +cdr is `done', if the item is now a done item, `changed', if its +text was truncated or augmented or, for a top priority item, if +its priority has changed, and `same' otherwise." + (string-match (concat (if todo-filter-done-items + (concat "\\(?:" todo-done-string-start "\\|" + todo-date-string-start "\\)") + todo-date-string-start) + todo-date-pattern "\\(?: " diary-time-regexp "\\)?" + (if todo-filter-done-items + "\\]" + (regexp-quote todo-nondiary-end)) "?" + "\\(?4: \\[\\(?3:(archive) \\)?\\(?2:.*:\\)?" + "\\(?1:.*\\)\\]\\).*$") str) + (let ((cat (match-string 1 str)) + (file (match-string 2 str)) + (archive (string= (match-string 3 str) "(archive) ")) + (filcat (match-string 4 str)) + (tpriority 1) + (tpbuf (save-match-data (string-match "top" (buffer-name)))) + found) + (setq str (replace-match "" nil nil str 4)) + (when tpbuf + ;; Calculate priority of STR wrt its category. + (save-excursion + (while (search-backward filcat nil t) + (setq tpriority (1+ tpriority))))) + (setq file (if file + (concat todo-directory (substring file 0 -1) + (if archive ".toda" ".todo")) + (if archive + (concat (file-name-sans-extension + todo-global-current-todo-file) ".toda") + todo-global-current-todo-file))) + (find-file-noselect file) + (with-current-buffer (find-buffer-visiting file) + (save-restriction + (widen) + (goto-char (point-min)) + (let ((beg (re-search-forward + (concat "^" (regexp-quote (concat todo-category-beg cat)) + "$") + nil t)) + (done (save-excursion + (re-search-forward + (concat "^" (regexp-quote todo-category-done)) nil t))) + (end (save-excursion + (or (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) + nil t) + (point-max))))) + (setq found (when (search-forward str end t) + (goto-char (match-beginning 0)))) + (when found + (setq found + (cons found (if (> (point) done) + 'done + (let ((cpriority 1)) + (when tpbuf + (save-excursion + ;; Not top item in category. + (while (> (point) (1+ beg)) + (let ((opoint (point))) + (todo-backward-item) + ;; Can't move backward beyond + ;; first item in file. + (unless (= (point) opoint) + (setq cpriority (1+ cpriority))))))) + (if (and (= tpriority cpriority) + ;; Proper substring is not the same. + (string= (todo-item-string) + str)) + 'same + 'changed))))))))) + (list found file cat))) + +(defun todo-check-filtered-items-file () + "Check if filtered items file is up to date and a show suitable message." + ;; (catch 'old + (let ((count 0)) + (while (not (eobp)) + (let* ((item (todo-item-string)) + (found (car (todo-find-item item)))) + (unless (eq (cdr found) 'same) + (save-excursion + (overlay-put (make-overlay (todo-item-start) (todo-item-end)) + 'face 'todo-search)) + (setq count (1+ count)))) + ;; (throw 'old (message "The marked item is not up to date."))) + (todo-forward-item)) + (if (zerop count) + (message "Filtered items file is up to date.") + (message (concat "The highlighted item" (if (= count 1) " is " "s are ") + "not up to date." + ;; "\nType on item for details." + ))))) + +(defun todo-filter-items-filename () + "Return absolute file name for saving this Filtered Items buffer." + (let ((bufname (buffer-name))) + (string-match "\"\\([^\"]+\\)\"" bufname) + (let* ((filename-str (substring bufname (match-beginning 1) (match-end 1))) + (filename-base (replace-regexp-in-string ", " "-" filename-str)) + (top-priorities (string-match "top priorities" bufname)) + (diary-items (string-match "diary items" bufname)) + (regexp-items (string-match "regexp items" bufname))) + (when regexp-items + (let ((prompt (concat "Enter a short identifying string" + " to make this file name unique: "))) + (setq filename-base (concat filename-base "-" (read-string prompt))))) + (concat todo-directory filename-base + (cond (top-priorities ".todt") + (diary-items ".tody") + (regexp-items ".todr")))))) + +(defun todo-save-filtered-items-buffer () + "Save current Filtered Items buffer to a file. +If the file already exists, overwrite it only on confirmation." + (let ((filename (or (buffer-file-name) (todo-filter-items-filename)))) + (write-file filename t))) + +;; ----------------------------------------------------------------------------- +;;; Printing Todo mode buffers +;; ----------------------------------------------------------------------------- + +(defcustom todo-print-buffer-function 'ps-print-buffer-with-faces + "Function called by the command `todo-print-buffer'." + :type 'symbol + :group 'todo) + +(defvar todo-print-buffer "*Todo Print*" + "Name of buffer with printable version of Todo mode buffer.") + +(defun todo-print-buffer (&optional to-file) + "Produce a printable version of the current Todo mode buffer. +This converts overlays and soft line wrapping and, depending on +the value of `todo-print-buffer-function', includes faces. With +non-nil argument TO-FILE write the printable version to a file; +otherwise, send it to the default printer." + (interactive) + (let ((buf todo-print-buffer) + (header (cond + ((eq major-mode 'todo-mode) + (concat "Todo File: " + (todo-short-file-name todo-current-todo-file) + "\nCategory: " (todo-current-category))) + ((eq major-mode 'todo-filtered-items-mode) + (buffer-name)))) + (prefix (propertize (concat todo-prefix " ") + 'face 'todo-prefix-string)) + (num 0) + (fill-prefix (make-string todo-indent-to-here 32)) + (content (buffer-string)) + file) + (with-current-buffer (get-buffer-create buf) + (insert content) + (goto-char (point-min)) + (while (not (eobp)) + (let ((beg (point)) + (end (save-excursion (todo-item-end)))) + (when todo-number-prefix + (setq num (1+ num)) + (setq prefix (propertize (concat (number-to-string num) " ") + 'face 'todo-prefix-string))) + (insert prefix) + (fill-region beg end)) + ;; Calling todo-forward-item infloops at todo-item-start due to + ;; non-overlay prefix, so search for item start instead. + (if (re-search-forward todo-item-start nil t) + (beginning-of-line) + (goto-char (point-max)))) + (if (re-search-backward (concat "^" (regexp-quote todo-category-done)) + nil t) + (replace-match todo-done-separator)) + (goto-char (point-min)) + (insert header) + (newline 2) + (if to-file + (let ((file (read-file-name "Print to file: "))) + (funcall todo-print-buffer-function file)) + (funcall todo-print-buffer-function))) + (kill-buffer buf))) + +(defun todo-print-buffer-to-file () + "Save printable version of this Todo mode buffer to a file." + (interactive) + (todo-print-buffer t)) + +;; ----------------------------------------------------------------------------- +;;; Legacy Todo mode files +;; ----------------------------------------------------------------------------- + +(defcustom todo-legacy-date-time-regexp + (concat "\\(?1:[0-9]\\{4\\}\\)-\\(?2:[0-9]\\{2\\}\\)-" + "\\(?3:[0-9]\\{2\\}\\) \\(?4:[0-9]\\{2\\}:[0-9]\\{2\\}\\)") + "Regexp matching legacy todo-mode.el item date-time strings. +In order for `todo-convert-legacy-files' to correctly convert +this string to the current Todo mode format, the regexp must +contain four explicitly numbered groups (see `(elisp) Regexp +Backslash'), where group 1 matches a string for the year, group 2 +a string for the month, group 3 a string for the day and group 4 +a string for the time. The default value converts date-time +strings built using the default value of +`todo-time-string-format' from todo-mode.el." + :type 'regexp + :group 'todo) + +(defun todo-convert-legacy-date-time () + "Return converted date-time string. +Helper function for `todo-convert-legacy-files'." + (let* ((year (match-string 1)) + (month (match-string 2)) + (monthname (calendar-month-name (string-to-number month) t)) + (day (match-string 3)) + (time (match-string 4)) + dayname) + (replace-match "") + (insert (mapconcat 'eval calendar-date-display-form "") + (when time (concat " " time))))) + +(defun todo-convert-legacy-files () + "Convert legacy todo files to the current Todo mode format. +The old-style files named by the variables `todo-file-do' and +`todo-file-done' from the old package are converted to the new +format and saved (the latter as a todo archive file) with a new +name in `todo-directory'. See also the documentation string of +`todo-legacy-date-time-regexp' for further details." + (interactive) + ;; If there are user customizations of legacy options, use them, + ;; otherwise use the legacy default values. + (let ((todo-file-do-tem (if (boundp 'todo-file-do) + todo-file-do + (locate-user-emacs-file "todo-do" ".todo-do"))) + (todo-file-done-tem (if (boundp 'todo-file-done) + todo-file-done + (locate-user-emacs-file "todo-done" ".todo-done"))) + (todo-initials-tem (and (boundp 'todo-initials) todo-initials)) + (todo-entry-prefix-function-tem (and (boundp 'todo-entry-prefix-function) + todo-entry-prefix-function)) + todo-prefix-tem) + ;; Convert `todo-file-do'. + (if (not (file-exists-p todo-file-do-tem)) + (message "No legacy todo file exists") + (let ((default "todo-do-conv") + file archive-sexp) + (with-temp-buffer + (insert-file-contents todo-file-do-tem) + ;; Eliminate old-style local variables list in first line. + (delete-region (line-beginning-position) (1+ (line-end-position))) + (search-forward " --- " nil t) ; Legacy todo-category-beg. + (setq todo-prefix-tem (buffer-substring-no-properties + (line-beginning-position) (match-beginning 0))) + (goto-char (point-min)) + (while (not (eobp)) + (cond + ;; Old-style category start delimiter. + ((looking-at (regexp-quote (concat todo-prefix-tem " --- "))) + (replace-match todo-category-beg)) + ;; Old-style category end delimiter. + ((looking-at (regexp-quote "--- End")) + (replace-match "")) + ;; Old-style category separator. + ((looking-at (regexp-quote + (concat todo-prefix-tem " " + (make-string 75 ?-)))) + (replace-match todo-category-done)) + ;; Old-style item header (date/time/initials). + ((looking-at (concat (regexp-quote todo-prefix-tem) " " + (if todo-entry-prefix-function-tem + (funcall todo-entry-prefix-function-tem) + (concat todo-legacy-date-time-regexp " " + (if todo-initials-tem + (regexp-quote todo-initials-tem) + "[^:]*") + ":")))) + (todo-convert-legacy-date-time))) + (forward-line)) + (setq file (concat todo-directory + (read-string + (format "Save file as (default \"%s\"): " default) + nil nil default) + ".todo")) + (unless (file-exists-p todo-directory) + (make-directory todo-directory)) + (write-region (point-min) (point-max) file nil 'nomessage nil t)) + (with-temp-buffer + (insert-file-contents file) + (let ((todo-categories (todo-make-categories-list t))) + (todo-update-categories-sexp) + (todo-check-format)) + (write-region (point-min) (point-max) file nil 'nomessage)) + (setq todo-files (funcall todo-files-function)) + ;; Convert `todo-file-done'. + (when (file-exists-p todo-file-done-tem) + (with-temp-buffer + (insert-file-contents todo-file-done-tem) + (let ((beg (make-marker)) + (end (make-marker)) + cat cats comment item) + (while (not (eobp)) + (when (looking-at todo-legacy-date-time-regexp) + (set-marker beg (point)) + (todo-convert-legacy-date-time) + (set-marker end (point)) + (goto-char beg) + (insert "[" todo-done-string) + (goto-char end) + (insert "]") + (forward-char) + (when (looking-at todo-legacy-date-time-regexp) + (todo-convert-legacy-date-time)) + (when (looking-at (concat " " (if todo-initials-tem + (regexp-quote + todo-initials-tem) + "[^:]*") + ":")) + (replace-match ""))) + (if (re-search-forward + (concat "^" todo-legacy-date-time-regexp) nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max))) + (backward-char) + (when (looking-back "\\[\\([^][]+\\)\\]") + (setq cat (match-string 1)) + (goto-char (match-beginning 0)) + (replace-match "")) + ;; If the item ends with a non-comment parenthesis not + ;; followed by a period, we lose (but we inherit that + ;; problem from the legacy code). + (when (looking-back "(\\(.*\\)) ") + (setq comment (match-string 1)) + (replace-match "") + (insert "[" todo-comment-string ": " comment "]")) + (set-marker end (point)) + (if (member cat cats) + ;; If item is already in its category, leave it there. + (unless (save-excursion + (re-search-backward + (concat "^" (regexp-quote todo-category-beg) + "\\(.*\\)$") nil t) + (string= (match-string 1) cat)) + ;; Else move it to its category. + (setq item (buffer-substring-no-properties beg end)) + (delete-region beg (1+ end)) + (set-marker beg (point)) + (re-search-backward + (concat "^" + (regexp-quote (concat todo-category-beg cat)) + "$") + nil t) + (forward-line) + (if (re-search-forward + (concat "^" (regexp-quote todo-category-beg) + "\\(.*\\)$") nil t) + (progn (goto-char (match-beginning 0)) + (newline) + (forward-line -1)) + (goto-char (point-max))) + (insert item "\n") + (goto-char beg)) + (push cat cats) + (goto-char beg) + (insert todo-category-beg cat "\n\n" + todo-category-done "\n")) + (forward-line)) + (set-marker beg nil) + (set-marker end nil)) + (setq file (concat (file-name-sans-extension file) ".toda")) + (write-region (point-min) (point-max) file nil 'nomessage nil t)) + (with-temp-buffer + (insert-file-contents file) + (let* ((todo-categories (todo-make-categories-list t))) + (todo-update-categories-sexp) + (todo-check-format)) + (write-region (point-min) (point-max) file nil 'nomessage) + (setq archive-sexp (read (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))))) + (setq file (concat (file-name-sans-extension file) ".todo")) + ;; Update categories sexp of converted todo file again, adding + ;; counts of archived items. + (with-temp-buffer + (insert-file-contents file) + (let ((sexp (read (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))))) + (dolist (cat sexp) + (let ((archive-cat (assoc (car cat) archive-sexp))) + (if archive-cat + (aset (cdr cat) 3 (aref (cdr archive-cat) 2))))) + (delete-region (line-beginning-position) (line-end-position)) + (prin1 sexp (current-buffer))) + (write-region (point-min) (point-max) file nil 'nomessage)) + (setq todo-archives (funcall todo-files-function t))) + (todo-reevaluate-filelist-defcustoms) + (when (y-or-n-p (concat "Format conversion done; do you want to " + "visit the converted file now? ")) + (setq todo-current-todo-file file) + (unless todo-default-todo-file + ;; We just initialized the first todo file, so make it the + ;; default now to avoid an infinite recursion with todo-show. + (setq todo-default-todo-file (todo-short-file-name file))) + (todo-show)))))) + +;; ----------------------------------------------------------------------------- +;;; Utility functions for todo files, categories and items +;; ----------------------------------------------------------------------------- + +(defun todo-absolute-file-name (name &optional type) + "Return the absolute file name of short todo file NAME. +With TYPE `archive' or `top' return the absolute file name of the +short todo archive or top priorities file name, respectively." + ;; No-op if there is no todo file yet (i.e. don't concatenate nil). + (when name + (file-truename + (concat todo-directory name + (cond ((eq type 'archive) ".toda") + ((eq type 'top) ".todt") + ((eq type 'diary) ".tody") + ((eq type 'regexp) ".todr") + (t ".todo")))))) + +(defun todo-category-number (cat) + "Return the number of category CAT in this todo file. +The buffer-local variable `todo-category-number' holds this +number as its value." + (let ((categories (mapcar 'car todo-categories))) + (setq todo-category-number + ;; Increment by one, so that the highest priority category in Todo + ;; Categories mode is numbered one rather than zero. + (1+ (- (length categories) + (length (member cat categories))))))) + +(defun todo-current-category () + "Return the name of the current category." + (car (nth (1- todo-category-number) todo-categories))) + +(defun todo-category-select () + "Display the current category correctly." + (let ((name (todo-current-category)) + cat-begin cat-end done-start done-sep-start done-end) + (widen) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote (concat todo-category-beg name)) "$") nil t) + (setq cat-begin (1+ (line-end-position))) + (setq cat-end (if (re-search-forward + (concat "^" (regexp-quote todo-category-beg)) nil t) + (match-beginning 0) + (point-max))) + (setq mode-line-buffer-identification + (funcall todo-mode-line-function name)) + (narrow-to-region cat-begin cat-end) + (todo-prefix-overlays) + (goto-char (point-min)) + (if (re-search-forward (concat "\n\\(" (regexp-quote todo-category-done) + "\\)") nil t) + (progn + (setq done-start (match-beginning 0)) + (setq done-sep-start (match-beginning 1)) + (setq done-end (match-end 0))) + (error "Category %s is missing todo-category-done string" name)) + (if todo-show-done-only + (narrow-to-region (1+ done-end) (point-max)) + (when (and todo-show-with-done + (re-search-forward todo-done-string-start nil t)) + ;; Now we want to see the done items, so reset displayed end to end of + ;; done items. + (setq done-start cat-end) + ;; Make display overlay for done items separator string, unless there + ;; already is one. + (let* ((done-sep todo-done-separator) + (ov (progn (goto-char done-sep-start) + (todo-get-overlay 'separator)))) + (unless ov + (setq ov (make-overlay done-sep-start done-end)) + (overlay-put ov 'todo 'separator) + (overlay-put ov 'display done-sep)))) + (narrow-to-region (point-min) done-start) + ;; Loading this from todo-mode, or adding it to the mode hook, causes + ;; Emacs to hang in todo-item-start, at (looking-at todo-item-start). + (when todo-highlight-item + (require 'hl-line) + (hl-line-mode 1))))) + +(defun todo-get-count (type &optional category) + "Return count of TYPE items in CATEGORY. +If CATEGORY is nil, default to the current category." + (let* ((cat (or category (todo-current-category))) + (counts (cdr (assoc cat todo-categories))) + (idx (cond ((eq type 'todo) 0) + ((eq type 'diary) 1) + ((eq type 'done) 2) + ((eq type 'archived) 3)))) + (aref counts idx))) + +(defun todo-update-count (type increment &optional category) + "Change count of TYPE items in CATEGORY by integer INCREMENT. +With nil or omitted CATEGORY, default to the current category." + (let* ((cat (or category (todo-current-category))) + (counts (cdr (assoc cat todo-categories))) + (idx (cond ((eq type 'todo) 0) + ((eq type 'diary) 1) + ((eq type 'done) 2) + ((eq type 'archived) 3)))) + (aset counts idx (+ increment (aref counts idx))))) + +(defun todo-set-categories () + "Set `todo-categories' from the sexp at the top of the file." + ;; New archive files created by `todo-move-category' are empty, which would + ;; make the sexp test fail and raise an error, so in this case we skip it. + (unless (zerop (buffer-size)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (setq todo-categories + (if (looking-at "\(\(\"") + (read (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))) + (error "Invalid or missing todo-categories sexp"))))))) + +(defun todo-update-categories-sexp () + "Update the `todo-categories' sexp at the top of the file." + (let (buffer-read-only) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (if (looking-at (concat "^" (regexp-quote todo-category-beg))) + (progn (newline) (goto-char (point-min)) ; Make space for sexp. + (setq todo-categories (todo-make-categories-list t))) + (delete-region (line-beginning-position) (line-end-position))) + (prin1 todo-categories (current-buffer)))))) + +(defun todo-make-categories-list (&optional force) + "Return an alist of todo categories and their item counts. +With non-nil argument FORCE parse the entire file to build the +list; otherwise, get the value by reading the sexp at the top of +the file." + (setq todo-categories nil) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let (counts cat archive) + ;; If the file is a todo file and has archived items, identify the + ;; archive, in order to count its items. But skip this with + ;; `todo-convert-legacy-files', since that converts filed items to + ;; archived items. + (when buffer-file-name ; During conversion there is no file yet. + ;; If the file is an archive, it doesn't have an archive. + (unless (member (file-truename buffer-file-name) + (funcall todo-files-function t)) + (setq archive (concat (file-name-sans-extension + todo-current-todo-file) ".toda")))) + (while (not (eobp)) + (cond ((looking-at (concat (regexp-quote todo-category-beg) + "\\(.*\\)\n")) + (setq cat (match-string-no-properties 1)) + ;; Counts for each category: [todo diary done archive] + (setq counts (make-vector 4 0)) + (setq todo-categories + (append todo-categories (list (cons cat counts)))) + ;; Add archived item count to the todo file item counts. + ;; Make sure to include newly created archives, e.g. due to + ;; todo-move-category. + (when (member archive (funcall todo-files-function t)) + (let ((archive-count 0)) + (with-current-buffer (find-file-noselect archive) + (widen) + (goto-char (point-min)) + (when (re-search-forward + (concat "^" (regexp-quote todo-category-beg) + cat "$") + (point-max) t) + (forward-line) + (while (not (or (looking-at + (concat + (regexp-quote todo-category-beg) + "\\(.*\\)\n")) + (eobp))) + (when (looking-at todo-done-string-start) + (setq archive-count (1+ archive-count))) + (forward-line)))) + (todo-update-count 'archived archive-count cat)))) + ((looking-at todo-done-string-start) + (todo-update-count 'done 1 cat)) + ((looking-at (concat "^\\(" + (regexp-quote diary-nonmarking-symbol) + "\\)?" todo-date-pattern)) + (todo-update-count 'diary 1 cat) + (todo-update-count 'todo 1 cat)) + ((looking-at (concat todo-date-string-start todo-date-pattern)) + (todo-update-count 'todo 1 cat)) + ;; If first line is todo-categories list, use it and end loop + ;; -- unless FORCEd to scan whole file. + ((bobp) + (unless force + (setq todo-categories (read (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) + (goto-char (1- (point-max)))))) + (forward-line))))) + todo-categories) + +(defun todo-repair-categories-sexp () + "Repair corrupt todo file categories sexp. +This should only be needed as a consequence of careless manual +editing or a bug in todo.el. + +*Warning*: Calling this command restores the category order to +the list element order in the todo file categories sexp, so any +order changes made in Todo Categories mode will have to be made +again." + (interactive) + (let ((todo-categories (todo-make-categories-list t))) + (todo-update-categories-sexp))) + +(defun todo-check-format () + "Signal an error if the current todo file is ill-formatted. +Otherwise return t. Display a message if the file is well-formed +but the categories sexp differs from the current value of +`todo-categories'." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let* ((cats (prin1-to-string todo-categories)) + (ssexp (buffer-substring-no-properties (line-beginning-position) + (line-end-position))) + (sexp (read ssexp))) + ;; Check the first line for `todo-categories' sexp. + (dolist (c sexp) + (let ((v (cdr c))) + (unless (and (stringp (car c)) + (vectorp v) + (= 4 (length v))) + (user-error "Invalid or missing todo-categories sexp")))) + (forward-line) + ;; Check well-formedness of categories. + (let ((legit (concat + "\\(^" (regexp-quote todo-category-beg) "\\)" + "\\|\\(" todo-date-string-start todo-date-pattern "\\)" + "\\|\\(^[ \t]+[^ \t]*\\)" + "\\|^$" + "\\|\\(^" (regexp-quote todo-category-done) "\\)" + "\\|\\(" todo-done-string-start "\\)"))) + (while (not (eobp)) + (unless (looking-at legit) + (user-error "Illegitimate todo file format at line %d" + (line-number-at-pos (point)))) + (forward-line))) + ;; Warn user if categories sexp has changed. + (unless (string= ssexp cats) + (message (concat "The sexp at the beginning of the file differs " + "from the value of `todo-categories.\n" + "If the sexp is wrong, you can fix it with " + "M-x todo-repair-categories-sexp,\n" + "but note this reverts any changes you have " + "made in the order of the categories.")))))) + t) + +(defun todo-item-start () + "Move to start of current todo item and return its position." + (unless (or + ;; Buffer is empty (invocation possible e.g. via todo-forward-item + ;; from todo-filter-items when processing category with no todo + ;; items). + (eq (point-min) (point-max)) + ;; Point is on the empty line below category's last todo item... + (and (looking-at "^$") + (or (eobp) ; ...and done items are hidden... + (save-excursion ; ...or done items are visible. + (forward-line) + (looking-at (concat "^" + (regexp-quote todo-category-done)))))) + ;; Buffer is widened. + (looking-at (regexp-quote todo-category-beg))) + (goto-char (line-beginning-position)) + (while (not (looking-at todo-item-start)) + (forward-line -1)) + (point))) + +(defun todo-item-end () + "Move to end of current todo item and return its position." + ;; Items cannot end with a blank line. + (unless (looking-at "^$") + (let* ((done (todo-done-item-p)) + (to-lim nil) + ;; For todo items, end is before the done items section, for done + ;; items, end is before the next category. If these limits are + ;; missing or inaccessible, end it before the end of the buffer. + (lim (if (save-excursion + (re-search-forward + (concat "^" (regexp-quote (if done + todo-category-beg + todo-category-done))) + nil t)) + (progn (setq to-lim t) (match-beginning 0)) + (point-max)))) + (when (bolp) (forward-char)) ; Find start of next item. + (goto-char (if (re-search-forward todo-item-start lim t) + (match-beginning 0) + (if to-lim lim (point-max)))) + ;; For last todo item, skip back over the empty line before the done + ;; items section, else just back to the end of the previous line. + (backward-char (when (and to-lim (not done) (eq (point) lim)) 2)) + (point)))) + +(defun todo-item-string () + "Return bare text of current item as a string." + (let ((opoint (point)) + (start (todo-item-start)) + (end (todo-item-end))) + (goto-char opoint) + (and start end (buffer-substring-no-properties start end)))) + +(defun todo-forward-item (&optional count) + "Move point COUNT items down (by default, move down by one item)." + (let* ((not-done (not (or (todo-done-item-p) (looking-at "^$")))) + (start (line-end-position))) + (goto-char start) + (if (re-search-forward todo-item-start nil t (or count 1)) + (goto-char (match-beginning 0)) + (goto-char (point-max))) + ;; If points advances by one from a todo to a done item, go back + ;; to the space above todo-done-separator, since that is a + ;; legitimate place to insert an item. But skip this space if + ;; count > 1, since that should only stop on an item. + (when (and not-done (todo-done-item-p) (not count)) + ;; (if (or (not count) (= count 1)) + (re-search-backward "^$" start t))));) + ;; The preceding sexp is insufficient when buffer is not narrowed, + ;; since there could be no done items in this category, so the + ;; search puts us on first todo item of next category. Does this + ;; ever happen? If so: + ;; (let ((opoint) (point)) + ;; (forward-line -1) + ;; (when (or (not count) (= count 1)) + ;; (cond ((looking-at (concat "^" (regexp-quote todo-category-beg))) + ;; (forward-line -2)) + ;; ((looking-at (concat "^" (regexp-quote todo-category-done))) + ;; (forward-line -1)) + ;; (t + ;; (goto-char opoint))))))) + +(defun todo-backward-item (&optional count) + "Move point up to start of item with next higher priority. +With positive numerical prefix COUNT, move point COUNT items +upward. + +If the category's done items are visible, this command called +with a prefix argument only moves point to a higher item, e.g., +with point on the first done item and called with prefix 1, it +moves to the last todo item; but if called with point on the +first done item without a prefix argument, it moves point the the +empty line above the done items separator." + (let* ((done (todo-done-item-p))) + (todo-item-start) + (unless (bobp) + (re-search-backward todo-item-start nil t (or count 1))) + ;; Unless this is a regexp filtered items buffer (which can contain + ;; intermixed todo and done items), if points advances by one from a + ;; done to a todo item, go back to the space above + ;; todo-done-separator, since that is a legitimate place to insert an + ;; item. But skip this space if count > 1, since that should only + ;; stop on an item. + (when (and done (not (todo-done-item-p)) (not count) + ;(or (not count) (= count 1)) + (not (equal (buffer-name) todo-regexp-items-buffer))) + (re-search-forward (concat "^" (regexp-quote todo-category-done)) + nil t) + (forward-line -1)))) + +(defun todo-remove-item () + "Internal function called in editing, deleting or moving items." + (let* ((end (progn (todo-item-end) (1+ (point)))) + (beg (todo-item-start)) + (ov (todo-get-overlay 'prefix))) + (when ov (delete-overlay ov)) + (delete-region beg end))) + +(defun todo-diary-item-p () + "Return non-nil if item at point has diary entry format." + (save-excursion + (when (todo-item-string) ; Exclude empty lines. + (todo-item-start) + (not (looking-at (regexp-quote todo-nondiary-start)))))) + +;; This duplicates the item locating code from diary-goto-entry, but +;; without the marker code, to test whether the latter is dispensible. +;; If it is, diary-goto-entry can be simplified. The code duplication +;; here can also be eliminated, leaving only the widening and category +;; selection, and instead of :override advice :around can be used. + +(defun todo-diary-goto-entry (button) + "Jump to the diary entry for the BUTTON at point. +If the entry is a todo item, display its category properly. +Overrides `diary-goto-entry'." + ;; Locate the diary item in its source file. + (let* ((locator (button-get button 'locator)) + (file (cadr locator)) + (date (regexp-quote (nth 2 locator))) + (content (regexp-quote (nth 3 locator)))) + (if (not (and (file-exists-p file) + (find-file-other-window file))) + (message "Unable to locate this diary entry") + (when (eq major-mode 'todo-mode) (widen)) + (goto-char (point-min)) + (when (re-search-forward (format "%s.*\\(%s\\)" date content) nil t) + (goto-char (match-beginning 1))) + ;; If it's a todo item, determine its category and display the + ;; category properly. + (when (eq major-mode 'todo-mode) + (let ((opoint (point))) + (re-search-backward (concat "^" (regexp-quote todo-category-beg) + "\\(.*\\)\n") nil t) + (todo-category-number (match-string 1)) + (todo-category-select) + (goto-char opoint)))))) + +(add-function :override diary-goto-entry-function #'todo-diary-goto-entry) + +(defun todo-done-item-p () + "Return non-nil if item at point is a done item." + (save-excursion + (todo-item-start) + (looking-at todo-done-string-start))) + +(defun todo-done-item-section-p () + "Return non-nil if point is in category's done items section." + (save-excursion + (or (re-search-backward (concat "^" (regexp-quote todo-category-done)) + nil t) + (progn (goto-char (point-min)) + (looking-at todo-done-string-start))))) + +(defun todo-reset-done-separator (sep) + "Replace existing overlays of done items separator string SEP." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward + (concat "\n\\(" (regexp-quote todo-category-done) "\\)") nil t) + (let* ((beg (match-beginning 1)) + (end (match-end 0)) + (ov (progn (goto-char beg) + (todo-get-overlay 'separator))) + (old-sep (when ov (overlay-get ov 'display))) + new-ov) + (when old-sep + (unless (string= old-sep sep) + (setq new-ov (make-overlay beg end)) + (overlay-put new-ov 'todo 'separator) + (overlay-put new-ov 'display todo-done-separator) + (delete-overlay ov)))))))) + +(defun todo-get-overlay (val) + "Return the overlay at point whose `todo' property has value VAL." + ;; Use overlays-in to find prefix overlays and check over two + ;; positions to find done separator overlay. + (let ((ovs (overlays-in (point) (1+ (point)))) + ov) + (catch 'done + (while ovs + (setq ov (pop ovs)) + (when (eq (overlay-get ov 'todo) val) + (throw 'done ov)))))) + +(defun todo-marked-item-p () + "Non-nil if this item begins with `todo-item-mark'. +In that case, return the item's prefix overlay." + (let* ((ov (todo-get-overlay 'prefix)) + ;; If an item insertion command is called on a todo file + ;; before it is visited, it has no prefix overlays yet, so + ;; check for this. + (pref (when ov (overlay-get ov 'before-string))) + (marked (when pref + (string-match (concat "^" (regexp-quote todo-item-mark)) + pref)))) + (when marked ov))) + +(defun todo-insert-with-overlays (item) + "Insert ITEM at point and update prefix/priority number overlays." + (todo-item-start) + ;; Insertion pushes item down but not its prefix overlay. When the + ;; overlay includes a mark, this would now mark the inserted ITEM, + ;; so move it to the pushed down item. + (let ((ov (todo-get-overlay 'prefix)) + (marked (todo-marked-item-p))) + (insert item "\n") + (when marked (move-overlay ov (point) (point)))) + (todo-backward-item) + (todo-prefix-overlays)) + +(defun todo-prefix-overlays () + "Update the prefix overlays of the current category's items. +The overlay's value is the string `todo-prefix' or with non-nil +`todo-number-prefix' an integer in the sequence from 1 to +the number of todo or done items in the category indicating the +item's priority. Todo and done items are numbered independently +of each other." + (let ((num 0) + (cat-tp (or (cdr (assoc-string + (todo-current-category) + (nth 2 (assoc-string todo-current-todo-file + todo-top-priorities-overrides)))) + todo-top-priorities)) + done prefix) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (or (todo-date-string-matcher (line-end-position)) + (todo-done-string-matcher (line-end-position))) + (goto-char (match-beginning 0)) + (setq num (1+ num)) + ;; Reset number to 1 for first done item. + (when (and (eq major-mode 'todo-mode) + (looking-at todo-done-string-start) + (looking-back (concat "^" + (regexp-quote todo-category-done) + "\n"))) + (setq num 1 + done t)) + (setq prefix (concat (propertize + (if todo-number-prefix + (number-to-string num) + todo-prefix) + 'face + ;; Prefix of top priority items has a + ;; distinct face in Todo mode. + (if (and (eq major-mode 'todo-mode) + (not done) + (<= num cat-tp)) + 'todo-top-priority + 'todo-prefix-string)) + " ")) + (let ((ov (todo-get-overlay 'prefix)) + (marked (todo-marked-item-p))) + ;; Prefix overlay must be at a single position so its + ;; bounds aren't changed when (re)moving an item. + (unless ov (setq ov (make-overlay (point) (point)))) + (overlay-put ov 'todo 'prefix) + (overlay-put ov 'before-string (if marked + (concat todo-item-mark prefix) + prefix)))) + (forward-line))))) + +;; ----------------------------------------------------------------------------- +;;; Utilities for generating item insertion commands and key bindings +;; ----------------------------------------------------------------------------- + +;; Wolfgang Jenkner posted this powerset definition to emacs-devel +;; (http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00423.html) +;; and kindly gave me permission to use it. + +(defun todo-powerset (list) + "Return the powerset of LIST." + (let ((powerset (list nil))) + (dolist (elt list (mapcar 'reverse powerset)) + (nconc powerset (mapcar (apply-partially 'cons elt) powerset))))) + +(defun todo-gen-arglists (arglist) + "Return list of lists of non-nil atoms produced from ARGLIST. +The elements of ARGLIST may be atoms or lists." + (let (arglists) + (while arglist + (let ((arg (pop arglist))) + (cond ((symbolp arg) + (setq arglists (if arglists + (mapcar (lambda (l) (push arg l)) arglists) + (list (push arg arglists))))) + ((listp arg) + (setq arglists + (mapcar (lambda (a) + (if (= 1 (length arglists)) + (apply (lambda (l) (push a l)) arglists) + (mapcar (lambda (l) (push a l)) arglists))) + arg)))))) + (setq arglists (mapcar 'reverse (apply 'append (mapc 'car arglists)))))) + +(defvar todo-insertion-commands-args-genlist + '(diary nonmarking (calendar date dayname) time (here region)) + "Generator list for argument lists of item insertion commands.") + +(defvar todo-insertion-commands-args + (let ((argslist (todo-gen-arglists todo-insertion-commands-args-genlist)) + res new) + (setq res (cl-remove-duplicates + (apply 'append (mapcar 'todo-powerset argslist)) :test 'equal)) + (dolist (l res) + (unless (= 5 (length l)) + (let ((v (make-vector 5 nil)) elt) + (while l + (setq elt (pop l)) + (cond ((eq elt 'diary) + (aset v 0 elt)) + ((eq elt 'nonmarking) + (aset v 1 elt)) + ((or (eq elt 'calendar) + (eq elt 'date) + (eq elt 'dayname)) + (aset v 2 elt)) + ((eq elt 'time) + (aset v 3 elt)) + ((or (eq elt 'here) + (eq elt 'region)) + (aset v 4 elt)))) + (setq l (append v nil)))) + (setq new (append new (list l)))) + new) + "List of all argument lists for Todo mode item insertion commands.") + +(defun todo-insertion-command-name (arglist) + "Generate Todo mode item insertion command name from ARGLIST." + (replace-regexp-in-string + "-\\_>" "" + (replace-regexp-in-string + "-+" "-" + (concat "todo-insert-item-" + (mapconcat (lambda (e) (if e (symbol-name e))) arglist "-"))))) + +(defvar todo-insertion-commands-names + (mapcar (lambda (l) + (todo-insertion-command-name l)) + todo-insertion-commands-args) + "List of names of Todo mode item insertion commands.") + +(defmacro todo-define-insertion-command (&rest args) + "Generate Todo mode item insertion command definitions from ARGS." + (let ((name (intern (todo-insertion-command-name args))) + (arg0 (nth 0 args)) + (arg1 (nth 1 args)) + (arg2 (nth 2 args)) + (arg3 (nth 3 args)) + (arg4 (nth 4 args))) + `(defun ,name (&optional arg &rest args) + "Todo mode item insertion command generated from ARGS. +For descriptions of the individual arguments, their values, and +their relation to key bindings, see `todo-basic-insert-item'." + (interactive (list current-prefix-arg)) + (todo-basic-insert-item arg ',arg0 ',arg1 ',arg2 ',arg3 ',arg4)))) + +(defvar todo-insertion-commands + (mapcar (lambda (c) + (eval `(todo-define-insertion-command ,@c))) + todo-insertion-commands-args) + "List of Todo mode item insertion commands.") + +(defvar todo-insertion-commands-arg-key-list + '(("diary" "y" "yy") + ("nonmarking" "k" "kk") + ("calendar" "c" "cc") + ("date" "d" "dd") + ("dayname" "n" "nn") + ("time" "t" "tt") + ("here" "h" "h") + ("region" "r" "r")) + "List of mappings of item insertion command arguments to key sequences.") + +(defun todo-insertion-key-bindings (map) + "Generate key binding definitions for item insertion keymap MAP." + (dolist (c todo-insertion-commands) + (let* ((key "") + (cname (symbol-name c))) + (mapc (lambda (l) + (let ((arg (nth 0 l)) + (key1 (nth 1 l)) + (key2 (nth 2 l))) + (if (string-match (concat (regexp-quote arg) "\\_>") cname) + (setq key (concat key key2))) + (if (string-match (concat (regexp-quote arg) ".+") cname) + (setq key (concat key key1))))) + todo-insertion-commands-arg-key-list) + (if (string-match (concat (regexp-quote "todo-insert-item") "\\_>") cname) + (setq key (concat key "i"))) + (define-key map key c)))) + +;; ----------------------------------------------------------------------------- +;;; Todo minibuffer utilities +;; ----------------------------------------------------------------------------- + +(defcustom todo-y-with-space nil + "Non-nil means allow SPC to affirm a \"y or n\" question." + :type 'boolean + :group 'todo) + +(defun todo-y-or-n-p (prompt) + "Ask \"y or n\" question PROMPT and return t if answer is \"y\". +Also return t if answer is \"Y\", but unlike `y-or-n-p', allow +SPC to affirm the question only if option `todo-y-with-space' is +non-nil." + (unless todo-y-with-space + (define-key query-replace-map " " 'ignore)) + (prog1 + (y-or-n-p prompt) + (define-key query-replace-map " " 'act))) + +(defun todo-category-completions (&optional archive) + "Return a list of completions for `todo-read-category'. +Each element of the list is a cons of a category name and the +file or list of files (as short file names) it is in. The files +are either the current (or if there is none, the default) todo +file plus the files listed in `todo-category-completions-files', +or, with non-nil ARCHIVE, the current archive file." + (let* ((curfile (or todo-current-todo-file + (and todo-show-current-file + todo-global-current-todo-file) + (todo-absolute-file-name todo-default-todo-file))) + (files (or (unless archive + (mapcar 'todo-absolute-file-name + todo-category-completions-files)) + (list curfile))) + listall listf) + ;; If file was just added, it has no category completions. + (unless (zerop (buffer-size (find-buffer-visiting curfile))) + (unless (member curfile todo-archives) + (add-to-list 'files curfile)) + (dolist (f files listall) + (with-current-buffer (find-file-noselect f 'nowarn) + ;; Ensure category is properly displayed in case user + ;; switches to file via a non-Todo mode command. And if + ;; done items in category are visible, keep them visible. + (let ((done todo-show-with-done)) + (when (> (buffer-size) (- (point-max) (point-min))) + (save-excursion + (goto-char (point-min)) + (setq done (re-search-forward todo-done-string-start nil t)))) + (let ((todo-show-with-done done)) + (save-excursion (todo-category-select)))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (setq listf (read (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))))))) + (mapc (lambda (elt) (let* ((cat (car elt)) + (la-elt (assoc cat listall))) + (if la-elt + (setcdr la-elt (append (list (cdr la-elt)) + (list f))) + (push (cons cat f) listall)))) + listf))))) + +(defun todo-read-file-name (prompt &optional archive mustmatch) + "Choose and return the name of a todo file, prompting with PROMPT. + +Show completions with TAB or SPC; the names are shown in short +form but the absolute truename is returned. With non-nil ARCHIVE +return the absolute truename of a todo archive file. With non-nil +MUSTMATCH the name of an existing file must be chosen; +otherwise, a new file name is allowed." + (let* ((completion-ignore-case todo-completion-ignore-case) + (files (mapcar 'todo-short-file-name + (if archive todo-archives todo-files))) + (file (completing-read prompt files nil mustmatch nil nil + (if files + ;; If user hit RET without + ;; choosing a file, default to + ;; current or default file. + (todo-short-file-name + (or todo-current-todo-file + (and todo-show-current-file + todo-global-current-todo-file) + (todo-absolute-file-name + todo-default-todo-file))) + ;; Trigger prompt for initial file. + "")))) + (unless (file-exists-p todo-directory) + (make-directory todo-directory)) + (unless mustmatch + (setq file (todo-validate-name file 'file))) + (setq file (file-truename (concat todo-directory file + (if archive ".toda" ".todo")))))) + +(defun todo-read-category (prompt &optional match-type file) + "Choose and return a category name, prompting with PROMPT. +Show completions for existing categories with TAB or SPC. + +The argument MATCH-TYPE specifies the matching requirements on +the category name: with the value `todo' or `archive' the name +must complete to that of an existing todo or archive category, +respectively; with the value `add' the name must not be that of +an existing category; with all other values both existing and new +valid category names are accepted. + +With non-nil argument FILE prompt for a file and complete only +against categories in that file; otherwise complete against all +categories from `todo-category-completions-files'." + ;; Allow SPC to insert spaces, for adding new category names. + (let ((map minibuffer-local-completion-map)) + (define-key map " " nil) + (let* ((add (eq match-type 'add)) + (archive (eq match-type 'archive)) + (file0 (when (and file (> (length todo-files) 1)) + (todo-read-file-name (concat "Choose a" (if archive + "n archive" + " todo") + " file: ") archive t))) + (completions (unless file0 (todo-category-completions archive))) + (categories (cond (file0 + (with-current-buffer + (find-file-noselect file0 'nowarn) + (let ((todo-current-todo-file file0)) + todo-categories))) + ((and add (not file)) + (with-current-buffer + (find-file-noselect todo-current-todo-file) + todo-categories)) + (t + completions))) + (completion-ignore-case todo-completion-ignore-case) + (cat (completing-read prompt categories nil + (eq match-type 'todo) nil nil + ;; Unless we're adding a category via + ;; todo-add-category, set default + ;; for existing categories to the + ;; current category of the chosen + ;; file or else of the current file. + (if (and categories (not add)) + (with-current-buffer + (find-file-noselect + (or file0 + todo-current-todo-file + (todo-absolute-file-name + todo-default-todo-file))) + (todo-current-category)) + ;; Trigger prompt for initial category. + ""))) + (catfil (cdr (assoc cat completions))) + (str "Category \"%s\" from which file (TAB for choices)? ")) + ;; If we do category completion and the chosen category name + ;; occurs in more than one file, prompt to choose one file. + (unless (or file0 add (not catfil)) + (setq file0 (file-truename + (if (atom catfil) + catfil + (todo-absolute-file-name + (let ((files (mapcar 'todo-short-file-name catfil))) + (completing-read (format str cat) files))))))) + ;; Default to the current file. + (unless file0 (setq file0 todo-current-todo-file)) + ;; First validate only a name passed interactively from + ;; todo-add-category, which must be of a nonexisting category. + (unless (and (assoc cat categories) (not add)) + ;; Validate only against completion categories. + (let ((todo-categories categories)) + (setq cat (todo-validate-name cat 'category))) + ;; When user enters a nonexisting category name by jumping or + ;; moving, confirm that it should be added, then validate. + (unless add + (if (todo-y-or-n-p (format "Add new category \"%s\" to file \"%s\"? " + cat (todo-short-file-name file0))) + (progn + (when (assoc cat categories) + (let ((todo-categories categories)) + (setq cat (todo-validate-name cat 'category)))) + ;; Restore point and narrowing after adding new + ;; category, to avoid moving to beginning of file when + ;; moving marked items to a new category + ;; (todo-move-item). + (save-excursion + (save-restriction + (todo-add-category file0 cat)))) + ;; If we decide not to add a category, exit without returning. + (keyboard-quit)))) + (cons cat file0)))) + +(defun todo-validate-name (name type) + "Prompt for new NAME for TYPE until it is valid, then return it. +TYPE can be either of the symbols `file' or `category'." + (let ((categories todo-categories) + (files (mapcar 'todo-short-file-name todo-files)) + prompt) + (while + (and + (cond ((string= "" name) + (setq prompt + (cond ((eq type 'file) + (if files + "Enter a non-empty file name: " + ;; Empty string passed by todo-show to + ;; prompt for initial todo file. + (concat "Initial file name [" + todo-initial-file "]: "))) + ((eq type 'category) + (if categories + "Enter a non-empty category name: " + ;; Empty string passed by todo-show to + ;; prompt for initial category of a new + ;; todo file. + (concat "Initial category name [" + todo-initial-category "]: ")))))) + ((string-match "\\`\\s-+\\'" name) + (setq prompt + "Enter a name that does not contain only white space: ")) + ((and (eq type 'file) (member name files)) + (setq prompt "Enter a non-existing file name: ")) + ((and (eq type 'category) (assoc name categories)) + (setq prompt "Enter a non-existing category name: "))) + (setq name (if (or (and (eq type 'file) files) + (and (eq type 'category) categories)) + (completing-read prompt (cond ((eq type 'file) + files) + ((eq type 'category) + categories))) + ;; Offer default initial name. + (completing-read prompt (if (eq type 'file) + files + categories) + nil nil (if (eq type 'file) + todo-initial-file + todo-initial-category)))))) + name)) + +;; Adapted from calendar-read-date and calendar-date-string. +(defun todo-read-date (&optional arg mo yr) + "Prompt for Gregorian date and return it in the current format. + +With non-nil ARG, prompt for and return only the date component +specified by ARG, which can be one of these symbols: +`month' (prompt for name, return name or number according to +value of `calendar-date-display-form'), `day' of month, or +`year'. The value of each of these components can be `*', +indicating an unspecified month, day, or year. + +When ARG is `day', non-nil arguments MO and YR determine the +number of the last the day of the month." + (let (year monthname month day + dayname) ; Needed by calendar-date-display-form. + (when (or (not arg) (eq arg 'year)) + (while (if (natnump year) (< year 1) (not (eq year '*))) + (setq year (read-from-minibuffer + "Year (>0 or RET for this year or * for any year): " + nil nil t nil (number-to-string + (calendar-extract-year + (calendar-current-date))))))) + (when (or (not arg) (eq arg 'month)) + (let* ((marray todo-month-name-array) + (mlist (append marray nil)) + (mabarray todo-month-abbrev-array) + (mablist (append mabarray nil)) + (completion-ignore-case todo-completion-ignore-case)) + (setq monthname (completing-read + "Month name (RET for current month, * for any month): " + mlist nil t nil nil + (calendar-month-name (calendar-extract-month + (calendar-current-date)) t)) + month (1+ (- (length mlist) + (length (or (member monthname mlist) + (member monthname mablist)))))) + (setq monthname (aref mabarray (1- month))))) + (when (or (not arg) (eq arg 'day)) + (let ((last (let ((mm (or month mo)) + (yy (or year yr))) + ;; If month is unspecified, use a month with 31 + ;; days for checking day of month input. Does + ;; Calendar do anything special when * is + ;; currently a shorter month? + (if (= mm 13) (setq mm 1)) + ;; If year is unspecified, use a leap year to + ;; allow Feb. 29. + (if (eq year '*) (setq yy 2012)) + (calendar-last-day-of-month mm yy)))) + (while (if (natnump day) (or (< day 1) (> day last)) (not (eq day '*))) + (setq day (read-from-minibuffer + (format "Day (1-%d or RET for today or * for any day): " + last) + nil nil t nil (number-to-string + (calendar-extract-day + (calendar-current-date)))))))) + ;; Stringify read values (monthname is already a string). + (and year (setq year (if (eq year '*) + (symbol-name '*) + (number-to-string year)))) + (and day (setq day (if (eq day '*) + (symbol-name '*) + (number-to-string day)))) + (and month (setq month (if (eq month '*) + (symbol-name '*) + (number-to-string month)))) + (if arg + (cond ((eq arg 'year) year) + ((eq arg 'day) day) + ((eq arg 'month) + (if (memq 'month calendar-date-display-form) + month + monthname))) + (mapconcat 'eval calendar-date-display-form "")))) + +(defun todo-read-dayname () + "Choose name of a day of the week with completion and return it." + (let ((completion-ignore-case todo-completion-ignore-case)) + (completing-read "Enter a day name: " + (append calendar-day-name-array nil) + nil t))) + +(defun todo-read-time () + "Prompt for and return a valid clock time as a string. + +Valid time strings are those matching `diary-time-regexp'. +Typing `' at the prompt returns the current time, if the +user option `todo-always-add-time-string' is non-nil, otherwise +the empty string (i.e., no time string)." + (let (valid answer) + (while (not valid) + (setq answer (read-string "Enter a clock time: " nil nil + (when todo-always-add-time-string + (substring (current-time-string) 11 16)))) + (when (or (string= "" answer) + (string-match diary-time-regexp answer)) + (setq valid t))) + answer)) + +;; ----------------------------------------------------------------------------- +;;; Customization groups and utilities +;; ----------------------------------------------------------------------------- + +(defgroup todo nil + "Create and maintain categorized lists of todo items." + :link '(emacs-commentary-link "todo") + :version "24.4" + :group 'calendar) + +(defgroup todo-edit nil + "User options for adding and editing todo items." + :version "24.4" + :group 'todo) + +(defgroup todo-categories nil + "User options for Todo Categories mode." + :version "24.4" + :group 'todo) + +(defgroup todo-filtered nil + "User options for Todo Filter Items mode." + :version "24.4" + :group 'todo) + +(defgroup todo-display nil + "User display options for Todo mode." + :version "24.4" + :group 'todo) + +(defgroup todo-faces nil + "Faces for the Todo modes." + :version "24.4" + :group 'todo) + +(defun todo-set-show-current-file (symbol value) + "The :set function for user option `todo-show-current-file'." + (custom-set-default symbol value) + (if value + (add-hook 'pre-command-hook 'todo-show-current-file nil t) + (remove-hook 'pre-command-hook 'todo-show-current-file t))) + +(defun todo-reset-prefix (symbol value) + "The :set function for `todo-prefix' and `todo-number-prefix'." + (let ((oldvalue (symbol-value symbol)) + (files todo-file-buffers)) + (custom-set-default symbol value) + (when (not (equal value oldvalue)) + (dolist (f files) + (with-current-buffer (find-file-noselect f) + ;; Activate the new setting in the current category. + (save-excursion (todo-category-select))))))) + +(defun todo-reset-nondiary-marker (symbol value) + "The :set function for user option `todo-nondiary-marker'." + (let ((oldvalue (symbol-value symbol)) + (files (append todo-files todo-archives))) + (custom-set-default symbol value) + ;; Need to reset these to get font-locking right. + (setq todo-nondiary-start (nth 0 todo-nondiary-marker) + todo-nondiary-end (nth 1 todo-nondiary-marker) + todo-date-string-start + ;; See comment in defvar of `todo-date-string-start'. + (concat "^\\(" (regexp-quote todo-nondiary-start) "\\|" + (regexp-quote diary-nonmarking-symbol) "\\)?")) + (when (not (equal value oldvalue)) + (dolist (f files) + (with-current-buffer (find-file-noselect f) + (let (buffer-read-only) + (widen) + (goto-char (point-min)) + (while (not (eobp)) + (if (re-search-forward + (concat "^\\(" todo-done-string-start "[^][]+] \\)?" + "\\(?1:" (regexp-quote (car oldvalue)) + "\\)" todo-date-pattern "\\( " + diary-time-regexp "\\)?\\(?2:" + (regexp-quote (cadr oldvalue)) "\\)") + nil t) + (progn + (replace-match (nth 0 value) t t nil 1) + (replace-match (nth 1 value) t t nil 2)) + (forward-line))) + (todo-category-select))))))) + +(defun todo-reset-done-separator-string (symbol value) + "The :set function for `todo-done-separator-string'." + (let ((oldvalue (symbol-value symbol)) + (files todo-file-buffers) + (sep todo-done-separator)) + (custom-set-default symbol value) + (when (not (equal value oldvalue)) + (dolist (f files) + (with-current-buffer (find-file-noselect f) + (let (buffer-read-only) + (setq todo-done-separator (todo-done-separator)) + (when (= 1 (length value)) + (todo-reset-done-separator sep))) + (todo-category-select)))))) + +(defun todo-reset-done-string (symbol value) + "The :set function for user option `todo-done-string'." + (let ((oldvalue (symbol-value symbol)) + (files (append todo-files todo-archives))) + (custom-set-default symbol value) + ;; Need to reset this to get font-locking right. + (setq todo-done-string-start + (concat "^\\[" (regexp-quote todo-done-string))) + (when (not (equal value oldvalue)) + (dolist (f files) + (with-current-buffer (find-file-noselect f) + (let (buffer-read-only) + (widen) + (goto-char (point-min)) + (while (not (eobp)) + (if (re-search-forward + (concat "^" (regexp-quote todo-nondiary-start) + "\\(" (regexp-quote oldvalue) "\\)") + nil t) + (replace-match value t t nil 1) + (forward-line))) + (todo-category-select))))))) + +(defun todo-reset-comment-string (symbol value) + "The :set function for user option `todo-comment-string'." + (let ((oldvalue (symbol-value symbol)) + (files (append todo-files todo-archives))) + (custom-set-default symbol value) + (when (not (equal value oldvalue)) + (dolist (f files) + (with-current-buffer (find-file-noselect f) + (let (buffer-read-only) + (save-excursion + (widen) + (goto-char (point-min)) + (while (not (eobp)) + (if (re-search-forward + (concat + "\\[\\(" (regexp-quote oldvalue) "\\): [^]]*\\]") + nil t) + (replace-match value t t nil 1) + (forward-line))) + (todo-category-select)))))))) + +(defun todo-reset-highlight-item (symbol value) + "The :set function for `todo-toggle-item-highlighting'." + (let ((oldvalue (symbol-value symbol)) + (files (append todo-files todo-archives))) + (custom-set-default symbol value) + (when (not (equal value oldvalue)) + (dolist (f files) + (let ((buf (find-buffer-visiting f))) + (when buf + (with-current-buffer buf + (require 'hl-line) + (if value + (hl-line-mode 1) + (hl-line-mode -1))))))))) + +(defun todo-reevaluate-filelist-defcustoms () + "Reevaluate defcustoms that provide choice list of todo files." + (custom-set-default 'todo-default-todo-file + (symbol-value 'todo-default-todo-file)) + (todo-reevaluate-default-file-defcustom) + (custom-set-default 'todo-filter-files (symbol-value 'todo-filter-files)) + (todo-reevaluate-filter-files-defcustom) + (custom-set-default 'todo-category-completions-files + (symbol-value 'todo-category-completions-files)) + (todo-reevaluate-category-completions-files-defcustom)) + +(defun todo-reevaluate-default-file-defcustom () + "Reevaluate defcustom of `todo-default-todo-file'. +Called after adding or deleting a todo file." + (eval (defcustom todo-default-todo-file (car (funcall todo-files-function)) + "Todo file visited by first session invocation of `todo-show'." + :type `(radio ,@(mapcar (lambda (f) (list 'const f)) + (mapcar 'todo-short-file-name + (funcall todo-files-function)))) + :group 'todo))) + +(defun todo-reevaluate-category-completions-files-defcustom () + "Reevaluate defcustom of `todo-category-completions-files'. +Called after adding or deleting a todo file." + (eval (defcustom todo-category-completions-files nil + "List of files for building `todo-read-category' completions." + :type `(set ,@(mapcar (lambda (f) (list 'const f)) + (mapcar 'todo-short-file-name + (funcall todo-files-function)))) + :group 'todo))) + +(defun todo-reevaluate-filter-files-defcustom () + "Reevaluate defcustom of `todo-filter-files'. +Called after adding or deleting a todo file." + (eval (defcustom todo-filter-files nil + "List of files for multifile item filtering." + :type `(set ,@(mapcar (lambda (f) (list 'const f)) + (mapcar 'todo-short-file-name + (funcall todo-files-function)))) + :group 'todo))) + +;; ----------------------------------------------------------------------------- +;;; Font locking +;; ----------------------------------------------------------------------------- + +(defun todo-nondiary-marker-matcher (lim) + "Search for todo item nondiary markers within LIM for font-locking." + (re-search-forward (concat "^\\(?1:" (regexp-quote todo-nondiary-start) "\\)" + todo-date-pattern "\\(?: " diary-time-regexp + "\\)?\\(?2:" (regexp-quote todo-nondiary-end) "\\)") + lim t)) + +(defun todo-diary-nonmarking-matcher (lim) + "Search for diary nonmarking symbol within LIM for font-locking." + (re-search-forward (concat "^\\(?1:" (regexp-quote diary-nonmarking-symbol) + "\\)" todo-date-pattern) lim t)) + +(defun todo-date-string-matcher (lim) + "Search for todo item date string within LIM for font-locking." + (re-search-forward + (concat todo-date-string-start "\\(?1:" todo-date-pattern "\\)") lim t)) + +(defun todo-time-string-matcher (lim) + "Search for todo item time string within LIM for font-locking." + (re-search-forward (concat todo-date-string-start todo-date-pattern + " \\(?1:" diary-time-regexp "\\)") lim t)) + +(defun todo-diary-expired-matcher (lim) + "Search for expired diary item date within LIM for font-locking." + (when (re-search-forward (concat "^\\(?:" + (regexp-quote diary-nonmarking-symbol) + "\\)?\\(?1:" todo-date-pattern "\\) \\(?2:" + diary-time-regexp "\\)?") lim t) + (let* ((date (match-string-no-properties 1)) + (time (match-string-no-properties 2)) + ;; Function days-between requires a non-empty time string. + (date-time (concat date " " (or time "00:00")))) + (or (and (not (string-match ".+day\\|\\*" date)) + (< (days-between date-time (current-time-string)) 0)) + (todo-diary-expired-matcher lim))))) + +(defun todo-done-string-matcher (lim) + "Search for done todo item header within LIM for font-locking." + (re-search-forward (concat todo-done-string-start + "[^][]+]") + lim t)) + +(defun todo-comment-string-matcher (lim) + "Search for done todo item comment within LIM for font-locking." + (re-search-forward (concat "\\[\\(?1:" todo-comment-string "\\):") + lim t)) + +(defun todo-category-string-matcher-1 (lim) + "Search for todo category name within LIM for font-locking. +This is for fontifying category and file names appearing in Todo +Filtered Items mode following done items." + (if (eq major-mode 'todo-filtered-items-mode) + (re-search-forward (concat todo-done-string-start todo-date-pattern + "\\(?: " diary-time-regexp + ;; Use non-greedy operator to prevent + ;; capturing possible following non-diary + ;; date string. + "\\)?] \\(?1:\\[.+?\\]\\)") + lim t))) + +(defun todo-category-string-matcher-2 (lim) + "Search for todo category name within LIM for font-locking. +This is for fontifying category and file names appearing in Todo +Filtered Items mode following todo (not done) items." + (if (eq major-mode 'todo-filtered-items-mode) + (re-search-forward (concat todo-date-string-start todo-date-pattern + "\\(?: " diary-time-regexp "\\)?\\(?:" + (regexp-quote todo-nondiary-end) + "\\)? \\(?1:\\[.+\\]\\)") + lim t))) + +(defvar todo-nondiary-face 'todo-nondiary) +(defvar todo-date-face 'todo-date) +(defvar todo-time-face 'todo-time) +(defvar todo-diary-expired-face 'todo-diary-expired) +(defvar todo-done-sep-face 'todo-done-sep) +(defvar todo-done-face 'todo-done) +(defvar todo-comment-face 'todo-comment) +(defvar todo-category-string-face 'todo-category-string) +(defvar todo-font-lock-keywords + (list + '(todo-nondiary-marker-matcher 1 todo-nondiary-face t) + '(todo-nondiary-marker-matcher 2 todo-nondiary-face t) + ;; diary-lib.el uses font-lock-constant-face for diary-nonmarking-symbol. + '(todo-diary-nonmarking-matcher 1 font-lock-constant-face t) + '(todo-date-string-matcher 1 todo-date-face t) + '(todo-time-string-matcher 1 todo-time-face t) + '(todo-done-string-matcher 0 todo-done-face t) + '(todo-comment-string-matcher 1 todo-comment-face t) + '(todo-category-string-matcher-1 1 todo-category-string-face t t) + '(todo-category-string-matcher-2 1 todo-category-string-face t t) + '(todo-diary-expired-matcher 1 todo-diary-expired-face t) + '(todo-diary-expired-matcher 2 todo-diary-expired-face t t) + ) + "Font-locking for Todo modes.") + +;; ----------------------------------------------------------------------------- +;;; Key binding +;; ----------------------------------------------------------------------------- + +(defvar todo-insertion-map + (let ((map (make-keymap))) + (todo-insertion-key-bindings map) + (define-key map "p" 'todo-copy-item) + map) + "Keymap for Todo mode item insertion commands.") + +(defvar todo-key-bindings-t + `( + ("Af" todo-find-archive) + ("Ac" todo-choose-archive) + ("Ad" todo-archive-done-item) + ("Cv" todo-toggle-view-done-items) + ("v" todo-toggle-view-done-items) + ("Ca" todo-add-category) + ("Cr" todo-rename-category) + ("Cg" todo-merge-category) + ("Cm" todo-move-category) + ("Ck" todo-delete-category) + ("Cts" todo-set-top-priorities-in-category) + ("Cey" todo-edit-category-diary-inclusion) + ("Cek" todo-edit-category-diary-nonmarking) + ("Fa" todo-add-file) + ("Ff" todo-find-filtered-items-file) + ("FV" todo-toggle-view-done-only) + ("V" todo-toggle-view-done-only) + ("Ftt" todo-filter-top-priorities) + ("Ftm" todo-filter-top-priorities-multifile) + ("Fts" todo-set-top-priorities-in-file) + ("Fyy" todo-filter-diary-items) + ("Fym" todo-filter-diary-items-multifile) + ("Frr" todo-filter-regexp-items) + ("Frm" todo-filter-regexp-items-multifile) + ("ee" todo-edit-item) + ("em" todo-edit-multiline-item) + ("edt" todo-edit-item-header) + ("edc" todo-edit-item-date-from-calendar) + ("eda" todo-edit-item-date-to-today) + ("edn" todo-edit-item-date-day-name) + ("edy" todo-edit-item-date-year) + ("edm" todo-edit-item-date-month) + ("edd" todo-edit-item-date-day) + ("et" todo-edit-item-time) + ("eyy" todo-edit-item-diary-inclusion) + ("eyk" todo-edit-item-diary-nonmarking) + ("ec" todo-edit-done-item-comment) + ("d" todo-item-done) + ("i" ,todo-insertion-map) + ("k" todo-delete-item) + ("m" todo-move-item) + ("u" todo-item-undone) + ([remap newline] newline-and-indent) + ) + "List of key bindings for Todo mode only.") + +(defvar todo-key-bindings-t+a+f + `( + ("C*" todo-mark-category) + ("Cu" todo-unmark-category) + ("Fh" todo-toggle-item-header) + ("h" todo-toggle-item-header) + ("Fe" todo-edit-file) + ("FH" todo-toggle-item-highlighting) + ("H" todo-toggle-item-highlighting) + ("FN" todo-toggle-prefix-numbers) + ("N" todo-toggle-prefix-numbers) + ("PB" todo-print-buffer) + ("PF" todo-print-buffer-to-file) + ("b" todo-backward-category) + ("d" todo-item-done) + ("f" todo-forward-category) + ("j" todo-jump-to-category) + ("n" todo-next-item) + ("p" todo-previous-item) + ("q" todo-quit) + ("s" todo-save) + ("t" todo-show) + ) + "List of key bindings for Todo, Archive, and Filtered Items modes.") + +(defvar todo-key-bindings-t+a + `( + ("Fc" todo-show-categories-table) + ("S" todo-search) + ("X" todo-clear-matches) + ("*" todo-toggle-mark-item) + ) + "List of key bindings for Todo and Todo Archive modes.") + +(defvar todo-key-bindings-t+f + `( + ("l" todo-lower-item-priority) + ("r" todo-raise-item-priority) + ("#" todo-set-item-priority) + ) + "List of key bindings for Todo and Todo Filtered Items modes.") + +(defvar todo-mode-map + (let ((map (make-keymap))) + ;; Don't suppress digit keys, so they can supply prefix arguments. + (suppress-keymap map) + (dolist (kb todo-key-bindings-t) + (define-key map (nth 0 kb) (nth 1 kb))) + (dolist (kb todo-key-bindings-t+a+f) + (define-key map (nth 0 kb) (nth 1 kb))) + (dolist (kb todo-key-bindings-t+a) + (define-key map (nth 0 kb) (nth 1 kb))) + (dolist (kb todo-key-bindings-t+f) + (define-key map (nth 0 kb) (nth 1 kb))) + map) + "Todo mode keymap.") + +(defvar todo-archive-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (dolist (kb todo-key-bindings-t+a+f) + (define-key map (nth 0 kb) (nth 1 kb))) + (dolist (kb todo-key-bindings-t+a) + (define-key map (nth 0 kb) (nth 1 kb))) + (define-key map "a" 'todo-jump-to-archive-category) + (define-key map "u" 'todo-unarchive-items) + map) + "Todo Archive mode keymap.") + +(defvar todo-edit-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-x\C-q" 'todo-edit-quit) + (define-key map [remap newline] 'newline-and-indent) + map) + "Todo Edit mode keymap.") + +(defvar todo-categories-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "c" 'todo-sort-categories-alphabetically-or-numerically) + (define-key map "t" 'todo-sort-categories-by-todo) + (define-key map "y" 'todo-sort-categories-by-diary) + (define-key map "d" 'todo-sort-categories-by-done) + (define-key map "a" 'todo-sort-categories-by-archived) + (define-key map "#" 'todo-set-category-number) + (define-key map "l" 'todo-lower-category) + (define-key map "r" 'todo-raise-category) + (define-key map "n" 'todo-next-button) + (define-key map "p" 'todo-previous-button) + (define-key map [tab] 'todo-next-button) + (define-key map [backtab] 'todo-previous-button) + (define-key map "q" 'todo-quit) + map) + "Todo Categories mode keymap.") + +(defvar todo-filtered-items-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (dolist (kb todo-key-bindings-t+a+f) + (define-key map (nth 0 kb) (nth 1 kb))) + (dolist (kb todo-key-bindings-t+f) + (define-key map (nth 0 kb) (nth 1 kb))) + (define-key map "g" 'todo-go-to-source-item) + (define-key map [remap newline] 'todo-go-to-source-item) + map) + "Todo Filtered Items mode keymap.") + +;; FIXME: Is it worth having a menu and if so, which commands? +;; (easy-menu-define +;; todo-menu todo-mode-map "Todo Menu" +;; '("Todo" +;; ("Navigation" +;; ["Next Item" todo-forward-item t] +;; ["Previous Item" todo-backward-item t] +;; "---" +;; ["Next Category" todo-forward-category t] +;; ["Previous Category" todo-backward-category t] +;; ["Jump to Category" todo-jump-to-category t] +;; "---" +;; ["Search Todo File" todo-search t] +;; ["Clear Highlighting on Search Matches" todo-category-done t]) +;; ("Display" +;; ["List Current Categories" todo-show-categories-table t] +;; ;; ["List Categories Alphabetically" todo-display-categories-alphabetically t] +;; ["Turn Item Highlighting on/off" todo-toggle-item-highlighting t] +;; ["Turn Item Numbering on/off" todo-toggle-prefix-numbers t] +;; ["Turn Item Time Stamp on/off" todo-toggle-item-header t] +;; ["View/Hide Done Items" todo-toggle-view-done-items t] +;; "---" +;; ["View Diary Items" todo-filter-diary-items t] +;; ["View Top Priority Items" todo-filter-top-priorities t] +;; ["View Multifile Top Priority Items" todo-filter-top-priorities-multifile t] +;; "---" +;; ["Print Category" todo-print-buffer t]) +;; ("Editing" +;; ["Insert New Item" todo-insert-item t] +;; ["Insert Item Here" todo-insert-item-here t] +;; ("More Insertion Commands") +;; ["Edit Item" todo-edit-item t] +;; ["Edit Multiline Item" todo-edit-multiline-item t] +;; ["Edit Item Header" todo-edit-item-header t] +;; ["Edit Item Date" todo-edit-item-date t] +;; ["Edit Item Time" todo-edit-item-time t] +;; "---" +;; ["Lower Item Priority" todo-lower-item-priority t] +;; ["Raise Item Priority" todo-raise-item-priority t] +;; ["Set Item Priority" todo-set-item-priority t] +;; ["Move (Recategorize) Item" todo-move-item t] +;; ["Delete Item" todo-delete-item t] +;; ["Undo Done Item" todo-item-undone t] +;; ["Mark/Unmark Item for Diary" todo-toggle-item-diary-inclusion t] +;; ["Mark/Unmark Items for Diary" todo-edit-item-diary-inclusion t] +;; ["Mark & Hide Done Item" todo-item-done t] +;; ["Archive Done Items" todo-archive-category-done-items t] +;; "---" +;; ["Add New Todo File" todo-add-file t] +;; ["Add New Category" todo-add-category t] +;; ["Delete Current Category" todo-delete-category t] +;; ["Rename Current Category" todo-rename-category t] +;; "---" +;; ["Save Todo File" todo-save t] +;; ) +;; "---" +;; ["Quit" todo-quit t] +;; )) + +;; ----------------------------------------------------------------------------- +;;; Hook functions and mode definitions +;; ----------------------------------------------------------------------------- + +(defun todo-show-current-file () + "Visit current instead of default todo file with `todo-show'. +This function is added to `pre-command-hook' when user option +`todo-show-current-file' is set to non-nil." + (setq todo-global-current-todo-file todo-current-todo-file)) + +(defun todo-display-as-todo-file () + "Show todo files correctly when visited from outside of Todo mode." + (and (member this-command todo-visit-files-commands) + (= (- (point-max) (point-min)) (buffer-size)) + (member major-mode '(todo-mode todo-archive-mode)) + (todo-category-select))) + +(defun todo-add-to-buffer-list () + "Add name of just visited todo file to `todo-file-buffers'. +This function is added to `find-file-hook' in Todo mode." + (let ((filename (file-truename (buffer-file-name)))) + (when (member filename todo-files) + (add-to-list 'todo-file-buffers filename)))) + +(defun todo-update-buffer-list () + "Make current Todo mode buffer file car of `todo-file-buffers'. +This function is added to `post-command-hook' in Todo mode." + (let ((filename (file-truename (buffer-file-name)))) + (unless (eq (car todo-file-buffers) filename) + (setq todo-file-buffers + (cons filename (delete filename todo-file-buffers)))))) + +(defun todo-reset-global-current-todo-file () + "Update the value of `todo-global-current-todo-file'. +This becomes the latest existing todo file or, if there is none, +the value of `todo-default-todo-file'. +This function is added to `kill-buffer-hook' in Todo mode." + (let ((filename (file-truename (buffer-file-name)))) + (setq todo-file-buffers (delete filename todo-file-buffers)) + (setq todo-global-current-todo-file + (or (car todo-file-buffers) + (todo-absolute-file-name todo-default-todo-file))))) + +(defun todo-reset-and-enable-done-separator () + "Show resized done items separator overlay after window change. +Added to `window-configuration-change-hook' in `todo-mode'." + (when (= 1 (length todo-done-separator-string)) + (let ((sep todo-done-separator)) + (setq todo-done-separator (todo-done-separator)) + (save-match-data (todo-reset-done-separator sep))))) + +(defun todo-modes-set-1 () + "Make some settings that apply to multiple Todo modes." + (setq-local font-lock-defaults '(todo-font-lock-keywords t)) + (setq-local tab-width todo-indent-to-here) + (setq-local indent-line-function 'todo-indent) + (when todo-wrap-lines + (visual-line-mode) + (setq wrap-prefix (make-string todo-indent-to-here 32)))) + +(defun todo-modes-set-2 () + "Make some settings that apply to multiple Todo modes." + (add-to-invisibility-spec 'todo) + (setq buffer-read-only t) + (when (boundp 'hl-line-range-function) + (setq-local hl-line-range-function + (lambda() (save-excursion + (when (todo-item-end) + (cons (todo-item-start) + (todo-item-end)))))))) + +(defun todo-modes-set-3 () + "Make some settings that apply to multiple Todo modes." + (setq-local todo-categories (todo-set-categories)) + (setq-local todo-category-number 1) + (add-hook 'find-file-hook 'todo-display-as-todo-file nil t)) + +(put 'todo-mode 'mode-class 'special) + +(define-derived-mode todo-mode special-mode "Todo" + "Major mode for displaying, navigating and editing todo lists. + +\\{todo-mode-map}" + ;; (easy-menu-add todo-menu) + (todo-modes-set-1) + (todo-modes-set-2) + (todo-modes-set-3) + ;; Initialize todo-current-todo-file. + (when (member (file-truename (buffer-file-name)) + (funcall todo-files-function)) + (setq-local todo-current-todo-file (file-truename (buffer-file-name)))) + (setq-local todo-show-done-only nil) + (setq-local todo-categories-with-marks nil) + (add-hook 'find-file-hook 'todo-add-to-buffer-list nil t) + (add-hook 'post-command-hook 'todo-update-buffer-list nil t) + (when todo-show-current-file + (add-hook 'pre-command-hook 'todo-show-current-file nil t)) + (add-hook 'window-configuration-change-hook + 'todo-reset-and-enable-done-separator nil t) + (add-hook 'kill-buffer-hook 'todo-reset-global-current-todo-file nil t)) + +(put 'todo-archive-mode 'mode-class 'special) + +;; If todo-mode is parent, all todo-mode key bindings appear to be +;; available in todo-archive-mode (e.g. shown by C-h m). +(define-derived-mode todo-archive-mode special-mode "Todo-Arch" + "Major mode for archived todo categories. + +\\{todo-archive-mode-map}" + (todo-modes-set-1) + (todo-modes-set-2) + (todo-modes-set-3) + (setq-local todo-current-todo-file (file-truename (buffer-file-name))) + (setq-local todo-show-done-only t)) + +(defun todo-mode-external-set () + "Set `todo-categories' externally to `todo-current-todo-file'." + (setq-local todo-current-todo-file todo-global-current-todo-file) + (let ((cats (with-current-buffer + ;; Can't use find-buffer-visiting when + ;; `todo-show-categories-table' is called on first + ;; invocation of `todo-show', since there is then + ;; no buffer visiting the current file. + (find-file-noselect todo-current-todo-file 'nowarn) + (or todo-categories + ;; In Todo Edit mode todo-categories is now nil + ;; since it uses same buffer as Todo mode but + ;; doesn't have the latter's local variables. + (save-excursion + (goto-char (point-min)) + (read (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))))))) + (setq-local todo-categories cats))) + +(define-derived-mode todo-edit-mode text-mode "Todo-Ed" + "Major mode for editing multiline todo items. + +\\{todo-edit-mode-map}" + (todo-modes-set-1) + (todo-mode-external-set) + (setq buffer-read-only nil)) + +(put 'todo-categories-mode 'mode-class 'special) + +(define-derived-mode todo-categories-mode special-mode "Todo-Cats" + "Major mode for displaying and editing todo categories. + +\\{todo-categories-mode-map}" + (todo-mode-external-set)) + +(put 'todo-filtered-items-mode 'mode-class 'special) + +(define-derived-mode todo-filtered-items-mode special-mode "Todo-Fltr" + "Mode for displaying and reprioritizing top priority Todo. + +\\{todo-filtered-items-mode-map}" + (todo-modes-set-1) + (todo-modes-set-2)) + +(add-to-list 'auto-mode-alist '("\\.todo\\'" . todo-mode)) +(add-to-list 'auto-mode-alist '("\\.toda\\'" . todo-archive-mode)) +(add-to-list 'auto-mode-alist '("\\.tod[tyr]\\'" . todo-filtered-items-mode)) + +;; ----------------------------------------------------------------------------- +(provide 'todo-mode) + +;;; todo-mode.el ends here === renamed file 'lisp/calendar/todo-mode.el' => 'lisp/obsolete/otodo-mode.el' ------------------------------------------------------------ revno: 113125 committer: Andreas Schwab branch nick: emacs timestamp: Fri 2013-06-21 23:27:17 +0200 message: * process.c (create_process): Mark PROCESS volatile. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-21 20:11:44 +0000 +++ src/ChangeLog 2013-06-21 21:27:17 +0000 @@ -1,3 +1,7 @@ +2013-06-21 Andreas Schwab + + * process.c (create_process): Mark PROCESS volatile. + 2013-06-21 Paul Eggert Use C99-style flexible array members if available. === modified file 'src/process.c' --- src/process.c 2013-06-18 18:41:48 +0000 +++ src/process.c 2013-06-21 21:27:17 +0000 @@ -1582,7 +1582,8 @@ static void -create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) +create_process (volatile Lisp_Object process, char **new_argv, + Lisp_Object current_dir) { int inchannel, outchannel; pid_t pid; ------------------------------------------------------------ revno: 113124 committer: Paul Eggert branch nick: trunk timestamp: Fri 2013-06-21 13:27:13 -0700 message: * lib-src/ebrowse.c: Include , needed on some platforms. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2013-06-21 20:11:44 +0000 +++ lib-src/ChangeLog 2013-06-21 20:27:13 +0000 @@ -1,7 +1,8 @@ 2013-06-21 Paul Eggert Use C99-style flexible array members if available. - * ebrowse.c (struct member, struct alias, struct sym): + * ebrowse.c: Include , for offsetof. + (struct member, struct alias, struct sym): Use FLEXIBLE_ARRAY_MEMBER. (add_sym, add_member, make_namespace, register_namespace_alias): Use offsetof (struct, flex_array_member), not sizeof (struct), as === modified file 'lib-src/ebrowse.c' --- lib-src/ebrowse.c 2013-06-21 20:11:44 +0000 +++ lib-src/ebrowse.c 2013-06-21 20:27:13 +0000 @@ -19,6 +19,7 @@ #include +#include #include #include #include ------------------------------------------------------------ revno: 113123 committer: Paul Eggert branch nick: trunk timestamp: Fri 2013-06-21 13:11:44 -0700 message: Use C99-style flexible array members if available. This avoids some subtle aliasing issues, which typically aren't a problem with GCC but may be a problem elsewhere. * lib-src/ebrowse.c (struct member, struct alias, struct sym): Use FLEXIBLE_ARRAY_MEMBER. (add_sym, add_member, make_namespace, register_namespace_alias): Use offsetof (struct, flex_array_member), not sizeof (struct), as that ports better to pre-C99 non-GCC. * src/alloc.c (sdata): New typedef, replacing the old struct sdata. It is a struct if GC_CHECK_STRING_BYTES, a union otherwise. In either case, it uses a flexible array member rather than the old struct hack. All uses changed. (SDATA_NBYTES, sweep_strings) [!GC_CHECK_STRING_BYTES]: Adjust to sdata reorganization. * src/alloc.c (VBLOCK_BYTES_MIN, allocate_vectorlike, Fgarbage_collect): Use offsetof (struct, flex_array_member), not sizeof (struct), as that ports better to pre-C99 non-GCC. * src/chartab.c (Fmake_char_table, make_sub_char_table, copy_char_table): Use CHAR_TABLE_STANDARD_SLOTS rather than its definition, as the latter has changed. * src/conf_post.h (FLEXIBLE_ARRAY_MEMBER): Move here from w32.c, and port better to pre-C99 GCC. * src/image.c (struct xpm_cached_color): * src/lisp.h (struct Lisp_Vector, struct Lisp_Bool_Vector) (struct Lisp_Char_Table, struct Lisp_Sub_Char_Table): Use FLEXIBLE_ARRAY_MEMBER. * src/lisp.h (string_bytes) [GC_CHECK_STRING_BYTES]: Move decl to top level so it gets checked against implementation. (CHAR_TABLE_STANDARD_SLOTS): Adjust to struct Lisp_Char_Table change. * src/w32.c (FLEXIBLE_ARRAY_MEMBER): Move to conf_post.h. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2013-06-19 20:10:57 +0000 +++ lib-src/ChangeLog 2013-06-21 20:11:44 +0000 @@ -1,3 +1,12 @@ +2013-06-21 Paul Eggert + + Use C99-style flexible array members if available. + * ebrowse.c (struct member, struct alias, struct sym): + Use FLEXIBLE_ARRAY_MEMBER. + (add_sym, add_member, make_namespace, register_namespace_alias): + Use offsetof (struct, flex_array_member), not sizeof (struct), as + that ports better to pre-C99 non-GCC. + 2013-05-29 Eli Zaretskii * Makefile.in (mostlyclean): Remove *.res files. === modified file 'lib-src/ebrowse.c' --- lib-src/ebrowse.c 2013-01-01 09:11:05 +0000 +++ lib-src/ebrowse.c 2013-06-21 20:11:44 +0000 @@ -237,7 +237,7 @@ char *def_regexp; /* Regular expression matching definition. */ const char *def_filename; /* File name of definition. */ int def_pos; /* Buffer position of definition. */ - char name[1]; /* Member name. */ + char name[FLEXIBLE_ARRAY_MEMBER]; /* Member name. */ }; /* Structures of this type are used to connect class structures with @@ -256,7 +256,7 @@ struct alias *next; /* Next in list. */ struct sym *namesp; /* Namespace in which defined. */ struct link *aliasee; /* List of aliased namespaces (A::B::C...). */ - char name[1]; /* Alias name. */ + char name[FLEXIBLE_ARRAY_MEMBER]; /* Alias name. */ }; /* The structure used to describe a class in the symbol table, @@ -280,7 +280,7 @@ const char *filename; /* File in which it can be found. */ const char *sfilename; /* File in which members can be found. */ struct sym *namesp; /* Namespace in which defined. . */ - char name[1]; /* Name of the class. */ + char name[FLEXIBLE_ARRAY_MEMBER]; /* Name of the class. */ }; /* Experimental: Print info for `--position-info'. We print @@ -567,8 +567,8 @@ puts (name); } - sym = (struct sym *) xmalloc (sizeof *sym + strlen (name)); - memset (sym, 0, sizeof *sym); + sym = xmalloc (offsetof (struct sym, name) + strlen (name) + 1); + memset (sym, 0, offsetof (struct sym, name)); strcpy (sym->name, name); sym->namesp = scope; sym->next = class_table[h]; @@ -852,7 +852,8 @@ static struct member * add_member (struct sym *cls, char *name, int var, int sc, unsigned int hash) { - struct member *m = (struct member *) xmalloc (sizeof *m + strlen (name)); + struct member *m = xmalloc (offsetof (struct member, name) + + strlen (name) + 1); struct member **list; struct member *p; struct member *prev; @@ -962,8 +963,8 @@ static struct sym * make_namespace (char *name, struct sym *context) { - struct sym *s = (struct sym *) xmalloc (sizeof *s + strlen (name)); - memset (s, 0, sizeof *s); + struct sym *s = xmalloc (offsetof (struct sym, name) + strlen (name) + 1); + memset (s, 0, offsetof (struct sym, name)); strcpy (s->name, name); s->next = all_namespaces; s->namesp = context; @@ -1046,7 +1047,7 @@ if (streq (new_name, al->name) && (al->namesp == current_namespace)) return; - al = (struct alias *) xmalloc (sizeof *al + strlen (new_name)); + al = xmalloc (offsetof (struct alias, name) + strlen (new_name) + 1); strcpy (al->name, new_name); al->next = namespace_alias_table[h]; al->namesp = current_namespace; === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-20 18:59:08 +0000 +++ src/ChangeLog 2013-06-21 20:11:44 +0000 @@ -1,3 +1,31 @@ +2013-06-21 Paul Eggert + + Use C99-style flexible array members if available. + This avoids some subtle aliasing issues, which typically + aren't a problem with GCC but may be a problem elsewhere. + * alloc.c (sdata): New typedef, replacing the old struct sdata. + It is a struct if GC_CHECK_STRING_BYTES, a union otherwise. + In either case, it uses a flexible array member rather than + the old struct hack. All uses changed. + (SDATA_NBYTES, sweep_strings) [!GC_CHECK_STRING_BYTES]: + Adjust to sdata reorganization. + * alloc.c (VBLOCK_BYTES_MIN, allocate_vectorlike, Fgarbage_collect): + Use offsetof (struct, flex_array_member), not sizeof (struct), as + that ports better to pre-C99 non-GCC. + * chartab.c (Fmake_char_table, make_sub_char_table, copy_char_table): + Use CHAR_TABLE_STANDARD_SLOTS rather than its definition, + as the latter has changed. + * conf_post.h (FLEXIBLE_ARRAY_MEMBER): Move here from w32.c, + and port better to pre-C99 GCC. + * image.c (struct xpm_cached_color): + * lisp.h (struct Lisp_Vector, struct Lisp_Bool_Vector) + (struct Lisp_Char_Table, struct Lisp_Sub_Char_Table): + Use FLEXIBLE_ARRAY_MEMBER. + * lisp.h (string_bytes) [GC_CHECK_STRING_BYTES]: + Move decl to top level so it gets checked against implementation. + (CHAR_TABLE_STANDARD_SLOTS): Adjust to struct Lisp_Char_Table change. + * w32.c (FLEXIBLE_ARRAY_MEMBER): Move to conf_post.h. + 2013-06-20 Paul Eggert * syntax.c: Integer cleanups. === modified file 'src/alloc.c' --- src/alloc.c 2013-06-20 14:47:46 +0000 +++ src/alloc.c 2013-06-21 20:11:44 +0000 @@ -1260,7 +1260,7 @@ When a Lisp_String is freed during GC, it is put back on string_free_list, and its `data' member and its sdata's `string' pointer is set to null. The size of the string is recorded in the - `u.nbytes' member of the sdata. So, sdata structures that are no + `n.nbytes' member of the sdata. So, sdata structures that are no longer used, can be easily recognized, and it's easy to compact the sblocks of small strings which we do in compact_small_strings. */ @@ -1274,10 +1274,12 @@ #define LARGE_STRING_BYTES 1024 -/* Structure describing string memory sub-allocated from an sblock. +/* Struct or union describing string memory sub-allocated from an sblock. This is where the contents of Lisp strings are stored. */ -struct sdata +#ifdef GC_CHECK_STRING_BYTES + +typedef struct { /* Back-pointer to the string this sdata belongs to. If null, this structure is free, and the NBYTES member of the union below @@ -1287,34 +1289,42 @@ contents. */ struct Lisp_String *string; -#ifdef GC_CHECK_STRING_BYTES - ptrdiff_t nbytes; - unsigned char data[1]; + unsigned char data[FLEXIBLE_ARRAY_MEMBER]; +} sdata; #define SDATA_NBYTES(S) (S)->nbytes #define SDATA_DATA(S) (S)->data #define SDATA_SELECTOR(member) member -#else /* not GC_CHECK_STRING_BYTES */ - - union - { - /* When STRING is non-null. */ - unsigned char data[1]; - - /* When STRING is null. */ +#else + +typedef union +{ + struct Lisp_String *string; + + /* When STRING is non-null. */ + struct + { + struct Lisp_String *string; + unsigned char data[FLEXIBLE_ARRAY_MEMBER]; + } u; + + /* When STRING is null. */ + struct + { + struct Lisp_String *string; ptrdiff_t nbytes; - } u; + } n; +} sdata; -#define SDATA_NBYTES(S) (S)->u.nbytes +#define SDATA_NBYTES(S) (S)->n.nbytes #define SDATA_DATA(S) (S)->u.data #define SDATA_SELECTOR(member) u.member #endif /* not GC_CHECK_STRING_BYTES */ -#define SDATA_DATA_OFFSET offsetof (struct sdata, SDATA_SELECTOR (data)) -}; +#define SDATA_DATA_OFFSET offsetof (sdata, SDATA_SELECTOR (data)) /* Structure describing a block of memory which is sub-allocated to @@ -1329,10 +1339,10 @@ /* Pointer to the next free sdata block. This points past the end of the sblock if there isn't any space left in this block. */ - struct sdata *next_free; + sdata *next_free; /* Start of data. */ - struct sdata first_data; + sdata first_data; }; /* Number of Lisp strings in a string_block structure. The 1020 is @@ -1388,7 +1398,7 @@ a pointer to the `u.data' member of its sdata structure; the structure starts at a constant offset in front of that. */ -#define SDATA_OF_STRING(S) ((struct sdata *) ((S)->data - SDATA_DATA_OFFSET)) +#define SDATA_OF_STRING(S) ((sdata *) ((S)->data - SDATA_DATA_OFFSET)) #ifdef GC_CHECK_STRING_OVERRUN @@ -1487,7 +1497,7 @@ static void check_sblock (struct sblock *b) { - struct sdata *from, *end, *from_end; + sdata *from, *end, *from_end; end = b->next_free; @@ -1501,7 +1511,7 @@ same as the one recorded in the sdata structure. */ nbytes = SDATA_SIZE (from->string ? string_bytes (from->string) : SDATA_NBYTES (from)); - from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); + from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); } } @@ -1631,7 +1641,7 @@ allocate_string_data (struct Lisp_String *s, EMACS_INT nchars, EMACS_INT nbytes) { - struct sdata *data, *old_data; + sdata *data, *old_data; struct sblock *b; ptrdiff_t needed, old_nbytes; @@ -1701,7 +1711,7 @@ b = current_sblock; data = b->next_free; - b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); + b->next_free = (sdata *) ((char *) data + needed + GC_STRING_EXTRA); MALLOC_UNBLOCK_INPUT; @@ -1772,7 +1782,7 @@ else { /* String is dead. Put it on the free-list. */ - struct sdata *data = SDATA_OF_STRING (s); + sdata *data = SDATA_OF_STRING (s); /* Save the size of S in its sdata so that we know how large that is. Reset the sdata's string @@ -1781,7 +1791,7 @@ if (string_bytes (s) != SDATA_NBYTES (data)) emacs_abort (); #else - data->u.nbytes = STRING_BYTES (s); + data->n.nbytes = STRING_BYTES (s); #endif data->string = NULL; @@ -1862,13 +1872,13 @@ compact_small_strings (void) { struct sblock *b, *tb, *next; - struct sdata *from, *to, *end, *tb_end; - struct sdata *to_end, *from_end; + sdata *from, *to, *end, *tb_end; + sdata *to_end, *from_end; /* TB is the sblock we copy to, TO is the sdata within TB we copy to, and TB_END is the end of TB. */ tb = oldest_sblock; - tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); + tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE); to = &tb->first_data; /* Step through the blocks from the oldest to the youngest. We @@ -1897,7 +1907,7 @@ eassert (nbytes <= LARGE_STRING_BYTES); nbytes = SDATA_SIZE (nbytes); - from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); + from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); #ifdef GC_CHECK_STRING_OVERRUN if (memcmp (string_overrun_cookie, @@ -1910,14 +1920,14 @@ if (s) { /* If TB is full, proceed with the next sblock. */ - to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); + to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); if (to_end > tb_end) { tb->next_free = to; tb = tb->next; - tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); + tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE); to = &tb->first_data; - to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); + to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); } /* Copy, and update the string's `data' pointer. */ @@ -2581,7 +2591,7 @@ /* Size of the minimal vector allocated from block. */ -#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector)) +#define VBLOCK_BYTES_MIN vroundup (header_size + sizeof (Lisp_Object)) /* Size of the largest vector allocated from block. */ @@ -2938,7 +2948,8 @@ else { struct large_vector *lv - = lisp_malloc (sizeof (*lv) + (len - 1) * word_size, + = lisp_malloc ((offsetof (struct large_vector, v.contents) + + len * word_size), MEM_TYPE_VECTORLIKE); lv->next.vector = large_vectors; large_vectors = lv; @@ -5416,7 +5427,8 @@ total[4] = list3 (Qstring_bytes, make_number (1), bounded_number (total_string_bytes)); - total[5] = list3 (Qvectors, make_number (sizeof (struct Lisp_Vector)), + total[5] = list3 (Qvectors, + make_number (header_size + sizeof (Lisp_Object)), bounded_number (total_vectors)); total[6] = list4 (Qvector_slots, make_number (word_size), === modified file 'src/chartab.c' --- src/chartab.c 2013-06-17 06:03:19 +0000 +++ src/chartab.c 2013-06-21 20:11:44 +0000 @@ -128,7 +128,7 @@ n_extras = XINT (n); } - size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras; + size = CHAR_TABLE_STANDARD_SLOTS + n_extras; vector = Fmake_vector (make_number (size), init); XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE); set_char_table_parent (vector, Qnil); @@ -141,7 +141,7 @@ make_sub_char_table (int depth, int min_char, Lisp_Object defalt) { Lisp_Object table; - int size = VECSIZE (struct Lisp_Sub_Char_Table) - 1 + chartab_size[depth]; + int size = CHAR_TABLE_STANDARD_SLOTS + chartab_size[depth]; table = Fmake_vector (make_number (size), defalt); XSETPVECTYPE (XVECTOR (table), PVEC_SUB_CHAR_TABLE); @@ -207,7 +207,7 @@ ? copy_sub_char_table (XCHAR_TABLE (table)->contents[i]) : XCHAR_TABLE (table)->contents[i])); set_char_table_ascii (copy, char_table_ascii (copy)); - size -= VECSIZE (struct Lisp_Char_Table) - 1; + size -= CHAR_TABLE_STANDARD_SLOTS; for (i = 0; i < size; i++) set_char_table_extras (copy, i, XCHAR_TABLE (table)->extras[i]); === modified file 'src/conf_post.h' --- src/conf_post.h 2013-06-18 18:36:13 +0000 +++ src/conf_post.h 2013-06-21 20:11:44 +0000 @@ -243,6 +243,17 @@ #define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN #define INLINE_HEADER_END _GL_INLINE_HEADER_END +/* To use the struct hack with N elements, declare the struct like this: + struct s { ...; t name[FLEXIBLE_ARRAY_MEMBER]; }; + and allocate (offsetof (struct s, name) + N * sizeof (t)) bytes. */ +#if 199901 <= __STDC_VERSION__ +# define FLEXIBLE_ARRAY_MEMBER +#elif __GNUC__ && !defined __STRICT_ANSI__ +# define FLEXIBLE_ARRAY_MEMBER 0 +#else +# define FLEXIBLE_ARRAY_MEMBER 1 +#endif + /* Use this to suppress gcc's `...may be used before initialized' warnings. */ #ifdef lint /* Use CODE only if lint checking is in effect. */ === modified file 'src/image.c' --- src/image.c 2013-05-12 19:17:04 +0000 +++ src/image.c 2013-06-21 20:11:44 +0000 @@ -3057,7 +3057,7 @@ XColor color; /* Color name. */ - char name[1]; + char name[FLEXIBLE_ARRAY_MEMBER]; }; /* The hash table used for the color cache, and its bucket vector === modified file 'src/lisp.h' --- src/lisp.h 2013-06-20 14:47:46 +0000 +++ src/lisp.h 2013-06-21 20:11:44 +0000 @@ -1073,16 +1073,20 @@ { return XSTRING (string)->size; } + +#ifdef GC_CHECK_STRING_BYTES +extern ptrdiff_t string_bytes (struct Lisp_String *); +#endif LISP_INLINE ptrdiff_t STRING_BYTES (struct Lisp_String *s) { #ifdef GC_CHECK_STRING_BYTES - extern ptrdiff_t string_bytes (struct Lisp_String *); return string_bytes (s); #else return s->size_byte < 0 ? s->size : s->size_byte; #endif } + LISP_INLINE ptrdiff_t SBYTES (Lisp_Object string) { @@ -1136,7 +1140,7 @@ struct Lisp_Vector { struct vectorlike_header header; - Lisp_Object contents[1]; + Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; }; /* A boolvector is a kind of vectorlike, with contents are like a string. */ @@ -1149,7 +1153,7 @@ /* This is the size in bits. */ EMACS_INT size; /* This contains the actual bits, packed into bytes. */ - unsigned char data[1]; + unsigned char data[FLEXIBLE_ARRAY_MEMBER]; }; /* Some handy constants for calculating sizes @@ -1272,7 +1276,7 @@ Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)]; /* These hold additional data. It is a vector. */ - Lisp_Object extras[1]; + Lisp_Object extras[FLEXIBLE_ARRAY_MEMBER]; }; struct Lisp_Sub_Char_Table @@ -1293,7 +1297,7 @@ Lisp_Object min_char; /* Use set_sub_char_table_contents to set this. */ - Lisp_Object contents[1]; + Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; }; LISP_INLINE Lisp_Object @@ -1366,7 +1370,7 @@ slots. */ enum CHAR_TABLE_STANDARD_SLOTS { - CHAR_TABLE_STANDARD_SLOTS = VECSIZE (struct Lisp_Char_Table) - 1 + CHAR_TABLE_STANDARD_SLOTS = PSEUDOVECSIZE (struct Lisp_Char_Table, extras) }; /* Return the number of "extra" slots in the char table CT. */ === modified file 'src/w32.c' --- src/w32.c 2013-06-03 17:15:44 +0000 +++ src/w32.c 2013-06-21 20:11:44 +0000 @@ -3785,12 +3785,6 @@ /* Caching SID and account values for faster lokup. */ -#ifdef __GNUC__ -# define FLEXIBLE_ARRAY_MEMBER -#else -# define FLEXIBLE_ARRAY_MEMBER 1 -#endif - struct w32_id { unsigned rid; struct w32_id *next; ------------------------------------------------------------ revno: 113122 committer: Glenn Morris branch nick: trunk timestamp: Fri 2013-06-21 09:00:00 -0700 message: Use cookie functions in yow * play/cookie1.el (cookie-apropos): Add optional display argument. * obsolete/yow.el (apropos-zippy): Use cookie-apropos. (psychoanalyze-pinhead): Use cookie-doctor. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 15:30:53 +0000 +++ lisp/ChangeLog 2013-06-21 16:00:00 +0000 @@ -1,3 +1,9 @@ +2013-06-21 Glenn Morris + + * play/cookie1.el (cookie-apropos): Add optional display argument. + * obsolete/yow.el (apropos-zippy): Use cookie-apropos. + (psychoanalyze-pinhead): Use cookie-doctor. + 2013-06-21 Juanma Barranquero * emacs-lisp/package.el (tar-get-file-descriptor) === modified file 'lisp/obsolete/yow.el' --- lisp/obsolete/yow.el 2013-06-21 07:35:33 +0000 +++ lisp/obsolete/yow.el 2013-06-21 16:00:00 +0000 @@ -74,33 +74,7 @@ "Return a list of all Zippy quotes matching REGEXP. If called interactively, display a list of matches." (interactive "sApropos Zippy (regexp): ") - ;; Make sure yows are loaded - (cookie yow-file yow-load-message yow-after-load-message) - (let* ((case-fold-search t) - (cookie-table-symbol (intern yow-file cookie-cache)) - (string-table (symbol-value cookie-table-symbol)) - (matches nil) - (len (length string-table)) - (i 0)) - (save-match-data - (while (< i len) - (and (string-match regexp (aref string-table i)) - (setq matches (cons (aref string-table i) matches))) - (setq i (1+ i)))) - (and matches - (setq matches (sort matches 'string-lessp))) - (and (called-interactively-p 'interactive) - (cond ((null matches) - (message "No matches found.")) - (t - (let ((l matches)) - (with-output-to-temp-buffer "*Zippy Apropos*" - (while l - (princ (car l)) - (setq l (cdr l)) - (and l (princ "\n\n"))) - (help-print-return-message)))))) - matches)) + (cookie-apropos regexp yow-file (called-interactively-p 'interactive))) ;; Yowza!! Feed zippy quotes to the doctor. Watch results. @@ -114,15 +88,7 @@ (defun psychoanalyze-pinhead () "Zippy goes to the analyst." (interactive) - (doctor) ; start the psychotherapy - (message "") - (switch-to-buffer "*doctor*") - (sit-for 0) - (while (not (input-pending-p)) - (insert (yow)) - (sit-for 0) - (doctor-ret-or-read 1) - (doctor-ret-or-read 1))) + (cookie-doctor yow-file)) (provide 'yow) === modified file 'lisp/play/cookie1.el' --- lisp/play/cookie1.el 2013-06-21 07:35:33 +0000 +++ lisp/play/cookie1.el 2013-06-21 16:00:00 +0000 @@ -185,11 +185,11 @@ (define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4") -(defun cookie-apropos (regexp phrase-file) +(defun cookie-apropos (regexp phrase-file &optional display) "Return a list of all entries matching REGEXP from PHRASE-FILE. Interactively, PHRASE-FILE defaults to `cookie-file', unless that is nil or a prefix argument is used. -If called interactively, display a list of matches." +If called interactively, or if DISPLAY is non-nil, display a list of matches." (interactive (list (read-regexp "Apropos phrase (regexp): ") (if (or current-prefix-arg (not cookie-file)) (read-file-name "Cookie file: " nil @@ -211,7 +211,7 @@ (setq i (1+ i)))) (and matches (setq matches (sort matches 'string-lessp))) - (and (called-interactively-p 'interactive) + (and (or display (called-interactively-p 'interactive)) (cond ((null matches) (message "No matches found.")) (t ------------------------------------------------------------ revno: 113121 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2013-06-21 17:30:53 +0200 message: lisp/emacs-lisp/package.el (tar-get-file-descriptor, tar--extract): Declare. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 14:36:13 +0000 +++ lisp/ChangeLog 2013-06-21 15:30:53 +0000 @@ -1,3 +1,8 @@ +2013-06-21 Juanma Barranquero + + * emacs-lisp/package.el (tar-get-file-descriptor) + (tar--extract): Declare. + 2013-06-21 Eduard Wiebe Extend flymake's warning predicate to be a function (bug#14217). === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-06-21 14:12:56 +0000 +++ lisp/emacs-lisp/package.el 2013-06-21 15:30:53 +0000 @@ -988,6 +988,9 @@ (if requires-str (package-read-from-string requires-str)) :kind 'single)))) +(declare-function tar-get-file-descriptor "tar-mode" (file)) +(declare-function tar--extract "tar-mode" (descriptor)) + (defun package-tar-file-info () "Find package information for a tar file. The return result is a `package-desc'." ------------------------------------------------------------ revno: 113120 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=14217 author: Eduard Wiebe committer: Stefan Monnier branch nick: trunk timestamp: Fri 2013-06-21 10:36:13 -0400 message: Extend flymake's warning predicate to be a function. Test suite for flymake. * lisp/progmodes/flymake.el (flymake-warning-predicate): New. (flymake-parse-line): Use it. (flymake-warning-re): Make obsolete alias to `flymake-warning-predicate'. * doc/misc/flymake.texi (Parsing the output, Customizable variables): Add reference to `flymake-warning-predicate'. * test/automated/flymake-tests.el: * test/automated/flymake/warnpred/Makefile * test/automated/flymake/warnpred/test.c * test/automated/flymake/warnpred/test.pl: New files. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2013-06-19 20:10:57 +0000 +++ doc/misc/ChangeLog 2013-06-21 14:36:13 +0000 @@ -1,3 +1,8 @@ +2013-06-21 Eduard Wiebe + + * flymake.texi (Parsing the output, Customizable variables): + Add reference to `flymake-warning-predicate'. + 2013-06-19 Michael Albinus * tramp.texi (Top, Configuration): Insert section `Predefined @@ -101,8 +106,8 @@ 2013-03-08 Jay Belanger - * calc.texi (Basic Operations on Units): Fix - cross-reference. + * calc.texi (Basic Operations on Units): + Fix cross-reference. 2013-03-07 Katsumi Yamaoka @@ -140,8 +145,8 @@ * tramp.texi (Inline methods): Remove "ssh1", "ssh2", "plink1" and "plink2" entries. "plink2" is obsolete for a long time. - (External methods): Remove "scp1" and "scp2" entries. Explain - user name and host name specification for "adb". + (External methods): Remove "scp1" and "scp2" entries. + Explain user name and host name specification for "adb". 2013-02-28 Michael Albinus @@ -221,8 +226,8 @@ from ede new. (Simple projects): Re-write to not talk about ede-simple-project which is deprecated, and instead use the term to mean projects - that don't do much management, just project wrapping. Add - ede-generic-project link. + that don't do much management, just project wrapping. + Add ede-generic-project link. (ede-generic-project): New node (bug#11441). 2013-02-07 Glenn Morris @@ -361,8 +366,8 @@ 2012-12-24 Lars Ingebrigtsen - * gnus.texi (Browse Foreign Server): Document - `gnus-browse-delete-group'. + * gnus.texi (Browse Foreign Server): + Document `gnus-browse-delete-group'. 2012-12-22 Glenn Morris @@ -599,8 +604,8 @@ Improve docs for url-queue-*. (Supported URL Types): Copyedits. Delete empty subnodes. - * url.texi (Introduction): Rename from Getting Started. Rewrite - the introduction. + * url.texi (Introduction): Rename from Getting Started. + Rewrite the introduction. (URI Parsing): Rewrite. Omit the obsolete attributes slot. 2012-11-10 Glenn Morris @@ -700,14 +705,14 @@ 2012-10-26 Bastien Guerry - * org.texi (Installation): Update the link to Org's ELPA. Also - don't mention org-install.el anymore as the replacement file + * org.texi (Installation): Update the link to Org's ELPA. + Also don't mention org-install.el anymore as the replacement file org-loaddefs.el is now loaded by org.el. 2012-10-25 Michael Albinus - * tramp.texi (Frequently Asked Questions): Mention - `tramp-completion-reread-directory-timeout' for performance + * tramp.texi (Frequently Asked Questions): + Mention `tramp-completion-reread-directory-timeout' for performance improvement. 2012-10-25 Glenn Morris @@ -830,8 +835,8 @@ (Referencing Labels): Update regarding reference styles. (Citation Styles): Mention support for ConTeXt. (Options (Defining Label Environments)): Fix typo. - (Options (Creating Citations)): Document - `reftex-cite-key-separator'. + (Options (Creating Citations)): + Document `reftex-cite-key-separator'. 2012-09-30 Achim Gratz @@ -863,8 +868,8 @@ 2012-09-30 Bastien Guerry - * org.texi (Installation, Feedback, Batch execution): Use - (add-to-list 'load-path ... t) for the contrib dir. + * org.texi (Installation, Feedback, Batch execution): + Use (add-to-list 'load-path ... t) for the contrib dir. * org.texi (results): Update documentation for ":results drawer" and ":results org". @@ -891,8 +896,8 @@ (Agenda commands): Reorder. Document `*' to toggle persistent marks. - * org.texi (Agenda dispatcher): Mention - `org-toggle-agenda-sticky'. + * org.texi (Agenda dispatcher): + Mention `org-toggle-agenda-sticky'. (Agenda commands, Exporting Agenda Views): Fix typo. * org.texi (Templates in contexts, Setting Options): Update to @@ -1067,8 +1072,8 @@ (Unsafe Simplifications): Mention `m E'. (Simplification of Units): Mention `m U'. (Trigonometric/Hyperbolic Functions, Reducing and Mapping) - (Kinds of Declarations, Functions for Declarations): Mention - "algebraic simplifications" instead of `a s'. + (Kinds of Declarations, Functions for Declarations): + Mention "algebraic simplifications" instead of `a s'. (Algebraic Entry): Remove mention of default simplifications. 2012-07-30 Jay Belanger @@ -1100,8 +1105,8 @@ 2012-07-06 Michael Albinus - * tramp.texi (Multi-hops): Introduce - `tramp-restricted-shell-hosts-alist'. + * tramp.texi (Multi-hops): + Introduce `tramp-restricted-shell-hosts-alist'. 2012-06-26 Lars Magne Ingebrigtsen @@ -1293,8 +1298,8 @@ (Synchronous Methods): Remove obsolete dbus-call-method-non-blocking. (Asynchronous Methods): Fix description of dbus-call-method-asynchronously. - (Receiving Method Calls): Fix some minor errors. Add - dbus-interface-emacs. + (Receiving Method Calls): Fix some minor errors. + Add dbus-interface-emacs. (Signals): Describe unicast signals and the new match rules. (Alternative Buses): Add the PRIVATE optional argument to dbus-init-bus. Describe its new return value. Add dbus-setenv. @@ -1327,8 +1332,8 @@ 2012-04-09 Eli Zaretskii - * makefile.w32-in (INFO_TARGETS, DVI_TARGETS, clean): Add - emacs-gnutls. + * makefile.w32-in (INFO_TARGETS, DVI_TARGETS, clean): + Add emacs-gnutls. ($(infodir)/emacs-gnutls, emacs-gnutls.dvi): New targets. 2012-04-09 Teodor Zlatanov @@ -1431,7 +1436,7 @@ 2012-04-01 Eric Schulte - * org.texi (Key bindings and useful functions): Updated babel key + * org.texi (Key bindings and useful functions): Update babel key binding documentation in manual. 2012-04-01 Eric Schulte @@ -1532,8 +1537,8 @@ 2012-02-13 Lars Ingebrigtsen - * gnus.texi (Customizing the IMAP Connection): Mention - nnimap-record-commands. + * gnus.texi (Customizing the IMAP Connection): + Mention nnimap-record-commands. 2012-02-10 Glenn Morris @@ -1604,8 +1609,8 @@ 2012-01-03 Bernt Hansen - * org.texi (Agenda commands): Document - `org-clock-report-include-clocking-task'. + * org.texi (Agenda commands): + Document `org-clock-report-include-clocking-task'. 2012-01-03 Bastien Guerry @@ -1690,8 +1695,8 @@ 2012-01-03 Eric Schulte - * org.texi (Buffer-wide header arguments): Update - documentation to reflect removal of #+PROPERTIES. + * org.texi (Buffer-wide header arguments): + Update documentation to reflect removal of #+PROPERTIES. 2012-01-03 Carsten Dominik @@ -1852,7 +1857,7 @@ * mh-e.texi (VERSION, EDITION, UPDATED, UPDATE-MONTH): Update for release 8.3. - (Preface): Updated support information. + (Preface): Update support information. (From Bill Wohler): Reset text to original version. As a historical quote, the tense should be correct in the time that it was written. @@ -2054,8 +2059,8 @@ 2011-08-15 Bastien Guerry - * org.texi (Dynamic blocks, Structure editing): Mention - the function `org-narrow-to-block'. + * org.texi (Dynamic blocks, Structure editing): + Mention the function `org-narrow-to-block'. 2011-08-15 Eric Schulte @@ -2082,15 +2087,15 @@ 2011-08-15 Eric Schulte - * org.texi (Conflicts): Changed "yasnippets" to "yasnippet" and + * org.texi (Conflicts): Change "yasnippets" to "yasnippet" and added extra whitespace around functions to be consistent with the rest of the section. 2011-08-15 Eric Schulte - * org.texi (Evaluating code blocks): Expanded discussion of + * org.texi (Evaluating code blocks): Expand discussion of #+call: line syntax. - (Header arguments in function calls): Expanded discussion of + (Header arguments in function calls): Expand discussion of #+call: line syntax. 2011-08-15 Eric Schulte @@ -2120,12 +2125,12 @@ 2011-08-15 Tom Dye - * org.texi (cache): Improved documentation of code block caches. + * org.texi (cache): Improve documentation of code block caches. 2011-08-15 Tom Dye - * org.texi (Code block specific header arguments): Documentation - of multi-line header arguments. + * org.texi (Code block specific header arguments): + Documentation of multi-line header arguments. 2011-08-15 Eric Schulte @@ -2181,15 +2186,15 @@ 2011-07-04 Michael Albinus - * tramp.texi (Cleanup remote connections): Add - `tramp-cleanup-this-connection'. + * tramp.texi (Cleanup remote connections): + Add `tramp-cleanup-this-connection'. 2011-07-03 Lars Magne Ingebrigtsen * gnus.texi (Subscription Methods): Link to "Group Levels" to explain zombies. (Checking New Groups): Ditto (bug#8974). - (Checking New Groups): Moved the reference to the right place. + (Checking New Groups): Move the reference to the right place. 2011-07-03 Dave Abrahams (tiny change) @@ -2216,8 +2221,8 @@ 2011-06-26 Lars Magne Ingebrigtsen - * gnus.texi (Summary Mail Commands): Document - `gnus-summary-reply-to-list-with-original'. + * gnus.texi (Summary Mail Commands): + Document `gnus-summary-reply-to-list-with-original'. 2011-06-20 Stefan Monnier @@ -2280,7 +2285,7 @@ * gnus.texi (nnmairix caveats, Setup, Registry Article Refer Method) (Fancy splitting to parent, Store arbitrary data): - Updated gnus-registry docs. + Update gnus-registry docs. 2011-04-13 Juanma Barranquero @@ -3401,8 +3406,8 @@ Sync with Tramp 2.1.19. - * tramp.texi (Inline methods, Default Method): Mention - `tramp-inline-compress-start-size'. Remove "kludgy" phrase. + * tramp.texi (Inline methods, Default Method): + Mention `tramp-inline-compress-start-size'. Remove "kludgy" phrase. Remove remark about doubled "-t" argument. (Auto-save and Backup): Remove reference to Emacs 21. (Filename Syntax): Describe port numbers. @@ -6056,7 +6061,7 @@ 2007-10-28 Kevin Greiner * gnus.texi (nntp-open-via-telnet-and-telnet): Fix grammar. - (Agent Parameters): Updated parameter names to match code. + (Agent Parameters): Update parameter names to match code. (Group Agent Commands): Corrected 'gnus-agent-fetch-series' as 'gnus-agent-summary-fetch-series'. (Agent and flags): New section providing a generalized discussion @@ -6860,7 +6865,7 @@ (Tag searches): Document regular expression search for tags. (Stuck projects): New section. (In-buffer settings): New keywords. - (History and Acknowledgments): Updated description. + (History and Acknowledgments): Update description. 2007-02-24 Alan Mackenzie @@ -7092,7 +7097,7 @@ (Custom agenda views): Section completely rewritten. (Summary): Compare with Planner. (Feedback): More info about creating backtraces. - (Plain lists): Modified example. + (Plain lists): Modify example. (Breaking down tasks): New section. (Custom time format): New section. (Time stamps): Document inactive timestamps. === modified file 'doc/misc/flymake.texi' --- doc/misc/flymake.texi 2013-05-25 01:26:12 +0000 +++ doc/misc/flymake.texi 2013-06-21 14:36:13 +0000 @@ -311,6 +311,9 @@ Patterns for error/warning messages in the form @code{(regexp file-idx line-idx col-idx err-text-idx)}. @xref{Parsing the output}. +@item flymake-warning-predicate +Predicate to classify error text as warning. @xref{Parsing the output}. + @item flymake-compilation-prevents-syntax-check A flag indicating whether compilation and syntax check of the same file cannot be run simultaneously. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 14:12:56 +0000 +++ lisp/ChangeLog 2013-06-21 14:36:13 +0000 @@ -1,3 +1,11 @@ +2013-06-21 Eduard Wiebe + + Extend flymake's warning predicate to be a function (bug#14217). + * progmodes/flymake.el (flymake-warning-predicate): New. + (flymake-parse-line): Use it. + (flymake-warning-re): Make obsolete alias to + `flymake-warning-predicate'. + 2013-06-21 Stefan Monnier * emacs-lisp/package.el (package-alist): Include obsolete packages. === modified file 'lisp/progmodes/flymake.el' --- lisp/progmodes/flymake.el 2013-05-25 02:21:49 +0000 +++ lisp/progmodes/flymake.el 2013-06-21 14:36:13 +0000 @@ -1049,8 +1049,12 @@ ;; :type '(repeat (string number number number)) ;;) -(defvar flymake-warning-re "^[wW]arning" - "Regexp matching against err-text to detect a warning.") +(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4") +(defvar flymake-warning-predicate "^[wW]arning" + "Predicate matching against error text to detect a warning. +Takes a single argument, the error's text and should return non-nil +if it's a warning. +Instead of a function, it can also be a regular expression.") (defun flymake-parse-line (line) "Parse LINE to see if it is an error or warning. @@ -1067,16 +1071,22 @@ (line-idx (nth 2 (car patterns)))) (setq raw-file-name (if file-idx (match-string file-idx line) nil)) - (setq line-no (if line-idx (string-to-number (match-string line-idx line)) 0)) + (setq line-no (if line-idx (string-to-number + (match-string line-idx line)) 0)) (setq err-text (if (> (length (car patterns)) 4) (match-string (nth 4 (car patterns)) line) - (flymake-patch-err-text (substring line (match-end 0))))) - (or err-text (setq err-text "")) - (if (and err-text (string-match flymake-warning-re err-text)) - (setq err-type "w") - ) - (flymake-log 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" file-idx line-idx - raw-file-name line-no err-text) + (flymake-patch-err-text + (substring line (match-end 0))))) + (if (null err-text) + (setq err-text "") + (when (cond ((stringp flymake-warning-predicate) + (string-match flymake-warning-predicate err-text)) + ((functionp flymake-warning-predicate) + (funcall flymake-warning-predicate err-text))) + (setq err-type "w"))) + (flymake-log + 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" + file-idx line-idx raw-file-name line-no err-text) (setq matched t))) (setq patterns (cdr patterns))) (if matched === modified file 'test/ChangeLog' --- test/ChangeLog 2013-06-19 20:10:57 +0000 +++ test/ChangeLog 2013-06-21 14:36:13 +0000 @@ -1,3 +1,11 @@ +2013-06-21 Eduard Wiebe + + Test suite for flymake. + * automated/flymake-tests.el: + * automated/flymake/warnpred/Makefile + * automated/flymake/warnpred/test.c + * automated/flymake/warnpred/test.pl: New files. + 2013-06-12 RĂ¼diger Sonderfeld * automated/reftex-tests.el (reftex-parse-from-file-test): Fix test. === added directory 'test/automated/flymake' === added file 'test/automated/flymake-tests.el' --- test/automated/flymake-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/flymake-tests.el 2013-06-21 14:36:13 +0000 @@ -0,0 +1,82 @@ +;;; flymake-tests.el --- Test suite for flymake + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Eduard Wiebe + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: +(require 'ert) +(require 'flymake) + +(defgroup flymake-tests nil + "Test suite for flymake.") + + +;; Warning predicate +(defun flymake-tests--current-face (file predicate) + (let ((buffer (find-file-noselect file))) + (unwind-protect + (with-current-buffer (find-file-noselect file) + (setq-local flymake-warning-predicate predicate) + (goto-char (point-min)) + (flymake-mode 1) + ;; XXX: is this reliable enough? + (sleep-for (+ 0.5 flymake-no-changes-timeout)) + (flymake-goto-next-error) + (face-at-point)) + (and buffer (kill-buffer buffer))))) + +(ert-deftest warnining-predicate-rx-gcc () + "Test GCC warning via regexp predicate." + :expected-result (if (executable-find "gcc") :passed :failed) + (should (eq 'flymake-warnline + (flymake-tests--current-face + "flymake/warnpred/test.c" + "^[Ww]arning")))) + +(ert-deftest warning-predicate-function-gcc () + "Test GCC warning via function predicate." + :expected-result (if (and (executable-find "gcc") (executable-find "make")) + :passed + :failed) + (should (eq 'flymake-warnline + (flymake-tests--current-face + "flymake/warnpred/test.c" + (lambda (msg) (string-match "^[Ww]arning" msg)))))) + +(ert-deftest warning-predicate-rx-perl () + "Test perl warning via regular expression predicate." + :expected-result (if (executable-find "perl") :passed :failed) + (should (eq 'flymake-warnline + (flymake-tests--current-face + "flymake/warnpred/test.pl" + "^Scalar value")))) + +(ert-deftest warning-predicate-function-perl () + "Test perl warning via function predicate." + :expected-result (if (executable-find "perl") :passed :failed) + (should (eq 'flymake-warnline + (flymake-tests--current-face + "flymake/warnpred/test.pl" + (lambda (msg) (string-match "^Scalar value" msg)))))) + +(provide 'flymake-tests) + +;;; flymake.el ends here === added directory 'test/automated/flymake/warnpred' === added file 'test/automated/flymake/warnpred/Makefile' --- test/automated/flymake/warnpred/Makefile 1970-01-01 00:00:00 +0000 +++ test/automated/flymake/warnpred/Makefile 2013-06-21 14:36:13 +0000 @@ -0,0 +1,8 @@ +# Makefile for flymake tests + +CC_OPTS = -Wall + +check-syntax: + $(CC) $(CC_OPTS) ${CHK_SOURCES} + +# eof === added file 'test/automated/flymake/warnpred/test.c' --- test/automated/flymake/warnpred/test.c 1970-01-01 00:00:00 +0000 +++ test/automated/flymake/warnpred/test.c 2013-06-21 14:36:13 +0000 @@ -0,0 +1,5 @@ +int main() +{ + char c = 1000; + return c; +} === added file 'test/automated/flymake/warnpred/test.pl' --- test/automated/flymake/warnpred/test.pl 1970-01-01 00:00:00 +0000 +++ test/automated/flymake/warnpred/test.pl 2013-06-21 14:36:13 +0000 @@ -0,0 +1,2 @@ +@arr = [1,2,3,4]; +@arr[1] = -1; ------------------------------------------------------------ revno: 113119 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2013-06-21 10:12:56 -0400 message: * lisp/emacs-lisp/package.el (package-alist): Include obsolete packages. (package-obsolete-list): Remove. (package-activate): Remove min-version argument. Add `force' argument. Adjust to new package-alist format. (package-mark-obsolete): Remove. (package-unpack): Force reload of the package's autoloads. (package-installed-p): Check builtins if the installed package is not recent enough. (package-initialize): Don't reset package-obsolete-list. Don't specify which package version to activate. (package-process-define-package, describe-package-1) (package-menu--generate): Adjust to new package-alist format. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 12:24:37 +0000 +++ lisp/ChangeLog 2013-06-21 14:12:56 +0000 @@ -1,3 +1,18 @@ +2013-06-21 Stefan Monnier + + * emacs-lisp/package.el (package-alist): Include obsolete packages. + (package-obsolete-list): Remove. + (package-activate): Remove min-version argument. Add `force' argument. + Adjust to new package-alist format. + (package-mark-obsolete): Remove. + (package-unpack): Force reload of the package's autoloads. + (package-installed-p): Check builtins if the installed package is not + recent enough. + (package-initialize): Don't reset package-obsolete-list. + Don't specify which package version to activate. + (package-process-define-package, describe-package-1) + (package-menu--generate): Adjust to new package-alist format. + 2013-06-21 Juanma Barranquero * allout-widgets.el (allout-widgets-mode-off) === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-06-21 03:08:47 +0000 +++ lisp/emacs-lisp/package.el 2013-06-21 14:12:56 +0000 @@ -192,8 +192,7 @@ For an element (NAME VERSION), NAME is a package name (a symbol). VERSION should be t, a string, or nil. -If VERSION is t, all versions are loaded, though obsolete ones - will be put in `package-obsolete-list' and not activated. +If VERSION is t, the most recent version is activated. If VERSION is a string, only that version is ever loaded. Any other version, even if newer, is silently ignored. Hence, the package is \"held\" at that version. @@ -371,8 +370,9 @@ (defvar package-alist nil "Alist of all packages available for activation. -Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a `package-desc' structure. +Each element has the form (PKG . DESCS), where PKG is a package +name (a symbol) and DESCS is a non-empty list of `package-desc' structure, +sorted by decreasing versions. This variable is set automatically by `package-load-descriptor', called via `package-initialize'. To change which packages are @@ -384,11 +384,6 @@ "List of the names of currently activated packages.") (put 'package-activated-list 'risky-local-variable t) -(defvar package-obsolete-list nil - "List of obsolete packages. -Each element of the list is a `package-desc'.") -(put 'package-obsolete-list 'risky-local-variable t) - (defun package-version-join (vlist) "Return the version string corresponding to the list VLIST. This is, approximately, the inverse of `version-to-list'. @@ -439,7 +434,7 @@ In each valid package subdirectory, this function loads the description file containing a call to `define-package', which -updates `package-alist' and `package-obsolete-list'." +updates `package-alist'." (dolist (dir (cons package-user-dir package-directory-list)) (when (file-directory-p dir) (dolist (subdir (directory-files dir)) @@ -502,33 +497,33 @@ ;; if an older one was already activated. This is not ideal; we'd at ;; least need to check to see if the package has actually been loaded, ;; and not merely activated. -(defun package-activate (package min-version) - "Activate package PACKAGE, of version MIN-VERSION or newer. -MIN-VERSION should be a version list. -If PACKAGE has any dependencies, recursively activate them. -Return nil if the package could not be activated." - (let ((pkg-vec (cdr (assq package package-alist))) - available-version found) +(defun package-activate (package &optional force) + "Activate package PACKAGE. +If FORCE is true, (re-)activate it if it's already activated." + (let ((pkg-descs (cdr (assq package package-alist)))) ;; Check if PACKAGE is available in `package-alist'. - (when pkg-vec - (setq available-version (package-desc-version pkg-vec) - found (version-list-<= min-version available-version))) + (while + (when pkg-descs + (let ((available-version (package-desc-version (car pkg-descs)))) + (or (package-disabled-p package available-version) + ;; Prefer a builtin package. + (package-built-in-p package available-version)))) + (setq pkg-descs (cdr pkg-descs))) (cond ;; If no such package is found, maybe it's built-in. - ((null found) - (package-built-in-p package min-version)) + ((null pkg-descs) + (package-built-in-p package)) ;; If the package is already activated, just return t. - ((memq package package-activated-list) + ((and (memq package package-activated-list) (not force)) t) - ;; If it's disabled, then just skip it. - ((package-disabled-p package available-version) nil) ;; Otherwise, proceed with activation. (t - (let ((fail (catch 'dep-failure - ;; Activate its dependencies recursively. - (dolist (req (package-desc-reqs pkg-vec)) - (unless (package-activate (car req) (cadr req)) - (throw 'dep-failure req)))))) + (let* ((pkg-vec (car pkg-descs)) + (fail (catch 'dep-failure + ;; Activate its dependencies recursively. + (dolist (req (package-desc-reqs pkg-vec)) + (unless (package-activate (car req) (cadr req)) + (throw 'dep-failure req)))))) (if fail (warn "Unable to activate package `%s'. Required package `%s-%s' is unavailable" @@ -536,10 +531,6 @@ ;; If all goes well, activate the package itself. (package-activate-1 pkg-vec))))))) -(defun package-mark-obsolete (pkg-desc) - "Put PKG-DESC on the obsolete list, if not already there." - (push pkg-desc package-obsolete-list)) - (defun define-package (_name-string _version-string &optional _docstring _requirements &rest _extra-properties) @@ -561,26 +552,18 @@ (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp))) (name (package-desc-name new-pkg-desc)) (version (package-desc-version new-pkg-desc)) - (old-pkg (assq name package-alist))) - (cond - ;; If it's not newer than a builtin version, mark it obsolete. - ((let ((bi (assq name package--builtin-versions))) - (and bi (version-list-<= version (cdr bi)))) - (package-mark-obsolete new-pkg-desc)) - ;; If there's no old package, just add this to `package-alist'. - ((null old-pkg) - (push (cons name new-pkg-desc) package-alist)) - ((version-list-< (package-desc-version (cdr old-pkg)) version) - ;; Remove the old package and declare it obsolete. - (package-mark-obsolete (cdr old-pkg)) - (setq package-alist (cons (cons name new-pkg-desc) - (delq old-pkg package-alist)))) - ;; You can have two packages with the same version, e.g. one in - ;; the system package directory and one in your private - ;; directory. We just let the first one win. - ((not (version-list-= (package-desc-version (cdr old-pkg)) version)) - ;; The package is born obsolete. - (package-mark-obsolete new-pkg-desc))) + (old-pkgs (assq name package-alist))) + (if (null old-pkgs) + ;; If there's no old package, just add this to `package-alist'. + (push (list name new-pkg-desc) package-alist) + ;; If there is, insert the new package at the right place in the list. + (while old-pkgs + (cond + ((null (cdr old-pkgs)) (push new-pkg-desc (cdr old-pkgs))) + ((version-list-< (package-desc-version (cadr old-pkgs)) version) + (push new-pkg-desc (cdr old-pkgs)) + (setq old-pkgs nil))) + (setq old-pkgs (cdr old-pkgs)))) new-pkg-desc)) ;; From Emacs 22, but changed so it adds to load-path. @@ -691,7 +674,7 @@ ;; and then compile them. (package--compile new-desc)) ;; Try to activate it. - (package-activate name (package-desc-version pkg-desc)) + (package-activate name 'force) pkg-dir)) (defun package--make-autoloads-and-stuff (pkg-desc pkg-dir) @@ -768,12 +751,13 @@ "Return true if PACKAGE, of MIN-VERSION or newer, is installed. MIN-VERSION should be a version list." (unless package--initialized (error "package.el is not yet initialized!")) - (let ((pkg-desc (assq package package-alist))) - (if pkg-desc - (version-list-<= min-version - (package-desc-version (cdr pkg-desc))) - ;; Also check built-in packages. - (package-built-in-p package min-version)))) + (or + (let ((pkg-descs (cdr (assq package package-alist)))) + (and pkg-descs + (version-list-<= min-version + (package-desc-version (car pkg-descs))))) + ;; Also check built-in packages. + (package-built-in-p package min-version))) (defun package-compute-transaction (package-list requirements) "Return a list of packages to be installed, including PACKAGE-LIST. @@ -905,7 +889,8 @@ (let ((bi (assq name package--builtin-versions))) (and bi (version-list-<= version (cdr bi)))) (let ((ins (cdr (assq name package-alist)))) - (and ins (version-list-<= version (package-desc-version ins))))) + (and ins (version-list-<= version + (package-desc-version (car ins)))))) nil) ((not existing-package) (push entry package-archive-contents)) @@ -1109,13 +1094,12 @@ The variable `package-load-list' controls which packages to load. If optional arg NO-ACTIVATE is non-nil, don't activate packages." (interactive) - (setq package-alist nil - package-obsolete-list nil) + (setq package-alist nil) (package-load-all-descriptors) (package-read-all-archive-contents) (unless no-activate (dolist (elt package-alist) - (package-activate (car elt) (package-desc-version (cdr elt))))) + (package-activate (car elt)))) (setq package--initialized t)) @@ -1161,7 +1145,7 @@ (princ " is ") (cond ;; Loaded packages are in `package-alist'. - ((setq desc (cdr (assq package package-alist))) + ((setq desc (cadr (assq package package-alist))) (setq version (package-version-join (package-desc-version desc))) (if (setq pkg-dir (package-desc-dir desc)) (insert "an installed package.\n\n") @@ -1389,10 +1373,23 @@ (dolist (elt package-alist) (setq name (car elt)) (when (or (eq packages t) (memq name packages)) - (package--push (cdr elt) - (if (stringp (cadr (assq name package-load-list))) - "held" "installed") - info-list))) + (let* ((lle (assq name package-load-list)) + (held (cadr lle)) + (hv (if (stringp held) (version-to-list held)))) + (dolist (pkg (cdr elt)) + (let ((version (package-desc-version pkg))) + (package--push pkg + (cond + ((and lle (null held)) "disabled") + (hv + (cond + ((version-list-= version hv) "held") + ((version-list-< version hv) "obsolete") + (t "disabled"))) + ((package-built-in-p name version) "obsolete") + ((eq pkg (cadr elt)) "installed") + (t "obsolete")) + info-list)))))) ;; Built-in packages: (dolist (elt package--builtins) @@ -1415,11 +1412,6 @@ (t "available")) info-list)))) - ;; Obsolete packages: - (dolist (elt package-obsolete-list) - (when (or (eq packages t) (memq (package-desc-full-name elt) packages)) - (package--push elt "obsolete" info-list))) - ;; Print the result. (setq tabulated-list-entries (mapcar 'package-menu--print-info info-list)) (tabulated-list-print remember-pos))) ------------------------------------------------------------ revno: 113118 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2013-06-21 15:37:15 +0200 message: leim/quail/*.el: Fix typos. * leim/quail/croatian.el ("croatian-prefix"): * leim/quail/czech.el ("czech", "czech-qwerty"): * leim/quail/ipa-praat.el ("ipa-praat"): * leim/quail/ipa.el ("ipa-x-sampa"): * leim/quail/tibetan.el ("tibetan-wylie", "tibetan-tibkey"): * leim/quail/uni-input.el (ucs-input-activate): Fix typos in docstrings. diff: === modified file 'leim/ChangeLog' --- leim/ChangeLog 2013-06-19 20:10:57 +0000 +++ leim/ChangeLog 2013-06-21 13:37:15 +0000 @@ -1,3 +1,12 @@ +2013-06-21 Juanma Barranquero + + * quail/croatian.el ("croatian-prefix"): + * quail/czech.el ("czech", "czech-qwerty"): + * quail/ipa-praat.el ("ipa-praat"): + * quail/ipa.el ("ipa-x-sampa"): + * quail/tibetan.el ("tibetan-wylie", "tibetan-tibkey"): + * quail/uni-input.el (ucs-input-activate): Fix typos in docstrings. + 2013-05-25 Eli Zaretskii * Makefile.in (leim-list.el, check-declare): === modified file 'leim/quail/croatian.el' --- leim/quail/croatian.el 2013-03-05 17:13:01 +0000 +++ leim/quail/croatian.el 2013-06-21 13:37:15 +0000 @@ -1,4 +1,4 @@ -;;; quail/croatian.el -- Quail package for inputting Croatian -*-coding: utf-8;-*- +;;; croatian.el -- Quail package for inputting Croatian -*-coding: utf-8;-*- ;; Copyright (C) 2003-2013 Free Software Foundation, Inc. @@ -96,7 +96,7 @@ (quail-define-package "croatian-prefix" "Croatian" "HR" nil - "Croatian input method, postfix. + "Croatian input method, prefix. \"c -> Ä 'c -> ć === modified file 'leim/quail/cyrillic.el' --- leim/quail/cyrillic.el 2013-04-02 01:18:40 +0000 +++ leim/quail/cyrillic.el 2013-06-21 13:37:15 +0000 @@ -1242,7 +1242,7 @@ "Bulgarian alternative Phonetic keyboard layout, producing Unicode. This phonetic layout replaces all the Latin letters with Bulgarian -\(Cyrillic\) letters based on similarities in their pronunciation or look. +\(Cyrillic) letters based on similarities in their pronunciation or look. Note that, since the letters 'щ', 'ÑŒ', 'Ñ' and 'Ñ' are attached to the ']', '\', '`' and '[' keys respectively, Caps Lock does not affect them." === modified file 'leim/quail/czech.el' --- leim/quail/czech.el 2013-04-02 01:18:40 +0000 +++ leim/quail/czech.el 2013-06-21 13:37:15 +0000 @@ -35,7 +35,7 @@ (quail-define-package "czech" "Czech" "CZ" t - "\"Standard\" Czech keyboard in the Windoze NT 105 keys version." + "\"Standard\" Czech keyboard in the Windows NT 105 keys version." nil t t t t nil nil nil nil nil t) (quail-define-rules @@ -157,7 +157,7 @@ (quail-define-package "czech-qwerty" "Czech" "CZ" t - "\"Standard\" Czech keyboard in the Windoze NT 105 keys version, QWERTY layout." + "\"Standard\" Czech keyboard in the Windows NT 105 keys version, QWERTY layout." nil t nil nil t nil nil nil nil nil t) (quail-define-rules === modified file 'leim/quail/ipa-praat.el' --- leim/quail/ipa-praat.el 2013-01-01 09:11:05 +0000 +++ leim/quail/ipa-praat.el 2013-06-21 13:37:15 +0000 @@ -24,7 +24,7 @@ ;; This is a new input method for IPA characters and diacritics, which follows ;; the conventions of Praat, a GPLed program for phonetical analysis. -;; +;; ;; This input method is much more complete than the current ipa.el. ;;; Code: @@ -65,10 +65,10 @@ For most of the codes, the first letter tells you the most -similar letter of the English alphabet. The second letter can be +similar letter of the English alphabet. The second letter can be t (turned), c (capital), s (script), r (reversed), - (barred or -retracted), or / (slashed). One symbol (É›) is a phonetic version -of a Greek letter. The codes for É™, ɤ, Ê and É are abbreviations +retracted), or / (slashed). One symbol (É›) is a phonetic version +of a Greek letter. The codes for É™, ɤ, Ê and É are abbreviations for schwa, ram's horn, horseshoe, and kidney bean. @@ -96,7 +96,7 @@ | | | Ê‘ \\zc | | | | palatal | c c | ɲ \\nj | ç \\c, | | | | | ÉŸ \\j. | | Ê \\jc | j j | | | Ê \\yt -lab-pal. | | | | | | | +lab.-pal. | | | | | | | | | | | É¥ \\ht | | | lab.-vela. | | | Ê \\wt | | | | | | | | w w | | | @@ -126,16 +126,16 @@ uvular | Ê› \\G^ | For most of the codes, the first letter tells you the most -similar letter of the English alphabet. The second letter can be -t (turned), c (capital or curled), s (script), - (barred), -l (with leg), i (inverted), or j (left tail). Some phonetic +similar letter of the English alphabet. The second letter can +be t (turned), c (capital or curled), s (script), - (barred), +l (with leg), i (inverted), or j (left tail). Some phonetic symbols are similar to Greek letters but have special phonetic (f) versions with serifs (ɸ, β, É£) or are otherwise -slightly different (θ, χ). The codes for Å‹ (engma), Ă° (eth), -ʃ (esh), and Ê’ (yogh) are traditional alternative spellings. The -retroflexes have a period in the second place, because an +slightly different (θ, χ). The codes for Å‹ (engma), Ă° (eth), +ʃ (esh), and Ê’ (yogh) are traditional alternative spellings. +The retroflexes have a period in the second place, because an alternative traditional spelling is to write a dot under -them. The code for ɾ is an abbreviation for fishhook. +them. The code for ɾ is an abbreviation for fishhook. * Diacritics @@ -197,7 +197,7 @@ ("\\gc" ?É¢) ; voiced uvular ("\\?-" ?Ê¡) ; epiglottal ("\\?g" ?Ê”) ; glottal - + ;; nasals ("\\mj" ?ɱ) ; labiodental ("\\n." ?ɳ) ; retroflex @@ -236,7 +236,7 @@ ("\\r." ?É») ; retroflex ("\\ht" ?É¥) ; labial-palatal ("\\ml" ?É°) ; velar - + ;; trills ("\\bc" ?Ê™) ; bilabial ("\\rc" ?Ê€) ; uvular @@ -246,7 +246,7 @@ ("\\fh" ?ɾ) ; alveolar ("\\rl" ?ɺ) ; alv.-lateral ("\\f." ?ɽ) ; retroflex - + ;; lateral approx. ("\\l." ?É­) ; retroflex ("\\yt" ?Ê) ; palatal @@ -272,12 +272,12 @@ ;; vowels ("\\i-" ?ɨ) ("\\u-" ?ʉ) - + ("\\mt" ?ɯ) ("\\ic" ?ɪ) ("\\yc" ?Ê) - + ("\\hs" ?Ê) ("\\o/" ?ø) === modified file 'leim/quail/ipa.el' --- leim/quail/ipa.el 2013-01-01 09:11:05 +0000 +++ leim/quail/ipa.el 2013-06-21 13:37:15 +0000 @@ -341,7 +341,7 @@ with a keyboard that's limited to ASCII. See http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf for a full definition -of the mapping. A caveat with regard to that document; while XEmacs +of the mapping. A caveat with regard to that document; while XEmacs currently preserves Unicode diacritics on reading and emitting them, it displays them, incorrectly, as separate from the modified glyphs.") === modified file 'leim/quail/tibetan.el' --- leim/quail/tibetan.el 2013-04-02 01:18:40 +0000 +++ leim/quail/tibetan.el 2013-06-21 13:37:15 +0000 @@ -148,13 +148,13 @@ SPECIAL KEYS + : Consonant Stacking - \(Consonant stacking for ordinary Tibetan is done automatically) + (Consonant stacking for ordinary Tibetan is done automatically) - : No Consonant Stacking - \(To suppress automatic stacking for \"g-y\", + (To suppress automatic stacking for \"g-y\", and to get da-drag in -r-d, -l-d .) | : Special signs. - Tsheg is assigned to SPC. Space is assigned to period '.'. + Tsheg is assigned to SPC. Space is assigned to period '.'. " nil nil nil nil nil nil nil nil 'quail-tibetan-update-translation) @@ -426,16 +426,16 @@ DIFFERENCE FROM THE ORIGINAL TIBKEY: 1. Vowel 'a' should be typed explicitly by the key 'A'. - This is really inconvenient. But to make the coding + This is really inconvenient. But to make the coding scheme clear, it is desirable to have an explicit vowel sign for 'a'. - 2. Tsheg is assigned to SPC key. You can input a space + 2. Tsheg is assigned to SPC key. You can input a space by typing '>'. 4. To avoid the default stacking ö„» and to obtain གཡ, type 'E' instead of 'v' (=ཡ). 3. There are many characters that are not supported in the - current implementation (especially special signs). I hope - I'll complete in a future revision. + current implementation (especially special signs). + I hope I'll complete in a future revision. " nil nil nil nil nil nil nil nil 'quail-tibkey-update-translation) === modified file 'leim/quail/uni-input.el' --- leim/quail/uni-input.el 2013-01-01 09:11:05 +0000 +++ leim/quail/uni-input.el 2013-06-21 13:37:15 +0000 @@ -87,7 +87,7 @@ (defun ucs-input-activate (&optional arg) "Activate UCS input method. -With arg, activate UCS input method if and only if arg is positive. +With ARG, activate UCS input method if and only if ARG is positive. While this input method is active, the variable `input-method-function' is bound to the function `ucs-input-method'." ------------------------------------------------------------ revno: 113117 committer: Juanma Barranquero branch nick: trunk timestamp: Fri 2013-06-21 14:24:37 +0200 message: lisp/*.el: Fix typos; use string-match-p, looking-at-p, setq-local, defvar-local. * lisp/allout-widgets.el (allout-widgets-mode-off) (allout-widgets-mode-on, allout-widgets-pre-command-business) (allout-widgets-post-command-business) (allout-widgets-after-copy-or-kill-function) (allout-widgets-after-undo-function, allout-test-range-overlaps) (allout-decorate-item-and-context) (allout-graphics-modification-handler): Fix typos in docstrings. (allout-get-or-create-parent-widget): Use `looking-at-p'. * lisp/cmuscheme.el (scheme-start-file): Doc fix. (inferior-scheme-mode, switch-to-scheme): Fix typos in docstrings. (scheme-input-filter): Use `string-match-p'. * lisp/composite.el (compose-gstring-for-terminal): Fix typo in docstring. * lisp/dired-x.el: Use Dired consistently in docstrings. * lisp/dired.el: Use Dired consistently in docstrings. (dired-readin, dired-mode): Use `setq-local'. (dired-switches-alist): Make defvar-local. (dired-buffers-for-dir): Use `zerop'. (dired-safe-switches-p, dired-switches-escape-p) (dired-insert-old-subdirs, dired-move-to-end-of-filename) (dired-glob-regexp, dired-in-this-tree, dired-goto-file-1) (dired-sort-set-mode-line, dired-sort-toggle, dired-sort-R-check): (dired-goto-next-nontrivial-file): Use `string-match-p'. (dired-align-file, dired-insert-directory, dired-mark-files-in-region) (dired-toggle-marks, dired-mark-files-containing-regexp) (dired-mark-symlinks, dired-mark-directories, dired-mark-executables) (dired-flag-auto-save-files, dired-flag-backup-files): Use `looking-at-p'. (dired-mark-files-regexp, dired-build-subdir-alist): Use `string-match-p', `looking-at-p'. * lisp/dos-w32.el (untranslated-canonical-name, untranslated-file-p) (direct-print-region-helper): Use `string-match-p'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 09:37:04 +0000 +++ lisp/ChangeLog 2013-06-21 12:24:37 +0000 @@ -1,7 +1,46 @@ +2013-06-21 Juanma Barranquero + + * allout-widgets.el (allout-widgets-mode-off) + (allout-widgets-mode-on, allout-widgets-pre-command-business) + (allout-widgets-post-command-business) + (allout-widgets-after-copy-or-kill-function) + (allout-widgets-after-undo-function, allout-test-range-overlaps) + (allout-decorate-item-and-context) + (allout-graphics-modification-handler): Fix typos in docstrings. + (allout-get-or-create-parent-widget): Use `looking-at-p'. + + * cmuscheme.el (scheme-start-file): Doc fix. + (inferior-scheme-mode, switch-to-scheme): Fix typos in docstrings. + (scheme-input-filter): Use `string-match-p'. + + * composite.el (compose-gstring-for-terminal): Fix typo in docstring. + + * dired-x.el: Use Dired consistently in docstrings. + + * dired.el: Use Dired consistently in docstrings. + (dired-readin, dired-mode): Use `setq-local'. + (dired-switches-alist): Make defvar-local. + (dired-buffers-for-dir): Use `zerop'. + (dired-safe-switches-p, dired-switches-escape-p) + (dired-insert-old-subdirs, dired-move-to-end-of-filename) + (dired-glob-regexp, dired-in-this-tree, dired-goto-file-1) + (dired-sort-set-mode-line, dired-sort-toggle, dired-sort-R-check): + (dired-goto-next-nontrivial-file): Use `string-match-p'. + (dired-align-file, dired-insert-directory, dired-mark-files-in-region) + (dired-toggle-marks, dired-mark-files-containing-regexp) + (dired-mark-symlinks, dired-mark-directories, dired-mark-executables) + (dired-flag-auto-save-files, dired-flag-backup-files): + Use `looking-at-p'. + (dired-mark-files-regexp, dired-build-subdir-alist): + Use `string-match-p', `looking-at-p'. + + * dos-w32.el (untranslated-canonical-name, untranslated-file-p) + (direct-print-region-helper): Use `string-match-p'. + 2013-06-21 Leo Liu - * comint.el (comint-redirect-results-list-from-process): Fix - infinite loop. + * comint.el (comint-redirect-results-list-from-process): + Fix infinite loop. 2013-06-21 Lars Magne Ingebrigtsen === modified file 'lisp/allout-widgets.el' --- lisp/allout-widgets.el 2013-01-01 09:11:05 +0000 +++ lisp/allout-widgets.el 2013-06-21 12:24:37 +0000 @@ -293,8 +293,8 @@ "If non-nil, show cursor position of each item decoration. This is for debugging purposes, and generally set at need in a -buffer rather than as a prevailing configuration \(but it's handy -to publicize it by making it a customization variable\)." +buffer rather than as a prevailing configuration (but it's handy +to publicize it by making it a customization variable)." :version "24.1" :type 'boolean :group 'allout-widgets-developer) @@ -346,7 +346,7 @@ "Cache allout icon images, as an association list. `allout-fetch-icon-image' uses this cache transparently, keying -images with lists containing the name of the icon directory \(as +images with lists containing the name of the icon directory (as found on the `load-path') and the icon name. Set this variable to `nil' to empty the cache, and have it replenish from the @@ -485,7 +485,7 @@ - encryption '~' - numbering '#' - indirect reference '@' - - distinctive bullets - see `allout-distinctive-bullets-string'.\)") + - distinctive bullets - see `allout-distinctive-bullets-string'.)") ;;;_ = allout-span-to-category (defvar allout-span-to-category '((:guides-span . allout-guides-span-category) @@ -534,7 +534,7 @@ The bullet-icon and guide line graphics provide keybindings and mouse bindings for easy outline navigation and exposure control, extending -outline hot-spot navigation \(see `allout-mode')." +outline hot-spot navigation (see `allout-mode')." :lighter nil :keymap nil @@ -646,11 +646,11 @@ (set-buffer-modified-p was-modified)))) ;;;_ > allout-widgets-mode-off (defun allout-widgets-mode-off () - "Explicitly disable allout-widgets-mode." + "Explicitly disable `allout-widgets-mode'." (allout-widgets-mode -1)) ;;;_ > allout-widgets-mode-off (defun allout-widgets-mode-on () - "Explicitly disable allout-widgets-mode." + "Explicitly enable `allout-widgets-mode'." (allout-widgets-mode 1)) ;;;_ > allout-setup-text-properties () (defun allout-setup-text-properties () @@ -714,18 +714,18 @@ (defvar allout-container-item-widget nil "A widget for the current outline's overarching container as an item. -The item has settings \(of the file/connection\) and maybe a body, but no +The item has settings (of the file/connection) and maybe a body, but no icon/bullet.") (make-variable-buffer-local 'allout-container-item-widget) ;;;_ . Hooks and hook helpers ;;;_ , major command-loop business: ;;;_ > allout-widgets-pre-command-business (&optional recursing) (defun allout-widgets-pre-command-business (&optional recursing) - "Handle actions pending before allout-mode activity." + "Handle actions pending before `allout-mode' activity." ) ;;;_ > allout-widgets-post-command-business (&optional recursing) (defun allout-widgets-post-command-business (&optional recursing) - "Handle actions pending after any allout-mode commands. + "Handle actions pending after any `allout-mode' commands. Optional RECURSING is for internal use, to limit recursion." ;; - check changed text for nesting discontinuities and escape anything @@ -1155,14 +1155,14 @@ (defun allout-widgets-after-copy-or-kill-function () "Do allout-widgets processing of text just placed in the kill ring. -Intended for use on allout-after-copy-or-kill-hook." +Intended for use on `allout-after-copy-or-kill-hook'." (if (car kill-ring) (setcar kill-ring (allout-widgets-undecorate-text (car kill-ring))))) ;;;_ > allout-widgets-after-undo-function () (defun allout-widgets-after-undo-function () "Do allout-widgets processing of text after an undo. -Intended for use on allout-post-undo-hook." +Intended for use on `allout-post-undo-hook'." (save-excursion (if (allout-goto-prefix) (allout-redecorate-item (allout-get-or-create-item-widget))))) @@ -1359,7 +1359,7 @@ (list (if included-from t) new-ranges))) ;;;_ > allout-test-range-overlaps () (defun allout-test-range-overlaps () - "allout-range-overlaps unit tests." + "`allout-range-overlaps' unit tests." (let* (ranges got (try (lambda (from to) @@ -1557,7 +1557,7 @@ The neighbors include its siblings and parent. -ITEM-WIDGET can be a created or converted allout-item-widget. +ITEM-WIDGET can be a created or converted `allout-item-widget'. If you're only trying to get or create a widget for an item, use `allout-get-or-create-item-widget'. If you have the item-widget, applying @@ -1565,7 +1565,7 @@ Optional BLANK-CONTAINER is for internal use. It is used to fabricate a container widget for an empty-bodied container, in the course of decorating -a proper \(non-container\) item which starts at the beginning of the file. +a proper (non-container) item which starts at the beginning of the file. Optional REDECORATE causes redecoration of the item-widget and its siblings, even if already decorated in this cycle of the command loop. @@ -1737,8 +1737,8 @@ the item prefix. If optional BLANK-CONTAINER is true, then the parameters of a container -which has an empty body are set. \(Though the body is blank, the object -may have subitems.\)" +which has an empty body are set. (Though the body is blank, the object +may have subitems.)" ;; Uncomment this sit-for to notice where decoration is happening: ;; (sit-for .1) @@ -1857,8 +1857,8 @@ &optional parent-widget has-successor) "Add ITEM-WIDGET guide icon-prefix descender and connector text properties. -Optional arguments provide context for deriving the guides. In -their absence, the current guide column flags are used. +Optional arguments provide context for deriving the guides. +In their absence, the current guide column flags are used. Optional PARENT-WIDGET is the widget for the item's parent item. @@ -2222,7 +2222,7 @@ Optional BLANK-CONTAINER is for internal use, to fabricate a meta-container item with an empty body when the first proper -\(non-container\) item starts at the beginning of the file. +\(non-container) item starts at the beginning of the file. Optional REDECORATE, if non-nil, means to redecorate the widget if it already exists." @@ -2254,7 +2254,7 @@ of the buffer." ;; use existing widget, if there, else establish it (if (or (bobp) (and (not (allout-ascend)) - (looking-at allout-regexp))) + (looking-at-p allout-regexp))) (allout-get-or-create-item-widget redecorate 'blank-container) (allout-get-or-create-item-widget redecorate))) ;;;_ : X- Item ancillaries @@ -2270,7 +2270,7 @@ ;; - removal and replacement of the settings ;; - maintenance of beginning-of-line guide lines ;; -;; ?? Escapes removal \(before changes\) is not done when edits span multiple +;; ?? Escapes removal (before changes) is not done when edits span multiple ;; items, recognizing that item structure is being preserved, including ;; escaping of item-prefix-like text within bodies. See ;; `allout-before-modification-handler' and @@ -2284,7 +2284,7 @@ (defun allout-graphics-modification-handler (beg end) "Protect against incoherent deletion of decoration graphics. -Deletes allowed only when inhibit-read-only is t." +Deletes allowed only when `inhibit-read-only' is t." (cond (undo-in-progress (when (eq (get-text-property beg 'category) 'allout-icon-span-category) === modified file 'lisp/cmuscheme.el' --- lisp/cmuscheme.el 2013-02-22 01:59:28 +0000 +++ lisp/cmuscheme.el 2013-06-21 12:24:37 +0000 @@ -170,22 +170,22 @@ A Scheme process can be fired up with M-x run-scheme. -Customization: Entry to this mode runs the hooks on comint-mode-hook and -inferior-scheme-mode-hook (in that order). +Customization: Entry to this mode runs the hooks on `comint-mode-hook' and +`inferior-scheme-mode-hook' (in that order). You can send text to the inferior Scheme process from other buffers containing Scheme source. - switch-to-scheme switches the current buffer to the Scheme process buffer. - scheme-send-definition sends the current definition to the Scheme process. - scheme-compile-definition compiles the current definition. - scheme-send-region sends the current region to the Scheme process. - scheme-compile-region compiles the current region. + `switch-to-scheme' switches the current buffer to the Scheme process buffer. + `scheme-send-definition' sends the current definition to the Scheme process. + `scheme-compile-definition' compiles the current definition. + `scheme-send-region' sends the current region to the Scheme process. + `scheme-compile-region' compiles the current region. - scheme-send-definition-and-go, scheme-compile-definition-and-go, - scheme-send-region-and-go, and scheme-compile-region-and-go + `scheme-send-definition-and-go', `scheme-compile-definition-and-go', + `scheme-send-region-and-go', and `scheme-compile-region-and-go' switch to the Scheme process buffer after sending their text. For information on running multiple processes in multiple buffers, see -documentation for variable scheme-buffer. +documentation for variable `scheme-buffer'. Commands: Return after the end of the process' output sends the text from the @@ -214,7 +214,7 @@ (defun scheme-input-filter (str) "Don't save anything matching `inferior-scheme-filter-regexp'." - (not (string-match inferior-scheme-filter-regexp str))) + (not (string-match-p inferior-scheme-filter-regexp str))) (defun scheme-get-old-input () "Snarf the sexp ending at point." @@ -233,7 +233,7 @@ it is given as initial input. Note that this may lose due to a timing error if the Scheme processor discards input when it starts up. -Runs the hook `inferior-scheme-mode-hook' \(after the `comint-mode-hook' +Runs the hook `inferior-scheme-mode-hook' (after the `comint-mode-hook' is run). \(Type \\[describe-mode] in the process buffer for a list of commands.)" @@ -251,8 +251,8 @@ (defun scheme-start-file (prog) "Return the name of the start file corresponding to PROG. -Search in the directories \"~\" and \"~/.emacs.d\", in this -order. Return nil if no start file found." +Search in the directories \"~\" and `user-emacs-directory', +in this order. Return nil if no start file found." (let* ((progname (file-name-nondirectory prog)) (start-file (concat "~/.emacs_" progname)) (alt-start-file (concat user-emacs-directory "init_" progname ".scm"))) @@ -367,7 +367,7 @@ (scheme-form-at-point))))) (defun switch-to-scheme (eob-p) - "Switch to the scheme process buffer. + "Switch to the Scheme process buffer. With argument, position cursor at end of buffer." (interactive "P") (if (or (and scheme-buffer (get-buffer scheme-buffer)) === modified file 'lisp/composite.el' --- lisp/composite.el 2012-07-10 11:51:54 +0000 +++ lisp/composite.el 2013-06-21 12:24:37 +0000 @@ -57,8 +57,8 @@ | | 7:bc or bottom-center 6----7----8 <---- descent 8:br or bottom-right -Glyph reference point symbols are to be used to specify composition -rule of the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where +Glyph reference point symbols are to be used to specify a composition +rule of the form (GLOBAL-REF-POINT . NEW-REF-POINT), where GLOBAL-REF-POINT is a reference point in the overall glyphs already composed, and NEW-REF-POINT is a reference point in the new glyph to be added. @@ -71,13 +71,13 @@ | | | | global| | | glyph | | - -- | | |-- <--- baseline \(doesn't change) + -- | | |-- <--- baseline (doesn't change) +----+--*--+ | | new | | |glyph| +----+-----+ <--- new descent -A composition rule may have the form \(GLOBAL-REF-POINT +A composition rule may have the form (GLOBAL-REF-POINT NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specify how much to shift NEW-REF-POINT from GLOBAL-REF-POINT. In this case, XOFF and YOFF are integers in the range -100..100 representing the @@ -279,8 +279,8 @@ (defun compose-chars (&rest args) "Return a string from arguments in which all characters are composed. For relative composition, arguments are characters. -For rule-based composition, Mth \(where M is odd) arguments are -characters, and Nth \(where N is even) arguments are composition rules. +For rule-based composition, Mth (where M is odd) arguments are +characters, and Nth (where N is even) arguments are composition rules. A composition rule is a cons of glyph reference points of the form \(GLOBAL-REF-POINT . NEW-REF-POINT). See the documentation of `reference-point-alist' for more detail." @@ -387,7 +387,7 @@ (defun compose-last-chars (args) "Compose last characters. The argument is a parameterized event of the form - \(compose-last-chars N COMPONENTS), + (compose-last-chars N COMPONENTS), where N is the number of characters before point to compose, COMPONENTS, if non-nil, is the same as the argument to `compose-region' \(which see). If it is nil, `compose-chars-after' is called, @@ -640,7 +640,7 @@ unicode-category-table)) (defun compose-gstring-for-terminal (gstring) - "Compose glyph string GSTRING for terminal display. + "Compose glyph-string GSTRING for terminal display. Non-spacing characters are composed with the preceding base character. If the preceding character is not a base character, each non-spacing character is composed as a spacing character by === modified file 'lisp/dired-x.el' --- lisp/dired-x.el 2013-02-09 05:09:02 +0000 +++ lisp/dired-x.el 2013-06-21 12:24:37 +0000 @@ -95,7 +95,7 @@ :group 'dired-keys) (defcustom dired-bind-man t - "Non-nil means bind `dired-man' to \"N\" in dired-mode, otherwise do not. + "Non-nil means bind `dired-man' to \"N\" in Dired, otherwise do not. Setting this variable directly after dired-x is loaded has no effect - use \\[customize]." :type 'boolean @@ -107,7 +107,7 @@ :group 'dired-keys) (defcustom dired-bind-info t - "Non-nil means bind `dired-info' to \"I\" in dired-mode, otherwise do not. + "Non-nil means bind `dired-info' to \"I\" in Dired, otherwise do not. Setting this variable directly after dired-x is loaded has no effect - use \\[customize]." :type 'boolean @@ -163,7 +163,7 @@ (defcustom dired-omit-files "^\\.?#\\|^\\.$\\|^\\.\\.$" "Filenames matching this regexp will not be displayed. This only has effect when `dired-omit-mode' is t. See interactive function -`dired-omit-mode' \(\\[dired-omit-mode]\) and variable +`dired-omit-mode' (\\[dired-omit-mode]) and variable `dired-omit-extensions'. The default is to omit `.', `..', auto-save files and lock files." :type 'regexp @@ -181,7 +181,7 @@ If nil, Dired finds the directory as a subdirectory in some other buffer if it is present as one. -If there are several dired buffers for a directory, the most recently +If there are several Dired buffers for a directory, the most recently used is chosen. Dired avoids switching to the current buffer, so that if you have @@ -345,7 +345,7 @@ marker-char)) (defun dired-flag-extension (extension) - "In dired, flag all files with a certain EXTENSION for deletion. + "In Dired, flag all files with a certain EXTENSION for deletion. A `.' is *not* automatically prepended to the string entered." (interactive "sFlagging extension: ") (dired-mark-extension extension dired-del-marker)) @@ -406,17 +406,17 @@ ;;;###autoload (defun dired-jump (&optional other-window file-name) - "Jump to dired buffer corresponding to current buffer. -If in a file, dired the current directory and move to file's line. + "Jump to Dired buffer corresponding to current buffer. +If in a file, Dired the current directory and move to file's line. If in Dired already, pop up a level and goto old directory's line. -In case the proper dired file line cannot be found, refresh the dired +In case the proper Dired file line cannot be found, refresh the dired buffer and try again. -When OTHER-WINDOW is non-nil, jump to dired buffer in other window. +When OTHER-WINDOW is non-nil, jump to Dired buffer in other window. Interactively with prefix argument, read FILE-NAME and move to its line in dired." (interactive (list nil (and current-prefix-arg - (read-file-name "Jump to dired file: ")))) + (read-file-name "Jump to Dired file: ")))) (let* ((file (or file-name buffer-file-name)) (dir (if file (file-name-directory file) default-directory))) (if (and (eq major-mode 'dired-mode) (null file-name)) @@ -446,7 +446,7 @@ "Like \\[dired-jump] (`dired-jump') but in other window." (interactive (list (and current-prefix-arg - (read-file-name "Jump to dired file: ")))) + (read-file-name "Jump to Dired file: ")))) (dired-jump t file-name)) ;;; OMITTING. @@ -486,12 +486,12 @@ dired-latex-unclean-extensions dired-bibtex-unclean-extensions dired-texinfo-unclean-extensions) - "If non-nil, a list of extensions \(strings\) to omit from Dired listings. + "If non-nil, a list of extensions (strings) to omit from Dired listings. Defaults to elements of `completion-ignored-extensions', `dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions', and `dired-texinfo-unclean-extensions'. -See interactive function `dired-omit-mode' \(\\[dired-omit-mode]\) and +See interactive function `dired-omit-mode' (\\[dired-omit-mode]) and variables `dired-omit-mode' and `dired-omit-files'." :type '(repeat string) :group 'dired-x) @@ -583,8 +583,8 @@ This is useful if you want to peruse and move around in an ls -lR output file, for example one you got from an ftp server. With -ange-ftp, you can even dired a directory containing an ls-lR file, -visit that file and turn on virtual dired mode. But don't try to save +ange-ftp, you can even Dired a directory containing an ls-lR file, +visit that file and turn on Virtual Dired mode. But don't try to save this file, as dired-virtual indents the listing and thus changes the buffer. @@ -593,7 +593,7 @@ Type \\\\[revert-buffer] \ in the Virtual Dired buffer and answer `y' to convert -the virtual to a real dired buffer again. You don't have to do this, though: +the virtual to a real Dired buffer again. You don't have to do this, though: you can relist single subdirs using \\[dired-do-redisplay]." ;; DIRNAME is the top level directory of the buffer. It will become @@ -682,7 +682,7 @@ \"^ \\\\(/[^ /]+\\\\)+/?:$\" -to put saved dired buffers automatically into Virtual Dired mode. +to put saved Dired buffers automatically into Virtual Dired mode. Also useful for `auto-mode-alist' like this: @@ -769,7 +769,7 @@ ;; Dired Buffer. (defcustom dired-local-variables-file (convert-standard-filename ".dired") - "Filename, as string, containing local dired buffer variables to be hacked. + "Filename, as string, containing local Dired buffer variables to be hacked. If this file found in current directory, then it will be inserted into dired buffer and `hack-local-variables' will be run. See Info node `(emacs)File Variables' for more information on local variables. @@ -780,7 +780,7 @@ (make-obsolete-variable 'dired-local-variables-file 'dir-locals-file "24.1") (defun dired-hack-local-variables () - "Evaluate local variables in `dired-local-variables-file' for dired buffer." + "Evaluate local variables in `dired-local-variables-file' for Dired buffer." (declare (obsolete hack-dir-local-variables-non-file-buffer "24.1")) (and (stringp dired-local-variables-file) (file-exists-p dired-local-variables-file) @@ -984,7 +984,7 @@ " " dired-guess-shell-znew-switches)) '("\\.pod\\'" "perldoc" "pod2man * | nroff -man") - '("\\.dvi\\'" "xdvi" "dvips") ; preview and printing + '("\\.dvi\\'" "xdvi" "dvips") ; preview and printing '("\\.au\\'" "play") ; play Sun audiofiles '("\\.mpe?g\\'\\|\\.avi\\'" "xine -p") '("\\.ogg\\'" "ogg123") @@ -1000,7 +1000,7 @@ '("\\.tif\\'" "xloadimage") '("\\.png\\'" "display") ; xloadimage 4.1 doesn't grok PNG '("\\.jpe?g\\'" "xloadimage") - '("\\.fig\\'" "xfig") ; edit fig pictures + '("\\.fig\\'" "xfig") ; edit fig pictures '("\\.out\\'" "xgraph") ; for plotting purposes. '("\\.tex\\'" "latex" "tex") '("\\.texi\\(nfo\\)?\\'" "makeinfo" "texi2dvi") @@ -1044,7 +1044,7 @@ Each element of this list looks like - \(REGEXP COMMAND...\) + (REGEXP COMMAND...) where each COMMAND can either be a string or a Lisp expression that evaluates to a string. If several COMMANDs are given, the first one will be the default @@ -1057,7 +1057,7 @@ You can set this variable in your ~/.emacs. For example, to add rules for `.foo' and `.bar' files, write - \(setq dired-guess-shell-alist-user + (setq dired-guess-shell-alist-user '((\"\\\\.foo\\\\'\" \"FOO-COMMAND\") (\"\\\\.bar\\\\'\" (if condition @@ -1258,7 +1258,7 @@ displayed this way is restricted by the height of the current window and `window-min-height'. -To keep dired buffer displayed, type \\[split-window-below] first. +To keep Dired buffer displayed, type \\[split-window-below] first. To display just marked files, type \\[delete-other-windows] first." (interactive "P") (dired-simultaneous-find-file (dired-get-marked-files) noselect)) === modified file 'lisp/dired.el' --- lisp/dired.el 2013-06-14 09:32:01 +0000 +++ lisp/dired.el 2013-06-21 12:24:37 +0000 @@ -87,8 +87,8 @@ spaces. You might want to install ls from GNU Coreutils, which does support this option. Alternatively, you might want to use Emacs's own emulation of \"ls\", by using: - \(setq ls-lisp-use-insert-directory-program nil) - \(require 'ls-lisp) + (setq ls-lisp-use-insert-directory-program nil) + (require 'ls-lisp) This is used by default on MS Windows, which does not have an \"ls\" program. Note that `ls-lisp' does not support as many options as GNU ls, though. For more details, see Info node `(emacs)ls in Lisp'." @@ -204,7 +204,7 @@ :type 'hook) (defcustom dired-before-readin-hook nil - "This hook is run before a dired buffer is read in (created or reverted)." + "This hook is run before a Dired buffer is read in (created or reverted)." :group 'dired :type 'hook) @@ -231,7 +231,7 @@ "The functions to call when a drop in `dired-mode' is made. See `dnd-protocol-alist' for more information. When nil, behave as in other buffers. Changing this option is effective only for -new dired buffers." +new Dired buffers." :type '(choice (repeat (cons (regexp) (function))) (const :tag "Behave as in other buffers" nil)) :version "22.1" @@ -279,18 +279,18 @@ ;;;###autoload (defvar dired-directory nil - "The directory name or wildcard spec that this dired directory lists. -Local to each dired buffer. May be a list, in which case the car is the + "The directory name or wildcard spec that this Dired directory lists. +Local to each Dired buffer. May be a list, in which case the car is the directory name and the cdr is the list of files to mention. The directory name must be absolute, but need not be fully expanded.") ;; Beware of "-l;reboot" etc. See bug#3230. (defun dired-safe-switches-p (switches) - "Return non-nil if string SWITCHES does not look risky for dired." + "Return non-nil if string SWITCHES does not look risky for Dired." (or (not switches) (and (stringp switches) (< (length switches) 100) ; arbitrary - (string-match "\\` *-[- [:alnum:]]+\\'" switches)))) + (string-match-p "\\` *-[- [:alnum:]]+\\'" switches)))) (defvar dired-actual-switches nil "The value of `dired-listing-switches' used to make this buffer's text.") @@ -330,10 +330,9 @@ The order of elements is the reverse of the order in the buffer. In simple cases, this list contains one element.") -(defvar dired-switches-alist nil +(defvar-local dired-switches-alist nil "Keeps track of which switches to use for inserted subdirectories. This is an alist of the form (SUBDIR . SWITCHES).") -(make-variable-buffer-local 'dired-switches-alist) (defvaralias 'dired-move-to-filename-regexp 'directory-listing-before-filename-regexp) @@ -360,11 +359,11 @@ (defface dired-mark '((t (:inherit font-lock-constant-face))) - "Face used for dired marks." + "Face used for Dired marks." :group 'dired-faces :version "22.1") (defvar dired-mark-face 'dired-mark - "Face name used for dired marks.") + "Face name used for Dired marks.") (defface dired-marked '((t (:inherit warning))) @@ -563,8 +562,8 @@ If optional third arg SHOW-PROGRESS evaluates to non-nil, redisplay the dired buffer after each file is processed. -No guarantee is made about the position on the marked line. BODY -must ensure this itself if it depends on this. +No guarantee is made about the position on the marked line. +BODY must ensure this itself if it depends on this. Search starts at the beginning of the buffer, thus the car of the list corresponds to the line nearest to the buffer's bottom. @@ -753,7 +752,7 @@ delete them by typing \\[dired-do-flagged-delete]. Type \\[describe-mode] after entering Dired for more info. -If DIRNAME is already in a dired buffer, that buffer is used without refresh." +If DIRNAME is already in a Dired buffer, that buffer is used without refresh." ;; Cannot use (interactive "D") because of wildcards. (interactive (dired-read-dir-and-switches "")) (switch-to-buffer (dired-noselect dirname switches))) @@ -774,7 +773,7 @@ ;;;###autoload (defun dired-noselect (dir-or-list &optional switches) - "Like `dired' but returns the dired buffer as value, does not select it." + "Like `dired' but returns the Dired buffer as value, does not select it." (or dir-or-list (setq dir-or-list default-directory)) ;; This loses the distinction between "/foo/*/" and "/foo/*" that ;; some shells make: @@ -812,9 +811,9 @@ (equal (nth 5 attributes) modtime))))) (defun dired-buffer-stale-p (&optional noconfirm) - "Return non-nil if current dired buffer needs updating. + "Return non-nil if current Dired buffer needs updating. If NOCONFIRM is non-nil, then this function always returns nil -for a remote directory. This feature is used by Auto Revert Mode." +for a remote directory. This feature is used by Auto Revert mode." (let ((dirname (if (consp dired-directory) (car dired-directory) dired-directory))) (and (stringp dirname) @@ -826,8 +825,8 @@ (dired-directory-changed-p dirname)))) (defcustom dired-auto-revert-buffer nil - "Automatically revert dired buffer on revisiting. -If t, revisiting an existing dired buffer automatically reverts it. + "Automatically revert Dired buffer on revisiting. +If t, revisiting an existing Dired buffer automatically reverts it. If its value is a function, call this function with the directory name as single argument and revert the buffer if it returns non-nil. Otherwise, a message offering to revert the changed dired buffer @@ -836,8 +835,8 @@ periodically reverts at specified time intervals." :type '(choice (const :tag "Don't revert" nil) - (const :tag "Always revert visited dired buffer" t) - (const :tag "Revert changed dired buffer" dired-directory-changed-p) + (const :tag "Always revert visited Dired buffer" t) + (const :tag "Revert changed Dired buffer" dired-directory-changed-p) (function :tag "Predicate function")) :group 'dired :version "23.2") @@ -910,7 +909,7 @@ ;; Enlarged by dired-advertise ;; Queried by function dired-buffers-for-dir. When this detects a ;; killed buffer, it is removed from this list. - "Alist of expanded directories and their associated dired buffers.") + "Alist of expanded directories and their associated Dired buffers.") (defvar dired-find-subdir) @@ -958,7 +957,7 @@ ;; Read in a new dired buffer (defun dired-readin () - "Read in a new dired buffer. + "Read in a new Dired buffer. Differs from `dired-insert-subdir' in that it accepts wildcards, erases the buffer, and builds the subdir-alist anew \(including making it buffer-local and clearing it first)." @@ -981,9 +980,8 @@ (run-hooks 'dired-before-readin-hook) (if (consp buffer-undo-list) (setq buffer-undo-list nil)) - (make-local-variable 'file-name-coding-system) - (setq file-name-coding-system - (or coding-system-for-read file-name-coding-system)) + (setq-local file-name-coding-system + (or coding-system-for-read file-name-coding-system)) (let ((inhibit-read-only t) ;; Don't make undo entries for readin. (buffer-undo-list t)) @@ -993,7 +991,7 @@ (goto-char (point-min)) ;; Must first make alist buffer local and set it to nil because ;; dired-build-subdir-alist will call dired-clear-alist first - (set (make-local-variable 'dired-subdir-alist) nil) + (setq-local dired-subdir-alist nil) (dired-build-subdir-alist) (let ((attributes (file-attributes dirname))) (if (eq (car attributes) t) @@ -1092,7 +1090,7 @@ ;; We're now just in front of a field, with a space behind us. (let* ((curcol (current-column)) ;; Nums are right-aligned. - (num-align (looking-at "[0-9]")) + (num-align (looking-at-p "[0-9]")) ;; Let's look at the other line, in the same column: we ;; should be either near the end of the previous field, or ;; in the space between that field and the next. @@ -1141,7 +1139,7 @@ (defun dired-switches-escape-p (switches) "Return non-nil if the string SWITCHES contains -b or --escape." ;; Do not match things like "--block-size" that happen to contain "b". - (string-match "\\(\\`\\| \\)-[[:alnum:]]*b\\|--escape\\>" switches)) + (string-match-p "\\(\\`\\| \\)-[[:alnum:]]*b\\|--escape\\>" switches)) (defun dired-insert-directory (dir switches &optional file-list wildcard hdr) "Insert a directory listing of DIR, Dired style. @@ -1219,7 +1217,7 @@ ;; Otherwise, indent them. (unless (save-excursion (goto-char opoint) - (looking-at " ")) + (looking-at-p " ")) (let ((indent-tabs-mode nil)) (indent-rigidly opoint (point) 2))) ;; Insert text at the beginning to standardize things. @@ -1227,7 +1225,7 @@ (save-excursion (goto-char opoint) (when (and (or hdr wildcard) - (not (and (looking-at "^ \\(.*\\):$") + (not (and (looking-at-p "^ \\(.*\\):$") (file-name-absolute-p (match-string 1))))) ;; Note that dired-build-subdir-alist will replace the name ;; by its expansion, so it does not matter whether what we insert @@ -1269,7 +1267,7 @@ ;; Reverting a dired buffer (defun dired-revert (&optional _arg _noconfirm) - "Reread the dired buffer. + "Reread the Dired buffer. Must also be called after `dired-actual-switches' have changed. Should not fail even on completely garbaged buffers. Preserves old cursor, marks/flags, hidden-p. @@ -1320,7 +1318,7 @@ "Return current positions in the buffer and all windows with this directory. The positions have the form (BUFFER-POSITION WINDOW-POSITIONS). -BUFFER-POSITION is the point position in the current dired buffer. +BUFFER-POSITION is the point position in the current Dired buffer. It has the form (BUFFER DIRED-FILENAME BUFFER-POINT). WINDOW-POSITIONS are current positions in all windows displaying @@ -1397,7 +1395,7 @@ (defun dired-insert-old-subdirs (old-subdir-alist) "Try to insert all subdirs that were displayed before. Do so according to the former subdir alist OLD-SUBDIR-ALIST." - (or (string-match "R" dired-actual-switches) + (or (string-match-p "R" dired-actual-switches) (let (elt dir) (while old-subdir-alist (setq elt (car old-subdir-alist) @@ -1636,7 +1634,7 @@ :help "Incrementally search for string in file names only.")) (define-key map [menu-bar immediate compare-directories] '(menu-item "Compare Directories..." dired-compare-directories - :help "Mark files with different attributes in two dired buffers")) + :help "Mark files with different attributes in two Dired buffers")) (define-key map [menu-bar immediate backup-diff] '(menu-item "Compare with Backup" dired-backup-diff :help "Diff file at cursor with its latest backup")) @@ -1660,7 +1658,7 @@ :help "Create a directory")) (define-key map [menu-bar immediate wdired-mode] '(menu-item "Edit File Names" wdired-change-to-wdired-mode - :help "Put a dired buffer in a mode in which filenames are editable" + :help "Put a Dired buffer in a mode in which filenames are editable" :keys "C-x C-q" :filter (lambda (x) (if (eq major-mode 'dired-mode) x)))) @@ -1867,7 +1865,7 @@ :help "Copy current file or all marked files")) map) - "Local keymap for `dired-mode' buffers.") + "Local keymap for Dired mode buffers.") ;; Dired mode is suitable only for specially formatted data. (put 'dired-mode 'mode-class 'special) @@ -1878,7 +1876,7 @@ "\ Mode for \"editing\" directory listings. In Dired, you are \"editing\" a list of the files in a directory and - \(optionally) its subdirectories, in the format of `ls -lR'. + (optionally) its subdirectories, in the format of `ls -lR'. Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise. \"Editing\" means that you can run shell commands on files, visit, compress, load or byte-compile them, change their file attributes @@ -1900,7 +1898,7 @@ Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'. Type \\[dired-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). -Type \\[dired-find-file-other-window] to find file or dired directory in Other window. +Type \\[dired-find-file-other-window] to find file or Dired directory in Other window. Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer. Type \\[dired-do-rename] to Rename a file or move the marked files to another directory. Type \\[dired-do-copy] to Copy files. @@ -1952,31 +1950,25 @@ ;; Ignore dired-hide-details-* value of invisible text property by default. (when (eq buffer-invisibility-spec t) (setq buffer-invisibility-spec (list t))) - (set (make-local-variable 'revert-buffer-function) - (function dired-revert)) - (set (make-local-variable 'buffer-stale-function) - (function dired-buffer-stale-p)) - (set (make-local-variable 'page-delimiter) - "\n\n") - (set (make-local-variable 'dired-directory) - (or dirname default-directory)) + (setq-local revert-buffer-function (function dired-revert)) + (setq-local buffer-stale-function (function dired-buffer-stale-p)) + (setq-local page-delimiter "\n\n") + (setq-local dired-directory (or dirname default-directory)) ;; list-buffers uses this to display the dir being edited in this buffer. (setq list-buffers-directory (expand-file-name (if (listp dired-directory) (car dired-directory) dired-directory))) - (set (make-local-variable 'dired-actual-switches) - (or switches dired-listing-switches)) - (set (make-local-variable 'font-lock-defaults) - '(dired-font-lock-keywords t nil nil beginning-of-line)) - (set (make-local-variable 'desktop-save-buffer) - 'dired-desktop-buffer-misc-data) + (setq-local dired-actual-switches (or switches dired-listing-switches)) + (setq-local font-lock-defaults + '(dired-font-lock-keywords t nil nil beginning-of-line)) + (setq-local desktop-save-buffer 'dired-desktop-buffer-misc-data) (setq dired-switches-alist nil) (hack-dir-local-variables-non-file-buffer) ; before sorting (dired-sort-other dired-actual-switches t) (when (featurep 'dnd) - (set (make-local-variable 'dnd-protocol-alist) - (append dired-dnd-protocol-alist dnd-protocol-alist))) + (setq-local dnd-protocol-alist + (append dired-dnd-protocol-alist dnd-protocol-alist))) (add-hook 'file-name-at-point-functions 'dired-file-name-at-point nil t) (add-hook 'isearch-mode-hook 'dired-isearch-filenames-setup nil t) (run-mode-hooks 'dired-mode-hook)) @@ -1984,7 +1976,7 @@ ;; Idiosyncratic dired commands that don't deal with marks. (defun dired-summary () - "Summarize basic Dired commands and show recent dired errors." + "Summarize basic Dired commands and show recent Dired errors." (interactive) (dired-why) ;>> this should check the key-bindings and use substitute-command-keys if non-standard @@ -1992,14 +1984,14 @@ "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp")) (defun dired-undo () - "Undo in a dired buffer. + "Undo in a Dired buffer. This doesn't recover lost files, it just undoes changes in the buffer itself. You can use it to recover marks, killed lines or subdirs." (interactive) (let ((inhibit-read-only t)) (undo)) (dired-build-subdir-alist) - (message "Change in dired buffer undone. + (message "Change in Dired buffer undone. Actual changes in files cannot be undone by Emacs.")) (defun dired-toggle-read-only () @@ -2032,7 +2024,7 @@ (dired-next-line (- (or arg 1)))) (defun dired-next-dirline (arg &optional opoint) - "Goto ARG'th next directory file line." + "Goto ARGth next directory file line." (interactive "p") (or opoint (setq opoint (point))) (if (if (> arg 0) @@ -2044,7 +2036,7 @@ (error "No more subdirectories"))) (defun dired-prev-dirline (arg) - "Goto ARG'th previous directory file line." + "Goto ARGth previous directory file line." (interactive "p") (dired-next-dirline (- arg))) @@ -2078,7 +2070,7 @@ file-name (if (file-symlink-p file-name) (error "File is a symlink to a nonexistent target") - (error "File no longer exists; type `g' to update dired buffer"))))) + (error "File no longer exists; type `g' to update Dired buffer"))))) ;; Force C-m keybinding rather than `f' or `e' in the mode doc: (define-obsolete-function-alias 'dired-advertised-find-file 'dired-find-file "23.2") @@ -2091,7 +2083,7 @@ (find-file (dired-get-file-for-visit)))) (defun dired-find-alternate-file () - "In Dired, visit this file or directory instead of the dired buffer." + "In Dired, visit this file or directory instead of the Dired buffer." (interactive) (set-buffer-modified-p nil) (find-alternate-file (dired-get-file-for-visit))) @@ -2276,7 +2268,7 @@ ;;; Minor mode for hiding details ;;;###autoload (define-minor-mode dired-hide-details-mode - "Hide details in `dired-mode'." + "Hide details in Dired mode." :group 'dired (unless (derived-mode-p 'dired-mode) (error "Not a Dired buffer")) @@ -2348,7 +2340,7 @@ (goto-char (next-single-property-change (point) 'dired-filename)) (let (opoint file-type executable symlink hidden case-fold-search used-F eol) ;; case-fold-search is nil now, so we can test for capital F: - (setq used-F (string-match "F" dired-actual-switches) + (setq used-F (string-match-p "F" dired-actual-switches) opoint (point) eol (line-end-position) hidden (and selective-display @@ -2408,7 +2400,7 @@ "Copy names of marked (or next ARG) files into the kill ring. The names are separated by a space. With a zero prefix arg, use the absolute file name of each marked file. -With \\[universal-argument], use the file name relative to the dired buffer's +With \\[universal-argument], use the file name relative to the Dired buffer's `default-directory'. (This still may contain slashes if in a subdirectory.) If on a subdir headerline, use absolute subdirname instead; @@ -2459,9 +2451,9 @@ (if (stringp dired-directory) (let ((wildcards (file-name-nondirectory dired-directory))) - (or (= 0 (length wildcards)) - (string-match (dired-glob-regexp wildcards) - file))) + (or (zerop (length wildcards)) + (string-match-p (dired-glob-regexp wildcards) + file))) (member (expand-file-name file dir) (cdr dired-directory)))) (setq result (cons buf result))))))) @@ -2488,7 +2480,7 @@ (if (= (aref pattern (1+ set-start)) ?^) (+ 3 set-start) (+ 2 set-start))) - (set-end (string-match "]" pattern set-cont)) + (set-end (string-match-p "]" pattern set-cont)) (set (substring pattern set-start (1+ set-end)))) (setq regexp (concat regexp set)) (setq matched-in-pattern (1+ set-end)))) @@ -2528,7 +2520,7 @@ (defun dired-in-this-tree (file dir) ;;"Is FILE part of the directory tree starting at DIR?" (let (case-fold-search) - (string-match (concat "^" (regexp-quote dir)) file))) + (string-match-p (concat "^" (regexp-quote dir)) file))) (defun dired-normalize-subdir (dir) ;; Prepend default-directory to DIR if relative file name. @@ -2610,7 +2602,7 @@ (R-ftp-base-dir-regex ;; Used to expand subdirectory names correctly in recursive ;; ange-ftp listings. - (and (string-match "R" switches) + (and (string-match-p "R" switches) (string-match "\\`/.*:\\(/.*\\)" default-directory) (concat "\\`" (match-string 1 default-directory))))) (goto-char (point-min)) @@ -2622,7 +2614,7 @@ (goto-char (match-beginning 0)) (beginning-of-line) (forward-char 2) - (save-match-data (looking-at dired-re-perms))) + (looking-at-p dired-re-perms)) (save-excursion (goto-char (match-beginning 1)) (setq new-dir-name @@ -2680,9 +2672,9 @@ (dired-goto-next-file);; so there is a file to compare with (if (stringp dired-trivial-filenames) (while (and (not (eobp)) - (string-match dired-trivial-filenames - (file-name-nondirectory - (or (dired-get-filename nil t) "")))) + (string-match-p dired-trivial-filenames + (file-name-nondirectory + (or (dired-get-filename nil t) "")))) (forward-line 1) (dired-move-to-filename)))) @@ -2692,7 +2684,7 @@ (forward-line 1)))) (defun dired-goto-file (file) - "Go to line describing file FILE in this dired buffer." + "Go to line describing file FILE in this Dired buffer." ;; Return value of point on success, else nil. ;; FILE must be an absolute file name. ;; Loses if FILE contains control chars like "\007" for which ls @@ -2741,7 +2733,7 @@ (setq str (replace-regexp-in-string "\^m" "\\^m" file nil t)) (setq str (replace-regexp-in-string "\\\\" "\\\\" str nil t)) (and (dired-switches-escape-p dired-actual-switches) - (string-match "[ \t\n]" str) + (string-match-p "[ \t\n]" str) ;; FIXME: to fix this for embedded control characters etc, we ;; should escape everything that `ls -b' does. (setq str (replace-regexp-in-string " " "\\ " str nil t) @@ -2989,7 +2981,7 @@ (kill-buffer buf))) (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))) (and buf-list - (y-or-n-p (format "Kill dired buffer%s of %s, too? " + (y-or-n-p (format "Kill Dired buffer%s of %s, too? " (dired-plural-s (length buf-list)) (file-name-nondirectory fn))) (dolist (buf buf-list) @@ -3078,7 +3070,7 @@ in the case of one marked file, to distinguish that from using just the current file. -FUNCTION should not manipulate files, just read input \(an +FUNCTION should not manipulate files, just read input (an argument or confirmation)." (if (or (eq dired-no-confirm t) (memq op-symbol dired-no-confirm) @@ -3183,7 +3175,7 @@ ;; Skip subdir line and following garbage like the `total' line: (while (and (< (point) end) (dired-between-files)) (forward-line 1)) - (if (and (not (looking-at dired-re-dot)) + (if (and (not (looking-at-p dired-re-dot)) (dired-get-filename nil t)) (progn (delete-char 1) @@ -3264,7 +3256,7 @@ (let ((inhibit-read-only t)) (while (not (eobp)) (or (dired-between-files) - (looking-at dired-re-dot) + (looking-at-p dired-re-dot) ;; use subst instead of insdel because it does not move ;; the gap and thus should be faster and because ;; other characters are left alone automatically @@ -3296,10 +3288,10 @@ (if current-prefix-arg ?\040))) (let ((dired-marker-char (or marker-char dired-marker-char))) (dired-mark-if - (and (not (looking-at dired-re-dot)) + (and (not (looking-at-p dired-re-dot)) (not (eolp)) ; empty line (let ((fn (dired-get-filename t t))) - (and fn (string-match regexp fn)))) + (and fn (string-match-p regexp fn)))) "matching file"))) (defun dired-mark-files-containing-regexp (regexp &optional marker-char) @@ -3312,7 +3304,7 @@ (if current-prefix-arg ?\040))) (let ((dired-marker-char (or marker-char dired-marker-char))) (dired-mark-if - (and (not (looking-at dired-re-dot)) + (and (not (looking-at-p dired-re-dot)) (not (eolp)) ; empty line (let ((fn (dired-get-filename nil t))) (when (and fn (file-readable-p fn) @@ -3346,15 +3338,15 @@ With prefix argument, unmark or unflag all those files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) - (dired-mark-if (looking-at dired-re-sym) "symbolic link"))) + (dired-mark-if (looking-at-p dired-re-sym) "symbolic link"))) (defun dired-mark-directories (unflag-p) "Mark all directory file lines except `.' and `..'. With prefix argument, unmark or unflag all those files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) - (dired-mark-if (and (looking-at dired-re-dir) - (not (looking-at dired-re-dot))) + (dired-mark-if (and (looking-at-p dired-re-dir) + (not (looking-at-p dired-re-dot))) "directory file"))) (defun dired-mark-executables (unflag-p) @@ -3362,7 +3354,7 @@ With prefix argument, unmark or unflag all those files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) - (dired-mark-if (looking-at dired-re-exe) "executable file"))) + (dired-mark-if (looking-at-p dired-re-exe) "executable file"))) ;; dired-x.el has a dired-mark-sexp interactive command: mark ;; files for which PREDICATE returns non-nil. @@ -3386,7 +3378,7 @@ (progn (forward-char -1) (eq (preceding-char) ?#))))) - (not (looking-at dired-re-dir)) + (not (looking-at-p dired-re-dir)) (let ((fn (dired-get-filename t t))) (if fn (auto-save-file-name-p (file-name-nondirectory fn))))) @@ -3424,7 +3416,7 @@ (if (eq (preceding-char) ?*) (forward-char -1)) (eq (preceding-char) ?~)) - (not (looking-at dired-re-dir)) + (not (looking-at-p dired-re-dir)) (let ((fn (dired-get-filename t t))) (if fn (backup-file-name-p fn)))) "backup file"))) @@ -3453,7 +3445,7 @@ (match-end 0) old new))))))) (defun dired-unmark-all-marks () - "Remove all marks from all files in the dired buffer." + "Remove all marks from all files in the Dired buffer." (interactive) (dired-unmark-all-files ?\r)) @@ -3560,12 +3552,12 @@ ;; So anything that does not contain these is sort "by name". (defvar dired-ls-sorting-switches "SXU" - "String of `ls' switches \(single letters\) except \"t\" that influence sorting. + "String of `ls' switches (single letters) except \"t\" that influence sorting. This indicates to Dired which option switches to watch out for because they will change the sorting order behavior of `ls'. -To change the default sorting order \(e.g. add a `-v' option\), see the +To change the default sorting order (e.g. add a `-v' option), see the variable `dired-listing-switches'. To temporarily override the listing format, use `\\[universal-argument] \\[dired]'.") @@ -3584,7 +3576,7 @@ (defvar dired-sort-inhibit nil "Non-nil means the Dired sort command is disabled. -The idea is to set this buffer-locally in special dired buffers.") +The idea is to set this buffer-locally in special Dired buffers.") (defun dired-sort-set-mode-line () ;; Set mode line display according to dired-actual-switches. @@ -3594,10 +3586,10 @@ (when (eq major-mode 'dired-mode) (setq mode-name (let (case-fold-search) - (cond ((string-match + (cond ((string-match-p dired-sort-by-name-regexp dired-actual-switches) "Dired by name") - ((string-match + ((string-match-p dired-sort-by-date-regexp dired-actual-switches) "Dired by date") (t @@ -3612,7 +3604,7 @@ With a prefix argument, edit the current listing switches instead." (interactive "P") (when dired-sort-inhibit - (error "Cannot sort this dired buffer")) + (error "Cannot sort this Dired buffer")) (if arg (dired-sort-other (read-string "ls switches (must contain -l): " dired-actual-switches)) @@ -3620,8 +3612,8 @@ (defun dired-sort-toggle () ;; Toggle between sort by date/name. Reverts the buffer. - (let ((sorting-by-date (string-match dired-sort-by-date-regexp - dired-actual-switches)) + (let ((sorting-by-date (string-match-p dired-sort-by-date-regexp + dired-actual-switches)) ;; Regexp for finding (possibly embedded) -t switches. (switch-regexp "\\(\\`\\| \\)-\\([a-su-zA-Z]*\\)\\(t\\)\\([^ ]*\\)") case-fold-search) @@ -3662,7 +3654,7 @@ (concat result (substring string start)))) (defun dired-sort-other (switches &optional no-revert) - "Specify new `ls' SWITCHES for current dired buffer. + "Specify new `ls' SWITCHES for current Dired buffer. Values matching `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp' set the minor mode accordingly, others appear literally in the mode line. With optional second arg NO-REVERT, don't refresh the listing afterwards." @@ -3671,9 +3663,8 @@ (dired-sort-set-mode-line) (or no-revert (revert-buffer))) -(defvar dired-subdir-alist-pre-R nil +(defvar-local dired-subdir-alist-pre-R nil "Value of `dired-subdir-alist' before -R switch added.") -(make-variable-buffer-local 'dired-subdir-alist-pre-R) (defun dired-sort-R-check (switches) "Additional processing of -R in ls option string SWITCHES. @@ -3681,12 +3672,12 @@ minus any directories explicitly deleted when R is cleared. To be called first in body of `dired-sort-other', etc." (cond - ((and (string-match "R" switches) - (not (string-match "R" dired-actual-switches))) + ((and (string-match-p "R" switches) + (not (string-match-p "R" dired-actual-switches))) ;; Adding -R to ls switches -- save `dired-subdir-alist': (setq dired-subdir-alist-pre-R dired-subdir-alist)) - ((and (string-match "R" dired-actual-switches) - (not (string-match "R" switches))) + ((and (string-match-p "R" dired-actual-switches) + (not (string-match-p "R" switches))) ;; Deleting -R from ls switches -- revert to pre-R subdirs ;; that are still present: (setq dired-subdir-alist @@ -3754,7 +3745,7 @@ (defvar dired-overwrite-confirmed) ;Defined in dired-aux. (defun dired-dnd-handle-local-file (uri action) - "Copy, move or link a file to the dired directory. + "Copy, move or link a file to the Dired directory. URI is the file to handle, ACTION is one of copy, move, link or ask. Ask means pop up a menu for the user to select one of copy, move or link." (require 'dired-aux) @@ -3801,7 +3792,7 @@ action)))))) (defun dired-dnd-handle-file (uri action) - "Copy, move or link a file to the dired directory if it is a local file. + "Copy, move or link a file to the Dired directory if it is a local file. URI is the file to handle. If the hostname in the URI isn't local, do nothing. ACTION is one of copy, move, link or ask. Ask means pop up a menu for the user to select one of copy, move or link." @@ -3835,7 +3826,7 @@ (defun dired-restore-desktop-buffer (_file-name _buffer-name misc-data) - "Restore a dired buffer specified in a desktop file." + "Restore a Dired buffer specified in a desktop file." ;; First element of `misc-data' is the value of `dired-directory'. ;; This value is a directory name, optionally with shell wildcard or ;; a directory name followed by list of files. @@ -4376,17 +4367,16 @@ ;;;*** -;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) -;;;;;; "dired-x" "dired-x.el" "90ba5245f6f5df3bdbda6303c725ef45") +;;;### (autoloads nil "dired-x" "dired-x.el" "4b863621846609105c0371f8ffb8c1cf") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ -Jump to dired buffer corresponding to current buffer. -If in a file, dired the current directory and move to file's line. +Jump to Dired buffer corresponding to current buffer. +If in a file, Dired the current directory and move to file's line. If in Dired already, pop up a level and goto old directory's line. -In case the proper dired file line cannot be found, refresh the dired +In case the proper Dired file line cannot be found, refresh the dired buffer and try again. -When OTHER-WINDOW is non-nil, jump to dired buffer in other window. +When OTHER-WINDOW is non-nil, jump to Dired buffer in other window. Interactively with prefix argument, read FILE-NAME and move to its line in dired. === modified file 'lisp/dos-w32.el' --- lisp/dos-w32.el 2013-02-09 12:52:01 +0000 +++ lisp/dos-w32.el 2013-06-21 12:24:37 +0000 @@ -86,7 +86,7 @@ If the file does not exist default value of `buffer-file-coding-system' Note that the CAR of arguments to `insert-file-contents' operation could -be a cons cell of the form \(FILENAME . BUFFER\), where BUFFER is a buffer +be a cons cell of the form (FILENAME . BUFFER), where BUFFER is a buffer into which the file's contents were already read, but not yet decoded. If operation is `write-region', the coding system is chosen based @@ -203,8 +203,8 @@ ;; with bare drive letters (which would have the cwd appended). ;; Avoid expanding names that could trigger ange-ftp to prompt ;; for passwords, though. - (if (or (string-match "^.:$" name) - (string-match "^/[^/:]+:" name)) + (if (or (string-match-p "^.:$" name) + (string-match-p "^/[^/:]+:" name)) name (expand-file-name name))) filename)) @@ -216,7 +216,7 @@ (ufs-list untranslated-filesystem-list) (found nil)) (while (and (not found) ufs-list) - (if (string-match (concat "^" (car ufs-list)) fs) + (if (string-match-p (concat "^" (car ufs-list)) fs) (setq found t) (setq ufs-list (cdr ufs-list)))) found)) @@ -288,19 +288,19 @@ ;; asking command.com to copy the file. ;; No action is needed for UNC printer names, which is just as well ;; because `expand-file-name' doesn't support UNC names on MS-DOS. - (if (and (stringp printer) (not (string-match "^\\\\" printer))) + (if (and (stringp printer) (not (string-match-p "^\\\\" printer))) (setq printer (subst-char-in-string ?/ ?\\ (expand-file-name printer safe-dir)))) ;; Handle known programs specially where necessary. (unwind-protect (cond ;; nprint.exe is the standard print command on Netware - ((string-match "^nprint\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog)) + ((string-match-p "^nprint\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog)) (write-region start end tempfile nil 0) (call-process lpr-prog nil errbuf nil tempfile (concat "P=" printer))) ;; print.exe is a standard command on NT - ((string-match "^print\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog)) + ((string-match-p "^print\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog)) ;; Be careful not to invoke print.exe on MS-DOS or Windows 9x ;; though, because it is a TSR program there (hangs Emacs). (or (and (eq system-type 'windows-nt) @@ -355,7 +355,7 @@ &rest rest) "DOS/Windows-specific function to print the region on a printer. Writes the region to the device or file which is a value of -`printer-name' \(which see\), unless the value of `lpr-command' +`printer-name' (which see), unless the value of `lpr-command' indicates a specific program should be invoked." ;; DOS printers need the lines to end with CR-LF pairs, so make @@ -405,7 +405,7 @@ &rest rest) "DOS/Windows-specific function to print the region on a PostScript printer. Writes the region to the device or file which is a value of -`ps-printer-name' \(which see\), unless the value of `ps-lpr-command' +`ps-printer-name' (which see), unless the value of `ps-lpr-command' indicates a specific program should be invoked." (let ((printer (or (and (boundp 'dos-ps-printer) ------------------------------------------------------------ revno: 113116 committer: Glenn Morris branch nick: trunk timestamp: Fri 2013-06-21 06:17:38 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/config.in' --- autogen/config.in 2013-06-19 10:17:40 +0000 +++ autogen/config.in 2013-06-21 10:17:38 +0000 @@ -746,6 +746,9 @@ /* Define to 1 if you have the `localtime_r' function. */ #undef HAVE_LOCALTIME_R +/* Define to 1 if you have the `log2' function. */ +#undef HAVE_LOG2 + /* Define to 1 if you support file names longer than 14 characters. */ #undef HAVE_LONG_FILE_NAMES === modified file 'autogen/configure' --- autogen/configure 2013-06-17 10:17:40 +0000 +++ autogen/configure 2013-06-21 10:17:38 +0000 @@ -14314,6 +14314,27 @@ HAVE_LIBXML2=no fi + # Built-in libxml2 on OS X 10.8 lacks libxml-2.0.pc. + if test "${HAVE_LIBXML2}" != "yes" -a "$opsys" = "darwin"; then + SAVE_CPPFLAGS="$CPPFLAGS" + CPPFLAGS="$CPPFLAGS -I/usr/include/libxml2" + ac_fn_c_check_header_mongrel "$LINENO" "libxml/HTMLparser.h" "ac_cv_header_libxml_HTMLparser_h" "$ac_includes_default" +if test "x$ac_cv_header_libxml_HTMLparser_h" = x""yes; then : + ac_fn_c_check_decl "$LINENO" "HTML_PARSE_RECOVER" "ac_cv_have_decl_HTML_PARSE_RECOVER" "#include +" +if test "x$ac_cv_have_decl_HTML_PARSE_RECOVER" = x""yes; then : + HAVE_LIBXML2=yes +fi + +fi + + + CPPFLAGS="$SAVE_CPPFLAGS" + if test "${HAVE_LIBXML2}" = "yes"; then + LIBXML2_LIBS="-lxml2" + LIBXML2_CFLAGS="-I/usr/include/libxml2" + fi + fi if test "${HAVE_LIBXML2}" = "yes"; then if test "${opsys}" != "mingw32"; then LIBS="$LIBXML2_LIBS $LIBS" @@ -14679,7 +14700,7 @@ difftime posix_memalign \ getpwent endpwent getgrent endgrent \ touchlock \ -cfmakeraw cfsetspeed copysign __executable_start +cfmakeraw cfsetspeed copysign __executable_start log2 do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" ------------------------------------------------------------ revno: 113115 committer: Leo Liu branch nick: trunk timestamp: Fri 2013-06-21 17:37:04 +0800 message: * comint.el (comint-redirect-results-list-from-process): Fix infinite loop. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 07:52:47 +0000 +++ lisp/ChangeLog 2013-06-21 09:37:04 +0000 @@ -1,3 +1,8 @@ +2013-06-21 Leo Liu + + * comint.el (comint-redirect-results-list-from-process): Fix + infinite loop. + 2013-06-21 Lars Magne Ingebrigtsen * net/eww.el (eww-update-header-line-format): Quote % characters. === modified file 'lisp/comint.el' --- lisp/comint.el 2013-06-21 01:21:15 +0000 +++ lisp/comint.el 2013-06-21 09:37:04 +0000 @@ -3733,12 +3733,13 @@ ;; Skip past the command, if it was echoed (and (looking-at command) (forward-line)) - (while (re-search-forward regexp nil t) + (while (and (not (eobp)) + (re-search-forward regexp nil t)) (push (buffer-substring-no-properties (match-beginning regexp-group) (match-end regexp-group)) results)) - results))) + (nreverse results)))) ;; Converting process modes to use comint mode ;; =========================================================================== ------------------------------------------------------------ revno: 113114 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2013-06-21 07:52:47 +0000 message: lisp/net/eww.el (eww-update-header-line-format): Quote % characters diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 07:38:46 +0000 +++ lisp/ChangeLog 2013-06-21 07:52:47 +0000 @@ -1,3 +1,7 @@ +2013-06-21 Lars Magne Ingebrigtsen + + * net/eww.el (eww-update-header-line-format): Quote % characters. + 2013-06-21 Glenn Morris * play/cookie1.el (cookie): New custom group. === modified file 'lisp/net/eww.el' --- lisp/net/eww.el 2013-06-19 22:28:04 +0000 +++ lisp/net/eww.el 2013-06-21 07:52:47 +0000 @@ -230,9 +230,12 @@ (defun eww-update-header-line-format () (if eww-header-line-format - (setq header-line-format (format-spec eww-header-line-format - `((?u . ,eww-current-url) - (?t . ,eww-current-title)))) + (setq header-line-format + (replace-regexp-in-string + "%" "%%" + (format-spec eww-header-line-format + `((?u . ,eww-current-url) + (?t . ,eww-current-title))))) (setq header-line-format nil))) (defun eww-tag-title (cont) ------------------------------------------------------------ revno: 113113 committer: Glenn Morris branch nick: trunk timestamp: Fri 2013-06-21 00:38:46 -0700 message: ChangeLog fix for previous change diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 07:35:33 +0000 +++ lisp/ChangeLog 2013-06-21 07:38:46 +0000 @@ -11,6 +11,7 @@ (cookie-read): Rename from read-cookie. Make start and end messages optional. Default to cookie-file. (cookie-shuffle-vector): Rename from shuffle-vector. Use dotimes. + Do not autoload it. (cookie-apropos, cookie-doctor): New functions, copied from yow.el * obsolete/yow.el (read-zippyism): Use new name for read-cookie. ------------------------------------------------------------ revno: 113112 committer: Glenn Morris branch nick: trunk timestamp: Fri 2013-06-21 00:35:33 -0700 message: cookie1.el small cleanup Make some funcs interactive, copy some functionality from yow.el. * lisp/play/cookie1.el (cookie): New custom group. (cookie-file): New option. (cookie-check-file): New function. (cookie): Make it interactive. Make start and end messages optional. Interactively, display the result. Default to cookie-file. (cookie-insert): Default to cookie-file. (cookie-snarf): Make start and end messages optional. Default to cookie-file. Use with-temp-buffer. (cookie-read): Rename from read-cookie. Make start and end messages optional. Default to cookie-file. (cookie-shuffle-vector): Rename from shuffle-vector. Use dotimes. (cookie-apropos, cookie-doctor): New functions, copied from yow.el * lisp/obsolete/yow.el (read-zippyism): Use new name for read-cookie. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 06:45:37 +0000 +++ lisp/ChangeLog 2013-06-21 07:35:33 +0000 @@ -1,3 +1,19 @@ +2013-06-21 Glenn Morris + + * play/cookie1.el (cookie): New custom group. + (cookie-file): New option. + (cookie-check-file): New function. + (cookie): Make it interactive. Make start and end messages optional. + Interactively, display the result. Default to cookie-file. + (cookie-insert): Default to cookie-file. + (cookie-snarf): Make start and end messages optional. + Default to cookie-file. Use with-temp-buffer. + (cookie-read): Rename from read-cookie. + Make start and end messages optional. Default to cookie-file. + (cookie-shuffle-vector): Rename from shuffle-vector. Use dotimes. + (cookie-apropos, cookie-doctor): New functions, copied from yow.el + * obsolete/yow.el (read-zippyism): Use new name for read-cookie. + 2013-06-21 Leo Liu * progmodes/octave.el (octave-mode): Backward compatibility fix. === modified file 'lisp/obsolete/yow.el' --- lisp/obsolete/yow.el 2013-02-13 08:50:44 +0000 +++ lisp/obsolete/yow.el 2013-06-21 07:35:33 +0000 @@ -60,7 +60,7 @@ (defsubst read-zippyism (prompt &optional require-match) "Read a Zippyism from the minibuffer with completion, prompting with PROMPT. If optional second arg is non-nil, require input to match a completion." - (read-cookie prompt yow-file yow-load-message yow-after-load-message + (cookie-read prompt yow-file yow-load-message yow-after-load-message require-match)) ;;;###autoload === modified file 'lisp/play/cookie1.el' --- lisp/play/cookie1.el 2013-01-01 09:11:05 +0000 +++ lisp/play/cookie1.el 2013-06-21 07:35:33 +0000 @@ -25,11 +25,10 @@ ;;; Commentary: ;; Support for random cookie fetches from phrase files, used for such -;; critical applications as emulating Zippy the Pinhead and confounding -;; the NSA Trunk Trawler. +;; critical applications as confounding the NSA Trunk Trawler. ;; ;; The two entry points are `cookie' and `cookie-insert'. The helper -;; function `shuffle-vector' may be of interest to programmers. +;; function `cookie-shuffle-vector' may be of interest to programmers. ;; ;; The code expects phrase files to be in one of two formats: ;; @@ -49,32 +48,62 @@ ;; This code derives from Steve Strassmann's 1987 spook.el package, but ;; has been generalized so that it supports multiple simultaneous ;; cookie databases and fortune files. It is intended to be called -;; from other packages such as yow.el and spook.el. +;; from other packages such as spook.el. ;;; Code: +(defgroup cookie nil + "Random cookies from phrase files." + :prefix "cookie-" + :group 'games) + +(defcustom cookie-file nil + "Default phrase file for cookie functions." + :type '(choice (const nil) file) + :group 'cookie + :version "24.4") + (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" "Delimiter used to separate cookie file entries.") (defvar cookie-cache (make-vector 511 0) "Cache of cookie files that have already been snarfed.") +(defun cookie-check-file (file) + "Return either FILE or `cookie-file'. +Signal an error if the result is nil or not readable." + (or (setq file (or file cookie-file)) (user-error "No phrase file specified")) + (or (file-readable-p file) (user-error "Cannot read file `%s'" file)) + file) + ;;;###autoload -(defun cookie (phrase-file startmsg endmsg) +(defun cookie (phrase-file &optional startmsg endmsg) "Return a random phrase from PHRASE-FILE. When the phrase file is read in, display STARTMSG at the beginning -of load, ENDMSG at the end." - (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) - (shuffle-vector cookie-vector) - (aref cookie-vector 0))) +of load, ENDMSG at the end. +Interactively, PHRASE-FILE defaults to `cookie-file', unless that +is nil or a prefix argument is used." + (interactive (list (if (or current-prefix-arg (not cookie-file)) + (read-file-name "Cookie file: " nil + cookie-file t cookie-file) + cookie-file) nil nil)) + (setq phrase-file (cookie-check-file phrase-file)) + (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)) + res) + (cookie-shuffle-vector cookie-vector) + (setq res (aref cookie-vector 0)) + (if (called-interactively-p 'interactive) + (message "%s" res) + res))) ;;;###autoload (defun cookie-insert (phrase-file &optional count startmsg endmsg) "Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file is read in, display STARTMSG at the beginning of load, ENDMSG at the end." + (setq phrase-file (cookie-check-file phrase-file)) (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg))) - (shuffle-vector cookie-vector) + (cookie-shuffle-vector cookie-vector) (let ((start (point))) (insert ?\n) (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector) @@ -89,12 +118,11 @@ (cookie1 (1- arg) cookie-vec)))) ;;;###autoload -(defun cookie-snarf (phrase-file startmsg endmsg) +(defun cookie-snarf (phrase-file &optional startmsg endmsg) "Reads in the PHRASE-FILE, returns it as a vector of strings. Emit STARTMSG and ENDMSG before and after. Caches the result; second and subsequent calls on the same file won't go to disk." - (or (file-readable-p phrase-file) - (error "Cannot read file `%s'" phrase-file)) + (setq phrase-file (cookie-check-file phrase-file)) (let ((sym (intern-soft phrase-file cookie-cache))) (and sym (not (equal (symbol-function sym) (nth 5 (file-attributes phrase-file)))) @@ -104,27 +132,25 @@ (if sym (symbol-value sym) (setq sym (intern phrase-file cookie-cache)) - (message "%s" startmsg) - (save-excursion - (let ((buf (generate-new-buffer "*cookie*")) - (result nil)) - (set-buffer buf) - (fset sym (nth 5 (file-attributes phrase-file))) + (if startmsg (message "%s" startmsg)) + (fset sym (nth 5 (file-attributes phrase-file))) + (let (result) + (with-temp-buffer (insert-file-contents (expand-file-name phrase-file)) (re-search-forward cookie-delimiter) (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) (let ((beg (point))) (re-search-forward cookie-delimiter) (setq result (cons (buffer-substring beg (match-beginning 0)) - result)))) - (kill-buffer buf) - (message "%s" endmsg) - (set sym (apply 'vector result))))))) + result))))) + (if endmsg (message "%s" endmsg)) + (set sym (apply 'vector result)))))) -(defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match) +(defun cookie-read (prompt phrase-file &optional startmsg endmsg require-match) "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE. STARTMSG and ENDMSG are passed along to `cookie-snarf'. -Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie." +Argument REQUIRE-MATCH non-nil forces a matching cookie." + (setq phrase-file (cookie-check-file phrase-file)) ;; Make sure the cookies are in the cache. (or (intern-soft phrase-file cookie-cache) (cookie-snarf phrase-file startmsg endmsg)) @@ -141,24 +167,85 @@ (put sym 'completion-alist alist)))) nil require-match nil nil)) -; Thanks to Ian G Batten -; [of the University of Birmingham Computer Science Department] -; for the iterative version of this shuffle. -; -;;;###autoload -(defun shuffle-vector (vector) +(define-obsolete-function-alias 'read-cookie 'cookie-read "24.4") + +;; Thanks to Ian G Batten +;; [of the University of Birmingham Computer Science Department] +;; for the iterative version of this shuffle. +(defun cookie-shuffle-vector (vector) "Randomly permute the elements of VECTOR (all permutations equally likely)." - (let ((i 0) - j - temp - (len (length vector))) - (while (< i len) - (setq j (+ i (random (- len i)))) - (setq temp (aref vector i)) + (let ((len (length vector)) + j temp) + (dotimes (i len vector) + (setq j (+ i (random (- len i))) + temp (aref vector i)) (aset vector i (aref vector j)) - (aset vector j temp) - (setq i (1+ i)))) - vector) + (aset vector j temp)))) + +(define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4") + + +(defun cookie-apropos (regexp phrase-file) + "Return a list of all entries matching REGEXP from PHRASE-FILE. +Interactively, PHRASE-FILE defaults to `cookie-file', unless that +is nil or a prefix argument is used. +If called interactively, display a list of matches." + (interactive (list (read-regexp "Apropos phrase (regexp): ") + (if (or current-prefix-arg (not cookie-file)) + (read-file-name "Cookie file: " nil + cookie-file t cookie-file) + cookie-file))) + (setq phrase-file (cookie-check-file phrase-file)) + ;; Make sure phrases are loaded. + (cookie phrase-file) + (let* ((case-fold-search t) + (cookie-table-symbol (intern phrase-file cookie-cache)) + (string-table (symbol-value cookie-table-symbol)) + (matches nil) + (len (length string-table)) + (i 0)) + (save-match-data + (while (< i len) + (and (string-match regexp (aref string-table i)) + (setq matches (cons (aref string-table i) matches))) + (setq i (1+ i)))) + (and matches + (setq matches (sort matches 'string-lessp))) + (and (called-interactively-p 'interactive) + (cond ((null matches) + (message "No matches found.")) + (t + (let ((l matches)) + (with-output-to-temp-buffer "*Cookie Apropos*" + (while l + (princ (car l)) + (setq l (cdr l)) + (and l (princ "\n\n"))) + (help-print-return-message)))))) + matches)) + + +(declare-function doctor-ret-or-read "doctor" (arg)) + +(defun cookie-doctor (phrase-file) + "Feed cookie phrases from PHRASE-FILE to the doctor. +Interactively, PHRASE-FILE defaults to `cookie-file', unless that +is nil or a prefix argument is used." + (interactive (list (if (or current-prefix-arg (not cookie-file)) + (read-file-name "Cookie file: " nil + cookie-file t cookie-file) + cookie-file))) + (setq phrase-file (cookie-check-file phrase-file)) + (doctor) ; start the psychotherapy + (message "") + (switch-to-buffer "*doctor*") + (sit-for 0) + (while (not (input-pending-p)) + (insert (cookie phrase-file)) + (sit-for 0) + (doctor-ret-or-read 1) + (doctor-ret-or-read 1))) + (provide 'cookie1) ------------------------------------------------------------ revno: 113111 committer: Leo Liu branch nick: trunk timestamp: Fri 2013-06-21 14:45:37 +0800 message: * progmodes/octave.el (octave-mode): Backward compatibility fix. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-21 06:37:44 +0000 +++ lisp/ChangeLog 2013-06-21 06:45:37 +0000 @@ -1,3 +1,7 @@ +2013-06-21 Leo Liu + + * progmodes/octave.el (octave-mode): Backward compatibility fix. + 2013-06-21 Glenn Morris * font-lock.el (lisp-font-lock-keywords-2): Add with-eval-after-load. === modified file 'lisp/progmodes/octave.el' --- lisp/progmodes/octave.el 2013-06-19 02:02:30 +0000 +++ lisp/progmodes/octave.el 2013-06-21 06:45:37 +0000 @@ -554,8 +554,13 @@ (setq-local fill-nobreak-predicate (lambda () (eq (octave-in-string-p) ?'))) - (add-function :around (local 'comment-line-break-function) - #'octave--indent-new-comment-line) + (with-no-warnings + (if (fboundp 'add-function) ; new in 24.4 + (add-function :around (local 'comment-line-break-function) + #'octave--indent-new-comment-line) + (setq-local comment-line-break-function + (apply-partially #'octave--indent-new-comment-line + #'comment-indent-new-line)))) (setq font-lock-defaults '(octave-font-lock-keywords)) @@ -1151,8 +1156,6 @@ ;;; Indentation (defun octave-indent-new-comment-line (&optional soft) - ;; FIXME: C-M-j should probably be bound globally to a function like - ;; this one. "Break Octave line at point, continuing comment if within one. Insert `octave-continuation-string' before breaking the line unless inside a list. Signal an error if within a single-quoted ------------------------------------------------------------ Use --include-merged or -n0 to see merged revisions.