From 3c82287e59ac1090c1f0bc680b6162ebc87953a4 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Mon, 27 Dec 2010 18:25:19 +0100 Subject: [PATCH 10/10] org-format-agenda-item use a full line format * org-agenda.el (org-agenda-custom-commands-local-options): Rename prefix format to format. (org-agenda-format-alist): New defcustom superseding `org-agenda-prefix-format'. (org-timeline, org-agenda-list, org-search-view) (org-todo-list, org-diary): Set org-agenda-format correctly. (org-search-view, org-agenda-get-todos) (org-agenda-get-timestamps, org-agenda-get-deadlines) (org-agenda-get-scheduled, org-agenda-get-blocks): Stop setting properties now set by `org-format-agenda-item'. (org-format-agenda-item): Automatically gets arguments from current buffer position and user org-format-spec to format the string. (org-agenda-format-tags): New function. (org-agenda-change-all-lines): Take only a marker as argument, the rest is automatically computed. Signed-off-by: Julien Danjou --- lisp/org-agenda.el | 729 +++++++++++++++++----------------------------------- lisp/org.el | 2 +- 2 files changed, 241 insertions(+), 490 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index f58ebe1..f95c89c 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -238,8 +238,8 @@ you can \"misuse\" it to also add other text to the header. However, (const :format "" quote) (repeat ,org-sorting-choice))) - (list :tag "Prefix format" - (const org-agenda-prefix-format :value " %-12:c%?-12t% s") + (list :tag "Format" + (const org-agenda-format :value " %i %-12:c%?-12t%? :x%o % s%+T") (string)) (list :tag "Number of days in agenda" (const org-agenda-span) @@ -1295,12 +1295,18 @@ When nil, such items are sorted as 0 minutes effort." :tag "Org Agenda Line Format" :group 'org-agenda) -(defcustom org-agenda-prefix-format - '((agenda . " %i %-12:c%?-12t% s") - (timeline . " % s") - (todo . " %i %-12:c") - (tags . " %i %-12:c") - (search . " %i %-12:c")) +(defvar org-agenda-format " %i %-12:c%?-12t%?: x%o % p% s%+T" + "Format used by `org-format-agenda-item'.") + +(defvar org-agenda-format-not-agenda " %i %-12:c %o% p% s%+T" + "Default format for timeline, todo, etc views.") + +(defcustom org-agenda-format-alist + `((agenda . ,org-agenda-format) + (timeline . ,org-agenda-format-not-agenda) + (todo . ,org-agenda-format-not-agenda) + (tags . ,org-agenda-format-not-agenda) + (search . ,org-agenda-format-not-agenda)) "Format specifications for the prefix of items in the agenda views. An alist with four entries, for the different agenda types. The keys to the sublists are `agenda', `timeline', `todo', `search' and `tags'. The values @@ -1311,11 +1317,17 @@ This format works similar to a printf format, with the following meaning: as given by the CATEGORY keyword or derived from the file name. %i the icon category of the item, as give in `org-agenda-category-icon-alist'. - %T the *last* tag of the item. Last because inherited tags come - first in the list. + %T the tags %t the time-of-day specification if one applies to the entry, in the format HH:MM - %s Scheduling/Deadline information, a short string + %x Scheduling/Deadline information, a short string + %s The heading + %o The TODO state + %p The priority + %S The start time + %E The end time + %e The effort + %E The effort in minute %(expression) Eval EXPRESSION and replace the control string by the result @@ -1337,22 +1349,26 @@ the value is not empty. For example, the format \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If the category were be empty, no additional colon would be inserted. -The default value of this option is \" %-12:c%?-12t% s\", meaning: +If the length specified is just `+', then the text will be right +aligned to `fill-column'. + +The default value of this option is \" %i %-12:c%?-12t%?: x%o % p% s%+T\", meaning: - Indent the line with two space characters +- Put the category icon and a space. - Give the category in a 12 chars wide field, padded with whitespace on the right (because of `-'). Append a colon if there is a category (because of `:'). - If there is a time-of-day, put it into a 12 chars wide field. If no time, don't put in an empty field, just skip it (because of '?'). -- Finally, put the scheduling information and append a whitespace. +- Put the scheduling information and append a whitespace. +- Put the entry +- Put the entry heading. +- Finally, put the tags right aligned. As another example, if you don't want the time-of-day of entries in the prefix, you could use: - (setq org-agenda-prefix-format \" %-11:c% s\") - -See also the variables `org-agenda-remove-times-when-in-prefix' and -`org-agenda-remove-tags'. + (setq org-agenda-format \" %-11:c% s\ %+T\") Custom commands can set this variable in the options section." :type '(choice @@ -1365,18 +1381,7 @@ Custom commands can set this variable in the options section." (cons (const search) (string :tag "Format")))) :group 'org-agenda-line-format) -(defvar org-prefix-format-compiled nil - "The compiled version of the most recently used prefix format. -See the variable `org-agenda-prefix-format'.") - -(defcustom org-agenda-todo-keyword-format "%-1s" - "Format for the TODO keyword in agenda lines. -Set this to something like \"%-12s\" if you want all TODO keywords -to occupy a fixed space in the agenda display." - :group 'org-agenda-line-format - :type 'string) - -(defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") +(defcustom org-agenda-timerange-leaders '("" "(%d/%d)") "Text preceding timerange entries in the agenda view. This is a list with two strings. The first applies when the range is entirely on one day. The second applies if the range spans several days. @@ -1390,7 +1395,7 @@ range, respectively." (string :tag "Format string") (function)))) -(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") +(defcustom org-agenda-scheduled-leaders '("Scheduled" "Sched.%2dx") "Text preceding scheduled items in the agenda view. This is a list with two strings. The first applies when the item is scheduled on the current day. The second applies when it has been scheduled @@ -1411,7 +1416,7 @@ These entries are added to the agenda when pressing \"[\"." (string :tag "Scheduled today ") (string :tag "Scheduled previously"))) -(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") +(defcustom org-agenda-deadline-leaders '("Deadline" "In %3d d.") "Text preceding deadline items in the agenda view. This is a list with two strings. The first applies when the item has its deadline on the current day. The second applies when it is in the past or @@ -1424,23 +1429,6 @@ is (was)." (string :tag "Format string") (function)))) -(defcustom org-agenda-remove-times-when-in-prefix t - "Non-nil means remove duplicate time specifications in agenda items. -When the format `org-agenda-prefix-format' contains a `%t' specifier, a -time-of-day specification in a headline or diary entry is extracted and -placed into the prefix. If this option is non-nil, the original specification -\(a timestamp or -range, or just a plain time(range) specification like -11:30-4pm) will be removed for agenda display. This makes the agenda less -cluttered. -The option can be t or nil. It may also be the symbol `beg', indicating -that the time should only be removed when it is located at the beginning of -the headline/diary entry." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When at beginning of entry" beg))) - (defcustom org-agenda-remove-timeranges-from-blocks nil "Non-nil means remove time ranges specifications in agenda items that span on several days." @@ -1471,31 +1459,6 @@ Nil means don't hide any tags." (const :tag "Hide none" nil) (string :tag "Regexp "))) -(defcustom org-agenda-remove-tags nil - "Non-nil means remove the tags from the headline copy in the agenda. -When this is the symbol `prefix', only remove tags when -`org-agenda-prefix-format' contains a `%T' specifier." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When prefix format contains %T" prefix))) - -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-remove-tags-when-in-prefix - 'org-agenda-remove-tags)) - -(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80) - "Shift tags in agenda items to this column. -If this number is positive, it specifies the column. If it is negative, -it means that the tags should be flushright to that column. For example, --80 works well for a normal 80 character screen." - :group 'org-agenda-line-format - :type 'integer) - -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) - (defcustom org-agenda-fontify-priorities 'cookies "Non-nil means highlight low and high priorities in agenda. When t, the highest priority entries are bold, lowest priority italic. @@ -2525,7 +2488,6 @@ 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) (if (> (length cmd-key) 2) (eval (list 'let (nreverse pars) (list 'org-tags-view nil cmd-key))) @@ -2986,7 +2948,6 @@ the global options and expect it to be applied to the entire view.") (while (org-activate-bracket-links (point-max)) (add-text-properties (match-beginning 0) (match-end 0) '(face org-link))) - (org-agenda-align-tags) (unless org-agenda-with-colors (remove-text-properties (point-min) (point-max) '(face nil)))) (if (and (boundp 'org-agenda-overriding-columns-format) @@ -3223,9 +3184,10 @@ under the current date. If the buffer contains an active region, only check the region for dates." (interactive "P") - (org-compile-prefix-format 'timeline) (org-set-sorting-strategy 'timeline) - (let* ((dopast t) + (let* ((org-agenda-format (or (cdr (assq 'timeline org-agenda-format-alist)) + org-agenda-format)) + (dopast t) (dotodo include-all) (doclosed org-agenda-show-log) (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) @@ -3419,9 +3381,10 @@ given in `org-agenda-start-on-weekday'." ;; 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)) - (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) (let* ((span (org-agenda-ndays-to-span (or span org-agenda-ndays org-agenda-span))) + (org-agenda-format (or (cdr (assq 'agenda org-agenda-format-alist)) + org-agenda-format)) (today (org-today)) (sd (or start-day today)) (ndays (org-agenda-span-to-ndays span sd)) @@ -3677,11 +3640,9 @@ as a whole, to include whitespace. This command searches the agenda files, and in addition the files listed in `org-agenda-text-search-extra-files'." (interactive "P") - (org-compile-prefix-format 'search) (org-set-sorting-strategy 'search) (org-prepare-agenda "SEARCH") - (let* ((props (list 'face nil - 'done-face 'org-agenda-done + (let* ((props (list 'done-face 'org-agenda-done 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp @@ -3689,8 +3650,10 @@ in `org-agenda-text-search-extra-files'." 'help-echo (format "mouse-2 or RET jump to location"))) (full-words org-agenda-search-view-force-full-words) (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) + (org-agenda-format (or (cdr (assq 'search org-agenda-format-alist)) + org-agenda-format)) regexp rtn rtnall files file pos - marker c neg re boolean + c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) @@ -3832,13 +3795,8 @@ in `org-agenda-text-search-extra-files'." regexps+) regexps+)) (goto-char beg) - (setq marker (org-agenda-new-marker (point)) - txt (org-format-agenda-item - "" - (buffer-substring-no-properties - beg1 (point-at-eol)))) + (setq txt (org-format-agenda-item)) (org-add-props txt props - 'org-marker marker 'org-hd-marker marker 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'priority 1000 @@ -3883,7 +3841,6 @@ the list to these. When using \\[universal-argument], you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'." (interactive "P") - (org-compile-prefix-format 'todo) (org-set-sorting-strategy 'todo) (org-prepare-agenda "TODO") (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) @@ -3891,6 +3848,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (date (calendar-gregorian-from-absolute today)) (kwds org-todo-keywords-for-agenda) (completion-ignore-case t) + (org-agenda-format (or (cdr (assq 'todo org-agenda-format-alist)) + org-agenda-format)) (org-select-this-todo-keyword (if (stringp arg) arg (and arg (integerp arg) (> arg 0) @@ -3952,11 +3911,12 @@ for a keyword. A numeric prefix directly selects the Nth keyword in "Show all headlines for all `org-agenda-files' matching a TAGS criterion. The prefix arg TODO-ONLY limits the search to TODO entries." (interactive "P") - (org-compile-prefix-format 'tags) (org-set-sorting-strategy 'tags) (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) (completion-ignore-case t) + (org-agenda-format (or (cdr (assq 'tags org-agenda-format-alist)) + org-agenda-format)) rtn rtnall files file pos matcher buffer) (when (and (stringp match) (not (string-match "\\S-" match))) @@ -4272,7 +4232,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" 'time)) + (setq x (org-format-agenda-item "" x nil "Diary" '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)) @@ -4375,12 +4335,13 @@ function from a program - use `org-agenda-get-day-entries' instead." org-agenda-last-marker-time) 5) (org-agenda-reset-markers)) - (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) (setq args (or args '(:deadline :scheduled :timestamp :sexp))) (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) (list entry) (org-agenda-files t))) + (org-agenda-format (or (cdr (assq 'agenda org-agenda-format-alist)) + org-agenda-format)) (time (org-float-time)) file rtn results) (when (or (not org-diary-last-run-time) @@ -4455,15 +4416,10 @@ the documentation of `org-diary'." (defun org-agenda-get-todos () "Return the TODO information for agenda display." - (let* ((props (list 'face nil - 'done-face 'org-agenda-done + (let* ((props (list 'done-face 'org-agenda-done 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'mouse-face 'highlight - 'help-echo - (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) + 'org-complex-heading-regexp org-complex-heading-regexp)) (regexp (concat "^\\*+[ \t]+\\(" (if org-select-this-todo-keyword (if (equal org-select-this-todo-keyword "*") @@ -4489,12 +4445,10 @@ the documentation of `org-diary'." (org-agenda-skip) (goto-char (match-beginning 1)) (setq marker (org-agenda-new-marker (match-beginning 0)) - txt (match-string 1) - txt (org-format-agenda-item "" txt) + txt (org-format-agenda-item) 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 'type "todo" 'todo-state todo-state) (push txt ee) @@ -4562,8 +4516,7 @@ the documentation of `org-diary'." (defun org-agenda-get-timestamps () "Return the date stamp information for agenda display." - (let* ((props (list 'face nil - 'org-not-done-regexp org-not-done-regexp + (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'mouse-face 'highlight @@ -4590,8 +4543,8 @@ the documentation of `org-diary'." 1 11)) "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) - marker hdmarker deadlinep scheduledp clockp closedp inactivep - donep tmp priority ee txt timestr b0 b3 e3 head + deadlinep scheduledp clockp closedp inactivep + donep tmp priority ee txt timestr b0 b3 e3 todo-state end-of-match) (goto-char (point-min)) (while (setq end-of-match (re-search-forward regexp nil t)) @@ -4628,21 +4581,17 @@ the documentation of `org-diary'." (if (string-match ">" timestr) ;; substring should only run to end of time stamp (setq timestr (substring timestr 0 (match-end 0)))) - (setq marker (org-agenda-new-marker b0)) (save-excursion (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (match-string 1)) (setq txt (org-format-agenda-item (if inactivep org-agenda-inactive-leader nil) - head nil timestr + nil nil nil timestr remove-re))) (setq priority (org-get-priority txt)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker) + (org-add-props txt props) (org-add-props txt nil 'priority priority 'date date 'todo-state todo-state @@ -4661,7 +4610,7 @@ the documentation of `org-diary'." (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") - marker ee txt entry result beg b sexp sexp-entry + ee txt entry result beg b sexp sexp-entry todo-state) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -4677,8 +4626,7 @@ the documentation of `org-diary'." "")) (setq result (org-diary-sexp-entry sexp sexp-entry date)) (when result - (setq marker (org-agenda-new-marker beg) - todo-state (org-get-todo-state)) + (setq todo-state (org-get-todo-state)) (dolist (r (if (stringp result) (list result) @@ -4688,8 +4636,7 @@ the documentation of `org-diary'." (setq txt "SEXP entry returned empty string")) (setq txt (org-format-agenda-item - "" txt nil 'time)) - (org-add-props txt props 'org-marker marker) + "" txt nil nil 'time)) (org-add-props txt nil 'date date 'todo-state todo-state 'type "sexp") @@ -4752,14 +4699,13 @@ be skipped." (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)))) (org-agenda-search-headline-for-time nil) - marker hdmarker priority closedp statep clockp state + priority closedp statep clockp state ee txt extra timestr rest clocked) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip (org-agenda-skip) - (setq marker (org-agenda-new-marker (match-beginning 0)) - closedp (equal (match-string 1) org-closed-string) + (setq closedp (equal (match-string 1) org-closed-string) statep (equal (string-to-char (match-string 1)) ?-) clockp (not (or closedp statep)) state (and statep (match-string 2)) @@ -4788,7 +4734,6 @@ be skipped." (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq txt (match-string 1)) (when extra @@ -4801,10 +4746,10 @@ be skipped." (closedp "Closed: ") (statep (concat "State: (" state ")")) (t (concat "Clocked: (" clocked ")"))) - txt nil timestr))) + txt nil nil timestr))) (setq priority 100000) (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done + 'face 'org-agenda-done 'priority priority 'type "closed" 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) @@ -4826,7 +4771,7 @@ be skipped." (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar d2 diff dfrac wdays pos pos1 suppress-prewarning - ee txt head face s todo-state upcomingp donep timestr) + ee txt face s todo-state upcomingp donep timestr) (goto-char (point-min)) (while (re-search-forward regexp nil t) (setq suppress-prewarning nil) @@ -4871,14 +4816,11 @@ be skipped." (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) (setq pos1 (match-beginning 0)) - (setq head (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "^\r\n") - (point)))) (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) (setq timestr (concat (substring s (match-beginning 1)) " ")) (setq timestr 'time)) + (setq face (org-agenda-deadline-face dfrac wdays)) (org-with-point-at pos1 (setq txt (org-format-agenda-item (if (= diff 0) @@ -4890,13 +4832,10 @@ be skipped." diff date) (format (nth 1 org-agenda-deadline-leaders) diff))) - head nil + nil face nil (if (not (= diff 0)) nil timestr)))))) (when txt - (setq face (org-agenda-deadline-face dfrac wdays)) (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)) 'todo-state todo-state @@ -4936,7 +4875,7 @@ FRACTION is what fraction of the head-warning time has passed." (cons (marker-position mm) a))) deadline-results)) d2 diff pos pos1 donep - ee txt head pastschedp todo-state face timestr s habitp) + ee txt pastschedp todo-state face timestr s habitp) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -4981,34 +4920,28 @@ FRACTION is what fraction of the head-warning time has passed." pastschedp)) (setq mm (assoc pos1 deadline-position-alist))) (throw :skip nil))) - (setq head (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "^\r\n") (point)))) (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) (setq timestr (concat (substring s (match-beginning 1)) " ")) (setq timestr 'time)) + (setq face + (cond + (donep 'org-agenda-done) + ((and (not habitp) pastschedp) + 'org-scheduled-previously) + (todayp 'org-scheduled-today) + (t 'org-scheduled))) (setq txt (org-format-agenda-item (if (= diff 0) (car org-agenda-scheduled-leaders) (format (nth 1 org-agenda-scheduled-leaders) (- 1 diff))) - head nil + nil face nil (if (not (= diff 0)) nil timestr) nil habitp)))) (when txt - (setq face - (cond - ((and (not habitp) pastschedp) - 'org-scheduled-previously) - (todayp 'org-scheduled-today) - (t 'org-scheduled)) - habitp (and habitp (org-habit-parse-todo))) (org-add-props txt props 'undone-face face - 'face (if donep 'org-agenda-done face) - 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker pos1) 'type (if pastschedp "past-scheduled" "scheduled") 'date (if pastschedp d2 date) 'priority (if habitp @@ -5021,8 +4954,7 @@ FRACTION is what fraction of the head-warning time has passed." (defun org-agenda-get-blocks () "Return the date-range information for agenda display." - (let* ((props (list 'face nil - 'org-not-done-regexp org-not-done-regexp + (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'mouse-face 'highlight @@ -5031,8 +4963,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 timestr todo-state pos - head donep) + ee txt d1 d2 s1 s2 timestr todo-state pos + donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -5051,13 +4983,10 @@ FRACTION is what fraction of the head-warning time has passed." (setq donep (member todo-state org-done-keywords)) (if (and donep org-agenda-skip-timestamp-if-done) (throw :skip t)) - (setq marker (org-agenda-new-marker (point))) (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker (point))) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (match-string 1)) (let ((remove-re (if org-agenda-remove-timeranges-from-blocks (concat @@ -5070,10 +4999,9 @@ FRACTION is what fraction of the head-warning time has passed." (nth (if (= d1 d2) 0 1) org-agenda-timerange-leaders) (1+ (- d0 d1)) (1+ (- d2 d1))) - head nil + nil nil nil timestr remove-re)))) (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date 'todo-state todo-state 'priority (org-get-priority txt)) @@ -5084,33 +5012,23 @@ FRACTION is what fraction of the head-warning time has passed." ;;; Agenda presentation and sorting -(defvar org-prefix-has-time nil - "A flag, set by `org-compile-prefix-format'. -The flag is set if the currently compiled format contains a `%t'.") -(defvar org-prefix-has-tag nil - "A flag, set by `org-compile-prefix-format'. -The flag is set if the currently compiled format contains a `%T'.") -(defvar org-prefix-has-effort nil - "A flag, set by `org-compile-prefix-format'. -The flag is set if the currently compiled format contains a `%e'.") -(defvar org-prefix-category-length nil - "Used by `org-compile-prefix-format' to remember the category field width.") -(defvar org-prefix-category-max-length nil - "Used by `org-compile-prefix-format' to remember the category field width.") - (defun org-agenda-get-category-icon (category) "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." (dolist (entry org-agenda-category-icon-alist) - (when (org-string-match-p (car entry) category) + (when (org-string-match-p (car entry) (or category "")) (if (listp (cadr entry)) (return (cadr entry)) (return (apply 'create-image (cdr entry))))))) -(defun org-format-agenda-item (extra txt &optional category dotime +(defvar org-agenda-format-extra-spec nil + "Extra spec for `org-format-agenda-item'. +See `org-format-spec' for this list format.") + +(defun org-format-agenda-item (&optional extra heading face category dotime remove-re habitp) - "Format TXT to be inserted into the agenda buffer. -In particular, it adds the prefix and corresponding text properties. EXTRA -must be a string and replaces the `%s' specifier in the prefix format. + "Format HEADING to be inserted into the agenda buffer. +In particular, it adds the corresponding text properties. EXTRA +must be a string and replaces the `%s' specifier in the format. CATEGORY (string, symbol or nil) may be used to overrule the default category taken from local variable or file name. It will replace the `%c' specifier in the format. DOTIME, when non-nil, indicates that a @@ -5119,29 +5037,34 @@ the `%t' specifier in the format. When DOTIME is a string, this string is searched for a time before TXT is. Any match of REMOVE-RE will be removed from TXT." (save-match-data - ;; Diary entries sometimes have extra whitespace at the beginning - (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) - (let* ((tags (org-get-tags-at)) - ;; Fix the tags part in txt - (txt (org-agenda-fix-displayed-tags - txt tags - org-agenda-show-inherited-tags - org-agenda-hide-tags-regexp)) + ;; If `heading' is specified, the we do not try to guess + ;; anything. + (heading-components (unless heading + (org-heading-components))) + (level (nth 0 heading-components)) + (reduced-level (nth 1 heading-components)) + (todo (nth 2 heading-components)) + (todo-face (org-get-todo-face todo)) + (priority (nth 3 heading-components)) + (heading (or heading (nth 4 heading-components))) (category (or category (org-get-category))) - (category-icon (org-agenda-get-category-icon category)) - (category-icon (if category-icon - (propertize " " 'display category-icon) - "")) - ;; time, tag, effort are needed for the eval of the prefix format - (tag (if tags (nth (1- (length tags)) tags) "")) - time effort neffort + ;; Do not try to get the effort if `heading' is specified. + (effort (when heading-components + (org-get-effort))) + (neffort (when effort (org-hh:mm-string-to-minutes effort))) + (effort (when effort (concat "[" effort "]" ))) + time (ts (if dotime (concat (if (stringp dotime) dotime "") - (and org-agenda-search-headline-for-time txt)))) + (and org-agenda-search-headline-for-time heading)))) (time-of-day (and dotime (org-get-time-of-day ts))) - stamp plain s0 s1 s2 rtn srp l + stamp plain s0 s1 s2 rtn srp duration) + + ;; Diary entries sometimes have extra whitespace at the beginning + (if (string-match "^ +" heading) (setq heading (replace-match "" nil nil heading))) + (and (org-mode-p) buffer-file-name (add-to-list 'org-agenda-contributing-files buffer-file-name)) (when (and dotime time-of-day) @@ -5154,16 +5077,11 @@ Any match of REMOVE-RE will be removed from TXT." s2 (match-string (if plain 8 (if srp 4 6)) ts)) ;; If the times are in TXT (not in DOTIMES), and the prefix will list - ;; them, we might want to remove them there to avoid duplication. - ;; The user can turn this off with a variable. - (if (and org-prefix-has-time - org-agenda-remove-times-when-in-prefix (or stamp plain) - (string-match (concat (regexp-quote s0) " *") txt) - (not (equal ?\] (string-to-char (substring txt (match-end 0))))) - (if (eq org-agenda-remove-times-when-in-prefix 'beg) - (= (match-beginning 0) 0) - t)) - (setq txt (replace-match "" nil nil txt)))) + ;; them, we want to remove them there to avoid duplication. + (if (and (or stamp plain) + (string-match (concat (regexp-quote s0) " *") heading) + (not (equal ?\] (string-to-char (substring heading (match-end 0)))))) + (setq heading (replace-match "" nil nil heading)))) ;; Normalize the time(s) to 24 hour (if s1 (setq s1 (org-get-time-of-day s1 'string t))) (if s2 (setq s2 (org-get-time-of-day s2 'string t))) @@ -5179,34 +5097,9 @@ Any match of REMOVE-RE will be removed from TXT." (setq duration (- (org-hh:mm-string-to-minutes s2) (org-hh:mm-string-to-minutes s1))))) - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") - txt) - ;; Tags are in the string - (if (or (eq org-agenda-remove-tags t) - (and org-agenda-remove-tags - org-prefix-has-tag)) - (setq txt (replace-match "" t t txt)) - (setq txt (replace-match - (concat (make-string (max (- 50 (length txt)) 1) ?\ ) - (match-string 2 txt)) - t t txt)))) - (when (org-mode-p) - (setq effort - (condition-case nil - (org-get-effort - (or (get-text-property 0 'org-hd-marker txt) - (get-text-property 0 'org-marker txt))) - (error nil))) - (when effort - (setq neffort (org-hh:mm-string-to-minutes effort) - effort (setq effort (concat "[" effort "]" ))))) - (when remove-re - (while (string-match remove-re txt) - (setq txt (replace-match "" t t txt)))) - - ;; Set org-heading property on `txt' - (setq txt (propertize txt 'org-heading t)) + (while (string-match remove-re heading) + (setq heading (replace-match "" t t heading)))) ;; Create the final string ;; Prepare the variables needed in the eval of the compiled format @@ -5218,24 +5111,31 @@ Any match of REMOVE-RE will be removed from TXT." (org-agenda-time-of-day-to-ampm-maybe s1) (if org-agenda-timegrid-use-ampm "........ " - "......"))) - (t "")) + "......")))) extra (or (and (not habitp) extra) "")) - (if (string-match org-bracket-link-regexp category) - (progn - (setq l (if (match-end 3) - (- (match-end 3) (match-beginning 3)) - (- (match-end 1) (match-beginning 1)))) - (when (< l (or org-prefix-category-length 0)) - (setq category (copy-sequence category)) - (org-add-props category nil - 'extra-space (make-string - (- org-prefix-category-length l 1) ?\ )))) - (if (and org-prefix-category-max-length - (>= (length category) org-prefix-category-max-length)) - (setq category (substring category 0 (1- org-prefix-category-max-length))))) - ;; Evaluate the compiled format - (setq rtn (concat (eval org-prefix-format-compiled) txt)) + ;; Evaluate the format + (setq rtn (org-format-spec (propertize org-agenda-format 'face face) + (append org-agenda-format-extra-spec + `((?s . (when heading + (org-activate-bracket-links-string + (propertize ,heading 'org-heading t)))) + (?i . (let ((category-icon + (org-agenda-get-category-icon category))) + (when category-icon + (propertize " " 'display category-icon)))) + (?o . (propertize ,(or todo "") + 'face (quote ,todo-face))) + (?p . ,priority) + (?S . ,s1) + (?E . ,s2) + (?o . ,todo) + (?t . ,time) + (?x . ,extra) + (?e . ,effort) + (?n . ,neffort) + (?T . (org-agenda-format-tags (quote ,tags))) + (?c . (when category + (org-activate-bracket-links-string ,category))))))) ;; And finally add the text properties (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) @@ -5248,42 +5148,47 @@ Any match of REMOVE-RE will be removed from TXT." 'duration duration 'effort effort 'effort-minutes neffort - 'txt txt + 'heading heading 'time time 'extra extra - 'dotime dotime)))) - -(defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) - "Remove tags string from TXT, and add a modified list of tags. -The modified list may contain inherited tags, and tags matched by + 'dotime dotime) + ;; If `heading' has not been specified, add markers + (when heading-components + (org-add-props rtn nil + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)) + 'org-marker (org-agenda-new-marker) + 'org-hd-marker (org-agenda-new-marker))) + rtn))) + +(defun org-agenda-format-tags (tags) + "Return the list of TAGS as a string. +The list may contain inherited tags, and tags matched by `org-agenda-hide-tags-regexp' will be removed." - (when (or add-inherited hide-re) - (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) - (setq txt (substring txt 0 (match-beginning 0)))) - (setq tags - (delq nil - (mapcar (lambda (tg) - (if (or (and hide-re (string-match hide-re tg)) - (and (not add-inherited) - (get-text-property 0 'inherited tg))) - nil - tg)) - tags))) - (when tags - (let ((have-i (get-text-property 0 'inherited (car tags))) - i) - (setq txt (concat txt " :" - (mapconcat - (lambda (x) - (setq i (get-text-property 0 'inherited x)) - (if (and have-i (not i)) - (progn - (setq have-i nil) - (concat ":" x)) - x)) - tags ":") - (if have-i "::" ":")))))) - txt) + (with-temp-buffer + ;; Insert tag string + (insert + (when (or org-agenda-show-inherited-tags + org-agenda-hide-tags-regexp) + (delq nil + (mapcar + (lambda (tag) + (unless (and (or (not org-agenda-hide-tags-regexp) + (not (org-string-match-p org-agenda-hide-tags-regexp tag))) + (or org-agenda-show-inherited-tags + (not (get-text-property 0 'inherited tag)))) + tag)) + tags)) + (if tags + (concat ":" (mapconcat 'identity tags ":") ":") + ""))) + ;; Add faces properties + (add-text-properties (point-min) (point-max) '(face org-tag)) + (goto-char (point-min)) + (org-font-lock-add-tag-faces (point-max)) + (buffer-string))) (defun org-downcase-keep-props (s) (let ((props (text-properties-at 0 s))) @@ -5316,73 +5221,24 @@ The modified list may contain inherited tags, and tags matched by (unless (and remove (member time have)) (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) (push (org-format-agenda-item - nil string "" + nil string nil 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 - nil + nil org-agenda-current-time-string - "" + 'org-agenda-current-time + nil (format-time-string "%H:%M ")) - new) - (put-text-property - 2 (length (car new)) 'face 'org-agenda-current-time (car new))) + new)) (if (member 'time-up org-agenda-sorting-strategy-selected) (append new list) (append list new))))) -(defun org-compile-prefix-format (key) - "Compile the prefix format into a Lisp form that can be evaluated. -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) - (let ((s (cond - ((stringp org-agenda-prefix-format) - org-agenda-prefix-format) - ((assq key org-agenda-prefix-format) - (cdr (assq key org-agenda-prefix-format))) - (t " %-12:c%?-12t% s"))) - (start 0) - varform vars var e c f opt) - (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\|(.+)\\)" - s start) - (setq var (or (cdr (assoc (match-string 4 s) - '(("c" . category) ("t" . time) ("s" . extra) - ("i" . category-icon) ("T" . tag) ("e" . effort)))) - 'eval) - c (or (match-string 3 s) "") - opt (match-beginning 1) - start (1+ (match-beginning 0))) - (if (equal var 'time) (setq org-prefix-has-time t)) - (if (equal var 'tag) (setq org-prefix-has-tag t)) - (if (equal var 'effort) (setq org-prefix-has-effort t)) - (setq f (concat "%" (match-string 2 s) "s")) - (when (equal var 'category) - (setq org-prefix-category-length - (floor (abs (string-to-number (match-string 2 s))))) - (setq org-prefix-category-max-length - (let ((x (match-string 2 s))) - (save-match-data - (if (string-match "\\.[0-9]+" x) - (string-to-number (substring (match-string 0 x) 1))))))) - (if (eq var 'eval) - (setq varform `(format ,f (org-eval ,(read (match-string 4 s))))) - (if opt - (setq varform - `(if (equal "" ,var) - "" - (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) - (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) - (setq s (replace-match "%s" t nil s)) - (push varform vars)) - (setq vars (nreverse vars)) - (setq org-prefix-format-compiled `(format ,s ,@vars)))) - (defun org-set-sorting-strategy (key) (if (symbolp (car org-agenda-sorting-strategy)) ;; the old format @@ -5442,46 +5298,12 @@ could bind the variable in the options section of a custom command.") (defun org-finalize-agenda-entries (list &optional nosort) "Sort and concatenate the agenda items." - (setq list (mapcar 'org-agenda-highlight-todo list)) (if nosort list (when org-agenda-before-sorting-filter-function (setq list (delq nil (mapcar org-agenda-before-sorting-filter-function list)))) (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))) -(defun org-agenda-highlight-todo (x) - (let ((org-done-keywords org-done-keywords-for-agenda) - (case-fold-search nil) - re) - (if (eq x 'line) - (save-excursion - (beginning-of-line 1) - (setq re (org-get-at-bol 'org-todo-regexp)) - (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point))) - (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) - (add-text-properties (match-beginning 0) (match-end 1) - (list 'face (org-get-todo-face 1))) - (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) - (delete-region (match-beginning 1) (1- (match-end 0))) - (goto-char (match-beginning 1)) - (insert (format org-agenda-todo-keyword-format s))))) - (let ((pl (text-property-any 0 (length x) 'org-heading t x))) - (setq re (concat (get-text-property 0 'org-todo-regexp x))) - (when (and re - (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") - x (or pl 0)) pl)) - (add-text-properties - (or (match-end 1) (match-end 0)) (match-end 0) - (list 'face (org-get-todo-face (match-string 2 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))))))) - x))) - (defsubst org-cmp-priority (a b) "Compare the priorities of string A and B." (let ((pa (or (get-text-property 1 'priority a) 0)) @@ -6830,7 +6652,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (hdmarker (org-get-at-bol 'org-hd-marker)) (todayp (org-agenda-todayp (org-get-at-bol 'day))) (inhibit-read-only t) - org-agenda-headline-snapshot-before-repeat newhead just-one) + org-agenda-headline-snapshot-before-repeat) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -6842,20 +6664,12 @@ the same tree node, and the headline of the tree node in the Org-mode file." (let ((current-prefix-arg arg)) (call-interactively 'org-todo)) (and (bolp) (forward-char 1)) - (setq newhead (org-get-heading)) - (when (and (org-bound-and-true-p - org-agenda-headline-snapshot-before-repeat) - (not (equal org-agenda-headline-snapshot-before-repeat - newhead)) - todayp) - (setq newhead org-agenda-headline-snapshot-before-repeat - just-one t)) (save-excursion (org-back-to-heading) (move-marker org-last-heading-marker (point)))) (beginning-of-line 1) (save-excursion - (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) + (org-agenda-change-all-lines hdmarker)) (org-move-to-column col)))) (defun org-agenda-add-note (&optional arg) @@ -6877,84 +6691,34 @@ the same tree node, and the headline of the tree node in the Org-mode file." (org-flag-heading nil))) ; show the next heading (org-add-note)))) -(defun org-agenda-change-all-lines (newhead hdmarker - &optional fixface just-this) +(defun org-agenda-change-all-lines (hdmarker) "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 -`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. -If JUST-THIS is non-nil, change just the current line, not all. -If FORCE-TAGS is non nil, the car of it returns the new tags." - (let* ((inhibit-read-only t) - (line (org-current-line)) - props m pl undone-face done-face finish new dotime) +HDMARKER is checked with `equal' against all `org-hd-marker' text +properties in the file." + (let ((inhibit-read-only t)) (save-excursion (goto-char (point-max)) (beginning-of-line 1) - (while (not finish) - (setq finish (bobp)) - (when (and (setq m (org-get-at-bol 'org-hd-marker)) - (or (not just-this) (= (org-current-line) line)) - (equal m hdmarker)) - (setq props (text-properties-at (point)) - dotime (org-get-at-bol 'dotime)) - (org-with-point-at hdmarker - (setq new (org-format-agenda-item - (org-get-at-bol 'extra) - newhead nil dotime))) - (setq - pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) - undone-face (org-get-at-bol 'undone-face) - done-face (org-get-at-bol 'done-face)) - (beginning-of-line 1) - (cond - ((equal new "") - (and (looking-at ".*\n?") (replace-match ""))) - ((looking-at ".*") - (replace-match new t t) + (while (not (bobp)) + (let ((current-marker (org-get-at-bol 'org-hd-marker))) + (when (and current-marker + (= hdmarker current-marker)) + (let ((dotime (org-get-at-bol 'dotime)) + (undone-face (org-get-at-bol 'undone-face)) + (done-face (org-get-at-bol 'done-face)) + (extra (org-get-at-bol 'extra))) + (org-with-point-at hdmarker + (setq new (org-format-agenda-item + extra nil + (if org-last-todo-state-is-todo + undone-face + done-face) + nil dotime)))) (beginning-of-line 1) - (add-text-properties (point-at-bol) (point-at-eol) props) - (when fixface - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'face - (if org-last-todo-state-is-todo - undone-face done-face)))) - (org-agenda-highlight-todo 'line) - (beginning-of-line 1)) - (t (error "Line update did not work")))) - (beginning-of-line 0))) - (org-finalize-agenda))) - -(defun org-agenda-align-tags (&optional line) - "Align all tags in agenda items to `org-agenda-tags-column'." - (let ((inhibit-read-only t) l c) - (save-excursion - (goto-char (if line (point-at-bol) (point-min))) - (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") - (if line (point-at-eol) nil) t) - (add-text-properties - (match-beginning 2) (match-end 2) - (list 'face (delq nil (let ((prop (get-text-property - (match-beginning 2) 'face))) - (or (listp prop) (setq prop (list prop))) - (if (memq 'org-tag prop) - prop - (cons 'org-tag prop)))))) - (setq l (- (match-end 2) (match-beginning 2)) - c (if (< org-agenda-tags-column 0) - (- (abs org-agenda-tags-column) l) - org-agenda-tags-column)) - (delete-region (match-beginning 1) (match-end 1)) - (goto-char (match-beginning 1)) - (insert (org-add-props - (make-string (max 1 (- c (current-column))) ?\ ) - (plist-put (copy-sequence (text-properties-at (point))) - 'face nil)))) - (goto-char (point-min)) - (org-font-lock-add-tag-faces (point-max))))) + (when (looking-at ".*") + (replace-match new t t)))) + (beginning-of-line 0)) + (org-finalize-agenda)))) (defun org-agenda-priority-up () "Increase the priority of line at point, also in Org-mode file." @@ -6979,8 +6743,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (hdmarker (org-get-at-bol 'org-hd-marker)) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -6990,9 +6753,8 @@ the same tree node, and the headline of the tree node in the Org-mode file." (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (funcall 'org-priority force-direction) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker) + (end-of-line 1)) + (org-agenda-change-all-lines hdmarker) (beginning-of-line 1)))) ;; FIXME: should fix the tags property of the agenda line. @@ -7007,8 +6769,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (org-agenda-error))) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -7022,9 +6783,8 @@ the same tree node, and the headline of the tree node in the Org-mode file." (if tag (org-toggle-tag tag onoff) (call-interactively 'org-set-tags)) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker) + (end-of-line 1)) + (org-agenda-change-all-lines hdmarker) (beginning-of-line 1))))) (defun org-agenda-set-property () @@ -7036,8 +6796,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (org-agenda-error))) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -7059,8 +6818,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (org-agenda-error))) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -7083,8 +6841,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (org-agenda-error))) (buffer (marker-buffer hdmarker)) (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) + (inhibit-read-only t)) (org-with-remote-undo buffer (with-current-buffer buffer (widen) @@ -7094,9 +6851,8 @@ the same tree node, and the headline of the tree node in the Org-mode file." (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (call-interactively 'org-toggle-archive-tag) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker) + (end-of-line 1)) + (org-agenda-change-all-lines hdmarker) (beginning-of-line 1)))) (defun org-agenda-do-date-later (arg) @@ -7343,8 +7099,7 @@ The cursor may be at a date in the calendar, or in the Org agenda." (org-agenda-error))) (hdmarker (or (org-get-at-bol 'org-hd-marker) marker)) - (pos (marker-position marker)) - newhead) + (pos (marker-position marker))) (org-with-remote-undo (marker-buffer marker) (with-current-buffer (marker-buffer marker) (widen) @@ -7352,16 +7107,15 @@ The cursor may be at a date in the calendar, or in the Org agenda." (org-show-context 'agenda) (org-show-entry) (org-cycle-hide-drawers 'children) - (org-clock-in arg) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker))))) + (org-clock-in arg)) + (org-agenda-change-all-lines hdmarker))))) (defun org-agenda-clock-out () "Stop the currently running clock." (interactive) (unless (marker-buffer org-clock-marker) (error "No running clock")) - (let ((marker (make-marker)) newhead) + (let ((marker (make-marker))) (org-with-remote-undo (marker-buffer org-clock-marker) (with-current-buffer (marker-buffer org-clock-marker) (save-excursion @@ -7370,9 +7124,8 @@ The cursor may be at a date in the calendar, or in the Org agenda." (goto-char org-clock-marker) (org-back-to-heading t) (move-marker marker (point)) - (org-clock-out) - (setq newhead (org-get-heading)))))) - (org-agenda-change-all-lines newhead marker) + (org-clock-out))))) + (org-agenda-change-all-lines marker) (move-marker marker nil))) (defun org-agenda-clock-cancel (&optional arg) @@ -7500,7 +7253,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to ;; Use org-format-agenda-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 t) + (setq fmt (org-format-agenda-item nil text nil nil t) time (get-text-property 0 'time fmt) time2 (if (> (length time) 0) ;; split-string removes trailing ...... if @@ -7508,7 +7261,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to ;; separates time from date. (concat " " (car (split-string time "\\."))) nil) - text (get-text-property 0 'txt fmt))) + text (get-text-property 0 'heading fmt))) (if (eq org-agenda-insert-diary-strategy 'top-level) (org-agenda-insert-diary-as-top-level text) (require 'org-datetree) @@ -7929,7 +7682,7 @@ tag and (if present) the flagging note." (interactive) (let ((hdmarker (org-get-at-bol 'org-hd-marker)) (win (selected-window)) - note heading newhead) + note heading) (unless hdmarker (error "No linked entry at point")) (if (and (eq this-command last-command) @@ -7955,13 +7708,11 @@ tag and (if present) the flagging note." (defun org-agenda-remove-flag (marker) "Remove the FLAGGED tag and any flagging note in the entry." - (let (newhead) - (org-with-point-at marker - (org-toggle-tag "FLAGGED" 'off) - (org-entry-delete nil "THEFLAGGINGNOTE") - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead marker) - (message "Entry unflaged"))) + (org-with-point-at marker + (org-toggle-tag "FLAGGED" 'off) + (org-entry-delete nil "THEFLAGGINGNOTE")) + (org-agenda-change-all-lines marker) + (message "Entry unflaged")) (defun org-agenda-get-any-marker (&optional pos) (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker) @@ -8016,7 +7767,7 @@ belonging to the \"Work\" category." ;; Map thru entries and find if we should filter them out (mapc (lambda(x) - (let* ((evt (org-trim (or (get-text-property 1 'txt x) ""))) + (let* ((evt (org-trim (or (get-text-property 1 'heading x) ""))) (cat (get-text-property 1 'org-category x)) (tod (get-text-property 1 'time-of-day x)) (ok (or (null filter) diff --git a/lisp/org.el b/lisp/org.el index ba1a3b4..452532e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18927,7 +18927,7 @@ the text that it generates." ;; Delete the percent sign. (delete-region (1- (match-beginning 0)) (match-beginning 0)))) ;; Valid format spec. - ((looking-at "\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([a-zA-z]\\)") + ((looking-at "\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]*?\\)\\([a-zA-z]\\)") (let* ((optional (match-string 1)) (num (match-string 2)) (punctuation (match-string 3)) -- 1.7.2.3