ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'maint'

This commit is contained in:
Bastien Guerry 2012-08-27 17:53:10 +02:00
parent 4e56f31a24 424f3ecedb
commit 68054d4a37
1 changed files with 122 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

180
lisp/org-agenda.el
View File

@ -2370,15 +2370,15 @@ duplicates.)"
(string :tag " Agenda key") (string :tag " Agenda key")
(string :tag "Replace by command") (string :tag "Replace by command")
(repeat :tag "Available when" (repeat :tag "Available when"
(choice (choice
(cons :tag "Condition" (cons :tag "Condition"
(choice (choice
(const :tag "In file" in-file) (const :tag "In file" in-file)
(const :tag "Not in file" not-in-file) (const :tag "Not in file" not-in-file)
(const :tag "In mode" in-mode) (const :tag "In mode" in-mode)
(const :tag "Not in mode" not-in-mode)) (const :tag "Not in mode" not-in-mode))
(regexp)) (regexp))
(function :tag "Custom function")))))) (function :tag "Custom function"))))))
;;;###autoload ;;;###autoload
(defun org-agenda (&optional arg keys restriction) (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-overriding-arguments nil) ; dynamically scoped parameter
(defvar org-agenda-last-arguments nil (defvar org-agenda-last-arguments nil
"The arguments of the previous call to `org-agenda'.") "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) (defun org-agenda-run-series (name series)
(org-let (nth 1 series) '(org-prepare-agenda name)) (org-let (nth 1 series) '(org-prepare-agenda name))
;; We need to reset agenda markers here, because when constructing a ;; 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) (org-agenda-reset-markers)
(let* ((org-agenda-multi t) (let* ((org-agenda-multi t)
(redo (list 'org-agenda-run-series name (list 'quote series))) (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)) (cmds (car series))
(gprops (nth 1 series)) (gprops (nth 1 series))
match ;; The byte compiler incorrectly complains about this. Keep it! match ;; The byte compiler incorrectly complains about this. Keep it!
cmd type lprops) 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)) (while (setq cmd (pop cmds))
(setq type (car cmd) match (eval (nth 1 cmd)) lprops (nth 2 cmd)) (setq org-agenda-multi-current-cmd cmd
(cond type (car cmd) match (eval (nth 1 cmd)) lprops (nth 2 cmd))
((eq type 'agenda) (let ((org-agenda-overriding-arguments
(org-let2 gprops lprops (cond ((not org-agenda-multi-multiple-agenda)
'(call-interactively 'org-agenda-list))) org-agenda-multi-overriding-arguments)
((eq type 'alltodo) ((eq org-agenda-overriding-cmd cmd)
(org-let2 gprops lprops org-agenda-overriding-arguments))))
'(call-interactively 'org-todo-list))) (cond
((eq type 'search) ((eq type 'agenda)
(org-let2 gprops lprops (org-let2 gprops lprops
'(org-search-view current-prefix-arg match nil))) '(call-interactively 'org-agenda-list)))
((eq type 'stuck) ((eq type 'alltodo)
(org-let2 gprops lprops (org-let2 gprops lprops
'(call-interactively 'org-agenda-list-stuck-projects))) '(call-interactively 'org-todo-list)))
((eq type 'tags) ((eq type 'search)
(org-let2 gprops lprops (org-let2 gprops lprops
'(org-tags-view current-prefix-arg match))) '(org-search-view current-prefix-arg match nil)))
((eq type 'tags-todo) ((eq type 'stuck)
(org-let2 gprops lprops (org-let2 gprops lprops
'(org-tags-view '(4) match))) '(call-interactively 'org-agenda-list-stuck-projects)))
((eq type 'todo) ((eq type 'tags)
(org-let2 gprops lprops (org-let2 gprops lprops
'(org-todo-list match))) '(org-tags-view current-prefix-arg match)))
((fboundp type) ((eq type 'tags-todo)
(org-let2 gprops lprops (org-let2 gprops lprops
'(funcall type match))) '(org-tags-view '(4) match)))
(t (error "Invalid type in command series")))) ((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) (widen)
(setq org-agenda-multi-current-cmd nil)
(setq org-agenda-redo-command redo) (setq org-agenda-redo-command redo)
(put 'org-agenda-redo-command 'last-args org-agenda-last-arguments)
(goto-char (point-min))) (goto-char (point-min)))
(org-fit-agenda-window) (org-fit-agenda-window)
(org-let (nth 1 series) '(org-finalize-agenda))) (org-let (nth 1 series) '(org-finalize-agenda)))
@ -2981,6 +2990,19 @@ This ensures the export commands can easily use it."
(goto-char pos) (goto-char pos)
(put-text-property (point-at-bol) (point-at-eol) (put-text-property (point-at-bol) (point-at-eol)
'org-agenda-structural-header t) '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 (when org-agenda-title-append
(put-text-property (point-at-bol) (point-at-eol) (put-text-property (point-at-bol) (point-at-eol)
'org-agenda-title-append org-agenda-title-append)))) '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))) (org-agenda-find-same-or-today-or-agenda)))
(t (error "Cannot find today"))))) (t (error "Cannot find today")))))
(defvar org-agenda-multi-back-to-pos nil)
(defun org-agenda-find-same-or-today-or-agenda (&optional cnt) (defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
(goto-char (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-today t)
(text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
(point-min)))) (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) (defun org-agenda-later (arg)
"Go forward in time by thee current span. "Go forward in time by thee current span.
With prefix ARG, go forward that many times the current span." With prefix ARG, go forward that many times the current span."
(interactive "p") (interactive "p")
(org-agenda-check-type t 'agenda) (org-agenda-check-type t 'agenda)
(let* ((span org-agenda-current-span) (let* ((span (or (car (org-agenda-get-text-property
(sd org-starting-day) '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)) (greg (calendar-gregorian-from-absolute sd))
(cnt (org-get-at-bol 'org-day-cnt)) (cnt (org-get-at-bol 'org-day-cnt))
greg2) greg2)
(cond (cond
((numberp span)
(setq sd (+ span sd)))
((eq span 'day) ((eq span 'day)
(setq sd (+ arg sd))) (setq sd (+ arg sd)))
((eq span 'week) ((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)))) (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
(t (t
(setq sd (+ (* span arg) sd)))) (setq sd (+ (* span arg) sd))))
(let ((org-agenda-overriding-arguments (let ((org-agenda-overriding-cmd
(list (car org-agenda-last-arguments) sd span t))) ;; `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-redo)
(org-agenda-find-same-or-today-or-agenda cnt)))) (org-agenda-find-same-or-today-or-agenda cnt))))
@ -7036,18 +7089,29 @@ written as 2-digit years."
"Change the agenda view to SPAN. "Change the agenda view to SPAN.
SPAN may be `day', `week', `month', `year'." SPAN may be `day', `week', `month', `year'."
(org-agenda-check-type t 'agenda) (org-agenda-check-type t 'agenda)
(if (and (not n) (equal org-agenda-current-span span)) (let ((org-agenda-cur-span
(error "Viewing span is already \"%s\"" span)) (or (car (org-agenda-get-text-property
(let* ((sd (or (org-get-at-bol 'day) 'org-agenda-current-span))
org-starting-day)) org-agenda-current-span))
(sd (org-agenda-compute-starting-span sd span n)) (org-agenda-overriding-arguments
(org-agenda-overriding-arguments (or (car (org-agenda-get-text-property
(or org-agenda-overriding-arguments 'org-agenda-overriding-arguments))
(list (car org-agenda-last-arguments) sd span t)))) org-agenda-overriding-arguments)))
(org-agenda-redo) (setq org-agenda-multi-back-to-pos
(org-agenda-find-same-or-today-or-agenda)) (cdr (org-agenda-get-text-property 'org-agenda-cmd)))
(org-agenda-set-mode-name) (if (and (not n) (equal org-agenda-cur-span span))
(message "Switched to %s view" 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) (defun org-agenda-compute-starting-span (sd span &optional n)
"Compute starting date for agenda. "Compute starting date for agenda.