[Top][All Lists]
[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))