emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/org/org-agenda.el,v


From: Carsten Dominik
Subject: [Emacs-diffs] Changes to emacs/lisp/org/org-agenda.el,v
Date: Sat, 25 Oct 2008 21:32:51 +0000

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Carsten Dominik <cdominik>      08/10/25 21:32:50

Index: lisp/org/org-agenda.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/org/org-agenda.el,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -b -r1.9 -r1.10
--- lisp/org/org-agenda.el      12 Oct 2008 06:12:44 -0000      1.9
+++ lisp/org/org-agenda.el      25 Oct 2008 21:32:47 -0000      1.10
@@ -6,7 +6,7 @@
 ;; Author: Carsten Dominik <carsten at orgmode dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 6.09a
+;; Version: 6.10c
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -32,6 +32,7 @@
 
 (require 'org)
 (eval-when-compile
+  (require 'cl)
   (require 'calendar))
 
 (declare-function diary-add-to-list "diary-lib"
@@ -386,6 +387,14 @@
          (repeat :tag "Projects are *not* stuck if they have an entry with TAG 
being any of" (string))
          (regexp :tag "Projects are *not* stuck if this regexp matches\ninside 
the subtree")))
 
+(defcustom org-agenda-filter-effort-default-operator "<"
+  "The default operator for effort estimate filtering.
+If you select an effort estimate limit with first pressing an operator,
+this one will be used."
+  :group 'org-agenda-custom-commands
+  :type '(choice (const :tag "less or equal" "<")
+                (const :tag "greater or equal"">")
+                (const :tag "equal" "=")))
 
 (defgroup org-agenda-skip nil
  "Options concerning skipping parts of agenda files."
@@ -1092,6 +1101,7 @@
 (org-defkey org-agenda-mode-map "t"        'org-agenda-todo)
 (org-defkey org-agenda-mode-map "a"        'org-agenda-toggle-archive-tag)
 (org-defkey org-agenda-mode-map ":"        'org-agenda-set-tags)
+(org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags)
 (org-defkey org-agenda-mode-map "."        'org-agenda-goto-today)
 (org-defkey org-agenda-mode-map "j"        'org-agenda-goto-date)
 (org-defkey org-agenda-mode-map "d"        'org-agenda-day-view)
@@ -1167,6 +1177,7 @@
 (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
 (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
 (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
+(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
 
 (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
   "Local keymap for agenda entries from Org-mode.")
@@ -1953,9 +1964,11 @@
 (defvar org-pre-agenda-window-conf nil)
 (defvar org-agenda-columns-active nil)
 (defvar org-agenda-name nil)
+(defvar org-agenda-filter nil)
 (defun org-prepare-agenda (&optional name)
   (setq org-todo-keywords-for-agenda nil)
   (setq org-done-keywords-for-agenda nil)
+  (setq org-agenda-filter nil)
   (if org-agenda-multi
       (progn
        (setq buffer-read-only nil)
@@ -3737,7 +3750,7 @@
 
       ;; And finally add the text properties
       (org-add-props rtn nil
-       'org-category (downcase category) 'tags tags
+       'org-category (downcase category) 'tags (mapcar 'downcase tags)
        'org-highest-priority org-highest-priority
        'org-lowest-priority org-lowest-priority
        'prefix-length (- (length rtn) (length txt))
@@ -3934,7 +3947,7 @@
          (t nil))))
 
 (defsubst org-cmp-tag (a b)
-  "Compare the string values of categories of strings A and B."
+  "Compare the string values of the first tags of A and B."
   (let ((ta (car (last (get-text-property 1 'tags a))))
        (tb (car (last (get-text-property 1 'tags b)))))
     (cond ((not ta) +1)
@@ -4101,6 +4114,7 @@
 When this is the global TODO list, a prefix argument will be interpreted."
   (interactive)
   (let* ((org-agenda-keep-modes t)
+        (filter org-agenda-filter)
         (cols org-agenda-columns-active)
         (line (org-current-line))
         (window-line (- line (org-current-line (window-start))))
@@ -4111,24 +4125,63 @@
     (setq org-agenda-undo-list nil
          org-agenda-pending-undo-list nil)
     (message "Rebuilding agenda buffer...done")
+    (and filter (org-agenda-filter-apply filter))
     (and cols (interactive-p) (org-agenda-columns))
     (goto-line line)
     (recenter window-line)))
 
+
 (defvar org-global-tags-completion-table nil)
-(defun org-agenda-filter-by-tag (strip &optional char)
+(defvar org-agenda-filter-form nil)
+(defun org-agenda-filter-by-tag (strip &optional char narrow)
   "Keep only those lines in the agenda buffer that have a specific tag.
 The tag is selected with its fast selection letter, as configured.
-With prefix argument STRIP, remove all lines that do have the tag."
+With prefix argument STRIP, remove all lines that do have the tag.
+A lisp caller can specify CHAR.  NARROW means that the new tag should be
+used to narrow the search - the interactive user can also press `-' or `+'
+to switch to narrowing."
   (interactive "P")
-  (let (char a tag tags (inhibit-read-only t))
-      (message "Select tag [%s] or no tag [ ], [TAB] to complete, [/] to 
restore: "
-              (mapconcat
+  (let* ((alist org-tag-alist-for-agenda)
+       (tag-chars (mapconcat 
                (lambda (x) (if (cdr x) (char-to-string (cdr x)) ""))
-               org-tag-alist-for-agenda ""))
+                   alist ""))
+       (efforts (org-split-string
+                 (or (cdr (assoc (concat org-effort-property "_ALL")
+                                 org-global-properties))
+                     "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00"     
              "")))
+       (effort-op org-agenda-filter-effort-default-operator)
+       (effort-prompt "")
+       (inhibit-read-only t)
+       (current org-agenda-filter)
+       char a n tag tags)
+    (unless char
+      (message 
+       "%s by tag [%s ], [TAB], [/]:off, [+-]:narrow, [>=<]:effort: "
+       (if narrow "Narrow" "Filter") tag-chars)
+      (setq char (read-char)))
+    (when (member char '(?+ ?-))
+      ;; Narrowing down
+      (cond ((equal char ?-) (setq strip t narrow t))
+           ((equal char ?+) (setq strip nil narrow t)))
+      (message 
+       "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
+      (setq char (read-char)))
+    (when (member char '(?< ?> ?=))
+      ;; An effort operator
+      (setq effort-op (char-to-string char))
+      (loop for i from 0 to 9 do
+           (setq effort-prompt
+                 (concat
+                  effort-prompt " ["
+                  (if (= i 9) "0" (int-to-string (1+ i)))
+                  "]" (nth i efforts))))
+      (setq alist nil) ; to make sure it will be interpreted as effort.
+      (message "Effort%s: %s " effort-op effort-prompt)
       (setq char (read-char))
+      (when (or (< char ?0) (> char ?9))
+       (error "Need 1-9,0 to select effort" )))
       (when (equal char ?\t)
-       (unless (local-variable-p 'org-global-tags-completion-table)
+      (unless (local-variable-p 'org-global-tags-completion-table 
(current-buffer))
          (org-set-local 'org-global-tags-completion-table
                         (org-global-tags-completion-table)))
        (let ((completion-ignore-case t))
@@ -4137,26 +4190,73 @@
       (cond
        ((equal char ?/) (org-agenda-filter-by-tag-show-all))
        ((or (equal char ?\ )
-           (setq a (rassoc char org-tag-alist-for-agenda))
+         (setq a (rassoc char alist))
+         (and (>= char ?0) (<= char ?9)
+              (setq n (if (= char ?0) 9 (- char ?0 1))
+                    tag (concat effort-op (nth n efforts))
+                    a (cons tag nil)))
            (and tag (setq a (cons tag nil))))
        (org-agenda-filter-by-tag-show-all)
        (setq tag (car a))
+      (setq org-agenda-filter
+           (cons (concat (if strip "-" "+") tag)
+                 (if narrow current nil)))
+      (org-agenda-filter-apply org-agenda-filter))
+     (t (error "Invalid tag selection character %c" char)))))
+
+(defun org-agenda-filter-by-tag-refine (strip &optional char)
+  "Refine the current filter.  See `org-agenda-filter-by-tag."
+  (interactive "P")
+  (org-agenda-filter-by-tag strip char 'refine))
+
+(defun org-agenda-filter-make-matcher ()
+  "Create the form that tests a line for the agenda filter."
+  (let (f f1)
+    (dolist (x org-agenda-filter)
+      (if (member x '("-" "+"))
+         (setq f1 '(not tags))
+       (if (string-match "[<=>]" x)
+           (setq f1 (org-agenda-filter-effort-form x))
+         (setq f1 (list 'member (downcase (substring x 1)) 'tags)))
+       (if (equal (string-to-char x) ?-)
+           (setq f1 (list 'not f1))))
+      (push f1 f))
+    (cons 'and (nreverse f))))
+
+(defun org-agenda-filter-effort-form (e)
+  "Return the form to compare the effort of the current line with what E says.
+E looks line \"+<2:25\"."
+  (let (op)
+    (setq e (substring e 1))
+    (setq op (string-to-char e) e (substring e 1))
+    (setq op (if (equal op ?<) '<= (if (equal op ?>) '>= '=)))
+    (list 'org-agenda-compare-effort (list 'quote op)
+         (org-hh:mm-string-to-minutes e))))
+
+(defun org-agenda-compare-effort (op value)
+  "Compare the effort of the current line with VALUE, using OP.
+If the line does not have an effort defined, return nil."
+  (let ((eff (get-text-property (point) 'effort-minutes)))
+    (if (not eff)
+       nil ; we don't have an effort defined
+      (funcall op eff value))))
+
+(defun org-agenda-filter-apply (filter)
+  "Set FILTER as the new agenda filter and apply it."
+  (let (tags)
+    (setq org-agenda-filter filter
+         org-agenda-filter-form (org-agenda-filter-make-matcher))
+    (org-agenda-set-mode-name)
        (save-excursion
          (goto-char (point-min))
          (while (not (eobp))
            (if (get-text-property (point) 'org-marker)
                (progn
                  (setq tags (get-text-property (point) 'tags))
-                 (if (not tag)
-                     (if (or (and strip (not tags))
-                             (and (not strip) tags))
+             (if (not (eval org-agenda-filter-form))
                          (org-agenda-filter-by-tag-hide-line))
-                   (if (or (and (member tag tags) strip)
-                           (and (not (member tag tags)) (not strip)))
-                       (org-agenda-filter-by-tag-hide-line)))
                  (beginning-of-line 2))
-             (beginning-of-line 2)))))
-       (t (error "Invalid tag selection character %c" char)))))
+         (beginning-of-line 2))))))
 
 (defvar org-agenda-filter-overlays nil)
 
@@ -4168,9 +4268,23 @@
     (org-overlay-put ov 'type 'tags-filter)
     (push ov org-agenda-filter-overlays)))
 
+(defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
+  (setq pos (or pos (point)))
+  (save-excursion
+    (dolist (ov (org-overlays-at pos))
+      (when (and (org-overlay-get ov 'invisible)
+                (eq (org-overlay-get ov 'type) 'tags-filter))
+       (goto-char pos)
+       (if (< (org-overlay-start ov) (point-at-eol))
+           (org-move-overlay ov (point-at-eol)
+                             (org-overlay-end ov)))))))
+
 (defun org-agenda-filter-by-tag-show-all ()
   (mapc 'org-delete-overlay org-agenda-filter-overlays)
-  (setq org-agenda-filter-overlays nil))
+  (setq org-agenda-filter-overlays nil)
+  (setq org-agenda-filter nil)
+  (setq org-agenda-filter-form nil)
+  (org-agenda-set-mode-name))
 
 (defun org-agenda-manipulate-query-add ()
   "Manipulate the query by adding a search term with positive selection.
@@ -4509,6 +4623,9 @@
                (if org-agenda-include-diary   " Diary"  "")
                (if org-agenda-use-time-grid   " Grid"   "")
                (if org-agenda-show-log        " Log"    "")
+               (if org-agenda-filter
+                   (concat " {" (mapconcat 'identity org-agenda-filter "") "}")
+                 "")
                (if org-agenda-archives-mode
                    (if (eq org-agenda-archives-mode t)
                        " Archives"
@@ -5002,13 +5119,15 @@
 (defun org-agenda-show-new-time (marker stamp &optional prefix)
   "Show new date stamp via text properties."
   ;; We use text properties to make this undoable
-  (let ((inhibit-read-only t))
+  (let ((inhibit-read-only t)
+       (buffer-invisibility-spec))
     (setq stamp (concat " " prefix " => " stamp))
     (save-excursion
       (goto-char (point-max))
       (while (not (bobp))
        (when (equal marker (get-text-property (point) 'org-marker))
          (org-move-to-column (- (window-width) (length stamp)) t)
+         (org-agenda-fix-tags-filter-overlays-at (point))
           (if (featurep 'xemacs)
              ;; Use `duplicable' property to trigger undo recording
               (let ((ex (make-extent nil nil))




reply via email to

[Prev in Thread] Current Thread [Next in Thread]