emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Adam Porter <adam@alphapapa.net>
To: emacs-orgmode@gnu.org
Subject: Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header
Date: Sat, 02 Sep 2017 20:44:15 -0500	[thread overview]
Message-ID: <87mv6ceets.fsf@alphapapa.net> (raw)
In-Reply-To: 87wp5h1qxc.fsf@nicolasgoaziou.fr

[-- 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


  reply	other threads:[~2017-09-03  1:45 UTC|newest]

Thread overview: 17+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-08-16  4:20 [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header Adam Porter
2017-08-17 14:25 ` Nicolas Goaziou
2017-08-17 19:57   ` Adam Porter
2017-08-18  9:07     ` Nicolas Goaziou
2017-08-20  2:47       ` Adam Porter
2017-08-20  8:25         ` Nicolas Goaziou
2017-08-23  1:41           ` Adam Porter
2017-08-23  2:32             ` Adam Porter
2017-08-23  8:48               ` Nicolas Goaziou
2017-09-02  2:41                 ` Adam Porter
2017-09-02  7:49                   ` Nicolas Goaziou
2017-09-03  1:44                     ` Adam Porter [this message]
2017-09-06 11:17                       ` Nicolas Goaziou
2017-09-06 23:00                         ` Adam Porter
2017-09-10 12:32                           ` Nicolas Goaziou
2017-09-06 23:06                         ` Adam Porter
2017-08-23  8:37             ` Nicolas Goaziou

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87mv6ceets.fsf@alphapapa.net \
    --to=adam@alphapapa.net \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).