forked from mirrors/org-mode
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.
This commit is contained in:
Bastien Guerry
parent
137bfd0aa7
commit
b508ff6901
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue