From 68f802ca720c0ba751d4b0cf603e5bca591228d1 Mon Sep 17 00:00:00 2001 From: Max Mikhanosha Date: Thu, 1 Mar 2012 10:49:23 -0500 Subject: [PATCH] Re-create mulitple-agenda-buffers support, to avoid git rebase hell --- lisp/org-agenda.el | 654 +++++++++++++++++++++++++++++++++++------------------ 1 file changed, 434 insertions(+), 220 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 98a2cc048..162aa9f9e 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1501,8 +1501,10 @@ Custom commands can set this variable in the options section." :group 'org-agenda-line-format) (defvar org-prefix-format-compiled nil - "The compiled version of the most recently used prefix format. -See the variable `org-agenda-prefix-format'.") + "The compiled prefix format and associated variables, as a list +where first element is a list of variable bindings, and second +element is the compiled format expression. See the variable +`org-agenda-prefix-format'.") (defcustom org-agenda-todo-keyword-format "%-1s" "Format for the TODO keyword in agenda lines. @@ -1810,6 +1812,127 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvar org-agenda-force-single-file nil) (defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file + +;;; Multiple agenda buffers support + +(defcustom org-agenda-sticky nil + "Non-nil means agenda q key will bury agenda buffers, instead +of killing it, and agenda commands show existing buffer instead +of generating new one" + :group 'org-agenda + :type 'boolean) + +(defvar org-agenda-buffer nil + "Agenda buffer currently being generated") + +(defun org-toggle-sticky-agenda (&optional arg) + "Toggle `org-agenda-sticky'" + (interactive) + (setq org-agenda-sticky (or arg (not org-agenda-sticky))) + (message "Sticky agenda was %s" (if org-agenda-sticky "enabled" "disabled"))) + +(defvar org-agenda-last-prefix-arg nil) +(defvar org-agenda-this-buffer-name nil) +(defvar org-agenda-doing-sticky-redo nil) +(defvar org-agenda-this-buffer-is-sticky nil) + +;; below list is generating by grepping org-agenda.el for defvar +(defconst org-agenda-local-vars + '(;; calendar-mode-map + org-agenda-this-buffer-name + org-clock-current-task + org-mobile-force-id-on-agenda-items + org-habit-show-habits + org-habit-show-habits-only-for-today + org-agenda-this-buffer-name + org-agenda-overriding-header + org-agenda-title-append + org-agenda-undo-list + org-agenda-pending-undo-list + org-agenda-archives-mode + org-agenda-entry-text-cleanup-hook + org-agenda-include-inactive-timestamps + org-prefix-format-compiled + org-agenda-mode-map + org-agenda-menu + org-agenda-restrict + org-agenda-follow-mode + org-agenda-entry-text-mode + org-agenda-clockreport-mode + org-agenda-show-log + org-agenda-redo-command + org-agenda-query-string + org-agenda-mode-hook + org-agenda-type + org-agenda-force-single-file + org-agenda-bulk-marked-entries + org-agenda-allow-remote-undo + org-agenda-undo-list + org-agenda-undo-has-started-in + org-agenda-pending-undo-list + org-agenda-restrict + org-agenda-restrict-begin + org-agenda-restrict-end + org-agenda-last-dispatch-buffer + ;; org-agenda-overriding-restriction + ;; org-agenda-overriding-arguments + org-agenda-last-arguments + org-agenda-info + org-mobile-creating-agendas + org-agenda-tag-filter-overlays + org-agenda-cat-filter-overlays + org-agenda-marker-table + org-pre-agenda-window-conf + org-agenda-columns-active + org-agenda-name + org-agenda-tag-filter + org-agenda-category-filter + org-agenda-tag-filter-while-redo + org-agenda-tag-filter-preset + org-agenda-category-filter-preset + org-agenda-skip-function + org-agenda-markers + org-agenda-last-marker-time + org-agenda-only-exact-dates + org-agenda-start-day + org-starting-day + org-agenda-current-span + org-arg-loc + org-agenda-entry-types + org-agenda-search-history + org-todo-only + org-search-syntax-table + org-agenda-last-search-view-search-was-boolean + org-last-arg + org-agenda-skip-regexp + org-agenda-overriding-header + org-disable-agenda-to-diary + diary-list-entries-hook + diary-time-regexp + org-agenda-cleanup-fancy-diary-hook + org-diary-last-run-time + org-heading-keyword-regexp-format + org-agenda-sorting-strategy + org-agenda-sorting-strategy-selected + org-agenda-before-sorting-filter-function + org-agenda-restriction-lock-overlay + org-global-tags-completion-table + org-agenda-filtered-by-category + org-agenda-filter-form + org-hl + org-agenda-after-show-hook + org-archive-default-command + org-agenda-show-window + org-agenda-cycle-counter + org-last-heading-marker + ;; calendar-longitude + ;; calendar-latitude + ;; calendar-location-name + org-agenda-bulk-marked-entries + appt-time-msg-list + org-agenda-last-prefix-arg)) + + (defun org-agenda-mode () "Mode for time-sorted view on action items in Org-mode files. @@ -1818,6 +1941,11 @@ The following commands are available: \\{org-agenda-mode-map}" (interactive) (kill-all-local-variables) + (let ((sticky-p (or org-agenda-sticky + org-agenda-doing-sticky-redo))) + (when sticky-p + (mapc 'make-local-variable org-agenda-local-vars)) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) sticky-p)) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil org-agenda-bulk-marked-entries nil) @@ -1931,6 +2059,7 @@ The following commands are available: 'org-clock-modify-effort-estimate) (org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property) (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) +(org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit) (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write) (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) @@ -2703,7 +2832,7 @@ agenda-day The day in the agenda where this is listed" (defun org-fix-agenda-info (props) "Make sure all properties on an agenda item have a canonical form. -This ensures the export commands can easily use it." + This ensures the export commands can easily use it." (let (tmp re) (when (setq tmp (plist-get props 'tags)) (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) @@ -2740,8 +2869,8 @@ This ensures the export commands can easily use it." ((stringp res) res) (t (prin1-to-string res)))) (while (string-match "," res) - (setq res (replace-match ";" t t res))) - (org-trim res))) + (setq res (replace-match ";" t t res))) ; + (org-trim res))) ;;;###autoload @@ -3092,61 +3221,99 @@ the entire agenda view. In a block agenda, it will not work reliably to define a filter for one of the individual blocks. You need to set it in the global options and expect it to be applied to the entire view.") + +(defun org-agenda-use-sticky-p () + "Return non-NIL if existing agenda buffer named +`org-agenda-buffer-name' exists, and should be shown instead of +generating a new one" + (and + ;; turned off by user + org-agenda-sticky + ;; For multi-agenda buffer already exists + (not org-agenda-multi) + ;; buffer found + (get-buffer org-agenda-buffer-name) + ;; C-u parameter is same as last call + (with-current-buffer (get-buffer org-agenda-buffer-name) + (and + (equal current-prefix-arg + org-agenda-last-prefix-arg) + ;; In case user turned stickiness on, while having existing + ;; Agenda buffer active, don't reuse that buffer, because it + ;; does not have org variables local + org-agenda-this-buffer-is-sticky)))) + +(defun org-prepare-agenda-window (abuf) + "Setup agenda buffer in the window" + (let* ((awin (get-buffer-window abuf))) + (cond + ((equal (current-buffer) abuf) nil) + (awin (select-window awin)) + ((not (setq org-pre-agenda-window-conf (current-window-configuration)))) + ((equal org-agenda-window-setup 'current-window) + (org-pop-to-buffer-same-window abuf)) + ((equal org-agenda-window-setup 'other-window) + (org-switch-to-buffer-other-window abuf)) + ((equal org-agenda-window-setup 'other-frame) + (switch-to-buffer-other-frame abuf)) + ((equal org-agenda-window-setup 'reorganize-frame) + (delete-other-windows) + (org-switch-to-buffer-other-window abuf))) + ;; additional test in case agenda is invoked from within agenda + ;; buffer via elisp link + (unless (equal (current-buffer) abuf) + (org-pop-to-buffer-same-window abuf)))) + (defun org-prepare-agenda (&optional name) - (setq org-todo-keywords-for-agenda nil) - (setq org-done-keywords-for-agenda nil) - (setq org-drawers-for-agenda nil) - (unless org-agenda-persistent-filter - (setq org-agenda-tag-filter nil - org-agenda-category-filter nil)) - (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset) - (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset) - (if org-agenda-multi + (if (org-agenda-use-sticky-p) (progn - (setq buffer-read-only nil) - (goto-char (point-max)) - (unless (or (bobp) org-agenda-compact-blocks - (not org-agenda-block-separator)) - (insert "\n" - (if (stringp org-agenda-block-separator) - org-agenda-block-separator - (make-string (window-width) org-agenda-block-separator)) - "\n")) - (narrow-to-region (point) (point-max))) - (org-agenda-reset-markers) - (setq org-agenda-contributing-files nil) - (setq org-agenda-columns-active nil) - (org-prepare-agenda-buffers (org-agenda-files nil 'ifmode)) - (setq org-todo-keywords-for-agenda - (org-uniquify org-todo-keywords-for-agenda)) - (setq org-done-keywords-for-agenda - (org-uniquify org-done-keywords-for-agenda)) - (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) - (let* ((abuf (get-buffer-create org-agenda-buffer-name)) - (awin (get-buffer-window abuf))) - (cond - ((equal (current-buffer) abuf) nil) - (awin (select-window awin)) - ((not (setq org-pre-agenda-window-conf (current-window-configuration)))) - ((equal org-agenda-window-setup 'current-window) - (org-pop-to-buffer-same-window abuf)) - ((equal org-agenda-window-setup 'other-window) - (org-switch-to-buffer-other-window abuf)) - ((equal org-agenda-window-setup 'other-frame) - (switch-to-buffer-other-frame abuf)) - ((equal org-agenda-window-setup 'reorganize-frame) - (delete-other-windows) - (org-switch-to-buffer-other-window abuf))) - ;; additional test in case agenda is invoked from within agenda - ;; buffer via elisp link - (unless (equal (current-buffer) abuf) - (org-pop-to-buffer-same-window abuf))) - (setq buffer-read-only nil) - (let ((inhibit-read-only t)) (erase-buffer)) - (org-agenda-mode) - (and name (not org-agenda-name) - (org-set-local 'org-agenda-name name))) - (setq buffer-read-only nil)) + ;; Popup existing buffer + (org-prepare-agenda-window (get-buffer org-agenda-buffer-name)) + (message + "Sticky Agenda buffer, use `r' to refresh") + (throw 'exit nil)) + (setq org-todo-keywords-for-agenda nil) + (setq org-done-keywords-for-agenda nil) + (setq org-drawers-for-agenda nil) + (unless org-agenda-persistent-filter + (setq org-agenda-tag-filter nil + org-agenda-category-filter nil)) + (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset) + (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset) + (if org-agenda-multi + (progn + (setq buffer-read-only nil) + (goto-char (point-max)) + (unless (or (bobp) org-agenda-compact-blocks + (not org-agenda-block-separator)) + (insert "\n" + (if (stringp org-agenda-block-separator) + org-agenda-block-separator + (make-string (window-width) org-agenda-block-separator)) + "\n")) + (narrow-to-region (point) (point-max))) + + ;; any org variables need to be set after being in agenda buffer + ;; since they are now buffer local + (org-prepare-agenda-window (get-buffer-create org-agenda-buffer-name)) + (setq buffer-read-only nil) + (let ((inhibit-read-only t)) (erase-buffer)) + (org-agenda-mode) + (setq org-agenda-buffer (current-buffer)) + (org-agenda-reset-markers) + (setq org-agenda-contributing-files nil) + (setq org-agenda-columns-active nil) + (org-prepare-agenda-buffers (org-agenda-files nil 'ifmode)) + (setq org-todo-keywords-for-agenda + (org-uniquify org-todo-keywords-for-agenda)) + (setq org-done-keywords-for-agenda + (org-uniquify org-done-keywords-for-agenda)) + (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) + (setq org-agenda-last-prefix-arg current-prefix-arg) + (setq org-agenda-this-buffer-name org-agenda-buffer-name) + (and name (not org-agenda-name) + (org-set-local 'org-agenda-name name))) + (setq buffer-read-only nil))) (defun org-finalize-agenda () "Finishing touch for the agenda buffer, called just before displaying it." @@ -3328,7 +3495,8 @@ Org-mode keeps a list of these markers and resets them when they are no longer in use." (let ((m (copy-marker (or pos (point))))) (setq org-agenda-last-marker-time (org-float-time)) - (push m org-agenda-markers) + (with-current-buffer org-agenda-buffer + (push m org-agenda-markers)) m)) (defun org-agenda-reset-markers () @@ -3400,8 +3568,6 @@ under the current date. If the buffer contains an active region, only check the region for dates." (interactive "P") - (org-compile-prefix-format 'timeline) - (org-set-sorting-strategy 'timeline) (let* ((dopast t) (doclosed org-agenda-show-log) (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) @@ -3428,6 +3594,8 @@ dates." (if (>= x today) x nil)) day-numbers)))) (org-prepare-agenda (concat "Timeline " (file-name-nondirectory entry))) + (org-compile-prefix-format 'timeline) + (org-set-sorting-strategy 'timeline) (if doclosed (push :closed args)) (push :timestamp args) (push :deadline args) @@ -3583,6 +3751,7 @@ given in `org-agenda-start-on-weekday'." (interactive "P") (if (and (integerp arg) (> arg 0)) (setq span arg arg nil)) + (org-prepare-agenda "Day/Week") (setq start-day (or start-day org-agenda-start-day)) (if org-agenda-overriding-arguments (setq arg (car org-agenda-overriding-arguments) @@ -3624,7 +3793,6 @@ given in `org-agenda-start-on-weekday'." (setq day-numbers (nreverse day-numbers)) (setq clocktable-start (car day-numbers) clocktable-end (1+ (or (org-last day-numbers) 0))) - (org-prepare-agenda "Day/Week") (org-set-local 'org-starting-day (car day-numbers)) (org-set-local 'org-arg-loc arg) (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) @@ -3834,9 +4002,9 @@ as a whole, to include whitespace. This command searches the agenda files, and in addition the files listed in `org-agenda-text-search-extra-files'." (interactive "P") + (org-prepare-agenda "SEARCH") (org-compile-prefix-format 'search) (org-set-sorting-strategy 'search) - (org-prepare-agenda "SEARCH") (let* ((props (list 'face nil 'done-face 'org-agenda-done 'org-not-done-regexp org-not-done-regexp @@ -4045,9 +4213,9 @@ the list to these. When using \\[universal-argument], you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'." (interactive "P") + (org-prepare-agenda "TODO") (org-compile-prefix-format 'todo) (org-set-sorting-strategy 'todo) - (org-prepare-agenda "TODO") (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) (let* ((today (org-today)) (date (calendar-gregorian-from-absolute today)) @@ -4061,7 +4229,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (when (equal arg '(4)) (setq org-select-this-todo-keyword (org-icompleting-read "Keyword (or KWD1|K2D2|...): " - (mapcar 'list kwds) nil nil))) + (mapcar 'list kwds) nil nil))) (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) (org-set-local 'org-last-arg arg) (setq org-agenda-redo-command @@ -4114,8 +4282,6 @@ for a keyword. A numeric prefix directly selects the Nth keyword in "Show all headlines for all `org-agenda-files' matching a TAGS criterion. The prefix arg TODO-ONLY limits the search to TODO entries." (interactive "P") - (org-compile-prefix-format 'tags) - (org-set-sorting-strategy 'tags) (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) (completion-ignore-case t) @@ -4126,6 +4292,8 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (setq matcher (org-make-tags-matcher match) match (car matcher) matcher (cdr matcher)) (org-prepare-agenda (concat "TAGS " match)) + (org-compile-prefix-format 'tags) + (org-set-sorting-strategy 'tags) (setq org-agenda-query-string match) (setq org-agenda-redo-command (list 'org-tags-view (list 'quote todo-only) @@ -5527,151 +5695,166 @@ time-of-day should be extracted from TXT for sorting of this entry, and for the `%t' specifier in the format. When DOTIME is a string, this string is searched for a time before TXT is. TAGS can be the tags of the headline. Any match of REMOVE-RE will be removed from TXT." - (save-match-data - ;; Diary entries sometimes have extra whitespace at the beginning - (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) - - ;; Fix the tags part in txt - (setq txt (org-agenda-fix-displayed-tags - txt tags - org-agenda-show-inherited-tags - org-agenda-hide-tags-regexp)) - (let* ((category (or category - (if (stringp org-category) - org-category - (and org-category (symbol-name org-category))) - (if buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ""))) - (category-icon (org-agenda-get-category-icon category)) - (category-icon (if category-icon - (propertize " " 'display category-icon) - "")) - ;; time, tag, effort are needed for the eval of the prefix format - (tag (if tags (nth (1- (length tags)) tags) "")) - time effort neffort - (ts (if dotime (concat - (if (stringp dotime) dotime "") - (and org-agenda-search-headline-for-time txt)))) - (time-of-day (and dotime (org-get-time-of-day ts))) - stamp plain s0 s1 s2 rtn srp l - duration thecategory) - (and (eq major-mode 'org-mode) buffer-file-name - (add-to-list 'org-agenda-contributing-files buffer-file-name)) - (when (and dotime time-of-day) - ;; Extract starting and ending time and move them to prefix - (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) - (setq plain (string-match org-plain-time-of-day-regexp ts))) - (setq s0 (match-string 0 ts) - srp (and stamp (match-end 3)) - s1 (match-string (if plain 1 2) ts) - s2 (match-string (if plain 8 (if srp 4 6)) ts)) - - ;; If the times are in TXT (not in DOTIMES), and the prefix will list - ;; them, we might want to remove them there to avoid duplication. - ;; The user can turn this off with a variable. - (if (and org-prefix-has-time - org-agenda-remove-times-when-in-prefix (or stamp plain) - (string-match (concat (regexp-quote s0) " *") txt) - (not (equal ?\] (string-to-char (substring txt (match-end 0))))) - (if (eq org-agenda-remove-times-when-in-prefix 'beg) - (= (match-beginning 0) 0) - t)) - (setq txt (replace-match "" nil nil txt)))) - ;; Normalize the time(s) to 24 hour - (if s1 (setq s1 (org-get-time-of-day s1 'string t))) - (if s2 (setq s2 (org-get-time-of-day s2 'string t))) - - ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set - (when (and s1 (not s2) org-agenda-default-appointment-duration) - (setq s2 - (org-minutes-to-hh:mm-string - (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration)))) - - ;; Compute the duration - (when s2 - (setq duration (- (org-hh:mm-string-to-minutes s2) - (org-hh:mm-string-to-minutes s1))))) - - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") - txt) - ;; Tags are in the string - (if (or (eq org-agenda-remove-tags t) - (and org-agenda-remove-tags - org-prefix-has-tag)) - (setq txt (replace-match "" t t txt)) - (setq txt (replace-match - (concat (make-string (max (- 50 (length txt)) 1) ?\ ) - (match-string 2 txt)) - t t txt)))) - (when (eq major-mode 'org-mode) - (setq effort - (condition-case nil - (org-get-effort - (or (get-text-property 0 'org-hd-marker txt) - (get-text-property 0 'org-marker txt))) - (error nil))) - (when effort - (setq neffort (org-duration-string-to-minutes effort) - effort (setq effort (concat "[" effort "]"))))) - ;; prevent erroring out with %e format when there is no effort - (or effort (setq effort "")) - - (when remove-re - (while (string-match remove-re txt) - (setq txt (replace-match "" t t txt)))) - - ;; Set org-heading property on `txt' to mark the start of the - ;; heading. - (add-text-properties 0 (length txt) '(org-heading t) txt) - - ;; Prepare the variables needed in the eval of the compiled format - (setq time (cond (s2 (concat - (org-agenda-time-of-day-to-ampm-maybe s1) - "-" (org-agenda-time-of-day-to-ampm-maybe s2) - (if org-agenda-timegrid-use-ampm " "))) - (s1 (concat - (org-agenda-time-of-day-to-ampm-maybe s1) - (if org-agenda-timegrid-use-ampm - "........ " - "......"))) - (t "")) - extra (or (and (not habitp) extra) "") - category (if (symbolp category) (symbol-name category) category) - thecategory (copy-sequence category)) - (if (string-match org-bracket-link-regexp category) - (progn - (setq l (if (match-end 3) - (- (match-end 3) (match-beginning 3)) - (- (match-end 1) (match-beginning 1)))) - (when (< l (or org-prefix-category-length 0)) - (setq category (copy-sequence category)) - (org-add-props category nil - 'extra-space (make-string - (- org-prefix-category-length l 1) ?\ )))) - (if (and org-prefix-category-max-length - (>= (length category) org-prefix-category-max-length)) - (setq category (substring category 0 (1- org-prefix-category-max-length))))) - ;; Evaluate the compiled format - (setq rtn (concat (eval org-prefix-format-compiled) txt)) - - ;; And finally add the text properties - (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) - (org-add-props rtn nil - 'org-category (if thecategory (downcase thecategory) category) - 'tags (mapcar 'org-downcase-keep-props tags) - 'org-highest-priority org-highest-priority - 'org-lowest-priority org-lowest-priority - 'time-of-day time-of-day - 'duration duration - 'effort effort - 'effort-minutes neffort - 'txt txt - 'time time - 'extra extra - 'format org-prefix-format-compiled - 'dotime dotime)))) + ;; We keep the org-prefix-* variable values along with a compiled + ;; formatter, so that multiple agendas existing at the same time, do + ;; not step on each other toes. + ;; + ;; It was inconvenient to make these variables buffer local in + ;; Agenda buffers, because this function expects to be called with + ;; the buffer where item comes from being current, and not agenda + ;; buffer + (let* ((org-prefix-format-compiled + (with-current-buffer org-agenda-buffer + org-prefix-format-compiled)) + (bindings (car org-prefix-format-compiled)) + (formatter (cadr org-prefix-format-compiled))) + (loop for (var value) in bindings + do (set var value)) + (save-match-data + ;; Diary entries sometimes have extra whitespace at the beginning + (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) + + ;; Fix the tags part in txt + (setq txt (org-agenda-fix-displayed-tags + txt tags + org-agenda-show-inherited-tags + org-agenda-hide-tags-regexp)) + (let* ((category (or category + (if (stringp org-category) + org-category + (and org-category (symbol-name org-category))) + (if buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ""))) + (category-icon (org-agenda-get-category-icon category)) + (category-icon (if category-icon + (propertize " " 'display category-icon) + "")) + ;; time, tag, effort are needed for the eval of the prefix format + (tag (if tags (nth (1- (length tags)) tags) "")) + time effort neffort + (ts (if dotime (concat + (if (stringp dotime) dotime "") + (and org-agenda-search-headline-for-time txt)))) + (time-of-day (and dotime (org-get-time-of-day ts))) + stamp plain s0 s1 s2 rtn srp l + duration thecategory) + (and (eq major-mode 'org-mode) buffer-file-name + (add-to-list 'org-agenda-contributing-files buffer-file-name)) + (when (and dotime time-of-day) + ;; Extract starting and ending time and move them to prefix + (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) + (setq plain (string-match org-plain-time-of-day-regexp ts))) + (setq s0 (match-string 0 ts) + srp (and stamp (match-end 3)) + s1 (match-string (if plain 1 2) ts) + s2 (match-string (if plain 8 (if srp 4 6)) ts)) + + ;; If the times are in TXT (not in DOTIMES), and the prefix will list + ;; them, we might want to remove them there to avoid duplication. + ;; The user can turn this off with a variable. + (if (and org-prefix-has-time + org-agenda-remove-times-when-in-prefix (or stamp plain) + (string-match (concat (regexp-quote s0) " *") txt) + (not (equal ?\] (string-to-char (substring txt (match-end 0))))) + (if (eq org-agenda-remove-times-when-in-prefix 'beg) + (= (match-beginning 0) 0) + t)) + (setq txt (replace-match "" nil nil txt)))) + ;; Normalize the time(s) to 24 hour + (if s1 (setq s1 (org-get-time-of-day s1 'string t))) + (if s2 (setq s2 (org-get-time-of-day s2 'string t))) + + ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set + (when (and s1 (not s2) org-agenda-default-appointment-duration) + (setq s2 + (org-minutes-to-hh:mm-string + (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration)))) + + ;; Compute the duration + (when s2 + (setq duration (- (org-hh:mm-string-to-minutes s2) + (org-hh:mm-string-to-minutes s1))))) + + (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + txt) + ;; Tags are in the string + (if (or (eq org-agenda-remove-tags t) + (and org-agenda-remove-tags + org-prefix-has-tag)) + (setq txt (replace-match "" t t txt)) + (setq txt (replace-match + (concat (make-string (max (- 50 (length txt)) 1) ?\ ) + (match-string 2 txt)) + t t txt)))) + (when (eq major-mode 'org-mode) + (setq effort + (condition-case nil + (org-get-effort + (or (get-text-property 0 'org-hd-marker txt) + (get-text-property 0 'org-marker txt))) + (error nil))) + (when effort + (setq neffort (org-duration-string-to-minutes effort) + effort (setq effort (concat "[" effort "]"))))) + ;; prevent erroring out with %e format when there is no effort + (or effort (setq effort "")) + + (when remove-re + (while (string-match remove-re txt) + (setq txt (replace-match "" t t txt)))) + + ;; Set org-heading property on `txt' to mark the start of the + ;; heading. + (add-text-properties 0 (length txt) '(org-heading t) txt) + + ;; Prepare the variables needed in the eval of the compiled format + (setq time (cond (s2 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + "-" (org-agenda-time-of-day-to-ampm-maybe s2) + (if org-agenda-timegrid-use-ampm " "))) + (s1 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + (if org-agenda-timegrid-use-ampm + "........ " + "......"))) + (t "")) + extra (or (and (not habitp) extra) "") + category (if (symbolp category) (symbol-name category) category) + thecategory (copy-sequence category)) + (if (string-match org-bracket-link-regexp category) + (progn + (setq l (if (match-end 3) + (- (match-end 3) (match-beginning 3)) + (- (match-end 1) (match-beginning 1)))) + (when (< l (or org-prefix-category-length 0)) + (setq category (copy-sequence category)) + (org-add-props category nil + 'extra-space (make-string + (- org-prefix-category-length l 1) ?\ )))) + (if (and org-prefix-category-max-length + (>= (length category) org-prefix-category-max-length)) + (setq category (substring category 0 (1- org-prefix-category-max-length))))) + ;; Evaluate the compiled format + (setq rtn (concat (eval formatter) txt)) + + ;; And finally add the text properties + (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) + (org-add-props rtn nil + 'org-category (if thecategory (downcase thecategory) category) + 'tags (mapcar 'org-downcase-keep-props tags) + 'org-highest-priority org-highest-priority + 'org-lowest-priority org-lowest-priority + 'time-of-day time-of-day + 'duration duration + 'effort effort + 'effort-minutes neffort + 'txt txt + 'time time + 'extra extra + 'format org-prefix-format-compiled + 'dotime dotime))))) (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) "Remove tags string from TXT, and add a modified list of tags. @@ -5757,8 +5940,8 @@ The modified list may contain inherited tags, and tags matched by (defun org-compile-prefix-format (key) "Compile the prefix format into a Lisp form that can be evaluated. -The resulting form is returned and stored in the variable -`org-prefix-format-compiled'." +The resulting form and associated variable bindings is returned +and stored in the variable `org-prefix-format-compiled'." (setq org-prefix-has-time nil org-prefix-has-tag nil org-prefix-category-length nil org-prefix-has-effort nil) @@ -5802,7 +5985,14 @@ The resulting form is returned and stored in the variable (setq s (replace-match "%s" t nil s)) (push varform vars)) (setq vars (nreverse vars)) - (setq org-prefix-format-compiled `(format ,s ,@vars)))) + (with-current-buffer org-agenda-buffer + (setq org-prefix-format-compiled + (list + `((org-prefix-has-time ,org-prefix-has-time) + (org-prefix-has-tag ,org-prefix-has-tag) + (org-prefix-category-length ,org-prefix-category-length) + (org-prefix-has-effort ,org-prefix-has-effort)) + `(format ,s ,@vars)))))) (defun org-set-sorting-strategy (key) (if (symbolp (car org-agenda-sorting-strategy)) @@ -6127,8 +6317,9 @@ If ERROR is non-nil, throw an error, otherwise just return nil." (error "Not allowed in %s-type agenda buffers" org-agenda-type) nil))) -(defun org-agenda-quit () - "Exit agenda by removing the window or the buffer." + +(defun org-agenda-Quit (&optional arg) + "Exit agenda by removing the window or the buffer" (interactive) (if org-agenda-columns-active (org-columns-quit) @@ -6153,6 +6344,24 @@ If ERROR is non-nil, throw an error, otherwise just return nil." org-pre-agenda-window-conf (set-window-configuration org-pre-agenda-window-conf)))) +(defun org-agenda-quit () + "Exit agenda by killing agenda buffer or burying it when +`org-agenda-sticky' is non-NIL" + (interactive) + (if org-agenda-columns-active + (org-columns-quit) + (if org-agenda-sticky + (let ((buf (current-buffer))) + (if (eq org-agenda-window-setup 'other-frame) + (progn + (delete-frame)) + (and (not (eq org-agenda-window-setup 'current-window)) + (not (one-window-p)) + (delete-window))) + (with-current-buffer buf + (bury-buffer))) + (org-agenda-Quit)))) + (defun org-agenda-exit () "Exit agenda by removing the window or the buffer. Also kill all Org-mode buffers which have been loaded by `org-agenda'. @@ -6160,7 +6369,7 @@ Org-mode buffers visited directly by the user will not be touched." (interactive) (org-release-buffers org-agenda-new-buffers) (setq org-agenda-new-buffers nil) - (org-agenda-quit)) + (org-agenda-Quit)) (defun org-agenda-execute (arg) "Execute another agenda command, keeping same window. @@ -6174,7 +6383,11 @@ in the agenda." "Rebuild Agenda. When this is the global TODO list, a prefix argument will be interpreted." (interactive) - (let* ((org-agenda-keep-modes t) + (let* ((org-agenda-doing-sticky-redo org-agenda-sticky) + (org-agenda-sticky nil) + (org-agenda-buffer-name (or org-agenda-this-buffer-name + org-agenda-buffer-name)) + (org-agenda-keep-modes t) (tag-filter org-agenda-tag-filter) (tag-preset (get 'org-agenda-tag-filter :preset-filter)) (cat-filter org-agenda-category-filter) @@ -6267,7 +6480,7 @@ to switch to narrowing." (message "Effort%s: %s " effort-op effort-prompt) (setq char (read-char-exclusive)) (when (or (< char ?0) (> char ?9)) - (error "Need 1-9,0 to select effort" )))) + (error "Need 1-9,0 to select effort")))) (when (equal char ?\t) (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) (org-set-local 'org-global-tags-completion-table @@ -7414,6 +7627,7 @@ If JUST-THIS is non-nil, change just the current line, not all. If FORCE-TAGS is non nil, the car of it returns the new tags." (let* ((inhibit-read-only t) (line (org-current-line)) + (org-agenda-buffer (current-buffer)) (thetags (with-current-buffer (marker-buffer hdmarker) (save-excursion (save-restriction (widen) (goto-char hdmarker) -- 2.11.4.GIT