diff lisp/org/org-agenda.el @ 99139:8fa7ef477c04

2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org-agenda.el (org-format-agenda-item) (org-agenda-filter-make-matcher): Make sure tags are stored and compared donwcased. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org.el (org-insert-todo-heading): Fix bug with force-heading argument. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org-exp.el (org-export-as-ascii): Handle the case that we are bulishing from an indirect buffer. * org-table.el (org-table-copy-down): Fix bug with time stamp increment. * org-mouse.el (org-mouse-features): New option. (org-mode-hook): Turn on features depending on `org-mouse-features'. * org.el (org-insert-heading-respect-content): Force heading creation. (org-insert-heading): keep the folding state of the heading before the inserted one. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org-archive.el (org-archive-to-archive-sibling): Handle top level headlines better. 2008-10-26 Bastien Guerry <bzg@altern.org> * org-export-latex.el (org-export-latex-classes): Added \usepackage{graphicx} to the default list of packages. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org-agenda.el (org-agenda-filter): Renamed from `org-agenda-filter-tags'. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org.el (org-entry-properties): Add CATEGORY property, iven if it is not defined as a property in this entry. (org-add-log-note): Mask prefix argument when immediately storing the note. * org-agenda.el (org-agenda-filter-effort-default-operator): New option. 2008-10-26 James TD Smith <ahktenzero@mohorovi.cc> * org.el (org-add-log-setup): Bugfix; code to find insertion point after drawers was skipping ahead one line too many, so notes were inserted after the first note instead of before it. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org-agenda.el (org-agenda-filter-tags,org-agenda-filter-form): New variables. (org-prepare-agenda): Reset the filter tags. (org-agenda-filter-by-tag, org-agenda-filter-by-tag-show-all): Show filter tags in mode line. * org-table.el (orgtbl-to-html): Bind `html-table-tag' for the formatter. * org-export-latex.el (org-latex-entities-regexp): New constant. (org-export-as-pdf): Use two calls to `shell-command'. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org-export-latex.el (org-export-latex-treat-sub-super-char): Honor the {} value of the subsuperscript setting. Make sure that longer subsuperscripts are typeset in a roman font. * org.el (org-clock-update-time-maybe): Compute negative clock intervals correctly. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org.el (org-add-log-setup): Respect `org-log-state-notes-insert-after-drawers'. (org-log-state-notes-insert-after-drawers): New option. (org-todo-trigger-tag-changes): New function. (org-todo): Call `org-todo-trigger-tag-changes'. 2008-10-26 James TD Smith <ahktenzero@mohorovi.cc> * org.el (org-add-log-setup): Only skip drawers if the are immediately after the scheduling keywords. * org-clock.el (org-clock-in-switch-to-state): Allow this to be a function (org-clock-in): If `org-clock-in-switch-to-state' is a function, call it with the current todo state to get the state to switch to when clocking in. (org-clock-in): Use org-indent-line-function to indent clock lines. (org-clock-find-position): Fix indentation of empty clock drawers. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org-publish.el (org-publish-org-to): Handle case when org-export-to-pdf does return a file name, not a buffer. (org-publish-org-to-pdf): New function. * org-export-latex.el (org-export-as-pdf) (org-export-as-pdf-and-open): New commands. * org-table.el (org-table-eval-formula): Avoid parsing Calc's HMS forms as ranges. * org-export-latex.el (org-export-latex-lists): Ignore lists-like things in protexted regions. 2008-10-26 Carsten Dominik <dominik@science.uva.nl> * org-export-latex.el (org-export-latex-preprocess): Improve quoting of LaTeX environments.
author Carsten Dominik <dominik@science.uva.nl>
date Sat, 25 Oct 2008 21:32:46 +0000
parents e1cc41b9282d
children ff3f463a949c
line wrap: on
line diff
--- a/lisp/org/org-agenda.el	Sat Oct 25 20:59:38 2008 +0000
+++ b/lisp/org/org-agenda.el	Sat Oct 25 21:32:46 2008 +0000
@@ -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,52 +4125,138 @@
     (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
-		(lambda (x) (if (cdr x) (char-to-string (cdr x)) ""))
-		org-tag-alist-for-agenda ""))
+  (let* ((alist org-tag-alist-for-agenda)
+	(tag-chars (mapconcat 
+		    (lambda (x) (if (cdr x) (char-to-string (cdr x)) ""))
+		    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 (equal char ?\t)
-	(unless (local-variable-p 'org-global-tags-completion-table)
-	  (org-set-local 'org-global-tags-completion-table
-			 (org-global-tags-completion-table)))
-	(let ((completion-ignore-case t))
-	  (setq tag (completing-read
-		     "Tag: " org-global-tags-completion-table))))
-      (cond
-       ((equal char ?/) (org-agenda-filter-by-tag-show-all))
-       ((or (equal char ?\ )
-	    (setq a (rassoc char org-tag-alist-for-agenda))
-	    (and tag (setq a (cons tag nil))))
-	(org-agenda-filter-by-tag-show-all)
-	(setq tag (car a))
-	(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))
-			  (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)))))
+      (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 (current-buffer))
+	(org-set-local 'org-global-tags-completion-table
+		       (org-global-tags-completion-table)))
+      (let ((completion-ignore-case t))
+	(setq tag (completing-read
+		   "Tag: " org-global-tags-completion-table))))
+    (cond
+     ((equal char ?/) (org-agenda-filter-by-tag-show-all))
+     ((or (equal char ?\ )
+	  (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 (eval org-agenda-filter-form))
+		  (org-agenda-filter-by-tag-hide-line))
+	      (beginning-of-line 2))
+	  (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))