summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien Guerry <bzg@altern.org>2012-09-12 11:41:50 +0200
committerBastien Guerry <bzg@altern.org>2012-09-12 11:41:50 +0200
commitb508ff69015cbacdd151aa05ace9131fa66c73f6 (patch)
tree8a70ac159a26c229e8b284d916a1439ea1cf4b4d
parent137bfd0aa7a4668058ea5be13d672cd5d0406325 (diff)
downloadorg-mode-b508ff69015cbacdd151aa05ace9131fa66c73f6.tar.gz
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.
-rw-r--r--lisp/org-agenda.el129
1 files changed, 87 insertions, 42 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index b2f690d..a38d7a8 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