From 424f3ecedbea0117fb7008e686a897276936a1d7 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 27 Aug 2012 17:52:22 +0200 Subject: [PATCH] Fix bug when redoing multiple (agenda) blocks. * org-agenda.el (org-agenda-overriding-cmd) (org-agenda-multi-current-cmd) (org-agenda-multi-overriding-arguments): New variables. (org-agenda-run-series): `org-agenda-overriding-arguments' defaults to the last agenda block arguments, so don't use it globally. (org-agenda-mark-header-line): Add properties needed so that `org-agenda-overriding-arguments', `org-agenda-current-span' and `org-agenda-last-arguments' can be set to their correct contextual value. (org-agenda-multi-back-to-pos): New variable. (org-agenda-later): Retrieve `org-agenda-current-span' and `org-agenda-overriding-arguments' from text properties. Also handle numeric span. (org-agenda-later, org-agenda-change-time-span): Set `org-agenda-overriding-cmd' so that we to take overriding arguments into account for this command only. The behavior for agenda blocks where there is only one (agenda) command is not changed. Changing the time span and redoing with `g' will keep the new time span. The behavior changed for blocks where there are multiples (agenda) blocks. In this case, redoing will restore the initial view (before any time span change) and changing the time span is done independantly for each block. Thanks to Charles Philip Chan for reporting this nasty bug. --- lisp/org-agenda.el | 180 ++++++++++++++++++++++++++++++--------------- 1 file changed, 122 insertions(+), 58 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 00441e538..88e1b928e 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2370,15 +2370,15 @@ duplicates.)" (string :tag " Agenda key") (string :tag "Replace by command") (repeat :tag "Available when" - (choice - (cons :tag "Condition" - (choice - (const :tag "In file" in-file) - (const :tag "Not in file" not-in-file) - (const :tag "In mode" in-mode) - (const :tag "Not in mode" not-in-mode)) - (regexp)) - (function :tag "Custom function")))))) + (choice + (cons :tag "Condition" + (choice + (const :tag "In file" in-file) + (const :tag "Not in file" not-in-file) + (const :tag "In mode" in-mode) + (const :tag "Not in mode" not-in-mode)) + (regexp)) + (function :tag "Custom function")))))) ;;;###autoload (defun org-agenda (&optional arg keys restriction) @@ -2773,6 +2773,10 @@ s Search for keywords * Toggle sticky agenda views (defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter (defvar org-agenda-last-arguments nil "The arguments of the previous call to `org-agenda'.") +(defvar org-agenda-overriding-cmd nil) ; Dynamically scoped +(defvar org-agenda-multi-multiple-agenda nil) +(defvar org-agenda-multi-current-cmd nil) +(defvar org-agenda-multi-overriding-arguments nil) (defun org-agenda-run-series (name series) (org-let (nth 1 series) '(org-prepare-agenda name)) ;; We need to reset agenda markers here, because when constructing a @@ -2780,45 +2784,50 @@ s Search for keywords * Toggle sticky agenda views (org-agenda-reset-markers) (let* ((org-agenda-multi t) (redo (list 'org-agenda-run-series name (list 'quote series))) - (org-agenda-overriding-arguments - (or org-agenda-overriding-arguments - (unless (null (delq nil (get 'org-agenda-redo-command 'last-args))) - (get 'org-agenda-redo-command 'last-args)))) (cmds (car series)) (gprops (nth 1 series)) match ;; The byte compiler incorrectly complains about this. Keep it! cmd type lprops) + (setq org-agenda-multi-multiple-agenda + (< 1 (length + (delq nil (mapcar (lambda(c) (eq (car c) 'agenda)) cmds))))) (while (setq cmd (pop cmds)) - (setq type (car cmd) match (eval (nth 1 cmd)) lprops (nth 2 cmd)) - (cond - ((eq type 'agenda) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list))) - ((eq type 'alltodo) - (org-let2 gprops lprops - '(call-interactively 'org-todo-list))) - ((eq type 'search) - (org-let2 gprops lprops - '(org-search-view current-prefix-arg match nil))) - ((eq type 'stuck) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list-stuck-projects))) - ((eq type 'tags) - (org-let2 gprops lprops - '(org-tags-view current-prefix-arg match))) - ((eq type 'tags-todo) - (org-let2 gprops lprops - '(org-tags-view '(4) match))) - ((eq type 'todo) - (org-let2 gprops lprops - '(org-todo-list match))) - ((fboundp type) - (org-let2 gprops lprops - '(funcall type match))) - (t (error "Invalid type in command series")))) + (setq org-agenda-multi-current-cmd cmd + type (car cmd) match (eval (nth 1 cmd)) lprops (nth 2 cmd)) + (let ((org-agenda-overriding-arguments + (cond ((not org-agenda-multi-multiple-agenda) + org-agenda-multi-overriding-arguments) + ((eq org-agenda-overriding-cmd cmd) + org-agenda-overriding-arguments)))) + (cond + ((eq type 'agenda) + (org-let2 gprops lprops + '(call-interactively 'org-agenda-list))) + ((eq type 'alltodo) + (org-let2 gprops lprops + '(call-interactively 'org-todo-list))) + ((eq type 'search) + (org-let2 gprops lprops + '(org-search-view current-prefix-arg match nil))) + ((eq type 'stuck) + (org-let2 gprops lprops + '(call-interactively 'org-agenda-list-stuck-projects))) + ((eq type 'tags) + (org-let2 gprops lprops + '(org-tags-view current-prefix-arg match))) + ((eq type 'tags-todo) + (org-let2 gprops lprops + '(org-tags-view '(4) match))) + ((eq type 'todo) + (org-let2 gprops lprops + '(org-todo-list match))) + ((fboundp type) + (org-let2 gprops lprops + '(funcall type match))) + (t (error "Invalid type in command series"))))) (widen) + (setq org-agenda-multi-current-cmd nil) (setq org-agenda-redo-command redo) - (put 'org-agenda-redo-command 'last-args org-agenda-last-arguments) (goto-char (point-min))) (org-fit-agenda-window) (org-let (nth 1 series) '(org-finalize-agenda))) @@ -2981,6 +2990,19 @@ This ensures the export commands can easily use it." (goto-char pos) (put-text-property (point-at-bol) (point-at-eol) 'org-agenda-structural-header t) + (when org-agenda-multi-current-cmd + (put-text-property (point-at-bol) (point-at-eol) + 'org-agenda-cmd org-agenda-multi-current-cmd)) + (when org-agenda-multi-multiple-agenda + (put-text-property (point-at-bol) (point-at-eol) + 'org-agenda-overriding-arguments + org-agenda-overriding-arguments) + (put-text-property (point-at-bol) (point-at-eol) + 'org-agenda-current-span + org-agenda-current-span) + (put-text-property (point-at-bol) (point-at-eol) + 'org-agenda-last-arguments + org-agenda-last-arguments)) (when org-agenda-title-append (put-text-property (point-at-bol) (point-at-eol) 'org-agenda-title-append org-agenda-title-append)))) @@ -6921,24 +6943,46 @@ Negative selection means regexp must not match for selection of an entry." (org-agenda-find-same-or-today-or-agenda))) (t (error "Cannot find today"))))) +(defvar org-agenda-multi-back-to-pos nil) (defun org-agenda-find-same-or-today-or-agenda (&optional cnt) (goto-char - (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) + (or (and org-agenda-multi-back-to-pos (move-beginning-of-line 1)) + (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) (text-property-any (point-min) (point-max) 'org-today t) (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) (point-min)))) +(defun org-agenda-get-text-property (prop) + "Find text property PROP. +The search starts by looking backward, to find the previous text +property PROP, then continues forward if none has been found." + (save-excursion + (unless (looking-at "\\'") + (forward-char)) + (let ((p (previous-single-property-change (point) prop)) + (n (next-single-property-change (or (and (looking-at "\\`") 1) + (1- (point))) prop))) + (cond ((eq n (point-at-eol)) + (cons (get-text-property (1- n) prop) (1- n))) + (p (cons (get-text-property (1- p) prop) (1- p))))))) + (defun org-agenda-later (arg) "Go forward in time by thee current span. With prefix ARG, go forward that many times the current span." (interactive "p") (org-agenda-check-type t 'agenda) - (let* ((span org-agenda-current-span) - (sd org-starting-day) + (let* ((span (or (car (org-agenda-get-text-property + 'org-agenda-current-span)) + org-agenda-current-span)) + (sd (or (cadr (car (org-agenda-get-text-property + 'org-agenda-overriding-arguments))) + org-starting-day)) (greg (calendar-gregorian-from-absolute sd)) (cnt (org-get-at-bol 'org-day-cnt)) greg2) (cond + ((numberp span) + (setq sd (+ span sd))) ((eq span 'day) (setq sd (+ arg sd))) ((eq span 'week) @@ -6953,8 +6997,17 @@ With prefix ARG, go forward that many times the current span." (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) (t (setq sd (+ (* span arg) sd)))) - (let ((org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) sd span t))) + (let ((org-agenda-overriding-cmd + ;; `cmd' may have been set by `org-agenda-run-series' which + ;; uses `org-agenda-overriding-cmd' to decide whether + ;; overriding is allowed for `cmd' + (car (org-agenda-get-text-property 'org-agenda-cmd))) + (org-agenda-overriding-arguments + (list (car org-agenda-last-arguments) sd span))) + (setq org-agenda-multi-back-to-pos + (cdr (org-agenda-get-text-property 'org-agenda-cmd)) + org-agenda-multi-overriding-arguments + org-agenda-overriding-arguments) (org-agenda-redo) (org-agenda-find-same-or-today-or-agenda cnt)))) @@ -7036,18 +7089,29 @@ written as 2-digit years." "Change the agenda view to SPAN. SPAN may be `day', `week', `month', `year'." (org-agenda-check-type t 'agenda) - (if (and (not n) (equal org-agenda-current-span span)) - (error "Viewing span is already \"%s\"" span)) - (let* ((sd (or (org-get-at-bol 'day) - org-starting-day)) - (sd (org-agenda-compute-starting-span sd span n)) - (org-agenda-overriding-arguments - (or org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) sd span t)))) - (org-agenda-redo) - (org-agenda-find-same-or-today-or-agenda)) - (org-agenda-set-mode-name) - (message "Switched to %s view" span)) + (let ((org-agenda-cur-span + (or (car (org-agenda-get-text-property + 'org-agenda-current-span)) + org-agenda-current-span)) + (org-agenda-overriding-arguments + (or (car (org-agenda-get-text-property + 'org-agenda-overriding-arguments)) + org-agenda-overriding-arguments))) + (setq org-agenda-multi-back-to-pos + (cdr (org-agenda-get-text-property 'org-agenda-cmd))) + (if (and (not n) (equal org-agenda-cur-span span)) + (error "Viewing span is already \"%s\"" span)) + (let* ((sd (or (org-get-at-bol 'day) + org-starting-day)) + (sd (org-agenda-compute-starting-span sd span n)) + (org-agenda-overriding-cmd + (car (org-agenda-get-text-property 'org-agenda-cmd))) + (org-agenda-overriding-arguments + (list (car org-agenda-last-arguments) sd span))) + (org-agenda-redo) + (org-agenda-find-same-or-today-or-agenda)) + (org-agenda-set-mode-name) + (message "Switched to %s view" span))) (defun org-agenda-compute-starting-span (sd span &optional n) "Compute starting date for agenda.