[PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Adam Porter]

[-- Attachment #1: Type: text/plain, Size: 374 bytes --]

Hi,

This patch adds a 'none setting for org-agenda-overriding-header, which
allows it to be disabled completely, rather than inserting a blank line
as it does when set to an empty string.

This was requested by a user here:
<https://github.com/alphapapa/org-super-agenda/issues/10>, but I guess
it may also be useful for Org users who don't use that package.

Thanks,
Adam

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 9190 bytes --]

From 8ae87be7ba98dec23b6875b72234272b78ea76a8 Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Tue, 15 Aug 2017 23:01:32 -0500
Subject: [PATCH] org-agenda: Add 'none setting for
 org-agenda-overriding-header

* lisp/org-agenda.el (org-agenda-overriding-header): Update docstring.
(org-agenda-list): Handle 'none setting.
(org-search-view): Handle 'none setting.
(org-todo-list): Handle 'none setting.
(org-tags-view): Handle 'none setting.

* etc/ORG-NEWS: Mention new setting.
---
 etc/ORG-NEWS       |   5 ++
 lisp/org-agenda.el | 151 +++++++++++++++++++++++++++++------------------------
 2 files changed, 89 insertions(+), 67 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 9631411..ba6eb32 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -118,6 +118,11 @@ See docstring for details.
 automatically align tags to the right edge of the window.  This is now
 the default setting.
 
+**** New =none= setting for =org-agenda-overriding-header=
+
+=org-agenda-overriding-header= may now be set to the symbol =none=, which
+will prevent the header from being inserted into the agenda buffer.
+
 *** New value for ~org-publish-sitemap-sort-folders~
 
 The new ~ignore~ value effectively allows toggling inclusion of
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index a661a78..836ebd2 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -4159,17 +4159,20 @@ items if they have an hour specification like [h]h:mm."
 	       (w1 (org-days-to-iso-week d1))
 	       (w2 (org-days-to-iso-week d2)))
 	  (setq s (point))
-	  (if org-agenda-overriding-header
-	      (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-			  nil 'face 'org-agenda-structure) "\n")
-	    (insert (org-agenda-span-name span)
-		    "-agenda"
-		    (if (< (- d2 d1) 350)
-			(if (= w1 w2)
-			    (format " (W%02d)" w1)
-			  (format " (W%02d-W%02d)" w1 w2))
-		      "")
-		    ":\n")))
+	  (pcase org-agenda-overriding-header
+	    ((pred stringp)
+	     (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+			 nil 'face 'org-agenda-structure) "\n"))
+	    ('none nil)
+	    ((pred null)
+	     (insert (org-agenda-span-name span)
+		     "-agenda"
+		     (if (< (- d2 d1) 350)
+			 (if (= w1 w2)
+			     (format " (W%02d)" w1)
+			   (format " (W%02d-W%02d)" w1 w2))
+		       "")
+		     ":\n"))))
 	(add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
 						  'org-date-line t))
 	(org-agenda-mark-header-line s))
@@ -4580,25 +4583,28 @@ in `org-agenda-text-search-extra-files'."
 			(goto-char (1- end))))))))))
 	(setq rtn (nreverse ee))
 	(setq rtnall (append rtnall rtn)))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Search words: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure))
-	(setq pos (point))
-	(insert string "\n")
-	(add-text-properties pos (1- (point)) (list 'face 'org-warning))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys "\
+      (pcase org-agenda-overriding-header
+	((pred stringp)
+	 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+		     nil 'face 'org-agenda-structure) "\n"))
+	('none nil)
+	((pred null)
+	 (insert "Search words: ")
+	 (add-text-properties (point-min) (1- (point))
+			      (list 'face 'org-agenda-structure))
+	 (setq pos (point))
+	 (insert string "\n")
+	 (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+	 (setq pos (point))
+	 (unless org-agenda-multi
+	   (insert (substitute-command-keys "\
 Press `\\[org-agenda-manipulate-query-add]', \
 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
 `\\[org-agenda-manipulate-query-add-re]', \
 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
 `\\[universal-argument] \\[org-agenda-redo]' to edit\n"))
-	  (add-text-properties pos (1- (point))
-			       (list 'face 'org-agenda-structure))))
+	   (add-text-properties pos (1- (point))
+				(list 'face 'org-agenda-structure)))))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'search) "\n"))
@@ -4676,31 +4682,34 @@ for a keyword.  A numeric prefix directly selects the Nth keyword in
 	  (org-check-agenda-file file)
 	  (setq rtn (org-agenda-get-day-entries file date :todo))
 	  (setq rtnall (append rtnall rtn))))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Global list of TODO items of type: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure
-				   'short-heading
-				   (concat "ToDo: "
-					   (or org-select-this-todo-keyword "ALL"))))
-	(org-agenda-mark-header-line (point-min))
-	(insert (org-agenda-propertize-selected-todo-keywords
-		 org-select-this-todo-keyword))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys "Available with \
+      (pcase org-agenda-overriding-header
+	((pred stringp)
+	 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+		     nil 'face 'org-agenda-structure) "\n"))
+	('none nil)
+	((pred null)
+	 (insert "Global list of TODO items of type: ")
+	 (add-text-properties (point-min) (1- (point))
+			      (list 'face 'org-agenda-structure
+				    'short-heading
+				    (concat "ToDo: "
+					    (or org-select-this-todo-keyword "ALL"))))
+	 (org-agenda-mark-header-line (point-min))
+	 (insert (org-agenda-propertize-selected-todo-keywords
+		  org-select-this-todo-keyword))
+	 (setq pos (point))
+	 (unless org-agenda-multi
+	   (insert (substitute-command-keys "Available with \
 `N \\[org-agenda-redo]': (0)[ALL]"))
-	  (let ((n 0) s)
-	    (mapc (lambda (x)
-		    (setq s (format "(%d)%s" (setq n (1+ n)) x))
-		    (if (> (+ (current-column) (string-width s) 1) (frame-width))
-			(insert "\n                     "))
-		    (insert " " s))
-		  kwds))
-	  (insert "\n"))
-	(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
+	   (let ((n 0) s)
+	     (mapc (lambda (x)
+		     (setq s (format "(%d)%s" (setq n (1+ n)) x))
+		     (if (> (+ (current-column) (string-width s) 1) (frame-width))
+			 (insert "\n                     "))
+		     (insert " " s))
+		   kwds))
+	   (insert "\n"))
+	 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
@@ -4778,24 +4787,27 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
 					   matcher
 					   org--matcher-tags-todo-only))
 		  (setq rtnall (append rtnall rtn))))))))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Headlines with TAGS match: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure
-				   'short-heading
-				   (concat "Match: " match)))
-	(setq pos (point))
-	(insert match "\n")
-	(add-text-properties pos (1- (point)) (list 'face 'org-warning))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys
-		   "Press `\\[universal-argument] \\[org-agenda-redo]' \
+      (pcase org-agenda-overriding-header
+	((pred stringp)
+	 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+		     nil 'face 'org-agenda-structure) "\n"))
+	('none nil)
+	((pred null)
+	 (insert "Headlines with TAGS match: ")
+	 (add-text-properties (point-min) (1- (point))
+			      (list 'face 'org-agenda-structure
+				    'short-heading
+				    (concat "Match: " match)))
+	 (setq pos (point))
+	 (insert match "\n")
+	 (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+	 (setq pos (point))
+	 (unless org-agenda-multi
+	   (insert (substitute-command-keys
+		    "Press `\\[universal-argument] \\[org-agenda-redo]' \
 to search again with new search string\n")))
-	(add-text-properties pos (1- (point))
-			     (list 'face 'org-agenda-structure)))
+	 (add-text-properties pos (1- (point))
+			      (list 'face 'org-agenda-structure))))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
@@ -4820,7 +4832,12 @@ used by user-defined selections using `org-agenda-skip-function'.")
 (defvar org-agenda-overriding-header nil
   "When set during agenda, todo and tags searches it replaces the header.
 This variable should not be set directly, but custom commands can bind it
-in the options section.")
+in the options section.  See `org-agenda-custom-commands'.
+
+This may be a string, in which case it will be displayed
+as-written; the symbol `none', in which case no header will be
+inserted; or nil, in which case a header will be generated
+automatically depending on the command.")
 
 (defun org-agenda-skip-entry-if (&rest conditions)
   "Skip entry if any of CONDITIONS is true.
-- 
2.7.4

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Nicolas Goaziou]

Hello,

Adam Porter <adam@alphapapa.net> writes:

> This patch adds a 'none setting for org-agenda-overriding-header, which
> allows it to be disabled completely, rather than inserting a blank line
> as it does when set to an empty string.

Thank you.

What about "fixing" the empty string case, i.e., not inserting a blank
line when set to the empty string?

Regards,

-- 
Nicolas Goaziou

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Adam Porter]

Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

> What about "fixing" the empty string case, i.e., not inserting a blank
> line when set to the empty string?

Hi Nicolas,

I almost did that, making it not insert a header if it was set to an
empty string, but I thought that this approach gives more flexibility,
allowing users to insert a blank header if they want.  But if you would
prefer it that way, I'll adjust the patch.  Let me know.

Thanks,
Adam

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Nicolas Goaziou]

Hello,

Adam Porter <adam@alphapapa.net> writes:

> I almost did that, making it not insert a header if it was set to an
> empty string, but I thought that this approach gives more flexibility,
> allowing users to insert a blank header if they want.

"\n" would allow to insert a blank header.

> But if you would prefer it that way, I'll adjust the patch. Let me
> know.

Let's adjust the patch, then. Thank you!

Regards,

-- 
Nicolas Goaziou

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Adam Porter]

[-- Attachment #1: Type: text/plain, Size: 309 bytes --]

Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

> Let's adjust the patch, then. Thank you!

Hi Nicolas,

Here is the new patch.  I took the liberty of using a macro to replace
the code that was duplicated in the four agenda functions.  Please let
me know if you would like any further changes.

Thanks,
Adam

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 9996 bytes --]

From 203bc583da0c482ab7092623383fe47c2d729420 Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Sat, 19 Aug 2017 21:26:12 -0500
Subject: [PATCH] org-agenda: Refactor org-agenda-overriding-header code

Replace org-agenda-overriding-header tests in these four functions with
calls to a macro, eliminating the duplicate code.  Also, disable the
header when the variable is set to the empty string.

* lisp/org-agenda.el (org-agenda--insert-overriding-header): Add macro.
(org-agenda-list): Use macro.
(org-search-view): Use macro.
(org-todo-list): Use macro.
(org-tags-view): Use macro.
(org-agenda-overriding-header): Update docstring.

* etc/ORG-NEWS: Explain that header can be disabled with empty string.
---
 etc/ORG-NEWS       |   4 ++
 lisp/org-agenda.el | 153 +++++++++++++++++++++++++++++------------------------
 2 files changed, 89 insertions(+), 68 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 1901c29..e55d1e4 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -135,6 +135,10 @@ See docstring for details.
 =org-agenda-tags-column= can now be set to =auto=, which will
 automatically align tags to the right edge of the window.  This is now
 the default setting.
+**** Disable =org-agenda-overriding-header= by setting to empty string
+
+The =org-agenda-overriding-header= inserted into agenda views can now be
+disabled by setting it to an empty string.
 
 *** New value for ~org-publish-sitemap-sort-folders~
 
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index fe7c4f2..940bf7b 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -2065,6 +2065,22 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
 	(setcdr ass (cdr entry))
       (push entry org-agenda-custom-commands))))
 
+(cl-defmacro org-agenda--insert-overriding-header (&key default)
+  "Insert header into agenda view depending on value of `org-agenda-overriding-header'.
+If the empty string, don't insert a header.  If any other string,
+insert it as a header.  If nil, insert DEFAULT, which should
+evaluate to a string."
+  (declare (debug (&key form)))
+  `(pcase org-agenda-overriding-header
+     ("" nil)  ; Don't insert a header if set to empty string
+     ;; Insert user-specified string
+     ((pred stringp) (insert
+		      (org-add-props (copy-sequence org-agenda-overriding-header)
+			  nil 'face 'org-agenda-structure)
+		      "\n"))
+     ;; When nil, make string automatically and insert it
+     ((pred null) (insert ,default))))
+
 ;;; Define the org-agenda-mode
 
 (defvar org-agenda-mode-map (make-sparse-keymap)
@@ -4160,17 +4176,15 @@ items if they have an hour specification like [h]h:mm."
 	       (w1 (org-days-to-iso-week d1))
 	       (w2 (org-days-to-iso-week d2)))
 	  (setq s (point))
-	  (if org-agenda-overriding-header
-	      (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-			  nil 'face 'org-agenda-structure) "\n")
-	    (insert (org-agenda-span-name span)
-		    "-agenda"
-		    (if (< (- d2 d1) 350)
-			(if (= w1 w2)
-			    (format " (W%02d)" w1)
-			  (format " (W%02d-W%02d)" w1 w2))
-		      "")
-		    ":\n")))
+	  (org-agenda--insert-overriding-header
+	   :default (concat (org-agenda-span-name span)
+			    "-agenda"
+			    (if (< (- d2 d1) 350)
+				(if (= w1 w2)
+				    (format " (W%02d)" w1)
+				  (format " (W%02d-W%02d)" w1 w2))
+			      "")
+			    ":\n")))
 	(add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
 						  'org-date-line t))
 	(org-agenda-mark-header-line s))
@@ -4581,25 +4595,25 @@ in `org-agenda-text-search-extra-files'."
 			(goto-char (1- end))))))))))
 	(setq rtn (nreverse ee))
 	(setq rtnall (append rtnall rtn)))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Search words: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure))
-	(setq pos (point))
-	(insert string "\n")
-	(add-text-properties pos (1- (point)) (list 'face 'org-warning))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys "\
+      (org-agenda--insert-overriding-header
+       :default (with-temp-buffer
+		  (insert "Search words: ")
+		  (add-text-properties (point-min) (1- (point))
+				       (list 'face 'org-agenda-structure))
+		  (setq pos (point))
+		  (insert string "\n")
+		  (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+		  (setq pos (point))
+		  (unless org-agenda-multi
+		    (insert (substitute-command-keys "\
 Press `\\[org-agenda-manipulate-query-add]', \
 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
 `\\[org-agenda-manipulate-query-add-re]', \
 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
 `\\[universal-argument] \\[org-agenda-redo]' to edit\n"))
-	  (add-text-properties pos (1- (point))
-			       (list 'face 'org-agenda-structure))))
+		    (add-text-properties pos (1- (point))
+					 (list 'face 'org-agenda-structure)))
+		  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'search) "\n"))
@@ -4677,31 +4691,31 @@ for a keyword.  A numeric prefix directly selects the Nth keyword in
 	  (org-check-agenda-file file)
 	  (setq rtn (org-agenda-get-day-entries file date :todo))
 	  (setq rtnall (append rtnall rtn))))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Global list of TODO items of type: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure
-				   'short-heading
-				   (concat "ToDo: "
-					   (or org-select-this-todo-keyword "ALL"))))
-	(org-agenda-mark-header-line (point-min))
-	(insert (org-agenda-propertize-selected-todo-keywords
-		 org-select-this-todo-keyword))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys "Available with \
+      (org-agenda--insert-overriding-header
+       :default (with-temp-buffer
+		  (insert "Global list of TODO items of type: ")
+		  (add-text-properties (point-min) (1- (point))
+				       (list 'face 'org-agenda-structure
+					     'short-heading
+					     (concat "ToDo: "
+						     (or org-select-this-todo-keyword "ALL"))))
+		  (org-agenda-mark-header-line (point-min))
+		  (insert (org-agenda-propertize-selected-todo-keywords
+			   org-select-this-todo-keyword))
+		  (setq pos (point))
+		  (unless org-agenda-multi
+		    (insert (substitute-command-keys "Available with \
 `N \\[org-agenda-redo]': (0)[ALL]"))
-	  (let ((n 0) s)
-	    (mapc (lambda (x)
-		    (setq s (format "(%d)%s" (setq n (1+ n)) x))
-		    (if (> (+ (current-column) (string-width s) 1) (frame-width))
-			(insert "\n                     "))
-		    (insert " " s))
-		  kwds))
-	  (insert "\n"))
-	(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
+		    (let ((n 0) s)
+		      (mapc (lambda (x)
+			      (setq s (format "(%d)%s" (setq n (1+ n)) x))
+			      (if (> (+ (current-column) (string-width s) 1) (frame-width))
+				  (insert "\n                     "))
+			      (insert " " s))
+			    kwds))
+		    (insert "\n"))
+		  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))
+		  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
@@ -4779,24 +4793,24 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
 					   matcher
 					   org--matcher-tags-todo-only))
 		  (setq rtnall (append rtnall rtn))))))))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Headlines with TAGS match: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure
-				   'short-heading
-				   (concat "Match: " match)))
-	(setq pos (point))
-	(insert match "\n")
-	(add-text-properties pos (1- (point)) (list 'face 'org-warning))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys
-		   "Press `\\[universal-argument] \\[org-agenda-redo]' \
+      (org-agenda--insert-overriding-header
+       :default (with-temp-buffer
+		  (insert "Headlines with TAGS match: ")
+		  (add-text-properties (point-min) (1- (point))
+				       (list 'face 'org-agenda-structure
+					     'short-heading
+					     (concat "Match: " match)))
+		  (setq pos (point))
+		  (insert match "\n")
+		  (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+		  (setq pos (point))
+		  (unless org-agenda-multi
+		    (insert (substitute-command-keys
+			     "Press `\\[universal-argument] \\[org-agenda-redo]' \
 to search again with new search string\n")))
-	(add-text-properties pos (1- (point))
-			     (list 'face 'org-agenda-structure)))
+		  (add-text-properties pos (1- (point))
+				       (list 'face 'org-agenda-structure))
+		  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
@@ -4820,8 +4834,11 @@ used by user-defined selections using `org-agenda-skip-function'.")
 
 (defvar org-agenda-overriding-header nil
   "When set during agenda, todo and tags searches it replaces the header.
-This variable should not be set directly, but custom commands can bind it
-in the options section.")
+If an empty string, no header will be inserted.  If any other
+string, it will be inserted as a header.  If nil, a header will
+be generated automatically according to the command.  This
+variable should not be set directly, but custom commands can bind
+it in the options section.")
 
 (defun org-agenda-skip-entry-if (&rest conditions)
   "Skip entry if any of CONDITIONS is true.
-- 
2.7.4

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Nicolas Goaziou]

Hello,

Adam Porter <adam@alphapapa.net> writes:

> Here is the new patch.

Thank you.

> I took the liberty of using a macro to replace the code that was
> duplicated in the four agenda functions. Please let me know if you
> would like any further changes.

Some comments follow.

> From 203bc583da0c482ab7092623383fe47c2d729420 Mon Sep 17 00:00:00 2001
> From: Adam Porter <adam@alphapapa.net>
> Date: Sat, 19 Aug 2017 21:26:12 -0500
> Subject: [PATCH] org-agenda: Refactor org-agenda-overriding-header code
>
> Replace org-agenda-overriding-header tests in these four functions with
> calls to a macro, eliminating the duplicate code.  Also, disable the
> header when the variable is set to the empty string.

Nitpick: the paragraph above usually comes after the list of changes.

> * lisp/org-agenda.el (org-agenda--insert-overriding-header): Add macro.
> (org-agenda-list): Use macro.
> (org-search-view): Use macro.
> (org-todo-list): Use macro.
> (org-tags-view): Use macro.

Nitpick: you can only write "Use macro" once, on the last line.

> +(cl-defmacro org-agenda--insert-overriding-header (&key default)

Why `cl-defmacro'? Usually, `defmacro' is enough.

> +  "Insert header into agenda view depending on value of `org-agenda-overriding-header'.
> +If the empty string, don't insert a header.  If any other string,
> +insert it as a header.  If nil, insert DEFAULT, which should
> +evaluate to a string."
> +  (declare (debug (&key form)))
> +  `(pcase org-agenda-overriding-header
> +     ("" nil)  ; Don't insert a header if set to empty string
> +     ;; Insert user-specified string
> +     ((pred stringp) (insert
> +		      (org-add-props (copy-sequence org-agenda-overriding-header)
> +			  nil 'face 'org-agenda-structure)
> +		      "\n"))

While we're at it,

  `org-add-props' + `copy-sequence' = `propertize'

> +     ;; When nil, make string automatically and insert it
> +     ((pred null) (insert ,default))))

I suggest to use ,@default (and, obviously (&rest default) in the
arguments) so we are not limited to one S-exp.

> +	  (org-agenda--insert-overriding-header
> +	   :default (concat (org-agenda-span-name span)
> +			    "-agenda"
> +			    (if (< (- d2 d1) 350)
> +				(if (= w1 w2)
> +				    (format " (W%02d)" w1)
> +				  (format " (W%02d-W%02d)" w1 w2))
> +			      "")

If you're ready for further refactoring, the nested `if' above could be
turned into a nicer `cond'.

> +		    (let ((n 0) s)
> +		      (mapc (lambda (x)
> +			      (setq s (format "(%d)%s" (setq n (1+ n)) x))
> +			      (if (> (+ (current-column) (string-width s) 1) (frame-width))
> +				  (insert "\n                     "))
> +			      (insert " " s))
> +			    kwds))
> +		    (insert "\n"))

Same here: `mapc' + `lambda' = `dolist' to avoid funcall overhead. `s'
could be let-bound too.

All in all, the only requested change is `cl-defmacro' -> `defmacro'.
This is no blocker if you don't want/have time to do the refactoring.

Regards,

-- 
Nicolas Goaziou

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Adam Porter]

Hi Nicolas,

Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

> Nitpick: the paragraph above usually comes after the list of changes.

Fixed.

> Nitpick: you can only write "Use macro" once, on the last line.

Fixed.

> Why `cl-defmacro'? Usually, `defmacro' is enough.

Fixed.

> While we're at it,
>
>   `org-add-props' + `copy-sequence' = `propertize'
>
> If you're ready for further refactoring, the nested `if' above could
> be turned into a nicer `cond'.
>
> Same here: `mapc' + `lambda' = `dolist' to avoid funcall overhead. `s'
> could be let-bound too.

I'll refactor these in a separate patch to isolate any potential
mistakes.

>> +     ;; When nil, make string automatically and insert it
>> +     ((pred null) (insert ,default))))
>
> I suggest to use ,@default (and, obviously (&rest default) in the
> arguments) so we are not limited to one S-exp.

I saw that all of the default header code boiled down to inserting a
string, so I moved the ultimate `insert' into the macro so it could
accept a form that evaluates to a string; it seemed like a cleaner, more
functional approach to essentially accept a string rather than arbitrary
code (even though it does accept any sexp, but that is to avoid
evaluating it unless it's needed).  I used a keyword argument rather
than &rest for two reasons: 1) so the macro could accept different
option arguments in the future, and 2) so it's plain from looking at the
macro call that the form given is the default, which may be overridden,
rather than what's always used.

If you would prefer the &rest approach, that would mean doing the actual
insertion into the agenda buffer in the macro call rather than the macro
expansion.  I thought it would be better to separate the actual
insertion by abstracting it behind the macro.  In fact, it could be done
as a function instead, but, of course, that would mean evaluating the
default even when it's not used, so that's why I chose a macro.  (Or the
default could be passed as a lambda, but that seems even more awkward.)
Anyway, let me know what you prefer.

> All in all, the only requested change is `cl-defmacro' -> `defmacro'.
> This is no blocker if you don't want/have time to do the refactoring.

I'll post a new patch soon.  Thanks.

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Adam Porter]

[-- Attachment #1: Type: text/plain, Size: 185 bytes --]

Adam Porter <adam@alphapapa.net> writes:

> I'll post a new patch soon.  Thanks.

Hi Nicolas,

Here are the patches.  Please let me know if any other changes are
needed.

Thanks,
Adam


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 9961 bytes --]

From 2b938e98e2cc2409044eb7b03bff98b0a37d404e Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Sat, 19 Aug 2017 21:26:12 -0500
Subject: [PATCH 1/2] org-agenda: Refactor org-agenda-overriding-header code

* lisp/org-agenda.el (org-agenda--insert-overriding-header): Add macro.
(org-agenda-list)
(org-search-view)
(org-todo-list)
(org-tags-view): Use macro.
(org-agenda-overriding-header): Update docstring.

* etc/ORG-NEWS: Explain that header can be disabled with empty string.

Replace org-agenda-overriding-header tests in these four functions with
calls to a macro, eliminating the duplicate code.  Also, disable the
header when the variable is set to the empty string.
---
 etc/ORG-NEWS       |   4 ++
 lisp/org-agenda.el | 153 +++++++++++++++++++++++++++++------------------------
 2 files changed, 89 insertions(+), 68 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 1901c29..e55d1e4 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -135,6 +135,10 @@ See docstring for details.
 =org-agenda-tags-column= can now be set to =auto=, which will
 automatically align tags to the right edge of the window.  This is now
 the default setting.
+**** Disable =org-agenda-overriding-header= by setting to empty string
+
+The =org-agenda-overriding-header= inserted into agenda views can now be
+disabled by setting it to an empty string.
 
 *** New value for ~org-publish-sitemap-sort-folders~
 
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index fe7c4f2..0cb462e 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -2065,6 +2065,22 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
 	(setcdr ass (cdr entry))
       (push entry org-agenda-custom-commands))))
 
+(defmacro org-agenda--insert-overriding-header (&key default)
+  "Insert header into agenda view depending on value of `org-agenda-overriding-header'.
+If the empty string, don't insert a header.  If any other string,
+insert it as a header.  If nil, insert DEFAULT, which should
+evaluate to a string."
+  (declare (debug (&key form)))
+  `(pcase org-agenda-overriding-header
+     ("" nil)  ; Don't insert a header if set to empty string
+     ;; Insert user-specified string
+     ((pred stringp) (insert
+		      (org-add-props (copy-sequence org-agenda-overriding-header)
+			  nil 'face 'org-agenda-structure)
+		      "\n"))
+     ;; When nil, make string automatically and insert it
+     ((pred null) (insert ,default))))
+
 ;;; Define the org-agenda-mode
 
 (defvar org-agenda-mode-map (make-sparse-keymap)
@@ -4160,17 +4176,15 @@ items if they have an hour specification like [h]h:mm."
 	       (w1 (org-days-to-iso-week d1))
 	       (w2 (org-days-to-iso-week d2)))
 	  (setq s (point))
-	  (if org-agenda-overriding-header
-	      (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-			  nil 'face 'org-agenda-structure) "\n")
-	    (insert (org-agenda-span-name span)
-		    "-agenda"
-		    (if (< (- d2 d1) 350)
-			(if (= w1 w2)
-			    (format " (W%02d)" w1)
-			  (format " (W%02d-W%02d)" w1 w2))
-		      "")
-		    ":\n")))
+	  (org-agenda--insert-overriding-header
+	   :default (concat (org-agenda-span-name span)
+			    "-agenda"
+			    (if (< (- d2 d1) 350)
+				(if (= w1 w2)
+				    (format " (W%02d)" w1)
+				  (format " (W%02d-W%02d)" w1 w2))
+			      "")
+			    ":\n")))
 	(add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
 						  'org-date-line t))
 	(org-agenda-mark-header-line s))
@@ -4581,25 +4595,25 @@ in `org-agenda-text-search-extra-files'."
 			(goto-char (1- end))))))))))
 	(setq rtn (nreverse ee))
 	(setq rtnall (append rtnall rtn)))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Search words: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure))
-	(setq pos (point))
-	(insert string "\n")
-	(add-text-properties pos (1- (point)) (list 'face 'org-warning))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys "\
+      (org-agenda--insert-overriding-header
+       :default (with-temp-buffer
+		  (insert "Search words: ")
+		  (add-text-properties (point-min) (1- (point))
+				       (list 'face 'org-agenda-structure))
+		  (setq pos (point))
+		  (insert string "\n")
+		  (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+		  (setq pos (point))
+		  (unless org-agenda-multi
+		    (insert (substitute-command-keys "\
 Press `\\[org-agenda-manipulate-query-add]', \
 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
 `\\[org-agenda-manipulate-query-add-re]', \
 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
 `\\[universal-argument] \\[org-agenda-redo]' to edit\n"))
-	  (add-text-properties pos (1- (point))
-			       (list 'face 'org-agenda-structure))))
+		    (add-text-properties pos (1- (point))
+					 (list 'face 'org-agenda-structure)))
+		  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'search) "\n"))
@@ -4677,31 +4691,31 @@ for a keyword.  A numeric prefix directly selects the Nth keyword in
 	  (org-check-agenda-file file)
 	  (setq rtn (org-agenda-get-day-entries file date :todo))
 	  (setq rtnall (append rtnall rtn))))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Global list of TODO items of type: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure
-				   'short-heading
-				   (concat "ToDo: "
-					   (or org-select-this-todo-keyword "ALL"))))
-	(org-agenda-mark-header-line (point-min))
-	(insert (org-agenda-propertize-selected-todo-keywords
-		 org-select-this-todo-keyword))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys "Available with \
+      (org-agenda--insert-overriding-header
+       :default (with-temp-buffer
+		  (insert "Global list of TODO items of type: ")
+		  (add-text-properties (point-min) (1- (point))
+				       (list 'face 'org-agenda-structure
+					     'short-heading
+					     (concat "ToDo: "
+						     (or org-select-this-todo-keyword "ALL"))))
+		  (org-agenda-mark-header-line (point-min))
+		  (insert (org-agenda-propertize-selected-todo-keywords
+			   org-select-this-todo-keyword))
+		  (setq pos (point))
+		  (unless org-agenda-multi
+		    (insert (substitute-command-keys "Available with \
 `N \\[org-agenda-redo]': (0)[ALL]"))
-	  (let ((n 0) s)
-	    (mapc (lambda (x)
-		    (setq s (format "(%d)%s" (setq n (1+ n)) x))
-		    (if (> (+ (current-column) (string-width s) 1) (frame-width))
-			(insert "\n                     "))
-		    (insert " " s))
-		  kwds))
-	  (insert "\n"))
-	(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
+		    (let ((n 0) s)
+		      (mapc (lambda (x)
+			      (setq s (format "(%d)%s" (setq n (1+ n)) x))
+			      (if (> (+ (current-column) (string-width s) 1) (frame-width))
+				  (insert "\n                     "))
+			      (insert " " s))
+			    kwds))
+		    (insert "\n"))
+		  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))
+		  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
@@ -4779,24 +4793,24 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
 					   matcher
 					   org--matcher-tags-todo-only))
 		  (setq rtnall (append rtnall rtn))))))))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Headlines with TAGS match: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure
-				   'short-heading
-				   (concat "Match: " match)))
-	(setq pos (point))
-	(insert match "\n")
-	(add-text-properties pos (1- (point)) (list 'face 'org-warning))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys
-		   "Press `\\[universal-argument] \\[org-agenda-redo]' \
+      (org-agenda--insert-overriding-header
+       :default (with-temp-buffer
+		  (insert "Headlines with TAGS match: ")
+		  (add-text-properties (point-min) (1- (point))
+				       (list 'face 'org-agenda-structure
+					     'short-heading
+					     (concat "Match: " match)))
+		  (setq pos (point))
+		  (insert match "\n")
+		  (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+		  (setq pos (point))
+		  (unless org-agenda-multi
+		    (insert (substitute-command-keys
+			     "Press `\\[universal-argument] \\[org-agenda-redo]' \
 to search again with new search string\n")))
-	(add-text-properties pos (1- (point))
-			     (list 'face 'org-agenda-structure)))
+		  (add-text-properties pos (1- (point))
+				       (list 'face 'org-agenda-structure))
+		  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
@@ -4820,8 +4834,11 @@ used by user-defined selections using `org-agenda-skip-function'.")
 
 (defvar org-agenda-overriding-header nil
   "When set during agenda, todo and tags searches it replaces the header.
-This variable should not be set directly, but custom commands can bind it
-in the options section.")
+If an empty string, no header will be inserted.  If any other
+string, it will be inserted as a header.  If nil, a header will
+be generated automatically according to the command.  This
+variable should not be set directly, but custom commands can bind
+it in the options section.")
 
 (defun org-agenda-skip-entry-if (&rest conditions)
   "Skip entry if any of CONDITIONS is true.
-- 
2.7.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: patch --]
[-- Type: text/x-diff, Size: 2933 bytes --]

From 1e3bbf2c236039462a679bb69ea93f4ba1aa44ee Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Tue, 22 Aug 2017 21:12:14 -0500
Subject: [PATCH 2/2] org-agenda: Minor refactoring and tiny bug fix

* lisp/org-agenda.el (org-agenda--insert-overriding-header): Use
propertize instead of org-add-props.
(org-agenda-list): Replace nested if with cond.
(org-todo-list): Replace mapc-lambda with cl-loop.
(org-todo-list): Fix bug by using window-width instead of frame-width.
---
 lisp/org-agenda.el | 33 +++++++++++++++++----------------
 1 file changed, 17 insertions(+), 16 deletions(-)

diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 0cb462e..b349bc5 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -2074,10 +2074,9 @@ evaluate to a string."
   `(pcase org-agenda-overriding-header
      ("" nil)  ; Don't insert a header if set to empty string
      ;; Insert user-specified string
-     ((pred stringp) (insert
-		      (org-add-props (copy-sequence org-agenda-overriding-header)
-			  nil 'face 'org-agenda-structure)
-		      "\n"))
+     ((pred stringp) (insert (propertize org-agenda-overriding-header
+					 'face 'org-agenda-structure)
+			     "\n"))
      ;; When nil, make string automatically and insert it
      ((pred null) (insert ,default))))
 
@@ -4179,11 +4178,12 @@ items if they have an hour specification like [h]h:mm."
 	  (org-agenda--insert-overriding-header
 	   :default (concat (org-agenda-span-name span)
 			    "-agenda"
-			    (if (< (- d2 d1) 350)
-				(if (= w1 w2)
-				    (format " (W%02d)" w1)
-				  (format " (W%02d-W%02d)" w1 w2))
-			      "")
+			    ;; Format week number span
+			    (cond ((< (- d2 d1) 350)
+				   (if (= w1 w2)
+				       (format " (W%02d)" w1)
+				     (format " (W%02d-W%02d)" w1 w2)))
+				  (t ""))
 			    ":\n")))
 	(add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
 						  'org-date-line t))
@@ -4704,15 +4704,16 @@ for a keyword.  A numeric prefix directly selects the Nth keyword in
 			   org-select-this-todo-keyword))
 		  (setq pos (point))
 		  (unless org-agenda-multi
+		    ;; Insert TODO-keyword-selection key menu
 		    (insert (substitute-command-keys "Available with \
 `N \\[org-agenda-redo]': (0)[ALL]"))
-		    (let ((n 0) s)
-		      (mapc (lambda (x)
-			      (setq s (format "(%d)%s" (setq n (1+ n)) x))
-			      (if (> (+ (current-column) (string-width s) 1) (frame-width))
-				  (insert "\n                     "))
-			      (insert " " s))
-			    kwds))
+		    (cl-loop for keyword in kwds
+			     and num from 1
+			     for string = (format "(%d)%s" num keyword)
+			     when (> (+ (current-column) (string-width string) 1)
+				     (window-width))
+			     do (insert "\n                     ")
+			     do (insert " " string))
 		    (insert "\n"))
 		  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))
 		  (buffer-string)))
-- 
2.7.4

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Nicolas Goaziou]

Hello,

Adam Porter <adam@alphapapa.net> writes:

> If you would prefer the &rest approach, that would mean doing the actual
> insertion into the agenda buffer in the macro call rather than the macro
> expansion.  I thought it would be better to separate the actual
> insertion by abstracting it behind the macro.

I don't understand. There no difference of evaluation between (default)
and (&rest default).

Anyway, I'm fine with a single S-exp in the macro.

See may comments about the patches.

Regards,

-- 
Nicolas Goaziou

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Nicolas Goaziou]

Adam Porter <adam@alphapapa.net> writes:

> Here are the patches.  Please let me know if any other changes are
> needed.

Thank you! Comments follow.

> +(defmacro org-agenda--insert-overriding-header (&key default)

There is no "&key" in `defmacro'.

It should be (default).

> +  "Insert header into agenda view depending on value of `org-agenda-overriding-header'.
> +If the empty string, don't insert a header.  If any other string,
> +insert it as a header.  If nil, insert DEFAULT, which should
> +evaluate to a string."
> +  (declare (debug (&key form)))

It needs to be updated according to the above.

> +			    ;; Format week number span
> +			    (cond ((< (- d2 d1) 350)
> +				   (if (= w1 w2)
> +				       (format " (W%02d)" w1)
> +				     (format " (W%02d-W%02d)" w1 w2)))
> +				  (t ""))

  (cond ((<= 350 (- d2 d1)) "")
        ((= w1 w2) (format " (W%02d)" w1))
        (t (format " (W%02d-W%02d)" w1 w2)))

> -		    (let ((n 0) s)
> -		      (mapc (lambda (x)
> -			      (setq s (format "(%d)%s" (setq n (1+ n)) x))
> -			      (if (> (+ (current-column) (string-width s) 1) (frame-width))
> -				  (insert "\n                     "))
> -			      (insert " " s))
> -			    kwds))
> +		    (cl-loop for keyword in kwds
> +			     and num from 1
> +			     for string = (format "(%d)%s" num keyword)
> +			     when (> (+ (current-column) (string-width string) 1)
> +				     (window-width))
> +			     do (insert "\n                     ")
> +			     do (insert " " string))

Ouch. Why `cl-loop' over `dolist'? Also it looks wrong since the last
`do' is not always executed? (or is it?).

I know there is more than one way to skin a cat, but I'd rather use
a straightforward one:

  (let ((n 0))
    (dolist (k kwds)
      (let ((s (format "(%d)%s" (cl-incf n) k)))
        (when (> (+ (current-column) (string-width s) 1) (frame-width))
          (insert "\n                     "))
        (insert " " s))))


Regards,

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Adam Porter]

Hi Nicolas,

Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

> Adam Porter <adam@alphapapa.net> writes:
>
>> Here are the patches.  Please let me know if any other changes are
>> needed.
>
> Thank you! Comments follow.
>
>> +(defmacro org-agenda--insert-overriding-header (&key default)
>
> There is no "&key" in `defmacro'.

You're right, that's why IIRC I used cl-defmacro originally.  The
issue here seems to be using the keyword argument.  It seemed like a
good idea to specify it with the ":default: keyword argument for two
reasons:

1.  To make it explicitly clear that the body of code passed to the
macro is only the default header, not necessarily the one that will be
used.

2.  To make it easier to add other arguments in the future.  For
example, I could imagine adding an argument to change the face or
properties of the overriding header, a prefix or suffix, etc., and those
would be much easier to handle as keyword args, to avoid calling it as
something like "nil nil t nil", as happens with some other Emacs
function signatures (e.g. I often have to look up how to call
re-search-forward as opposed to replace-regexp-in-string).

> It should be (default).
>
>> +  "Insert header into agenda view depending on value of `org-agenda-overriding-header'.
>> +If the empty string, don't insert a header.  If any other string,
>> +insert it as a header.  If nil, insert DEFAULT, which should
>> +evaluate to a string."
>> +  (declare (debug (&key form)))
>
> It needs to be updated according to the above.

I'm not sure what you mean here, but I guess it depends on the previous matter.

>> +			    ;; Format week number span
>> +			    (cond ((< (- d2 d1) 350)
>> +				   (if (= w1 w2)
>> +				       (format " (W%02d)" w1)
>> +				     (format " (W%02d-W%02d)" w1 w2)))
>> +				  (t ""))
>
>   (cond ((<= 350 (- d2 d1)) "")
>         ((= w1 w2) (format " (W%02d)" w1))
>         (t (format " (W%02d-W%02d)" w1 w2)))

I see.  That doesn't seem to be exactly the same logic as the nested if,
and I didn't follow the surrounding logic well enough to try to
transform it that way.  But I assume you know what you're doing, so I'll
swap that in.  :)

>> -		    (let ((n 0) s)
>> -		      (mapc (lambda (x)
>> -			      (setq s (format "(%d)%s" (setq n (1+ n)) x))
>> -			      (if (> (+ (current-column) (string-width s) 1) (frame-width))
>> -				  (insert "\n                     "))
>> -			      (insert " " s))
>> -			    kwds))
>> +		    (cl-loop for keyword in kwds
>> +			     and num from 1
>> +			     for string = (format "(%d)%s" num keyword)
>> +			     when (> (+ (current-column) (string-width string) 1)
>> +				     (window-width))
>> +			     do (insert "\n                     ")
>> +			     do (insert " " string))
>
> Ouch. Why `cl-loop' over `dolist'? Also it looks wrong since the last
> `do' is not always executed? (or is it?).

Yes, it is always executed: the "when" only applies to the next clause,
and I tested it to be sure, both by executing it and expanding the
macro.  I've used cl-loop a lot lately, so it is familiar to me.

> I know there is more than one way to skin a cat, but I'd rather use
> a straightforward one:
>
>   (let ((n 0))
>     (dolist (k kwds)
>       (let ((s (format "(%d)%s" (cl-incf n) k)))
>         (when (> (+ (current-column) (string-width s) 1) (frame-width))
>           (insert "\n                     "))
>         (insert " " s))))

I guess this is a matter of style, as I prefer the cl-loop version,
which doesn't hide the incrementing in the format call and avoids
another level of nesting just for the counter variable.  :)  But if you
want me to use the dolist instead, it's up to you.

Let me know about these issues and I'll send another patch series.

Thanks.

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Nicolas Goaziou]

Hello,

Adam Porter <adam@alphapapa.net> writes:

> You're right, that's why IIRC I used cl-defmacro originally.  The
> issue here seems to be using the keyword argument.  It seemed like a
> good idea to specify it with the ":default: keyword argument for two
> reasons:
>
> 1.  To make it explicitly clear that the body of code passed to the
> macro is only the default header, not necessarily the one that will be
> used.
>
> 2.  To make it easier to add other arguments in the future.


This is an internal macro. We can add anything without problem in the
future. For now, I really think `defmacro' is enough.

>>> +			    ;; Format week number span
>>> +			    (cond ((< (- d2 d1) 350)
>>> +				   (if (= w1 w2)
>>> +				       (format " (W%02d)" w1)
>>> +				     (format " (W%02d-W%02d)" w1 w2)))
>>> +				  (t ""))
>>
>>   (cond ((<= 350 (- d2 d1)) "")
>>         ((= w1 w2) (format " (W%02d)" w1))
>>         (t (format " (W%02d-W%02d)" w1 w2)))
>
> I see.  That doesn't seem to be exactly the same logic as the nested if,

Why do you think it isn't equivalent?

>>> -		    (let ((n 0) s)
>>> -		      (mapc (lambda (x)
>>> -			      (setq s (format "(%d)%s" (setq n (1+ n)) x))
>>> -			      (if (> (+ (current-column) (string-width s) 1) (frame-width))
>>> -				  (insert "\n                     "))
>>> -			      (insert " " s))
>>> -			    kwds))
>>> +		    (cl-loop for keyword in kwds
>>> +			     and num from 1
>>> +			     for string = (format "(%d)%s" num keyword)
>>> +			     when (> (+ (current-column) (string-width string) 1)
>>> +				     (window-width))
>>> +			     do (insert "\n                     ")
>>> +			     do (insert " " string))
>>
>> Ouch. Why `cl-loop' over `dolist'? Also it looks wrong since the last
>> `do' is not always executed? (or is it?).
>
> Yes, it is always executed: the "when" only applies to the next clause,
> and I tested it to be sure, both by executing it and expanding the
> macro.  I've used cl-loop a lot lately, so it is familiar to me.

This looks too much magical to me. Both `do' are treated differently.

>> I know there is more than one way to skin a cat, but I'd rather use
>> a straightforward one:
>>
>>   (let ((n 0))
>>     (dolist (k kwds)
>>       (let ((s (format "(%d)%s" (cl-incf n) k)))
>>         (when (> (+ (current-column) (string-width s) 1) (frame-width))
>>           (insert "\n                     "))
>>         (insert " " s))))
>
> I guess this is a matter of style, as I prefer the cl-loop version,
> which doesn't hide the incrementing in the format call

You must be kidding. `cl-loop' hides a lot of things. In any case, you
can increment the counter above the `s' binding if you want to.

> and avoids another level of nesting just for the counter variable. :)
> But if you want me to use the dolist instead, it's up to you.

I'd rather have `dolist' yes. That's more basic and therefore, easier to
understand.

Thank you.

Regards,

-- 
Nicolas Goaziou

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Adam Porter]

[-- Attachment #1: Type: text/plain, Size: 84 bytes --]

Hi Nicolas,

Here is another patch series with the requested changes.

Thanks,
Adam

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 9473 bytes --]

From 98a90c8e05acc8733972be731e5a9eb1efe10fee Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Sat, 19 Aug 2017 21:26:12 -0500
Subject: [PATCH 1/2] org-agenda: Refactor org-agenda-overriding-header code

* lisp/org-agenda.el (org-agenda--insert-overriding-header): Add macro.
(org-agenda-list)
(org-search-view)
(org-todo-list)
(org-tags-view): Use macro.
(org-agenda-overriding-header): Update docstring.

* etc/ORG-NEWS: Explain that header can be disabled with empty string.

Replace org-agenda-overriding-header tests in these four functions with
calls to a macro, eliminating the duplicate code.  Also, disable the
header when the variable is set to the empty string.
---
 etc/ORG-NEWS       |   4 ++
 lisp/org-agenda.el | 139 ++++++++++++++++++++++++++++++-----------------------
 2 files changed, 82 insertions(+), 61 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 9f3e624..05b1418 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -135,6 +135,10 @@ See docstring for details.
 =org-agenda-tags-column= can now be set to =auto=, which will
 automatically align tags to the right edge of the window.  This is now
 the default setting.
+**** Disable =org-agenda-overriding-header= by setting to empty string
+
+The =org-agenda-overriding-header= inserted into agenda views can now be
+disabled by setting it to an empty string.
 
 *** New value for ~org-publish-sitemap-sort-folders~
 
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 221a11d..2233f38 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -2062,6 +2062,22 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
 	(setcdr ass (cdr entry))
       (push entry org-agenda-custom-commands))))
 
+(defmacro org-agenda--insert-overriding-header (default)
+  "Insert header into agenda view depending on value of `org-agenda-overriding-header'.
+If the empty string, don't insert a header.  If any other string,
+insert it as a header.  If nil, insert DEFAULT, which should
+evaluate to a string."
+  (declare (debug (form)) (indent defun))
+  `(pcase org-agenda-overriding-header
+     ("" nil)  ; Don't insert a header if set to empty string
+     ;; Insert user-specified string
+     ((pred stringp) (insert
+		      (org-add-props (copy-sequence org-agenda-overriding-header)
+			  nil 'face 'org-agenda-structure)
+		      "\n"))
+     ;; When nil, make string automatically and insert it
+     ((pred null) (insert ,default))))
+
 ;;; Define the org-agenda-mode
 
 (defvar org-agenda-mode-map (make-sparse-keymap)
@@ -4153,10 +4169,8 @@ items if they have an hour specification like [h]h:mm."
 	       (w1 (org-days-to-iso-week d1))
 	       (w2 (org-days-to-iso-week d2)))
 	  (setq s (point))
-	  (if org-agenda-overriding-header
-	      (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-			  nil 'face 'org-agenda-structure) "\n")
-	    (insert (org-agenda-span-name span)
+	  (org-agenda--insert-overriding-header
+	    (concat (org-agenda-span-name span)
 		    "-agenda"
 		    (if (< (- d2 d1) 350)
 			(if (= w1 w2)
@@ -4574,25 +4588,25 @@ in `org-agenda-text-search-extra-files'."
 			(goto-char (1- end))))))))))
 	(setq rtn (nreverse ee))
 	(setq rtnall (append rtnall rtn)))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Search words: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure))
-	(setq pos (point))
-	(insert string "\n")
-	(add-text-properties pos (1- (point)) (list 'face 'org-warning))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys "\
+      (org-agenda--insert-overriding-header
+	(with-temp-buffer
+	  (insert "Search words: ")
+	  (add-text-properties (point-min) (1- (point))
+			       (list 'face 'org-agenda-structure))
+	  (setq pos (point))
+	  (insert string "\n")
+	  (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+	  (setq pos (point))
+	  (unless org-agenda-multi
+	    (insert (substitute-command-keys "\
 Press `\\[org-agenda-manipulate-query-add]', \
 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
 `\\[org-agenda-manipulate-query-add-re]', \
 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
 `\\[universal-argument] \\[org-agenda-redo]' to edit\n"))
-	  (add-text-properties pos (1- (point))
-			       (list 'face 'org-agenda-structure))))
+	    (add-text-properties pos (1- (point))
+				 (list 'face 'org-agenda-structure)))
+	  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'search) "\n"))
@@ -4670,31 +4684,31 @@ for a keyword.  A numeric prefix directly selects the Nth keyword in
 	  (org-check-agenda-file file)
 	  (setq rtn (org-agenda-get-day-entries file date :todo))
 	  (setq rtnall (append rtnall rtn))))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Global list of TODO items of type: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure
-				   'short-heading
-				   (concat "ToDo: "
-					   (or org-select-this-todo-keyword "ALL"))))
-	(org-agenda-mark-header-line (point-min))
-	(insert (org-agenda-propertize-selected-todo-keywords
-		 org-select-this-todo-keyword))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys "Available with \
+      (org-agenda--insert-overriding-header
+        (with-temp-buffer
+	  (insert "Global list of TODO items of type: ")
+	  (add-text-properties (point-min) (1- (point))
+			       (list 'face 'org-agenda-structure
+				     'short-heading
+				     (concat "ToDo: "
+					     (or org-select-this-todo-keyword "ALL"))))
+	  (org-agenda-mark-header-line (point-min))
+	  (insert (org-agenda-propertize-selected-todo-keywords
+		   org-select-this-todo-keyword))
+	  (setq pos (point))
+	  (unless org-agenda-multi
+	    (insert (substitute-command-keys "Available with \
 `N \\[org-agenda-redo]': (0)[ALL]"))
-	  (let ((n 0) s)
-	    (mapc (lambda (x)
-		    (setq s (format "(%d)%s" (setq n (1+ n)) x))
-		    (if (> (+ (current-column) (string-width s) 1) (frame-width))
-			(insert "\n                     "))
-		    (insert " " s))
-		  kwds))
-	  (insert "\n"))
-	(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
+	    (let ((n 0) s)
+	      (mapc (lambda (x)
+		      (setq s (format "(%d)%s" (setq n (1+ n)) x))
+		      (if (> (+ (current-column) (string-width s) 1) (frame-width))
+			  (insert "\n                     "))
+		      (insert " " s))
+		    kwds))
+	    (insert "\n"))
+	  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))
+	  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
@@ -4772,24 +4786,24 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
 					   matcher
 					   org--matcher-tags-todo-only))
 		  (setq rtnall (append rtnall rtn))))))))
-      (if org-agenda-overriding-header
-	  (insert (org-add-props (copy-sequence org-agenda-overriding-header)
-		      nil 'face 'org-agenda-structure) "\n")
-	(insert "Headlines with TAGS match: ")
-	(add-text-properties (point-min) (1- (point))
-			     (list 'face 'org-agenda-structure
-				   'short-heading
-				   (concat "Match: " match)))
-	(setq pos (point))
-	(insert match "\n")
-	(add-text-properties pos (1- (point)) (list 'face 'org-warning))
-	(setq pos (point))
-	(unless org-agenda-multi
-	  (insert (substitute-command-keys
-		   "Press `\\[universal-argument] \\[org-agenda-redo]' \
+      (org-agenda--insert-overriding-header
+        (with-temp-buffer
+	  (insert "Headlines with TAGS match: ")
+	  (add-text-properties (point-min) (1- (point))
+			       (list 'face 'org-agenda-structure
+				     'short-heading
+				     (concat "Match: " match)))
+	  (setq pos (point))
+	  (insert match "\n")
+	  (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+	  (setq pos (point))
+	  (unless org-agenda-multi
+	    (insert (substitute-command-keys
+		     "Press `\\[universal-argument] \\[org-agenda-redo]' \
 to search again with new search string\n")))
-	(add-text-properties pos (1- (point))
-			     (list 'face 'org-agenda-structure)))
+	  (add-text-properties pos (1- (point))
+			       (list 'face 'org-agenda-structure))
+	  (buffer-string)))
       (org-agenda-mark-header-line (point-min))
       (when rtnall
 	(insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
@@ -4813,8 +4827,11 @@ used by user-defined selections using `org-agenda-skip-function'.")
 
 (defvar org-agenda-overriding-header nil
   "When set during agenda, todo and tags searches it replaces the header.
-This variable should not be set directly, but custom commands can bind it
-in the options section.")
+If an empty string, no header will be inserted.  If any other
+string, it will be inserted as a header.  If nil, a header will
+be generated automatically according to the command.  This
+variable should not be set directly, but custom commands can bind
+it in the options section.")
 
 (defun org-agenda-skip-entry-if (&rest conditions)
   "Skip entry if any of CONDITIONS is true.
-- 
2.7.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: patch --]
[-- Type: text/x-diff, Size: 2776 bytes --]

From 222e9ea285a2c55e67b6cd4ae0ac82a89eb7bfe2 Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Tue, 22 Aug 2017 21:12:14 -0500
Subject: [PATCH 2/2] org-agenda: Minor refactoring and tiny bug fix

* lisp/org-agenda.el (org-agenda--insert-overriding-header): Use
propertize instead of org-add-props.
(org-agenda-list): Replace nested if with cond.
(org-todo-list): Replace mapc-lambda with dolist.
(org-todo-list): Fix bug by using window-width instead of frame-width.
---
 lisp/org-agenda.el | 28 ++++++++++++----------------
 1 file changed, 12 insertions(+), 16 deletions(-)

diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 2233f38..9dac7b3 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -2071,10 +2071,9 @@ evaluate to a string."
   `(pcase org-agenda-overriding-header
      ("" nil)  ; Don't insert a header if set to empty string
      ;; Insert user-specified string
-     ((pred stringp) (insert
-		      (org-add-props (copy-sequence org-agenda-overriding-header)
-			  nil 'face 'org-agenda-structure)
-		      "\n"))
+     ((pred stringp) (insert (propertize org-agenda-overriding-header
+					 'face 'org-agenda-structure)
+			     "\n"))
      ;; When nil, make string automatically and insert it
      ((pred null) (insert ,default))))
 
@@ -4172,11 +4171,9 @@ items if they have an hour specification like [h]h:mm."
 	  (org-agenda--insert-overriding-header
 	    (concat (org-agenda-span-name span)
 		    "-agenda"
-		    (if (< (- d2 d1) 350)
-			(if (= w1 w2)
-			    (format " (W%02d)" w1)
-			  (format " (W%02d-W%02d)" w1 w2))
-		      "")
+		    (cond ((<= 350 (- d2 d1)) "")
+                          ((= w1 w2) (format " (W%02d)" w1))
+                          (t (format " (W%02d-W%02d)" w1 w2)))
 		    ":\n")))
 	(add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
 						  'org-date-line t))
@@ -4699,13 +4696,12 @@ for a keyword.  A numeric prefix directly selects the Nth keyword in
 	  (unless org-agenda-multi
 	    (insert (substitute-command-keys "Available with \
 `N \\[org-agenda-redo]': (0)[ALL]"))
-	    (let ((n 0) s)
-	      (mapc (lambda (x)
-		      (setq s (format "(%d)%s" (setq n (1+ n)) x))
-		      (if (> (+ (current-column) (string-width s) 1) (frame-width))
-			  (insert "\n                     "))
-		      (insert " " s))
-		    kwds))
+	    (let ((n 0))
+              (dolist (k kwds)
+                (let ((s (format "(%d)%s" (cl-incf n) k)))
+                  (when (> (+ (current-column) (string-width s) 1) (window-width))
+                    (insert "\n                     "))
+                  (insert " " s))))
 	    (insert "\n"))
 	  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))
 	  (buffer-string)))
-- 
2.7.4

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Nicolas Goaziou]

Hello,

Adam Porter <adam@alphapapa.net> writes:

> Here is another patch series with the requested changes.

Applied. Thank you!

If you feel like it, some tests in "test-org-agenda.el" would be nice,
too.

Regards,

-- 
Nicolas Goaziou

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Adam Porter]

Nicolas Goaziou <mail@nicolasgoaziou.fr> writes:

> If you feel like it, some tests in "test-org-agenda.el" would be nice,
> too.

Hi Nicolas,

I looked at that file and I see that it's pretty basic.  I recently put
together a sort of testing framework for org-super-agenda that makes it
pretty easy to develop and run consistent tests on agendas:

https://github.com/alphapapa/org-super-agenda/blob/master/test/test.el

Would you be interested in a patch that adds something like that to Org?
It would make it easy to test specific agenda features, and I guess it
might help with your agenda rewrite.  :)

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Adam Porter]

By the way, one of its features is that, when a test doesn't pass, it
shows a line-by-line diff of the agenda buffer compared with the saved
result.  It's saved me a lot of time when debugging test failures, as
otherwise I'd have to visually compare a large agenda buffer.  :)

Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header

[Nicolas Goaziou]

Hello,

Adam Porter <adam@alphapapa.net> writes:

> I looked at that file and I see that it's pretty basic.

There's a first step in everything.

> I recently put together a sort of testing framework for
> org-super-agenda that makes it pretty easy to develop and run
> consistent tests on agendas:
>
> https://github.com/alphapapa/org-super-agenda/blob/master/test/test.el
>
> Would you be interested in a patch that adds something like that to Org?
> It would make it easy to test specific agenda features, and I guess it
> might help with your agenda rewrite.  :)

Thank you.

I didn't try it, but AFAIU, it requires to learn some DSL to write
tests. There are two possible issues: 
- the DSL does not cover all use cases, and therefore gets in the way;
- the DSL implies overhead in writing tests, which is counterproductive.

I didn't test your library, so I cannot tell if your system suffers from
one of the items above. I'm merely pointing out my concerns.

OTOH, I think we need proper tooling to write tests for Org agenda.
Since you put some thought in it, do you think it is feasible to have
something like this, albeit more lightweight (e.g., macros around
regular Org code instead of a DSL)? If so, would you to give it a try?

Regards,

-- 
Nicolas Goaziou