From b508ff69015cbacdd151aa05ace9131fa66c73f6 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 12 Sep 2012 11:41:50 +0200 Subject: [PATCH] org-agenda.el: Allow a new specifier `%l' in `org-agenda-prefix-format' * org-agenda.el (org-agenda-prefix-format): A new specifier `%l' allows to insert X spaces when the item is of level X. (org-search-view, org-get-entries-from-diary) (org-agenda-get-todos, org-agenda-get-timestamps) (org-agenda-get-sexps, org-agenda-get-progress) (org-agenda-get-deadlines, org-agenda-get-scheduled) (org-agenda-get-blocks, org-agenda-change-all-lines): Add a new text property 'level, a string with as many whitespaces as the level of the item. (org-agenda-format-item, org-compile-prefix-format): Handle the new `%l' specifier. This new specifier allows to have a visual clue about the level of the item in agenda views. --- lisp/org-agenda.el | 129 ++++++++++++++++++++++++++++++--------------- 1 file changed, 87 insertions(+), 42 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index b2f690dc0..a38d7a866 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1488,6 +1488,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 + %l the level of the item (insert X space(s) if item is of level X) %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 @@ -1496,7 +1497,7 @@ This format works similar to a printf format, with the following meaning: by the result All specifiers work basically like the standard `%s' of printf, but may -contain two additional characters: a question mark just after the `%' +contain two additional characters: a question mark just after the `%' and a whitespace/punctuation character just before the final letter. If the first character after `%' is a question mark, the entire field @@ -4130,7 +4131,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 category-pos tags c neg re boolean + marker category category-pos level tags c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) @@ -4282,16 +4283,22 @@ in `org-agenda-text-search-extra-files'." (goto-char beg) (setq marker (org-agenda-new-marker (point)) category (org-get-category) + level + (make-string + (1- (string-to-number + (substring (symbol-name (get-text-property + (match-beginning 0) 'face)) 10))) ? ) category-pos (get-text-property (point) 'org-category-position) tags (org-get-tags-at (point)) txt (org-agenda-format-item "" (buffer-substring-no-properties beg1 (point-at-eol)) - category tags)) + level category tags)) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'org-todo-regexp org-todo-regexp + 'level level 'org-complex-heading-regexp org-complex-heading-regexp 'priority 1000 'org-category category 'org-category-position category-pos @@ -4777,7 +4784,7 @@ of what a project is and how to check if it stuck, customize the variable (setq entries (mapcar (lambda (x) - (setq x (org-agenda-format-item "" x "Diary" nil 'time)) + (setq x (org-agenda-format-item "" x nil "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)) @@ -4987,7 +4994,7 @@ the documentation of `org-diary'." "|") "\\|") "\\)")) (t org-not-done-regexp)))) - marker priority category category-pos tags todo-state + marker priority category category-pos level tags todo-state ee txt beg end) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5007,12 +5014,17 @@ the documentation of `org-diary'." txt (org-trim (buffer-substring (match-beginning 2) (match-end 0))) tags (org-get-tags-at (point)) - txt (org-agenda-format-item "" txt category tags) + level (make-string + (1- (string-to-number + (substring (symbol-name (get-text-property + (match-beginning 0) 'face)) 10))) ? ) + txt (org-agenda-format-item "" txt level 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 + 'level level 'org-category-position category-pos 'type "todo" 'todo-state todo-state) (push txt ee) @@ -5128,7 +5140,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) marker hdmarker deadlinep scheduledp clockp closedp inactivep - donep tmp priority category category-pos ee txt timestr tags + donep tmp priority category category-pos level ee txt timestr tags b0 b3 e3 head todo-state end-of-match show-all warntime) (goto-char (point-min)) (while (setq end-of-match (re-search-forward regexp nil t)) @@ -5180,18 +5192,22 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (assoc (point) deadline-position-alist)) (throw :skip nil)) (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) + tags (org-get-tags-at) + level + (make-string + (1- (string-to-number + (substring (symbol-name (get-text-property (point) 'face)) 10))) ? )) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (or (match-string 1) "")) (setq txt (org-agenda-format-item (if inactivep org-agenda-inactive-leader nil) - head category tags timestr + head level category tags 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 nil 'priority priority + (org-add-props txt props 'priority priority + 'org-marker marker 'org-hd-marker hdmarker 'org-category category 'date date + 'level level 'org-category-position category-pos 'todo-state todo-state 'warntime warntime @@ -5211,7 +5227,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") - marker category extra category-pos ee txt tags entry + marker category extra category-pos level ee txt tags entry result beg b sexp sexp-entry todo-state warntime) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5228,6 +5244,9 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (setq result (org-diary-sexp-entry sexp sexp-entry date)) (when result (setq marker (org-agenda-new-marker beg) + level (make-string + (1- (string-to-number + (substring (symbol-name (get-text-property beg 'face)) 10))) ? ) category (org-get-category beg) category-pos (get-text-property beg 'org-category-position) tags (save-excursion (org-backward-heading-same-level 0) @@ -5245,13 +5264,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (if (string-match "\\S-" r) (setq txt r) (setq txt "SEXP entry returned empty string")) - - (setq txt (org-agenda-format-item - extra txt category tags 'time)) - (org-add-props txt props 'org-marker marker) - (org-add-props txt nil + (setq txt (org-agenda-format-item extra txt level category tags 'time)) + (org-add-props txt props 'org-marker marker 'org-category category 'date date 'todo-state todo-state 'org-category-position category-pos 'tags tags + 'level level 'type "sexp" 'warntime warntime) (push txt ee))))) (nreverse ee))) @@ -5363,7 +5380,7 @@ 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 category-pos tags closedp + marker hdmarker priority category category-pos level tags closedp statep clockp state ee txt extra timestr rest clocked) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5402,7 +5419,11 @@ please use `org-class' instead." (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) + tags (org-get-tags-at) + level + (make-string + (1- (string-to-number + (substring (symbol-name (get-text-property (point) 'face)) 10))) ? )) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq txt (match-string 1)) (when extra @@ -5415,12 +5436,13 @@ please use `org-class' instead." (closedp "Closed: ") (statep (concat "State: (" state ")")) (t (concat "Clocked: (" clocked ")"))) - txt category tags timestr))) + txt level category tags timestr))) (setq priority 100000) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 'priority priority 'org-category category 'org-category-position category-pos + 'level level 'type "closed" 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) (push txt ee)) @@ -5558,7 +5580,7 @@ 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 category-pos + d2 diff dfrac wdays pos pos1 category category-pos level tags suppress-prewarning ee txt head face s todo-state show-all upcomingp donep timestr warntime) (goto-char (point-min)) @@ -5612,6 +5634,10 @@ See also the user option `org-agenda-clock-consistency-checks'." (setq txt org-agenda-no-heading-message) (goto-char (match-end 0)) (setq pos1 (match-beginning 0)) + (setq level + (make-string + (1- (string-to-number + (substring (symbol-name (get-text-property pos1 'face)) 10))) ? )) (setq tags (org-get-tags-at pos1)) (setq head (buffer-substring-no-properties (point) @@ -5631,13 +5657,14 @@ See also the user option `org-agenda-clock-consistency-checks'." diff date) (format (nth 1 org-agenda-deadline-leaders) diff))) - head category tags + head level category tags (if (not (= diff 0)) nil timestr))))) (when txt (setq face (org-agenda-deadline-face dfrac)) (org-add-props txt props 'org-marker (org-agenda-new-marker pos) 'warntime warntime + 'level level 'org-hd-marker (org-agenda-new-marker pos1) 'priority (+ (- diff) (org-get-priority txt)) @@ -5678,7 +5705,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 category-pos tags donep + d2 diff pos pos1 category category-pos level tags donep ee txt head pastschedp todo-state face timestr s habitp show-all did-habit-check-p warntime) (goto-char (point-min)) @@ -5741,6 +5768,11 @@ FRACTION is what fraction of the head-warning time has passed." (setq mm (assoc pos1 deadline-position-alist))) (throw :skip nil))) (setq tags (org-get-tags-at)) + (setq level + (make-string + (1- (string-to-number + (substring (symbol-name (get-text-property + (match-beginning 0) 'face)) 10))) ? )) (setq head (buffer-substring-no-properties (point) (progn (skip-chars-forward "^\r\n") (point)))) @@ -5753,7 +5785,7 @@ FRACTION is what fraction of the head-warning time has passed." (car org-agenda-scheduled-leaders) (format (nth 1 org-agenda-scheduled-leaders) (- 1 diff))) - head category tags + head level category tags (if (not (= diff 0)) nil timestr) nil habitp)))) (when txt @@ -5772,6 +5804,7 @@ FRACTION is what fraction of the head-warning time has passed." 'type (if pastschedp "past-scheduled" "scheduled") 'date (if pastschedp d2 date) 'warntime warntime + 'level level 'priority (if habitp (org-habit-get-priority habitp) (+ 94 (- 5 diff) (org-get-priority txt))) @@ -5795,7 +5828,7 @@ FRACTION is what fraction of the head-warning time has passed." (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) marker hdmarker ee txt d1 d2 s1 s2 category category-pos - todo-state tags pos head donep) + level todo-state tags pos head donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -5823,6 +5856,11 @@ FRACTION is what fraction of the head-warning time has passed." (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker (point))) (setq tags (org-get-tags-at)) + (setq level + (make-string + (1- (string-to-number + (substring (symbol-name (get-text-property + (match-beginning 0) 'face)) 10))) ? )) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (match-string 1)) (let ((remove-re @@ -5837,7 +5875,7 @@ 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 category tags + head level category tags (cond ((and (= d1 d0) (= d2 d0)) (concat "<" start-time ">--<" end-time ">")) ((= d1 d0) @@ -5848,6 +5886,7 @@ FRACTION is what fraction of the head-warning time has passed." (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date + 'level level 'todo-state todo-state 'priority (org-get-priority txt) 'org-category category 'org-category-position category-pos) @@ -5880,20 +5919,23 @@ The flag is set if the currently compiled format contains a `%e'.") (return (cadr entry)) (return (apply 'create-image (cdr entry))))))) -(defun org-agenda-format-item (extra txt &optional category tags dotime +(defun org-agenda-format-item (extra txt &optional level 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 -must be a string and replaces the `%s' specifier in the prefix format. -CATEGORY (string, symbol or nil) may be used to overrule the default +In particular, add the prefix and corresponding text properties. + +EXTRA must be a string to replace the `%s' specifier in the prefix format. +LEVEL may be a string to replace the `%l' specifier. +CATEGORY (a string, a 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 -time-of-day should be extracted from TXT for sorting of this entry, and for -the `%t' specifier in the format. When DOTIME is a string, this string is -searched for a time before TXT is. TAGS can be the tags of the headline. +specifier in the format. +DOTIME, when non-nil, indicates that a time-of-day should be extracted from +TXT for sorting of this entry, and for the `%t' specifier in the format. +When DOTIME is a string, this string is searched for a time before TXT is. +TAGS can be the tags of the headline. Any match of REMOVE-RE will be removed from TXT." ;; We keep the org-prefix-* variable values along with a compiled - ;; formatter, so that multiple agendas existing at the same time, do + ;; formatter, so that multiple agendas existing at the same time do ;; not step on each other toes. ;; ;; It was inconvenient to make these variables buffer local in @@ -5906,13 +5948,14 @@ Any match of REMOVE-RE will be removed from TXT." do (set var value)) (save-match-data ;; Diary entries sometimes have extra whitespace at the beginning - (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) + (setq txt (org-trim txt)) ;; Fix the tags part in txt (setq txt (org-agenda-fix-displayed-tags txt tags org-agenda-show-inherited-tags org-agenda-hide-tags-regexp)) + (let* ((category (or category (if (stringp org-category) org-category @@ -6136,7 +6179,8 @@ The modified list may contain inherited tags, and tags matched by "Compile the prefix format into a Lisp form that can be evaluated. The resulting form and associated variable bindings is returned and stored in the variable `org-prefix-format-compiled'." - (setq org-prefix-has-time nil org-prefix-has-tag nil + (setq org-prefix-has-time nil + org-prefix-has-tag nil org-prefix-category-length nil org-prefix-has-effort nil) (let ((s (cond @@ -6147,7 +6191,7 @@ and stored in the variable `org-prefix-format-compiled'." (t " %-12:c%?-12t% s"))) (start 0) varform vars var e c f opt) - (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\|(.+)\\)" + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltsei]\\|(.+)\\)" s start) (setq var (or (cdr (assoc (match-string 4 s) '(("c" . category) ("t" . time) ("s" . extra) @@ -7990,7 +8034,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (save-excursion (save-restriction (widen) (goto-char hdmarker) (org-get-tags-at))))) - props m pl undone-face done-face finish new dotime cat tags) + props m pl undone-face done-face finish new dotime level cat tags) (save-excursion (goto-char (point-max)) (beginning-of-line 1) @@ -8002,6 +8046,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (setq props (text-properties-at (point)) dotime (org-get-at-bol 'dotime) cat (org-get-at-bol 'org-category) + level (org-get-at-bol 'level) tags thetags new (let ((org-prefix-format-compiled @@ -8012,7 +8057,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (save-excursion (save-restriction (widen) - (org-agenda-format-item extra newhead cat tags dotime))))) + (org-agenda-format-item extra newhead level cat tags dotime))))) 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)) @@ -8556,7 +8601,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to ;; 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-agenda-format-item nil text nil nil t) + (setq fmt (org-agenda-format-item nil text nil nil nil t) time (get-text-property 0 'time fmt) time2 (if (> (length time) 0) ;; split-string removes trailing ...... if