|
@@ -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.
|