diff options
Diffstat (limited to 'lisp/org/org-agenda.el')
| -rw-r--r-- | lisp/org/org-agenda.el | 785 |
1 files changed, 489 insertions, 296 deletions
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index a54f3c4c3d3..f3024b171a6 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -1,11 +1,10 @@ ;;; org-agenda.el --- Dynamic task and appointment lists for Org -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004-2011 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -26,6 +25,23 @@ ;;; Commentary: ;; This file contains the code for creating and using the Agenda for Org-mode. +;; +;; The functions `org-batch-agenda', `org-batch-agenda-csv', and +;; `org-batch-store-agenda-views' are implemented as macros to provide +;; a conveniant way for extracting agenda information from the command +;; line. The Lisp does not evaluate parameters of a macro call; thus +;; it is not necessary to quote the parameters passed to one of those +;; functions. E.g. you can write: +;; +;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)' +;; +;; To export an agenda spanning 7 days. If `org-batch-agenda' would +;; have been implemented as a regular function you'd have to quote the +;; symbol org-agenda-span. Moreover: To use a symbol as parameter +;; value you would have to double quote the symbol. +;; +;; This is a hack, but it works even when running Org byte-compiled. +;; ;;; Code: @@ -50,6 +66,8 @@ (declare-function calendar-julian-date-string "cal-julian" (&optional date)) (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) (declare-function calendar-persian-date-string "cal-persia" (&optional date)) +(declare-function calendar-check-holidays "holidays" (date)) + (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) (declare-function org-columns-quit "org-colview" ()) @@ -60,6 +78,8 @@ (declare-function org-is-habit-p "org-habit" (&optional pom)) (declare-function org-habit-parse-todo "org-habit" (&optional pom)) (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) +(declare-function org-pop-to-buffer-same-window "org-compat" + (&optional buffer-or-name norecord label)) (defvar calendar-mode-map) (defvar org-clock-current-task) ; defined in org-clock.el @@ -156,7 +176,7 @@ and `org-agenda-entry-text-maxlines'." "Non-nil means export org-links as descriptive links in agenda added text. This variable applies to the text added to the agenda when `org-agenda-add-entry-text-maxlines' is larger than 0. -When this variable is nil, the URL will (also) be shown." +When this variable nil, the URL will (also) be shown." :group 'org-agenda :type 'boolean) @@ -225,6 +245,10 @@ you can \"misuse\" it to also add other text to the header. However, (const user-defined-up) (const user-defined-down)) "Sorting choices.") +;; Keep custom values for `org-agenda-filter-preset' compatible with +;; the new variable `org-agenda-tag-filter-preset'. +(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) + (defconst org-agenda-custom-commands-local-options `(repeat :tag "Local settings for this command. Remember to quote values" (choice :tag "Setting" @@ -266,8 +290,14 @@ you can \"misuse\" it to also add other text to the header. However, (list :tag "Deadline Warning days" (const org-deadline-warning-days) (integer :value 1)) + (list :tag "Category filter preset" + (const org-agenda-category-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+category or -category")))) (list :tag "Tags filter preset" - (const org-agenda-filter-preset) + (const org-agenda-tag-filter-preset) (list (const :format "" quote) (repeat @@ -330,7 +360,8 @@ This will be spliced into the custom type of `org-agenda-custom-commands'.") -(defcustom org-agenda-custom-commands nil +(defcustom org-agenda-custom-commands '(("n" "Agenda and all TODO's" + ((agenda "") (alltodo)))) "Custom commands for the agenda. These commands will be offered on the splash screen displayed by the agenda dispatcher \\[org-agenda]. Each entry is a list like this: @@ -339,7 +370,7 @@ agenda dispatcher \\[org-agenda]. Each entry is a list like this: key The key (one or more characters as a string) to be associated with the command. -desc A description of the command; when omitted or nil, a default +desc A description of the command, when omitted or nil, a default description is built using MATCH. type The command type, any of the following symbols: agenda The daily/weekly agenda. @@ -354,7 +385,7 @@ type The command type, any of the following symbols: match What to search for: - a single keyword for TODO keyword searches - a tags match expression for tags searches - - a word search expression for text searches + - a word search expression for text searches. - a regular expression for occur searches For all other commands, this should be the empty string. settings A list of option settings, similar to that in a let form, so like @@ -363,7 +394,7 @@ settings A list of option settings, similar to that in a let form, so like files A list of files file to write the produced agenda buffer to with the command `org-store-agenda-views'. If a file name ends in \".html\", an HTML version of the buffer - is written out. If it ends in \".ps\", a PostScript version is + is written out. If it ends in \".ps\", a postscript version is produced. Otherwise, only the plain text is written to the file. You can also define a set of commands, to create a composite agenda buffer. @@ -764,11 +795,11 @@ because you will take care of it on the day when scheduled." :group 'org-agenda-skip :group 'org-agenda-daily/weekly :type '(choice - (const :tag "Always show prewarning" nil) + (const :tag "Alwas show prewarning" nil) (const :tag "Remove prewarning if entry is scheduled" t) (integer :tag "Restart prewarning N days before deadline"))) -(defcustom org-agenda-skip-additional-timestamps-same-entry t +(defcustom org-agenda-skip-additional-timestamps-same-entry nil "When nil, multiple same-day timestamps in entry make multiple agenda lines. When non-nil, after the search for timestamps has matched once in an entry, the rest of the entry will not be searched." @@ -853,6 +884,12 @@ Needs to be set before org.el is loaded." :group 'org-agenda-startup :type 'boolean) +(defcustom org-agenda-follow-indirect nil + "Non-nil means `org-agenda-follow-mode' displays only the +current item's tree, in an indirect buffer." + :group 'org-agenda + :type 'boolean) + (defcustom org-agenda-show-outline-path t "Non-nil means show outline path in echo area after line motion." :group 'org-agenda-startup @@ -1048,6 +1085,15 @@ and timeline buffers." (const :tag "Saturday" 6) (const :tag "Sunday" 0))) +(defcustom org-agenda-move-date-from-past-immediately-to-today t + "Non-nil means jumpt to today when moving a past date forward in time. +When using S-right in the agenda to move a a date forward, and the date +stamp currently points to the past, the first key press will move it +to today. WHen nil, just move one day forward even if the date stays +in the past." + :group 'org-agenda-daily/weekly + :type 'boolean) + (defcustom org-agenda-include-diary nil "If non-nil, include in the agenda entries from the Emacs Calendar's diary. Custom commands can set this variable in the options section." @@ -1060,14 +1106,6 @@ Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly :type 'boolean) -(defcustom org-agenda-include-all-todo nil - "Set means weekly/daily agenda will always contain all TODO entries. -The TODO entries will be listed at the top of the agenda, before -the entries for specific days. -This option is deprecated, it is better to define a block agenda instead." - :group 'org-agenda-daily/weekly - :type 'boolean) - (defcustom org-agenda-repeating-timestamp-show-all t "Non-nil means show all occurrences of a repeating stamp in the agenda. When set to a list of strings, only show occurrences of repeating @@ -1396,6 +1434,7 @@ This format works similar to a printf format, with the following meaning: %c the category of the item, \"Diary\" for entries from the diary, or as given by the CATEGORY keyword or derived from the file name + %e the effort required by the item %i the icon category of the item, see `org-agenda-category-icon-alist' %T the last tag of the item (ignore inherited tags, which come first) %t the HH:MM time-of-day specification if one applies to the entry @@ -1619,7 +1658,7 @@ Where CATEGORY-REGEXP is a regexp matching the categories where the icon should be displayed. FILE-OR-DATA either a file path or a string containing image data. -The other fields can be omitted safely if not needed: +The other fields can be omited safely if not needed: TYPE indicates the image type. DATA-P is a boolean indicating whether the FILE-OR-DATA string is image data. @@ -1711,12 +1750,14 @@ Note that functions in this alist don't need to be quoted." If STRING is non-nil, the text property will be fetched from position 0 in that string. If STRING is nil, it will be fetched from the beginning of the current line." - `(let ((marker (get-text-property (if string 0 (point-at-bol)) - 'org-hd-marker string))) - (with-current-buffer (marker-buffer marker) - (save-excursion - (goto-char marker) - ,@body)))) + (org-with-gensyms (marker) + `(let ((,marker (get-text-property (if string 0 (point-at-bol)) + 'org-hd-marker ,string))) + (with-current-buffer (marker-buffer ,marker) + (save-excursion + (goto-char ,marker) + ,@body))))) +(def-edebug-spec org-agenda-with-point-at-orig-entry (form body)) (defun org-add-agenda-custom-command (entry) "Replace or add a command in `org-agenda-custom-commands'. @@ -1870,7 +1911,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property) (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) -(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) +(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write) (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) (org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority) @@ -1918,6 +1959,7 @@ The following commands are available: (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) +(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) (define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note) (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) @@ -1984,7 +2026,7 @@ The following commands are available: :keys "v A"] "--" ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) - ["Write view to file" org-write-agenda t] + ["Write view to file" org-agenda-write t] ["Rebuild buffer" org-agenda-redo t] ["Save all Org-mode Buffers" org-save-all-org-buffers t] "--" @@ -2295,7 +2337,7 @@ Pressing `<' twice means to restrict to the current subtree or region nil 'face 'org-warning))))))) t t)) ((equal keys "L") - (unless (org-mode-p) + (unless (eq major-mode 'org-mode) (error "This is not an Org-mode file")) (unless restriction (put 'org-agenda-files 'org-restrict (list bfn)) @@ -2330,7 +2372,7 @@ Agenda views are separated by `org-agenda-block-separator'." "The user interface for selecting an agenda command." (catch 'exit (let* ((bfn (buffer-file-name (buffer-base-buffer))) - (restrict-ok (and bfn (org-mode-p))) + (restrict-ok (and bfn (eq major-mode 'org-mode))) (region-p (org-region-active-p)) (custom org-agenda-custom-commands) (selstring "") @@ -2572,23 +2614,13 @@ If CMD-KEY is a string of length 1, it is used as a key in longer string it is used as a tags/todo match string. Parameters are alternating variable names and values that will be bound before running the agenda command." - (let (pars) - (while parameters - (push (list (pop parameters) (if parameters (pop parameters))) pars)) + (org-eval-in-environment (org-make-parameter-alist parameters) (if (> (length cmd-key) 2) - (eval (list 'let (nreverse pars) - (list 'org-tags-view nil cmd-key))) - (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key)))) - (set-buffer org-agenda-buffer-name) - (princ (org-encode-for-stdout (buffer-string))))) - -;(defun org-encode-for-stdout (string) -; (if (fboundp 'encode-coding-string) -; (encode-coding-string string buffer-file-coding-system) -; string)) - -(defun org-encode-for-stdout (string) - string) + (org-tags-view nil cmd-key) + (org-agenda nil cmd-key))) + (set-buffer org-agenda-buffer-name) + (princ (buffer-string))) +(def-edebug-spec org-batch-agenda (form &rest sexp)) (defvar org-agenda-info nil) @@ -2627,30 +2659,26 @@ extra Sting with extra planning info priority-l The priority letter if any was given priority-n The computed numerical priority agenda-day The day in the agenda where this is listed" - - (let (pars) - (while parameters - (push (list (pop parameters) (if parameters (pop parameters))) pars)) - (push (list 'org-agenda-remove-tags t) pars) + (org-eval-in-environment (append '((org-agenda-remove-tags t)) + (org-make-parameter-alist parameters)) (if (> (length cmd-key) 2) - (eval (list 'let (nreverse pars) - (list 'org-tags-view nil cmd-key))) - (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key)))) - (set-buffer org-agenda-buffer-name) - (let* ((lines (org-split-string (buffer-string) "\n")) - line) - (while (setq line (pop lines)) - (catch 'next - (if (not (get-text-property 0 'org-category line)) (throw 'next nil)) - (setq org-agenda-info - (org-fix-agenda-info (text-properties-at 0 line))) - (princ - (org-encode-for-stdout - (mapconcat 'org-agenda-export-csv-mapper - '(org-category txt type todo tags date time extra - priority-letter priority agenda-day) - ","))) - (princ "\n")))))) + (org-tags-view nil cmd-key) + (org-agenda nil cmd-key))) + (set-buffer org-agenda-buffer-name) + (let* ((lines (org-split-string (buffer-string) "\n")) + line) + (while (setq line (pop lines)) + (catch 'next + (if (not (get-text-property 0 'org-category line)) (throw 'next nil)) + (setq org-agenda-info + (org-fix-agenda-info (text-properties-at 0 line))) + (princ + (mapconcat 'org-agenda-export-csv-mapper + '(org-category txt type todo tags date time extra + priority-letter priority agenda-day) + ",")) + (princ "\n"))))) +(def-edebug-spec org-batch-agenda-csv (form &rest sexp)) (defun org-fix-agenda-info (props) "Make sure all properties on an agenda item have a canonical form. @@ -2700,17 +2728,14 @@ This ensures the export commands can easily use it." (interactive) (eval (list 'org-batch-store-agenda-views))) -;; FIXME, why is this a macro????? ;;;###autoload (defmacro org-batch-store-agenda-views (&rest parameters) "Run all custom agenda commands that have a file argument." (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) (pop-up-frames nil) (dir default-directory) - pars cmd thiscmdkey files opts cmd-or-set) - (while parameters - (push (list (pop parameters) (if parameters (pop parameters))) pars)) - (setq pars (reverse pars)) + (pars (org-make-parameter-alist parameters)) + cmd thiscmdkey files opts cmd-or-set) (save-window-excursion (while cmds (setq cmd (pop cmds) @@ -2720,15 +2745,17 @@ This ensures the export commands can easily use it." files (nth (if (listp cmd-or-set) 4 5) cmd)) (if (stringp files) (setq files (list files))) (when files - (eval (list 'let (append org-agenda-exporter-settings opts pars) - (list 'org-agenda nil thiscmdkey))) + (org-eval-in-environment (append org-agenda-exporter-settings + opts pars) + (org-agenda nil thiscmdkey)) (set-buffer org-agenda-buffer-name) (while files - (eval (list 'let (append org-agenda-exporter-settings opts pars) - (list 'org-write-agenda - (expand-file-name (pop files) dir) nil t)))) + (org-eval-in-environment (append org-agenda-exporter-settings + opts pars) + (org-agenda-write (expand-file-name (pop files) dir) nil t))) (and (get-buffer org-agenda-buffer-name) (kill-buffer org-agenda-buffer-name))))))) +(def-edebug-spec org-batch-store-agenda-views (&rest sexp)) (defun org-agenda-mark-header-line (pos) "Mark the line at POS as an agenda structure header." @@ -2741,11 +2768,12 @@ This ensures the export commands can easily use it." 'org-agenda-title-append org-agenda-title-append)))) (defvar org-mobile-creating-agendas) -(defun org-write-agenda (file &optional open nosettings) +(defvar org-agenda-write-buffer-name "Agenda View") +(defun org-agenda-write (file &optional open nosettings) "Write the current buffer (an agenda view) as a file. Depending on the extension of the file name, plain text (.txt), -HTML (.html or .htm) or PostScript (.ps) is produced. -If the extension is .ics, run iCalendar export over all files used +HTML (.html or .htm) or Postscript (.ps) is produced. +If the extension is .ics, run icalendar export over all files used to construct the agenda and limit the export to entries listed in the agenda now. With prefix argument OPEN, open the new file immediately. @@ -2763,7 +2791,7 @@ higher priority settings." (let ((bs (copy-sequence (buffer-string))) beg) (org-agenda-unmark-filtered-text) (with-temp-buffer - (rename-buffer "Agenda View" t) + (rename-buffer org-agenda-write-buffer-name t) (set-buffer-modified-p nil) (insert bs) (org-agenda-remove-marked-text 'org-filtered) @@ -2793,7 +2821,7 @@ higher priority settings." ((string-match "\\.ps\\'" file) (require 'ps-print) (ps-print-buffer-with-faces file) - (message "PostScript written to %s" file)) + (message "Postscript written to %s" file)) ((string-match "\\.pdf\\'" file) (require 'ps-print) (ps-print-buffer-with-faces @@ -2824,7 +2852,8 @@ higher priority settings." (set-buffer org-agenda-buffer-name)) (when open (org-open-file file))) -(defvar org-agenda-filter-overlays nil) +(defvar org-agenda-tag-filter-overlays nil) +(defvar org-agenda-cat-filter-overlays nil) (defun org-agenda-mark-filtered-text () "Mark all text hidden by filtering with a text property." @@ -2835,7 +2864,8 @@ higher priority settings." (put-text-property (overlay-start o) (overlay-end o) 'org-filtered t))) - org-agenda-filter-overlays))) + (append org-agenda-tag-filter-overlays + org-agenda-cat-filter-overlays)))) (defun org-agenda-unmark-filtered-text () "Remove the filtering text property." @@ -2882,7 +2912,7 @@ removed from the entry content. Currently only `planning' is allowed here." (let (txt drawer-re kwd-time-re ind) (save-excursion (with-current-buffer (marker-buffer marker) - (if (not (org-mode-p)) + (if (not (eq major-mode 'org-mode)) (setq txt "") (save-excursion (save-restriction @@ -2972,7 +3002,7 @@ removed from the entry content. Currently only `planning' is allowed here." (nreverse markers))) (defun org-create-marker-find-array (marker-list) - "Create an alist of files names with all marker positions in that file." + "Create a alist of files names with all marker positions in that file." (let (f tbl m a p) (while (setq m (pop marker-list)) (setq p (marker-position m) @@ -2997,8 +3027,8 @@ removed from the entry content. Currently only `planning' is allowed here." (member (point) (cdr a))))))) (defun org-check-for-org-mode () - "Make sure current buffer is in Org-mode. Error if not." - (or (org-mode-p) + "Make sure current buffer is in org-mode. Error if not." + (or (eq major-mode 'org-mode) (error "Cannot execute org-mode agenda command on buffer in %s" major-mode))) @@ -3018,9 +3048,10 @@ removed from the entry content. Currently only `planning' is allowed here." (defvar org-pre-agenda-window-conf nil) (defvar org-agenda-columns-active nil) (defvar org-agenda-name nil) -(defvar org-agenda-filter nil) -(defvar org-agenda-filter-while-redo nil) -(defvar org-agenda-filter-preset nil +(defvar org-agenda-tag-filter nil) +(defvar org-agenda-category-filter nil) +(defvar org-agenda-tag-filter-while-redo nil) +(defvar org-agenda-tag-filter-preset nil "A preset of the tags filter used for secondary agenda filtering. This must be a list of strings, each string must be a single tag preceded by \"+\" or \"-\". @@ -3030,13 +3061,25 @@ the entire agenda view. In a block agenda, it will not work reliably to define a filter for one of the individual blocks. You need to set it in the global options and expect it to be applied to the entire view.") +(defvar org-agenda-category-filter-preset nil + "A preset of the categeory filter used for secondary agenda filtering. +This must be a list of strings, each string must be a single category +preceded by \"+\" or \"-\". +This variable should not be set directly, but agenda custom commands can +bind it in the options section. The preset filter is a global property of +the entire agenda view. In a block agenda, it will not work reliably to +define a filter for one of the individual blocks. You need to set it in +the global options and expect it to be applied to the entire view.") + (defun org-prepare-agenda (&optional name) (setq org-todo-keywords-for-agenda nil) (setq org-done-keywords-for-agenda nil) (setq org-drawers-for-agenda nil) (unless org-agenda-persistent-filter - (setq org-agenda-filter nil)) - (put 'org-agenda-filter :preset-filter org-agenda-filter-preset) + (setq org-agenda-tag-filter nil + org-agenda-category-filter nil)) + (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset) + (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset) (if org-agenda-multi (progn (setq buffer-read-only nil) @@ -3065,7 +3108,7 @@ the global options and expect it to be applied to the entire view.") (awin (select-window awin)) ((not (setq org-pre-agenda-window-conf (current-window-configuration)))) ((equal org-agenda-window-setup 'current-window) - (switch-to-buffer abuf)) + (org-pop-to-buffer-same-window abuf)) ((equal org-agenda-window-setup 'other-window) (org-switch-to-buffer-other-window abuf)) ((equal org-agenda-window-setup 'other-frame) @@ -3076,7 +3119,7 @@ the global options and expect it to be applied to the entire view.") ;; additional test in case agenda is invoked from within agenda ;; buffer via elisp link (unless (equal (current-buffer) abuf) - (switch-to-buffer abuf))) + (org-pop-to-buffer-same-window abuf))) (setq buffer-read-only nil) (let ((inhibit-read-only t)) (erase-buffer)) (org-agenda-mode) @@ -3115,8 +3158,10 @@ the global options and expect it to be applied to the entire view.") (org-habit-insert-consistency-graphs)) (run-hooks 'org-finalize-agenda-hook) (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) - (when (or org-agenda-filter (get 'org-agenda-filter :preset-filter)) - (org-agenda-filter-apply org-agenda-filter)) + (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter)) + (org-agenda-filter-apply org-agenda-tag-filter 'tag)) + (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter)) + (org-agenda-filter-apply org-agenda-category-filter 'category)) ))) (defun org-agenda-mark-clocking-task () @@ -3190,17 +3235,9 @@ the global options and expect it to be applied to the entire view.") (setq org-blocked-by-checkboxes nil invis1 invis) (let ((marker (org-get-at-bol 'org-hd-marker))) (when (and marker - (not (with-current-buffer (marker-buffer marker) - (save-excursion - (goto-char marker) - (if (org-entry-get nil "NOBLOCKING") - t ;; Never block this entry - (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position marker - :from 'todo - :to 'done))))))) + (with-current-buffer (marker-buffer marker) + (save-excursion (goto-char marker) + (org-entry-blocked-p)))) (if org-blocked-by-checkboxes (setq invis1 nil)) (setq b (if invis1 (max (point-min) (1- (point-at-bol))) @@ -3334,7 +3371,7 @@ no longer in use." (defvar org-agenda-only-exact-dates nil) ; dynamically scoped -(defun org-timeline (&optional include-all) +(defun org-timeline (&optional dotodo) "Show a time-sorted view of the entries in the current org file. Only entries with a time stamp of today or later will be listed. With \\[universal-argument] prefix, all unfinished TODO items will also be shown, @@ -3345,7 +3382,6 @@ dates." (org-compile-prefix-format 'timeline) (org-set-sorting-strategy 'timeline) (let* ((dopast t) - (dotodo include-all) (doclosed org-agenda-show-log) (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) (current-buffer)))) @@ -3364,7 +3400,7 @@ dates." (setq org-agenda-redo-command (list 'progn (list 'org-switch-to-buffer-other-window (current-buffer)) - (list 'org-timeline (list 'quote include-all)))) + (list 'org-timeline (list 'quote dotodo)))) (if (not dopast) ;; Remove past dates from the list of dates. (setq day-numbers (delq nil (mapcar (lambda(x) @@ -3432,22 +3468,26 @@ When EMPTY is non-nil, also include days without any entries." (let ((re (concat (if pre-re pre-re "") (if inactive org-ts-regexp-both org-ts-regexp))) - dates dates1 date day day1 day2 ts1 ts2) + dates dates1 date day day1 day2 ts1 ts2 pos) (if force-today (setq dates (list (org-today)))) (save-excursion (goto-char beg) (while (re-search-forward re end t) (setq day (time-to-days (org-time-string-to-time - (substring (match-string 1) 0 10)))) + (substring (match-string 1) 0 10) + (current-buffer) (match-beginning 0)))) (or (memq day dates) (push day dates))) (unless no-ranges (goto-char beg) (while (re-search-forward org-tr-regexp end t) + (setq pos (match-beginning 0)) (setq ts1 (substring (match-string 1) 0 10) ts2 (substring (match-string 2) 0 10) - day1 (time-to-days (org-time-string-to-time ts1)) - day2 (time-to-days (org-time-string-to-time ts2))) + day1 (time-to-days (org-time-string-to-time + ts1 (current-buffer) pos)) + day2 (time-to-days (org-time-string-to-time + ts2 (current-buffer) pos))) (while (< (setq day1 (1+ day1)) day2) (or (memq day1 dates) (push day1 dates))))) (setq dates (sort dates '<)) @@ -3472,7 +3512,7 @@ Custom commands can set this variable in the options section.") (defvar org-starting-day nil) ; local variable in the agenda buffer (defvar org-agenda-current-span nil "The current span used in the agenda view.") ; local variable in the agenda buffer -(defvar org-include-all-loc nil) ; local variable +(defvar org-arg-loc nil) ; local variable (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) "List of types searched for when creating the daily/weekly agenda. @@ -3508,29 +3548,29 @@ somewhat less efficient) way of determining what is included in the daily/weekly agenda, see `org-agenda-skip-function'.") ;;;###autoload -(defun org-agenda-list (&optional include-all start-day span) +(defun org-agenda-list (&optional arg start-day span) "Produce a daily/weekly view from all files in variable `org-agenda-files'. The view will be for the current day or week, but from the overview buffer you will be able to go to other days/weeks. With a numeric prefix argument in an interactive call, the agenda will -span INCLUDE-ALL days. Lisp programs should instead specify SPAN to change +span ARG days. Lisp programs should instead specify SPAN to change the number of days. SPAN defaults to `org-agenda-span'. START-DAY defaults to TODAY, or to the most recent match for the weekday given in `org-agenda-start-on-weekday'." (interactive "P") - (if (and (integerp include-all) (> include-all 0)) - (setq span include-all include-all nil)) + (if (and (integerp arg) (> arg 0)) + (setq span arg arg nil)) (setq start-day (or start-day org-agenda-start-day)) (if org-agenda-overriding-arguments - (setq include-all (car org-agenda-overriding-arguments) + (setq arg (car org-agenda-overriding-arguments) start-day (nth 1 org-agenda-overriding-arguments) span (nth 2 org-agenda-overriding-arguments))) (if (stringp start-day) ;; Convert to an absolute day number (setq start-day (time-to-days (org-read-date nil t start-day)))) - (setq org-agenda-last-arguments (list include-all start-day span)) + (setq org-agenda-last-arguments (list arg start-day span)) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) (let* ((span (org-agenda-ndays-to-span @@ -3557,7 +3597,7 @@ given in `org-agenda-start-on-weekday'." s e rtn rtnall file date d start-pos end-pos todayp clocktable-start clocktable-end filter) (setq org-agenda-redo-command - (list 'org-agenda-list (list 'quote include-all) start-day (list 'quote span))) + (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span))) (dotimes (n (1- ndays)) (push (1+ (car day-numbers)) day-numbers)) (setq day-numbers (nreverse day-numbers)) @@ -3565,7 +3605,7 @@ given in `org-agenda-start-on-weekday'." clocktable-end (1+ (or (org-last day-numbers) 0))) (org-prepare-agenda "Day/Week") (org-set-local 'org-starting-day (car day-numbers)) - (org-set-local 'org-include-all-loc include-all) + (org-set-local 'org-arg-loc arg) (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) (unless org-agenda-compact-blocks (let* ((d1 (car day-numbers)) @@ -3616,7 +3656,7 @@ given in `org-agenda-start-on-weekday'." (setq rtn (apply 'org-agenda-get-day-entries file date org-agenda-entry-types))))) - (setq rtnall (append rtnall rtn)))) + (setq rtnall (append rtnall rtn)))) ;; all entries (if org-agenda-include-diary (let ((org-agenda-search-headline-for-time t)) (require 'diary-lib) @@ -3638,7 +3678,7 @@ given in `org-agenda-start-on-weekday'." (put-text-property s (1- (point)) 'org-day-cnt day-cnt) (when todayp (put-text-property s (1- (point)) 'org-today t)) - (if rtnall (insert + (if rtnall (insert ;; all entries (org-finalize-agenda-entries (org-agenda-add-time-grid-maybe rtnall ndays todayp)) @@ -3655,8 +3695,8 @@ given in `org-agenda-start-on-weekday'." (setq p (plist-put p :tend clocktable-end)) (setq p (plist-put p :scope 'agenda)) (when (and (eq org-agenda-clockreport-mode 'with-filter) - (setq filter (or org-agenda-filter-while-redo - (get 'org-agenda-filter :preset-filter)))) + (setq filter (or org-agenda-tag-filter-while-redo + (get 'org-agenda-tag-filter :preset-filter)))) (setq p (plist-put p :tags (mapconcat (lambda (x) (if (string-match "[<>=]" x) "" @@ -3715,9 +3755,9 @@ given in `org-agenda-start-on-weekday'." (defvar org-todo-only nil) (defvar org-search-syntax-table nil - "Special syntax table for Org-mode search. -In this table, we have single quotes not as word constituents, so -that when \"+Ameli\" is searched as a word, it will also match \"Ameli's\"") + "Special syntax table for org-mode search. +In this table, we have single quotes not as word constituents, to +that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") (defun org-search-syntax-table () (unless org-search-syntax-table @@ -3786,7 +3826,7 @@ in `org-agenda-text-search-extra-files'." (full-words org-agenda-search-view-force-full-words) (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) regexp rtn rtnall files file pos - marker category tags c neg re boolean + marker category org-category-pos tags c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) @@ -3869,7 +3909,7 @@ in `org-agenda-text-search-extra-files'." (if (not regexps+) (setq regexp org-outline-regexp-bol) (setq regexp (pop regexps+)) - (if hdl-only (setq regexp (concat "^" org-outline-regexp ".*?" + (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" regexp)))) (setq files (org-agenda-files nil 'ifmode)) (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) @@ -3890,7 +3930,7 @@ in `org-agenda-text-search-extra-files'." file)))) (with-current-buffer buffer (with-syntax-table (org-search-syntax-table) - (unless (org-mode-p) + (unless (eq major-mode 'org-mode) (error "Agenda file %s is not in `org-mode'" file)) (let ((case-fold-search t)) (save-excursion @@ -3900,7 +3940,7 @@ in `org-agenda-text-search-extra-files'." org-agenda-restrict-end) (widen)) (goto-char (point-min)) - (unless (or (org-on-heading-p) + (unless (or (org-at-heading-p) (outline-next-heading)) (throw 'nextfile t)) (goto-char (max (point-min) (1- (point)))) @@ -3930,8 +3970,9 @@ in `org-agenda-text-search-extra-files'." (goto-char beg) (setq marker (org-agenda-new-marker (point)) category (org-get-category) + org-category-pos (get-text-property (point) 'org-category-position) tags (org-get-tags-at (point)) - txt (org-format-agenda-item + txt (org-agenda-format-item "" (buffer-substring-no-properties beg1 (point-at-eol)) @@ -3941,6 +3982,7 @@ in `org-agenda-text-search-extra-files'." 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'priority 1000 'org-category category + 'org-category-position org-category-pos 'type "search") (push txt ee) (goto-char (1- end)))))))))) @@ -4081,7 +4123,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (format "ORG-AGENDA-ERROR: No such org-file %s" file)) rtnall (append rtnall rtn)) (with-current-buffer buffer - (unless (org-mode-p) + (unless (eq major-mode 'org-mode) (error "Agenda file %s is not in `org-mode'" file)) (save-excursion (save-restriction @@ -4305,8 +4347,8 @@ of what a project is and how to check if it stuck, customize the variable "\\)\\>")) (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) - (org-re (concat org-outline-regexp-bol - ".*:[[:alnum:]_@#%]+:[ \t]*$")) + (concat org-outline-regexp-bol + (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$")) (if tags (concat org-outline-regexp-bol ".*:\\(" @@ -4380,7 +4422,7 @@ of what a project is and how to check if it stuck, customize the variable (setq entries (mapcar (lambda (x) - (setq x (org-format-agenda-item "" x "Diary" nil 'time)) + (setq x (org-agenda-format-item "" x "Diary" nil 'time)) ;; Extend the text properties to the beginning of the line (org-add-props x (text-properties-at (1- (length x)) x) 'type "diary" 'date date 'face 'org-agenda-diary)) @@ -4425,7 +4467,7 @@ date. It also removes lines that contain only whitespace." (setq string (org-modify-diary-entry-string string)))))) (defun org-modify-diary-entry-string (string) - "Add text properties to string, allowing Org-mode to act on it." + "Add text properties to string, allowing org-mode to act on it." (org-add-props string nil 'mouse-face 'highlight 'help-echo (if buffer-file-name @@ -4525,7 +4567,7 @@ the documentation of `org-diary'." ;; If file does not exist, make sure an error message ends up in diary (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) (with-current-buffer buffer - (unless (org-mode-p) + (unless (eq major-mode 'org-mode) (error "Agenda file %s is not in `org-mode'" file)) (let ((case-fold-search nil)) (save-excursion @@ -4562,6 +4604,7 @@ the documentation of `org-diary'." (setq results (append results rtn)))))))) results)))) +(defvar org-heading-keyword-regexp-format) ; defined in org.el (defun org-agenda-get-todos () "Return the TODO information for agenda display." (let* ((props (list 'face nil @@ -4573,16 +4616,20 @@ the documentation of `org-diary'." 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) - (regexp (concat "^\\*+[ \t]+\\(" - (if org-select-this-todo-keyword - (if (equal org-select-this-todo-keyword "*") - org-todo-regexp - (concat "\\<\\(" - (mapconcat 'identity (org-split-string org-select-this-todo-keyword "|") "\\|") - "\\)\\>")) - org-not-done-regexp) - "[^\n\r]*\\)")) - marker priority category tags todo-state + (regexp (format org-heading-keyword-regexp-format + (cond + ((and org-select-this-todo-keyword + (equal org-select-this-todo-keyword "*")) + org-todo-regexp) + (org-select-this-todo-keyword + (concat "\\(" + (mapconcat 'identity + (org-split-string + org-select-this-todo-keyword + "|") + "\\|") "\\)")) + (t org-not-done-regexp)))) + marker priority category org-category-pos tags todo-state ee txt beg end) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4595,21 +4642,24 @@ the documentation of `org-diary'." (goto-char (1+ beg)) (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) (throw :skip nil))) - (goto-char (match-beginning 1)) + (goto-char (match-beginning 2)) (setq marker (org-agenda-new-marker (match-beginning 0)) category (org-get-category) - txt (match-string 1) + org-category-pos (get-text-property (point) 'org-category-position) + txt (org-trim + (buffer-substring (match-beginning 2) (match-end 0))) tags (org-get-tags-at (point)) - txt (org-format-agenda-item "" txt category tags) + txt (org-agenda-format-item "" txt category tags) priority (1+ (org-get-priority txt)) todo-state (org-get-todo-state)) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'priority priority 'org-category category + 'org-category-position org-category-pos 'type "todo" 'todo-state todo-state) (push txt ee) (if org-agenda-todo-list-sublevels - (goto-char (match-end 1)) + (goto-char (match-end 2)) (org-end-of-subtree 'invisible)))) (nreverse ee))) @@ -4691,7 +4741,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (defun org-agenda-get-timestamps () "Return the date stamp information for agenda display." - (let* ((props (list 'face nil + (let* ((props (list 'face 'org-agenda-calendar-event 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp @@ -4720,8 +4770,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) marker hdmarker deadlinep scheduledp clockp closedp inactivep - donep tmp priority category ee txt timestr tags b0 b3 e3 head - todo-state end-of-match show-all) + donep tmp priority category org-category-pos ee txt timestr tags + b0 b3 e3 head todo-state end-of-match show-all) (goto-char (point-min)) (while (setq end-of-match (re-search-forward regexp nil t)) (setq b0 (match-beginning 0) @@ -4735,7 +4785,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (org-agenda-skip) (if (and (match-end 1) (not (= d1 (org-time-string-to-absolute - (match-string 1) d1 nil show-all)))) + (match-string 1) d1 nil show-all + (current-buffer) b0)))) (throw :skip nil)) (if (and e3 (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) @@ -4760,7 +4811,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', ;; substring should only run to end of time stamp (setq timestr (substring timestr 0 (match-end 0)))) (setq marker (org-agenda-new-marker b0) - category (org-get-category b0)) + category (org-get-category b0) + org-category-pos (get-text-property b0 'org-category-position)) (save-excursion (if (not (re-search-backward org-outline-regexp-bol nil t)) (setq txt org-agenda-no-heading-message) @@ -4769,7 +4821,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (or (match-string 1) "")) - (setq txt (org-format-agenda-item + (setq txt (org-agenda-format-item (if inactivep org-agenda-inactive-leader nil) head category tags timestr remove-re))) @@ -4778,6 +4830,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', 'org-marker marker 'org-hd-marker hdmarker) (org-add-props txt nil 'priority priority 'org-category category 'date date + 'org-category-position org-category-pos 'todo-state todo-state 'type "timestamp") (push txt ee)) @@ -4789,13 +4842,14 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (defun org-agenda-get-sexps () "Return the sexp information for agenda display." (require 'diary-lib) - (let* ((props (list 'mouse-face 'highlight + (let* ((props (list 'face 'org-agenda-calendar-sexp + 'mouse-face 'highlight 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") - marker category ee txt tags entry result beg b sexp sexp-entry - todo-state) + marker category org-category-pos ee txt tags entry + result beg b sexp sexp-entry todo-state) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -4812,6 +4866,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (when result (setq marker (org-agenda-new-marker beg) category (org-get-category beg) + org-category-pos (get-text-property beg 'org-category-position) todo-state (org-get-todo-state)) (dolist (r (if (stringp result) @@ -4821,11 +4876,12 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (setq txt r) (setq txt "SEXP entry returned empty string")) - (setq txt (org-format-agenda-item + (setq txt (org-agenda-format-item "" txt category tags 'time)) (org-add-props txt props 'org-marker marker) (org-add-props txt nil 'org-category category 'date date 'todo-state todo-state + 'org-category-position org-category-pos 'type "sexp") (push txt ee))))) (nreverse ee))) @@ -4860,9 +4916,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', ;; Define the` org-class' function (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks) "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. -DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS -is any number of ISO weeks in the block period for which the item should -be skipped." +DAYNAME is a number between 0 (Sunday) and 6 (Saturday). +SKIP-WEEKS is any number of ISO weeks in the block period for which the +item should be skipped. If any of the SKIP-WEEKS arguments is the symbol +`holidays', then any date that is known by the Emacs calendar to be a +holidy will also be skipped." (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1))) (date2 (calendar-absolute-from-gregorian (list m2 d2 y2))) (d (calendar-absolute-from-gregorian date))) @@ -4874,6 +4932,8 @@ be skipped." (progn (require 'cal-iso) (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) + (not (and (memq 'holidays skip-weeks) + (calendar-check-holidays date))) entry))) (defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) @@ -4894,6 +4954,7 @@ please use `org-class' instead." (nth 2 date1) (car date1) (nth 1 date1) (nth 2 date2) (car date2) (nth 1 date2) dayname skip-weeks))) +(make-obsolete 'org-diary-class 'org-class "") (defalias 'org-get-closed 'org-agenda-get-progress) (defun org-agenda-get-progress () @@ -4929,8 +4990,8 @@ please use `org-class' instead." (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)))) (org-agenda-search-headline-for-time nil) - marker hdmarker priority category tags closedp statep clockp state - ee txt extra timestr rest clocked) + marker hdmarker priority category org-category-pos tags closedp + statep clockp state ee txt extra timestr rest clocked) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -4941,14 +5002,15 @@ please use `org-class' instead." clockp (not (or closedp statep)) state (and statep (match-string 2)) category (org-get-category (match-beginning 0)) - timestr (buffer-substring (match-beginning 0) (point-at-eol)) - ) + org-category-pos (get-text-property (match-beginning 0) 'org-category-position) + timestr (buffer-substring (match-beginning 0) (point-at-eol))) (when (string-match "\\]" timestr) ;; substring should only run to end of time stamp (setq rest (substring timestr (match-end 0)) timestr (substring timestr 0 (match-end 0))) (if (and (not closedp) (not statep) - (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest)) + (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" + rest)) (progn (setq timestr (concat (substring timestr 0 -1) "-" (match-string 1 rest) "]")) (setq clocked (match-string 2 rest))) @@ -4975,7 +5037,7 @@ please use `org-class' instead." (setq txt (concat (substring txt 0 (match-beginning 1)) " - " extra " " (match-string 2 txt))) (setq txt (concat txt " - " extra)))) - (setq txt (org-format-agenda-item + (setq txt (org-agenda-format-item (cond (closedp "Closed: ") (statep (concat "State: (" state ")")) @@ -4985,6 +5047,7 @@ please use `org-class' instead." (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 'priority priority 'org-category category + 'org-category-position org-category-pos 'type "closed" 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) (push txt ee)) @@ -5059,7 +5122,7 @@ See also the user option `org-agenda-clock-consistency-checks'." (/ (- tlend ts) 60)) face (or (plist-get pl :overlap-face) face))) ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap)))) - ;; There is a gap, let's see if we need to report it + ;; There is a gap, lets see if we need to report it (unless (org-agenda-check-clock-gap tlend ts gapok) (setq issue (format "Clocking gap: %d minutes" (/ (- ts tlend) 60)) @@ -5122,9 +5185,9 @@ See also the user option `org-agenda-clock-consistency-checks'." (regexp org-deadline-time-regexp) (todayp (org-agenda-todayp date)) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar - d2 diff dfrac wdays pos pos1 category tags - suppress-prewarning - ee txt head face s todo-state show-all upcomingp donep timestr) + d2 diff dfrac wdays pos pos1 category org-category-pos + tags suppress-prewarning ee txt head face s todo-state + show-all upcomingp donep timestr) (goto-char (point-min)) (while (re-search-forward regexp nil t) (setq suppress-prewarning nil) @@ -5147,13 +5210,14 @@ See also the user option `org-agenda-clock-consistency-checks'." (member todo-state org-agenda-repeating-timestamp-show-all)) d2 (org-time-string-to-absolute - (match-string 1) d1 'past show-all) + (match-string 1) d1 'past show-all + (current-buffer) pos) diff (- d2 d1) wdays (if suppress-prewarning (let ((org-deadline-warning-days suppress-prewarning)) (org-get-wdays s)) (org-get-wdays s)) - dfrac (/ (* 1.0 (- wdays diff)) (max wdays 1)) + dfrac (- 1 (/ (* 1.0 diff) (max wdays 1))) upcomingp (and todayp (> diff 0))) ;; When to show a deadline in the calendar: ;; If the expiration is within wdays warning time. @@ -5168,7 +5232,8 @@ See also the user option `org-agenda-clock-consistency-checks'." (or org-agenda-skip-deadline-if-done (not (= diff 0)))) (setq txt nil) - (setq category (org-get-category)) + (setq category (org-get-category) + org-category-pos (get-text-property (point) 'org-category-position)) (if (not (re-search-backward "^\\*+[ \t]+" nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) @@ -5182,7 +5247,7 @@ See also the user option `org-agenda-clock-consistency-checks'." (setq timestr (concat (substring s (match-beginning 1)) " ")) (setq timestr 'time)) - (setq txt (org-format-agenda-item + (setq txt (org-agenda-format-item (if (= diff 0) (car org-agenda-deadline-leaders) (if (functionp @@ -5195,13 +5260,14 @@ See also the user option `org-agenda-clock-consistency-checks'." head category tags (if (not (= diff 0)) nil timestr))))) (when txt - (setq face (org-agenda-deadline-face dfrac wdays)) + (setq face (org-agenda-deadline-face dfrac)) (org-add-props txt props 'org-marker (org-agenda-new-marker pos) 'org-hd-marker (org-agenda-new-marker pos1) 'priority (+ (- diff) (org-get-priority txt)) 'org-category category + 'org-category-position org-category-pos 'todo-state todo-state 'type (if upcomingp "upcoming-deadline" "deadline") 'date (if upcomingp date d2) @@ -5210,10 +5276,9 @@ See also the user option `org-agenda-clock-consistency-checks'." (push txt ee)))))) (nreverse ee))) -(defun org-agenda-deadline-face (fraction &optional wdays) +(defun org-agenda-deadline-face (fraction) "Return the face to displaying a deadline item. FRACTION is what fraction of the head-warning time has passed." - (if (equal wdays 0) (setq fraction 1.)) (let ((faces org-agenda-deadline-faces) f) (catch 'exit (while (setq f (pop faces)) @@ -5238,7 +5303,7 @@ FRACTION is what fraction of the head-warning time has passed." 0 'org-hd-marker a)) (cons (marker-position mm) a))) deadline-results)) - d2 diff pos pos1 category tags donep + d2 diff pos pos1 category org-category-pos tags donep ee txt head pastschedp todo-state face timestr s habitp show-all) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5252,7 +5317,8 @@ FRACTION is what fraction of the head-warning time has passed." (member todo-state org-agenda-repeating-timestamp-show-all)) d2 (org-time-string-to-absolute - (match-string 1) d1 'past show-all) + (match-string 1) d1 'past show-all + (current-buffer) pos) diff (- d2 d1)) (setq pastschedp (and todayp (< diff 0))) ;; When to show a scheduled item in the calendar: @@ -5271,7 +5337,8 @@ FRACTION is what fraction of the head-warning time has passed." (setq txt nil) (setq habitp (and (functionp 'org-is-habit-p) (org-is-habit-p))) - (setq category (org-get-category)) + (setq category (org-get-category) + org-category-pos (get-text-property (point) 'org-category-position)) (if (not (re-search-backward "^\\*+[ \t]+" nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) @@ -5295,7 +5362,7 @@ FRACTION is what fraction of the head-warning time has passed." (setq timestr (concat (substring s (match-beginning 1)) " ")) (setq timestr 'time)) - (setq txt (org-format-agenda-item + (setq txt (org-agenda-format-item (if (= diff 0) (car org-agenda-scheduled-leaders) (format (nth 1 org-agenda-scheduled-leaders) @@ -5322,6 +5389,7 @@ FRACTION is what fraction of the head-warning time has passed." (org-habit-get-priority habitp) (+ 94 (- 5 diff) (org-get-priority txt))) 'org-category category + 'org-category-position org-category-pos 'org-habit-p habitp 'todo-state todo-state) (push txt ee)))))) @@ -5339,8 +5407,8 @@ FRACTION is what fraction of the head-warning time has passed." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) - marker hdmarker ee txt d1 d2 s1 s2 category todo-state tags pos - head donep) + marker hdmarker ee txt d1 d2 s1 s2 category org-category-pos + todo-state tags pos head donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -5350,8 +5418,8 @@ FRACTION is what fraction of the head-warning time has passed." (end-time (match-string 2))) (setq s1 (match-string 1) s2 (match-string 2) - d1 (time-to-days (org-time-string-to-time s1)) - d2 (time-to-days (org-time-string-to-time s2))) + d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos)) + d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos))) (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) ;; Only allow days between the limits, because the normal ;; date stamps will catch the limits. @@ -5361,7 +5429,8 @@ FRACTION is what fraction of the head-warning time has passed." (if (and donep org-agenda-skip-timestamp-if-done) (throw :skip t)) (setq marker (org-agenda-new-marker (point))) - (setq category (org-get-category)) + (setq category (org-get-category) + org-category-pos (get-text-property (point) 'org-category-position)) (if (not (re-search-backward org-outline-regexp-bol nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) @@ -5376,13 +5445,15 @@ FRACTION is what fraction of the head-warning time has passed." "--" "<" (regexp-quote s2) ".*?>") nil))) - (setq txt (org-format-agenda-item + (setq txt (org-agenda-format-item (format (nth (if (= d1 d2) 0 1) org-agenda-timerange-leaders) (1+ (- d0 d1)) (1+ (- d2 d1))) head category tags - (cond ((= d1 d0) + (cond ((and (= d1 d0) (= d2 d0)) + (concat "<" start-time ">--<" end-time ">")) + ((= d1 d0) (concat "<" start-time ">")) ((= d2 d0) (concat "<" end-time ">")) @@ -5392,7 +5463,8 @@ FRACTION is what fraction of the head-warning time has passed." 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date 'todo-state todo-state - 'priority (org-get-priority txt) 'org-category category) + 'priority (org-get-priority txt) 'org-category category + 'org-category-position org-category-pos) (push txt ee)))) (goto-char pos))) ;; Sort the entries by expiration date. @@ -5422,7 +5494,7 @@ The flag is set if the currently compiled format contains a `%e'.") (return (cadr entry)) (return (apply 'create-image (cdr entry))))))) -(defun org-format-agenda-item (extra txt &optional category tags dotime +(defun org-agenda-format-item (extra txt &optional category tags dotime remove-re habitp) "Format TXT to be inserted into the agenda buffer. In particular, it adds the prefix and corresponding text properties. EXTRA @@ -5464,7 +5536,7 @@ Any match of REMOVE-RE will be removed from TXT." (time-of-day (and dotime (org-get-time-of-day ts))) stamp plain s0 s1 s2 rtn srp l duration thecategory) - (and (org-mode-p) buffer-file-name + (and (eq major-mode 'org-mode) buffer-file-name (add-to-list 'org-agenda-contributing-files buffer-file-name)) (when (and dotime time-of-day) ;; Extract starting and ending time and move them to prefix @@ -5512,7 +5584,7 @@ Any match of REMOVE-RE will be removed from TXT." (concat (make-string (max (- 50 (length txt)) 1) ?\ ) (match-string 2 txt)) t t txt)))) - (when (org-mode-p) + (when (eq major-mode 'org-mode) (setq effort (condition-case nil (org-get-effort @@ -5642,14 +5714,14 @@ The modified list may contain inherited tags, and tags matched by (while (setq time (pop gridtimes)) (unless (and remove (member time have)) (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) - (push (org-format-agenda-item + (push (org-agenda-format-item nil string "" nil (concat (substring time 0 -2) ":" (substring time -2))) new) (put-text-property 2 (length (car new)) 'face 'org-time-grid (car new)))) (when (and todayp org-agenda-show-current-time-in-grid) - (push (org-format-agenda-item + (push (org-agenda-format-item nil org-agenda-current-time-string "" nil @@ -5667,7 +5739,8 @@ The modified list may contain inherited tags, and tags matched by The resulting form is returned and stored in the variable `org-prefix-format-compiled'." (setq org-prefix-has-time nil org-prefix-has-tag nil - org-prefix-category-length nil org-prefix-has-effort nil) + org-prefix-category-length nil + org-prefix-has-effort nil) (let ((s (cond ((stringp org-agenda-prefix-format) org-agenda-prefix-format) @@ -5779,7 +5852,7 @@ could bind the variable in the options section of a custom command.") (defun org-agenda-highlight-todo (x) (let ((org-done-keywords org-done-keywords-for-agenda) (case-fold-search nil) - re) + re) (if (eq x 'line) (save-excursion (beginning-of-line 1) @@ -5800,13 +5873,13 @@ could bind the variable in the options section of a custom command.") (add-text-properties (or (match-end 1) (match-end 0)) (match-end 0) (list 'face (org-get-todo-face (match-string 2 x))) - x) + x) (when (match-end 1) (setq x (concat (substring x 0 (match-end 1)) (format org-agenda-todo-keyword-format (match-string 2 x)) - (org-add-props " " (text-properties-at 0 x)) - (substring x (match-end 3))))))) + (org-add-props " " (text-properties-at 0 x)) + (substring x (match-end 3))))))) x))) (defsubst org-cmp-priority (a b) @@ -5818,7 +5891,7 @@ could bind the variable in the options section of a custom command.") (t nil)))) (defsubst org-cmp-effort (a b) - "Compare the priorities of string A and B." + "Compare the effort values of string A and B." (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1)) (ea (or (get-text-property 1 'effort-minutes a) def)) (eb (or (get-text-property 1 'effort-minutes b) def))) @@ -6081,29 +6154,45 @@ in the agenda." When this is the global TODO list, a prefix argument will be interpreted." (interactive) (let* ((org-agenda-keep-modes t) - (filter org-agenda-filter) - (preset (get 'org-agenda-filter :preset-filter)) - (org-agenda-filter-while-redo (or filter preset)) + (tag-filter org-agenda-tag-filter) + (tag-preset (get 'org-agenda-tag-filter :preset-filter)) + (cat-filter org-agenda-category-filter) + (cat-preset (get 'org-agenda-category-filter :preset-filter)) + (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) (cols org-agenda-columns-active) (line (org-current-line)) (window-line (- line (org-current-line (window-start)))) (lprops (get 'org-agenda-redo-command 'org-lprops))) - (put 'org-agenda-filter :preset-filter nil) + (put 'org-agenda-tag-filter :preset-filter nil) + (put 'org-agenda-category-filter :preset-filter nil) (and cols (org-columns-quit)) (message "Rebuilding agenda buffer...") (org-let lprops '(eval org-agenda-redo-command)) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil) (message "Rebuilding agenda buffer...done") - (put 'org-agenda-filter :preset-filter preset) - (and (or filter preset) (org-agenda-filter-apply filter)) + (put 'org-agenda-tag-filter :preset-filter tag-preset) + (put 'org-agenda-category-filter :preset-filter cat-preset) + (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag)) + (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category)) (and cols (org-called-interactively-p 'any) (org-agenda-columns)) (org-goto-line line) (recenter window-line))) - (defvar org-global-tags-completion-table nil) (defvar org-agenda-filter-form nil) + +(defun org-agenda-filter-by-category (strip) + "Keep only those lines in the agenda buffer that have a specific category. +The category is that of the current line." + (interactive "P") + (if org-agenda-filtered-by-category + (org-agenda-filter-show-all-cat) + (let ((cat (org-no-properties (get-text-property (point) 'org-category)))) + (if cat (org-agenda-filter-apply + (list (concat (if strip "-" "+") cat)) 'category) + (error "No category at point"))))) + (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. @@ -6127,21 +6216,21 @@ to switch to narrowing." (effort-op org-agenda-filter-effort-default-operator) (effort-prompt "") (inhibit-read-only t) - (current org-agenda-filter) + (current org-agenda-tag-filter) maybe-refresh a n tag) (unless char (message "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: " (if narrow "Narrow" "Filter") tag-chars (if org-agenda-auto-exclude-function "[RET], " "")) - (setq char (read-char))) + (setq char (read-char-exclusive))) (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))) + (setq char (read-char-exclusive))) (when (member char '(?< ?> ?= ??)) ;; An effort operator (setq effort-op (char-to-string char)) @@ -6154,7 +6243,7 @@ to switch to narrowing." (if (= i 9) "0" (int-to-string (1+ i))) "]" (nth i efforts)))) (message "Effort%s: %s " effort-op effort-prompt) - (setq char (read-char)) + (setq char (read-char-exclusive)) (when (or (< char ?0) (> char ?9)) (error "Need 1-9,0 to select effort" )))) (when (equal char ?\t) @@ -6166,20 +6255,26 @@ to switch to narrowing." "Tag: " org-global-tags-completion-table)))) (cond ((equal char ?\r) - (org-agenda-filter-by-tag-show-all) + (org-agenda-filter-show-all-tag) (when org-agenda-auto-exclude-function - (setq org-agenda-filter '()) + (setq org-agenda-tag-filter '()) (dolist (tag (org-agenda-get-represented-tags)) (let ((modifier (funcall org-agenda-auto-exclude-function tag))) (if modifier - (push modifier org-agenda-filter)))) - (if (not (null org-agenda-filter)) - (org-agenda-filter-apply org-agenda-filter))) + (push modifier org-agenda-tag-filter)))) + (if (not (null org-agenda-tag-filter)) + (org-agenda-filter-apply org-agenda-tag-filter 'tag))) (setq maybe-refresh t)) ((equal char ?/) - (org-agenda-filter-by-tag-show-all) - (when (get 'org-agenda-filter :preset-filter) - (org-agenda-filter-apply org-agenda-filter)) + (org-agenda-filter-show-all-tag) + (when (get 'org-agenda-tag-filter :preset-filter) + (org-agenda-filter-apply org-agenda-tag-filter 'tag)) + (setq maybe-refresh t)) + ((equal char ?. ) + (setq org-agenda-tag-filter + (mapcar (lambda(tag) (concat "+" tag)) + (org-get-at-bol 'tags))) + (org-agenda-filter-apply org-agenda-tag-filter 'tag) (setq maybe-refresh t)) ((or (equal char ?\ ) (setq a (rassoc char alist)) @@ -6191,12 +6286,12 @@ to switch to narrowing." (setq tag "?eff") a (cons tag nil)) (and tag (setq a (cons tag nil)))) - (org-agenda-filter-by-tag-show-all) + (org-agenda-filter-show-all-tag) (setq tag (car a)) - (setq org-agenda-filter + (setq org-agenda-tag-filter (cons (concat (if strip "-" "+") tag) (if narrow current nil))) - (org-agenda-filter-apply org-agenda-filter) + (org-agenda-filter-apply org-agenda-tag-filter 'tag) (setq maybe-refresh t)) (t (error "Invalid tag selection character %c" char))) (when (and maybe-refresh @@ -6215,15 +6310,17 @@ to switch to narrowing." tags)) (defun org-agenda-filter-by-tag-refine (strip &optional char) - "Refine the current filter. See `org-agenda-filter-by-tag." + "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." + "Create the form that tests a line for agenda filter." (let (f f1) - (dolist (x (append (get 'org-agenda-filter :preset-filter) - org-agenda-filter)) + ;; first compute the tag-filter matcher + (dolist (x (delete-dups + (append (get 'org-agenda-tag-filter + :preset-filter) org-agenda-tag-filter))) (if (member x '("-" "+")) (setq f1 (if (equal x "-") 'tags '(not tags))) (if (string-match "[<=>?]" x) @@ -6232,6 +6329,12 @@ to switch to narrowing." (if (equal (string-to-char x) ?-) (setq f1 (list 'not f1)))) (push f1 f)) + ;; then compute the category-filter matcher + (dolist (x (delete-dups + (append (get 'org-agenda-category-filter + :preset-filter) org-agenda-category-filter))) + (setq f1 (list 'equal (substring x 1) 'cat)) + (push f1 f)) (cons 'and (nreverse f)))) (defun org-agenda-filter-effort-form (e) @@ -6256,49 +6359,64 @@ If the line does not have an effort defined, return nil." (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0)) value)))) -(defun org-agenda-filter-apply (filter) +(defvar org-agenda-filtered-by-category nil) +(defun org-agenda-filter-apply (filter type) "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)) + (if (eq type 'tag) + (setq org-agenda-tag-filter filter) + (setq org-agenda-category-filter filter + org-agenda-filtered-by-category t)) + (setq org-agenda-filter-form (org-agenda-filter-make-matcher)) (org-agenda-set-mode-name) (save-excursion (goto-char (point-min)) (while (not (eobp)) (if (org-get-at-bol 'org-marker) (progn - (setq tags (org-get-at-bol 'tags)) ; used in eval + (setq tags (org-get-at-bol 'tags) ; used in eval + cat (get-text-property (point) 'org-category)) (if (not (eval org-agenda-filter-form)) - (org-agenda-filter-by-tag-hide-line)) + (org-agenda-filter-hide-line type)) (beginning-of-line 2)) (beginning-of-line 2)))) (if (get-char-property (point) 'invisible) (org-agenda-previous-line)))) -(defun org-agenda-filter-by-tag-hide-line () +(defun org-agenda-filter-hide-line (type) (let (ov) (setq ov (make-overlay (max (point-min) (1- (point-at-bol))) (point-at-eol))) (overlay-put ov 'invisible t) - (overlay-put ov 'type 'tags-filter) - (push ov org-agenda-filter-overlays))) + (overlay-put ov 'type type) + (if (eq type 'tag) + (push ov org-agenda-tag-filter-overlays) + (push ov org-agenda-cat-filter-overlays)))) (defun org-agenda-fix-tags-filter-overlays-at (&optional pos) (setq pos (or pos (point))) (save-excursion (dolist (ov (overlays-at pos)) (when (and (overlay-get ov 'invisible) - (eq (overlay-get ov 'type) 'tags-filter)) + (eq (overlay-get ov 'type) 'tag)) (goto-char pos) (if (< (overlay-start ov) (point-at-eol)) (move-overlay ov (point-at-eol) (overlay-end ov))))))) -(defun org-agenda-filter-by-tag-show-all () - (mapc 'delete-overlay org-agenda-filter-overlays) - (setq org-agenda-filter-overlays nil) - (setq org-agenda-filter nil) - (setq org-agenda-filter-form nil) +(defun org-agenda-filter-show-all-tag nil + (mapc 'delete-overlay org-agenda-tag-filter-overlays) + (setq org-agenda-tag-filter-overlays nil + org-agenda-tag-filter nil + org-agenda-filter-form nil) + (org-agenda-set-mode-name)) + +(defun org-agenda-filter-show-all-cat nil + (mapc 'delete-overlay org-agenda-cat-filter-overlays) + (setq org-agenda-cat-filter-overlays nil + org-agenda-filtered-by-category nil + org-agenda-category-filter nil + org-agenda-filter-form nil) (org-agenda-set-mode-name)) (defun org-agenda-manipulate-query-add () @@ -6592,8 +6710,7 @@ so that the date SD will be in that range." (interactive) (setq org-agenda-follow-mode (not org-agenda-follow-mode)) (org-agenda-set-mode-name) - (if (and org-agenda-follow-mode (org-get-at-bol 'org-marker)) - (org-agenda-show)) + (org-agenda-do-context-action) (message "Follow mode is %s" (if org-agenda-follow-mode "on" "off"))) @@ -6714,13 +6831,33 @@ When called with a prefix argument, include all archive files as well." ((eq org-agenda-show-log 'clockcheck) " ClkCk") (org-agenda-show-log " Log") (t "")) - (if (or org-agenda-filter (get 'org-agenda-filter + (if (or org-agenda-category-filter (get 'org-agenda-category-filter + :preset-filter)) + '(:eval (org-propertize + (concat " <" + (mapconcat + 'identity + (append + (get 'org-agenda-category-filter :preset-filter) + org-agenda-category-filter) + "") + ">") + 'face 'org-agenda-filter-category + 'help-echo "Category used in filtering")) + "") + (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter)) - (concat " {" (mapconcat - 'identity - (append (get 'org-agenda-filter - :preset-filter) - org-agenda-filter) "") "}") + '(:eval (org-propertize + (concat " {" + (mapconcat + 'identity + (append + (get 'org-agenda-tag-filter :preset-filter) + org-agenda-tag-filter) + "") + "}") + 'face 'org-agenda-filter-tags + 'help-echo "Tags used in filtering")) "") (if org-agenda-archives-mode (if (eq org-agenda-archives-mode t) @@ -6754,11 +6891,13 @@ When called with a prefix argument, include all archive files as well." (defun org-agenda-do-context-action () "Show outline path and, maybe, follow mode window." (let ((m (org-get-at-bol 'org-marker))) - (if (and org-agenda-follow-mode m) - (org-agenda-show)) - (if (and m org-agenda-show-outline-path) - (org-with-point-at m - (org-display-outline-path t))))) + (when (and (markerp m) (marker-buffer m)) + (and org-agenda-follow-mode + (if org-agenda-follow-indirect + (org-agenda-tree-to-indirect-buffer) + (org-agenda-show))) + (and org-agenda-show-outline-path + (org-with-point-at m (org-display-outline-path t)))))) (defun org-agenda-show-priority () "Show the priority of the current item. @@ -6788,7 +6927,7 @@ and by additional input from the age of a schedules or deadline entry." (widen) (push-mark) (goto-char pos) - (when (org-mode-p) + (when (eq major-mode 'org-mode) (org-show-context 'agenda) (save-excursion (and (outline-next-heading) @@ -6817,7 +6956,7 @@ Point is in the buffer where the item originated.") (with-current-buffer buffer (save-excursion (goto-char pos) - (if (and (org-mode-p) (not (member type '("sexp")))) + (if (and (eq major-mode 'org-mode) (not (member type '("sexp")))) (setq dbeg (progn (org-back-to-heading t) (point)) dend (org-end-of-subtree t t)) (setq dbeg (point-at-bol) @@ -6869,7 +7008,7 @@ Point is in the buffer where the item originated.") (pos (marker-position marker))) (org-with-remote-undo buffer (with-current-buffer buffer - (if (org-mode-p) + (if (eq major-mode 'org-mode) (if (and confirm (not (y-or-n-p "Archive this subtree or entry? "))) (error "Abort") @@ -6970,11 +7109,11 @@ at the text of the entry itself." (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker))) - (switch-to-buffer buffer) + (org-pop-to-buffer-same-window buffer) (and delete-other-windows (delete-other-windows)) (widen) (goto-char pos) - (when (org-mode-p) + (when (eq major-mode 'org-mode) (org-show-context 'agenda) (save-excursion (and (outline-next-heading) @@ -7138,6 +7277,22 @@ With numerical prefix arg ARG, go up to this level and then take that tree. With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't use the dedicated frame)." (interactive) + (if (and current-prefix-arg (listp current-prefix-arg)) + (org-agenda-do-tree-to-indirect-buffer) + (let ((agenda-window (selected-window)) + (indirect-window (get-buffer-window org-last-indirect-buffer))) + (save-window-excursion (org-agenda-do-tree-to-indirect-buffer)) + (unwind-protect + (progn + (unless indirect-window + (setq indirect-window (split-window agenda-window))) + (select-window indirect-window) + (switch-to-buffer org-last-indirect-buffer :norecord) + (fit-window-to-buffer indirect-window)) + (select-window agenda-window))))) + +(defun org-agenda-do-tree-to-indirect-buffer () + "Same as `org-agenda-tree-to-indirect-buffer' without saving window." (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) @@ -7227,7 +7382,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." &optional fixface just-this) "Change all lines in the agenda buffer which match HDMARKER. The new content of the line will be NEWHEAD (as modified by -`org-format-agenda-item'). HDMARKER is checked with +`org-agenda-format-item'). HDMARKER is checked with `equal' against all `org-hd-marker' text properties in the file. If FIXFACE is non-nil, the face of each item is modified according to the new TODO state. @@ -7260,7 +7415,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (save-excursion (save-restriction (widen) - (org-format-agenda-item (org-get-at-bol 'extra) + (org-agenda-format-item (org-get-at-bol 'extra) newhead cat tags dotime))))) pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) undone-face (org-get-at-bol 'undone-face) @@ -7494,15 +7649,33 @@ the same tree node, and the headline of the tree node in the Org-mode file." (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) (buffer (marker-buffer marker)) - (pos (marker-position marker))) + (pos (marker-position marker)) + cdate today) (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (if (not (org-at-timestamp-p)) - (error "Cannot find time stamp")) - (org-timestamp-change arg (or what 'day))) - (org-agenda-show-new-time marker org-last-changed-timestamp)) + (with-current-buffer buffer + (widen) + (goto-char pos) + (if (not (org-at-timestamp-p)) + (error "Cannot find time stamp")) + (when (and org-agenda-move-date-from-past-immediately-to-today + (equal arg 1) + (or (not what) (eq what 'day)) + (not (save-match-data (org-at-date-range-p)))) + (setq cdate (org-parse-time-string (match-string 0) 'nodefault) + cdate (calendar-absolute-from-gregorian + (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate))) + today (org-today)) + (if (> today cdate) + ;; immediately shift to today + (setq arg (- today cdate)))) + (org-timestamp-change arg (or what 'day)) + (when (and (org-at-date-range-p) + (re-search-backward org-tr-regexp-both (point-at-bol))) + (let ((end org-last-changed-timestamp)) + (org-timestamp-change arg (or what 'day)) + (setq org-last-changed-timestamp + (concat org-last-changed-timestamp "--" end))))) + (org-agenda-show-new-time marker org-last-changed-timestamp)) (message "Time stamp changed to %s" org-last-changed-timestamp))) (defun org-agenda-date-earlier (arg &optional what) @@ -7827,7 +8000,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to ((eq type 'anniversary) (or (re-search-forward "^*[ \t]+Anniversaries" nil t) (progn - (or (org-on-heading-p t) + (or (org-at-heading-p t) (progn (outline-next-heading) (insert "* Anniversaries\n\n") @@ -7843,10 +8016,10 @@ the resulting entry will not be shown. When TEXT is empty, switch to (org-agenda-time-leading-zero t) fmt time time2) (if org-agenda-insert-diary-extract-time - ;; Use org-format-agenda-item to parse text for a time-range and + ;; Use org-agenda-format-item to parse text for a time-range and ;; remove it. FIXME: This is a hack, we should refactor ;; that function to make time extraction available separately - (setq fmt (org-format-agenda-item nil text nil nil t) + (setq fmt (org-agenda-format-item nil text nil nil t) time (get-text-property 0 'time fmt) time2 (if (> (length time) 0) ;; split-string removes trailing ...... if @@ -8299,7 +8472,8 @@ The prefix arg is passed through to the command if possible." (progn (message "Skipping removed entry at %s" e) (setq cntskip (1+ cntskip))) (goto-char pos) - (eval cmd) + (let (org-loop-over-headlines-in-active-region) + (eval cmd)) (setq org-agenda-bulk-marked-entries (delete e org-agenda-bulk-marked-entries)) (setq cnt (1+ cnt)))) @@ -8331,7 +8505,7 @@ tag and (if present) the flagging note." (org-agenda-remove-flag hdmarker) (let ((win (get-buffer-window "*Flagging Note*"))) (and win (delete-window win))) - (message "Entry unflagged")) + (message "Entry unflaged")) (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE")) (unless note (error "No flagging note")) @@ -8354,7 +8528,7 @@ tag and (if present) the flagging note." (org-entry-delete nil "THEFLAGGINGNOTE") (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead marker) - (message "Entry unflagged"))) + (message "Entry unflaged"))) (defun org-agenda-get-any-marker (&optional pos) (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker) @@ -8365,7 +8539,7 @@ tag and (if present) the flagging note." (defvar appt-time-msg-list) ;;;###autoload -(defun org-agenda-to-appt (&optional refresh filter) +(defun org-agenda-to-appt (&optional refresh filter &rest args) "Activate appointments found in `org-agenda-files'. With a \\[universal-argument] prefix, refresh the list of appointments. @@ -8376,6 +8550,10 @@ expression, and filter out entries that don't match it. If FILTER is a string, use this string as a regular expression for filtering entries out. +If FILTER is a function, filter out entries against which +calling the function returns nil. This function takes one +argument: an entry from `org-agenda-get-day-entries'. + FILTER can also be an alist with the car of each cell being either 'headline or 'category. For example: @@ -8383,12 +8561,18 @@ either 'headline or 'category. For example: (category \"Work\")) will only add headlines containing IMPORTANT or headlines -belonging to the \"Work\" category." +belonging to the \"Work\" category. + +ARGS are symbols indicating what kind of entries to consider. +By default `org-agenda-to-appt' will use :deadline, :scheduled +and :timestamp entries. See the docstring of `org-diary' for +details and examples." (interactive "P") (if refresh (setq appt-time-msg-list nil)) (if (eq filter t) (setq filter (read-from-minibuffer "Regexp filter: "))) (let* ((cnt 0) ; count added events + (scope (or args '(:deadline :scheduled :timestamp))) (org-agenda-new-buffers nil) (org-deadline-warning-days 0) ;; Do not use `org-today' here because appt only takes @@ -8402,10 +8586,10 @@ belonging to the \"Work\" category." (org-prepare-agenda-buffers files) (while (setq file (pop files)) (setq entries - (append entries - (org-agenda-get-day-entries - file today :timestamp :scheduled :deadline)))) - (setq entries (delq nil entries)) + (delq nil + (append entries + (apply 'org-agenda-get-day-entries + file today scope))))) ;; Map thru entries and find if we should filter them out (mapc (lambda(x) @@ -8414,11 +8598,14 @@ belonging to the \"Work\" category." (tod (get-text-property 1 'time-of-day x)) (ok (or (null filter) (and (stringp filter) (string-match filter evt)) + (and (functionp filter) (funcall filter x)) (and (listp filter) - (or (string-match - (cadr (assoc 'category filter)) cat) - (string-match - (cadr (assoc 'headline filter)) evt)))))) + (let ((cat-filter (cadr (assoc 'category filter))) + (evt-filter (cadr (assoc 'headline filter)))) + (or (and (stringp cat-filter) + (string-match cat-filter cat)) + (and (stringp evt-filter) + (string-match evt-filter evt)))))))) ;; FIXME: Shall we remove text-properties for the appt text? ;; (setq evt (set-text-properties 0 (length evt) nil evt)) (when (and ok tod) @@ -8441,8 +8628,14 @@ belonging to the \"Work\" category." date))) (eq date today))) -(provide 'org-agenda) - +(defun org-agenda-todo-yesterday (&optional arg) + "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday" + (interactive "P") + (let* ((hour (third (decode-time + (org-current-time)))) + (org-extend-today-until (1+ hour))) + (org-agenda-todo arg))) +(provide 'org-agenda) ;;; org-agenda.el ends here |