From mboxrd@z Thu Jan 1 00:00:00 1970 From: Adam Porter Subject: Re: [PATCH] org-agenda: Add 'none setting for org-agenda-overriding-header Date: Sat, 02 Sep 2017 20:44:15 -0500 Message-ID: <87mv6ceets.fsf@alphapapa.net> References: <87k22416un.fsf@alphapapa.net> <87bmnep8yz.fsf@nicolasgoaziou.fr> <8760dmynkk.fsf@alphapapa.net> <871so9nt04.fsf@nicolasgoaziou.fr> <87pobrc5vp.fsf@alphapapa.net> <87wp5yir25.fsf@nicolasgoaziou.fr> <87a82rkqmf.fsf@alphapapa.net> <8760dfko9f.fsf@alphapapa.net> <87lgma1xgj.fsf@nicolasgoaziou.fr> <87efrphle7.fsf@alphapapa.net> <87wp5h1qxc.fsf@nicolasgoaziou.fr> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:55008) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1doJyB-00051w-97 for emacs-orgmode@gnu.org; Sat, 02 Sep 2017 21:45:11 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1doJy5-0003hu-Fm for emacs-orgmode@gnu.org; Sat, 02 Sep 2017 21:45:03 -0400 Received: from [195.159.176.226] (port=50100 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1doJy5-0003gg-1y for emacs-orgmode@gnu.org; Sat, 02 Sep 2017 21:44:57 -0400 Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1doJxu-0000qv-6U for emacs-orgmode@gnu.org; Sun, 03 Sep 2017 03:44:46 +0200 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: emacs-orgmode@gnu.org --=-=-= Content-Type: text/plain Hi Nicolas, Here is another patch series with the requested changes. Thanks, Adam --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-org-agenda-Refactor-org-agenda-overriding-header-cod.patch Content-Description: patch >From 98a90c8e05acc8733972be731e5a9eb1efe10fee Mon Sep 17 00:00:00 2001 From: Adam Porter 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 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-org-agenda-Minor-refactoring-and-tiny-bug-fix.patch Content-Description: patch >From 222e9ea285a2c55e67b6cd4ae0ac82a89eb7bfe2 Mon Sep 17 00:00:00 2001 From: Adam Porter 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 --=-=-=--