Browse Source

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.
Bastien Guerry 7 years ago
parent
commit
b508ff6901
1 changed files with 87 additions and 42 deletions
  1. 87 42
      lisp/org-agenda.el

+ 87 - 42
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