diff options
Diffstat (limited to 'lisp/calendar')
| -rw-r--r-- | lisp/calendar/ChangeLog | 12 | ||||
| -rw-r--r-- | lisp/calendar/diary-lib.el | 9 | ||||
| -rw-r--r-- | lisp/calendar/todos.el | 81 |
3 files changed, 59 insertions, 43 deletions
diff --git a/lisp/calendar/ChangeLog b/lisp/calendar/ChangeLog index a0c527faa12..fa62f8bdac4 100644 --- a/lisp/calendar/ChangeLog +++ b/lisp/calendar/ChangeLog @@ -1,3 +1,15 @@ +2013-06-18 Stephen Berman <stephen.berman@gmx.net> + + * todos.el (todos-diary-goto-entry): Add item locating code from + diary-goto-entry. Add it at the top-level to override the latter + function. + (todos-powerset): Use definition by Wolfgang Jenkner, posted at + http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00423.html. + + * 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. + 2013-06-09 Stephen Berman <stephen.berman@gmx.net> * todos.el (todos-edit-done-item-comment): Rename from diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 7be44b4083e..7bdb3cd49f6 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1032,7 +1032,14 @@ in the mode line. This is an option for `diary-display-function'." (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) diff --git a/lisp/calendar/todos.el b/lisp/calendar/todos.el index 5b2c465457b..6964494a4d8 100644 --- a/lisp/calendar/todos.el +++ b/lisp/calendar/todos.el @@ -5005,16 +5005,39 @@ empty line above the done items separator." (todos-item-start) (not (looking-at (regexp-quote todos-nondiary-start)))))) -(defun todos-diary-goto-entry () - "Jump to todo item included in Fancy Diary display. -Helper function for `diary-goto-entry'." - (when (eq major-mode 'todos-mode) - (let ((opoint (point))) - (re-search-backward (concat "^" (regexp-quote todos-category-beg) - "\\(.*\\)\n") nil t) - (todos-category-number (match-string 1)) - (todos-category-select) - (goto-char opoint)))) +;; 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 todos-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 'todos-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 'todos-mode) + (let ((opoint (point))) + (re-search-backward (concat "^" (regexp-quote todos-category-beg) + "\\(.*\\)\n") nil t) + (todos-category-number (match-string 1)) + (todos-category-select) + (goto-char opoint)))))) + +(add-function :override diary-goto-entry-function #'todos-diary-goto-entry) (defun todos-done-item-p () "Return non-nil if item at point is a done item." @@ -5146,41 +5169,15 @@ of each other." ;;; Utilities for generating item insertion commands and key bindings ;; ----------------------------------------------------------------------------- -;; These two powerset definitions are adaptations of code published at -;; http://rosettacode.org, whose content is licensed under GFDL 1.2. -;; The recursive definition is a slight reformulation of -;; http://rosettacode.org/wiki/Power_set#Common_Lisp. The iterative -;; definition is my Elisp implementation of -;; http://rosettacode.org/wiki/Power_set#C. Can either of these be -;; included in Emacs, or is there no need to concerned about copyright -;; here? - -;; (defun todos-powerset (list) -;; "Return the powerset of LIST." -;; (cond ((null list) -;; (list nil)) -;; (t -;; (let ((recur (todos-powerset-recursive (cdr list))) -;; pset) -;; (dolist (elt recur pset) -;; (push (cons (car list) elt) pset)) -;; (append pset recur))))) +;; 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 todos-powerset (list) "Return the powerset of LIST." - (let ((card (expt 2 (length list))) - pset elt) - (dotimes (n card) - (let ((i n) - (l list)) - (while (not (zerop i)) - (let ((arg (pop l))) - (when (cl-oddp i) - (setq elt (append elt (list arg)))) - (setq i (/ i 2)))) - (setq pset (append pset (list elt))) - (setq elt nil))) - pset)) + (let ((powerset (list nil))) + (dolist (elt list (mapcar 'reverse powerset)) + (nconc powerset (mapcar (apply-partially 'cons elt) powerset))))) (defun todos-gen-arglists (arglist) "Return list of lists of non-nil atoms produced from ARGLIST. |