Merge branch 'maint'

This commit is contained in:
Bastien Guerry 2012-08-28 13:39:45 +02:00
commit 0a78e90362
7 changed files with 389 additions and 326 deletions

View File

@ -211,7 +211,7 @@ The file is stored under the name `org-combined-agenda-remind-file'."
If COMBINE is non-nil, combine all calendar entries into a single large
file and store it under the name `org-combined-agenda-remind-file'."
(save-excursion
(org-prepare-agenda-buffers files)
(org-agenda-prepare-buffers files)
(let* ((dir (org-export-directory
:ical (list :publishing-directory
org-export-publishing-directory)))

View File

@ -7425,7 +7425,8 @@ is always up to date. If you switch between views often and the build time
bothers you, you can turn on sticky agenda buffers (make this the default by
customizing the variable @code{org-agenda-sticky}). With sticky agendas, the
dispatcher only switches to the selected view, you need to update it by hand
with @kbd{r} or @kbd{g}.
with @kbd{r} or @kbd{g}. You can toggle sticky agenda view any time with
@code{org-toggle-sticky-agenda}.
@end table
You can also define custom commands that will be accessible through the
@ -8587,7 +8588,7 @@ Export a single iCalendar file containing entries from all agenda files.
This is a globally available command, and also available in the agenda menu.
@tsubheading{Exporting to a file}
@orgcmd{C-x C-w,org-write-agenda}
@orgcmd{C-x C-w,org-agenda-write}
@cindex exporting agenda views
@cindex agenda views, exporting
@vindex org-agenda-exporter-settings
@ -8836,7 +8837,7 @@ a PDF file will also create the postscript file.}, and iCalendar files. If
you want to do this only occasionally, use the command
@table @kbd
@orgcmd{C-x C-w,org-write-agenda}
@orgcmd{C-x C-w,org-agenda-write}
@cindex exporting agenda views
@cindex agenda views, exporting
@vindex org-agenda-exporter-settings

View File

@ -2396,6 +2396,7 @@ M Like `m', but select only TODO entries, no ordinary headlines.
L Create a timeline for the current buffer.
e Export views to associated files.
s Search entries for keywords.
S Search entries for keywords, only with TODO keywords.
/ Multi occur across all agenda files and also files listed
in `org-agenda-text-search-extra-files'.
< Restrict agenda commands to buffer, subtree, or region.
@ -2459,11 +2460,6 @@ Pressing `<' twice means to restrict to the current subtree or region
(setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
keys (car ans)
restriction (cdr ans)))
;; If we have sticky agenda buffers, set a name for the buffer,
;; depending on the invoking keys. The user may still set this
;; as a command option, which will overwrite what we do here.
(if org-agenda-sticky
(setq org-agenda-buffer-name (format "*Org Agenda(%s)*" keys)))
;; Establish the restriction, if any
(when (and (not org-agenda-overriding-restriction) restriction)
(put 'org-agenda-files 'org-restrict (list bfn))
@ -2487,6 +2483,13 @@ Pressing `<' twice means to restrict to the current subtree or region
(progn
(setq type (nth 2 entry) match (eval (nth 3 entry))
lprops (nth 4 entry))
;; If we have sticky agenda buffers, set a name for the buffer,
;; depending on the invoking keys. The user may still set this
;; as a command option, which will overwrite what we do here.
(if org-agenda-sticky
(setq org-agenda-buffer-name
(or (and (stringp match) (format "*Org Agenda(%s:%s)*" keys match))
(format "*Org Agenda(%s)*" keys))))
(put 'org-agenda-redo-command 'org-lprops lprops)
(cond
((eq type 'agenda)
@ -2526,6 +2529,7 @@ Pressing `<' twice means to restrict to the current subtree or region
(customize-variable 'org-agenda-custom-commands))
((equal keys "a") (call-interactively 'org-agenda-list))
((equal keys "s") (call-interactively 'org-search-view))
((equal keys "S") (org-call-with-arg 'org-search-view (or arg '(4))))
((equal keys "t") (call-interactively 'org-todo-list))
((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
((equal keys "m") (call-interactively 'org-tags-view))
@ -2601,10 +2605,10 @@ Agenda views are separated by `org-agenda-block-separator'."
a Agenda for current week or day e Export agenda views
t List of all TODO entries T Entries with special TODO kwd
m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
s Search for keywords S Like s, but only TODO entries
L Timeline for current buffer # List stuck projects (!=configure)
s Search for keywords * Toggle sticky agenda views
/ Multi-occur ? Find :FLAGGED: entries
C Configure custom agenda commands
/ Multi-occur C Configure custom agenda commands
? Find :FLAGGED: entries * Toggle sticky agenda views
")
(start 0))
(while (string-match
@ -2761,7 +2765,7 @@ s Search for keywords * Toggle sticky agenda views
((eq c ?>)
(org-agenda-remove-restriction-lock 'noupdate)
(setq restriction nil))
((and (equal selstring "") (memq c '(?s ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
(throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
((and (> (length selstring) 0) (eq c ?\d))
(delete-window)
@ -2770,6 +2774,15 @@ s Search for keywords * Toggle sticky agenda views
((equal c ?q) (error "Abort"))
(t (error "Invalid key %c" c))))))))
(defun org-agenda-fit-window-to-buffer ()
"Fit the window to the buffer size."
(and (memq org-agenda-window-setup '(reorganize-frame))
(fboundp 'fit-window-to-buffer)
(org-fit-window-to-buffer
nil
(floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
(floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
(defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter
(defvar org-agenda-last-arguments nil
"The arguments of the previous call to `org-agenda'.")
@ -2778,7 +2791,7 @@ s Search for keywords * Toggle sticky agenda views
(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))
(org-let (nth 1 series) '(org-agenda-prepare name))
;; We need to reset agenda markers here, because when constructing a
;; block agenda, the individual blocks do not do that.
(org-agenda-reset-markers)
@ -2829,7 +2842,7 @@ s Search for keywords * Toggle sticky agenda views
(setq org-agenda-multi-current-cmd nil)
(setq org-agenda-redo-command redo)
(goto-char (point-min)))
(org-fit-agenda-window)
(org-agenda-fit-window-to-buffer)
(org-let (nth 1 series) '(org-finalize-agenda)))
;;;###autoload
@ -2960,12 +2973,17 @@ This ensures the export commands can easily use it."
(pop-up-frames nil)
(dir default-directory)
(pars (org-make-parameter-alist parameters))
cmd thiscmdkey files opts cmd-or-set bufname)
cmd thiscmdkey thiscmdcmd files opts cmd-or-set bufname)
(save-window-excursion
(while cmds
(setq cmd (pop cmds)
thiscmdkey (car cmd)
bufname (if org-agenda-sticky (format "*Org Agenda(%s)*" thiscmdkey)
thiscmdcmd (cdr cmd)
match (nth 2 thiscmdcmd)
bufname (if org-agenda-sticky
(or (and (stringp match)
(format "*Org Agenda(%s:%s)*" thiscmdkey match))
(format "*Org Agenda(%s)*" thiscmdkey))
org-agenda-buffer-name)
cmd-or-set (nth 2 cmd)
opts (nth (if (listp cmd-or-set) 3 4) cmd)
@ -3274,15 +3292,6 @@ removed from the entry content. Currently only `planning' is allowed here."
(error "Cannot execute org-mode agenda command on buffer in %s"
major-mode)))
(defun org-fit-agenda-window ()
"Fit the window to the buffer size."
(and (memq org-agenda-window-setup '(reorganize-frame))
(fboundp 'fit-window-to-buffer)
(org-fit-window-to-buffer
nil
(floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
(floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
;;; Agenda prepare and finalize
(defvar org-agenda-multi nil) ; dynamically scoped
@ -3336,7 +3345,7 @@ generating a new one."
;; does not have org variables local
org-agenda-this-buffer-is-sticky))))
(defun org-prepare-agenda-window (abuf)
(defun org-agenda-prepare-window (abuf)
"Setup agenda buffer in the window."
(let* ((awin (get-buffer-window abuf))
wconf)
@ -3360,14 +3369,14 @@ generating a new one."
(setq org-pre-agenda-window-conf
(or org-pre-agenda-window-conf wconf))))
(defun org-prepare-agenda (&optional name)
(defun org-agenda-prepare (&optional name)
(if (org-agenda-use-sticky-p)
(progn
;; Popup existing buffer
(org-prepare-agenda-window (get-buffer org-agenda-buffer-name))
(org-agenda-prepare-window (get-buffer org-agenda-buffer-name))
(message "Sticky Agenda buffer, use `r' to refresh")
(or org-agenda-multi (org-fit-agenda-window))
(throw 'exit nil))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
(setq org-todo-keywords-for-agenda nil)
(setq org-drawers-for-agenda nil)
(unless org-agenda-persistent-filter
@ -3393,7 +3402,7 @@ generating a new one."
;; Setting any org variables that are in org-agenda-local-vars
;; list need to be done after the prepare call
(org-prepare-agenda-window (get-buffer-create org-agenda-buffer-name))
(org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name))
(setq buffer-read-only nil)
(org-agenda-reset-markers)
(let ((inhibit-read-only t)) (erase-buffer))
@ -3401,7 +3410,7 @@ generating a new one."
(setq org-agenda-buffer (current-buffer))
(setq org-agenda-contributing-files nil)
(setq org-agenda-columns-active nil)
(org-prepare-agenda-buffers (org-agenda-files nil 'ifmode))
(org-agenda-prepare-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
@ -3700,7 +3709,7 @@ dates."
(setq day-numbers (delq nil (mapcar (lambda(x)
(if (>= x today) x nil))
day-numbers))))
(org-prepare-agenda (concat "Timeline " (file-name-nondirectory entry)))
(org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry)))
(org-compile-prefix-format 'timeline)
(org-set-sorting-strategy 'timeline)
(if org-agenda-show-log-scoped (push :closed args))
@ -3858,166 +3867,174 @@ 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)
start-day (nth 1 org-agenda-overriding-arguments)
span (nth 2 org-agenda-overriding-arguments)))
(if (stringp start-day)
;; Convert to an absolute day number
(setq start-day (time-to-days (org-read-date nil t start-day))))
(setq org-agenda-last-arguments (list arg start-day span))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
(let* ((span (org-agenda-ndays-to-span
(or span org-agenda-ndays org-agenda-span)))
(today (org-today))
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
(org-agenda-start-on-weekday
(if (eq ndays 7)
org-agenda-start-on-weekday))
(thefiles (org-agenda-files nil 'ifmode))
(files thefiles)
(start (if (or (null org-agenda-start-on-weekday)
(< ndays 7))
sd
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(n1 org-agenda-start-on-weekday)
(d (- nt n1)))
(- sd (+ (if (< d 0) 7 0) d)))))
(day-numbers (list start))
(day-cnt 0)
(inhibit-redisplay (not debug-on-error))
(org-agenda-show-log-scoped org-agenda-show-log)
s e rtn rtnall file date d start-pos end-pos todayp
clocktable-start clocktable-end filter)
(setq org-agenda-redo-command
(list 'org-agenda-list (list 'quote arg) start-day (list 'quote span)))
(dotimes (n (1- ndays))
(push (1+ (car day-numbers)) day-numbers))
(setq day-numbers (nreverse day-numbers))
(setq clocktable-start (car day-numbers)
clocktable-end (1+ (or (org-last day-numbers) 0)))
(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))
(unless org-agenda-compact-blocks
(let* ((d1 (car day-numbers))
(d2 (org-last day-numbers))
(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)
"-agenda"
(if (< (- d2 d1) 350)
(if (= w1 w2)
(format " (W%02d)" w1)
(format " (W%02d-W%02d)" w1 w2))
"")
":\n")))
(add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
'org-date-line t))
(org-agenda-mark-header-line s))
(while (setq d (pop day-numbers))
(setq date (calendar-gregorian-from-absolute d)
s (point))
(if (or (setq todayp (= d today))
(and (not start-pos) (= d sd)))
(setq start-pos (point))
(if (and start-pos (not end-pos))
(setq end-pos (point))))
(setq files thefiles
rtnall nil)
(while (setq file (pop files))
(catch 'nextfile
(org-check-agenda-file file)
(let ((org-agenda-entry-types org-agenda-entry-types))
(unless org-agenda-include-deadlines
(setq org-agenda-entry-types
(delq :deadline org-agenda-entry-types)))
(cond
((memq org-agenda-show-log-scoped '(only clockcheck))
(setq rtn (org-agenda-get-day-entries
file date :closed)))
(org-agenda-show-log-scoped
(setq rtn (apply 'org-agenda-get-day-entries
file date
(append '(:closed) org-agenda-entry-types))))
(t
(setq rtn (apply 'org-agenda-get-day-entries
file date
org-agenda-entry-types)))))
(setq rtnall (append rtnall rtn)))) ;; all entries
(if org-agenda-include-diary
(let ((org-agenda-search-headline-for-time t))
(require 'diary-lib)
(setq rtn (org-get-entries-from-diary date))
(setq rtnall (append rtnall rtn))))
(if (or rtnall org-agenda-show-all-dates)
(progn
(setq day-cnt (1+ day-cnt))
(insert
(if (stringp org-agenda-format-date)
(format-time-string org-agenda-format-date
(org-time-from-absolute date))
(funcall org-agenda-format-date date))
"\n")
(put-text-property s (1- (point)) 'face
(org-agenda-get-day-face date))
(put-text-property s (1- (point)) 'org-date-line t)
(put-text-property s (1- (point)) 'org-agenda-date-header t)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt)
(when todayp
(put-text-property s (1- (point)) 'org-today t))
(setq rtnall
(org-agenda-add-time-grid-maybe rtnall ndays todayp))
(if rtnall (insert ;; all entries
(org-finalize-agenda-entries rtnall)
"\n"))
(put-text-property s (1- (point)) 'day d)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
(when (and org-agenda-clockreport-mode clocktable-start)
(let ((org-agenda-files (org-agenda-files nil 'ifmode))
;; the above line is to ensure the restricted range!
(p (copy-sequence org-agenda-clockreport-parameter-plist))
tbl)
(setq p (org-plist-delete p :block))
(setq p (plist-put p :tstart clocktable-start))
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
(when (and (eq org-agenda-clockreport-mode 'with-filter)
(setq filter (or org-agenda-tag-filter-while-redo
(get 'org-agenda-tag-filter :preset-filter))))
(setq p (plist-put p :tags (mapconcat (lambda (x)
(if (string-match "[<>=]" x)
""
x))
filter ""))))
(setq tbl (apply 'org-get-clocktable p))
(insert tbl)))
(goto-char (point-min))
(or org-agenda-multi (org-fit-agenda-window))
(unless (and (pos-visible-in-window-p (point-min))
(pos-visible-in-window-p (point-max)))
(goto-char (1- (point-max)))
(recenter -1)
(if (not (pos-visible-in-window-p (or start-pos 1)))
(progn
(goto-char (or start-pos 1))
(recenter 1))))
(goto-char (or start-pos 1))
(add-text-properties (point-min) (point-max) '(org-agenda-type agenda))
(if (eq org-agenda-show-log-scoped 'clockcheck)
(org-agenda-show-clocking-issues))
(org-finalize-agenda)
(setq buffer-read-only t)
(message "")))
(catch 'exit
(if org-agenda-sticky
(setq org-agenda-buffer-name
(cond ((and keys (stringp match))
(format "*Org Agenda(%s:%s)*" keys match))
(keys
(format "*Org Agenda(%s)*" keys))
(t (format "*Org Agenda(a)*")))))
(org-agenda-prepare "Day/Week")
(setq start-day (or start-day org-agenda-start-day))
(if org-agenda-overriding-arguments
(setq arg (car org-agenda-overriding-arguments)
start-day (nth 1 org-agenda-overriding-arguments)
span (nth 2 org-agenda-overriding-arguments)))
(if (stringp start-day)
;; Convert to an absolute day number
(setq start-day (time-to-days (org-read-date nil t start-day))))
(setq org-agenda-last-arguments (list arg start-day span))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
(let* ((span (org-agenda-ndays-to-span
(or span org-agenda-ndays org-agenda-span)))
(today (org-today))
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
(org-agenda-start-on-weekday
(if (eq ndays 7)
org-agenda-start-on-weekday))
(thefiles (org-agenda-files nil 'ifmode))
(files thefiles)
(start (if (or (null org-agenda-start-on-weekday)
(< ndays 7))
sd
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(n1 org-agenda-start-on-weekday)
(d (- nt n1)))
(- sd (+ (if (< d 0) 7 0) d)))))
(day-numbers (list start))
(day-cnt 0)
(inhibit-redisplay (not debug-on-error))
(org-agenda-show-log-scoped org-agenda-show-log)
s e rtn rtnall file date d start-pos end-pos todayp
clocktable-start clocktable-end filter)
(setq org-agenda-redo-command
(list 'org-agenda-list (list 'quote arg) start-day (list 'quote span)))
(dotimes (n (1- ndays))
(push (1+ (car day-numbers)) day-numbers))
(setq day-numbers (nreverse day-numbers))
(setq clocktable-start (car day-numbers)
clocktable-end (1+ (or (org-last day-numbers) 0)))
(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))
(unless org-agenda-compact-blocks
(let* ((d1 (car day-numbers))
(d2 (org-last day-numbers))
(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)
"-agenda"
(if (< (- d2 d1) 350)
(if (= w1 w2)
(format " (W%02d)" w1)
(format " (W%02d-W%02d)" w1 w2))
"")
":\n")))
(add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
'org-date-line t))
(org-agenda-mark-header-line s))
(while (setq d (pop day-numbers))
(setq date (calendar-gregorian-from-absolute d)
s (point))
(if (or (setq todayp (= d today))
(and (not start-pos) (= d sd)))
(setq start-pos (point))
(if (and start-pos (not end-pos))
(setq end-pos (point))))
(setq files thefiles
rtnall nil)
(while (setq file (pop files))
(catch 'nextfile
(org-check-agenda-file file)
(let ((org-agenda-entry-types org-agenda-entry-types))
(unless org-agenda-include-deadlines
(setq org-agenda-entry-types
(delq :deadline org-agenda-entry-types)))
(cond
((memq org-agenda-show-log-scoped '(only clockcheck))
(setq rtn (org-agenda-get-day-entries
file date :closed)))
(org-agenda-show-log-scoped
(setq rtn (apply 'org-agenda-get-day-entries
file date
(append '(:closed) org-agenda-entry-types))))
(t
(setq rtn (apply 'org-agenda-get-day-entries
file date
org-agenda-entry-types)))))
(setq rtnall (append rtnall rtn)))) ;; all entries
(if org-agenda-include-diary
(let ((org-agenda-search-headline-for-time t))
(require 'diary-lib)
(setq rtn (org-get-entries-from-diary date))
(setq rtnall (append rtnall rtn))))
(if (or rtnall org-agenda-show-all-dates)
(progn
(setq day-cnt (1+ day-cnt))
(insert
(if (stringp org-agenda-format-date)
(format-time-string org-agenda-format-date
(org-time-from-absolute date))
(funcall org-agenda-format-date date))
"\n")
(put-text-property s (1- (point)) 'face
(org-agenda-get-day-face date))
(put-text-property s (1- (point)) 'org-date-line t)
(put-text-property s (1- (point)) 'org-agenda-date-header t)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt)
(when todayp
(put-text-property s (1- (point)) 'org-today t))
(setq rtnall
(org-agenda-add-time-grid-maybe rtnall ndays todayp))
(if rtnall (insert ;; all entries
(org-finalize-agenda-entries rtnall)
"\n"))
(put-text-property s (1- (point)) 'day d)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
(when (and org-agenda-clockreport-mode clocktable-start)
(let ((org-agenda-files (org-agenda-files nil 'ifmode))
;; the above line is to ensure the restricted range!
(p (copy-sequence org-agenda-clockreport-parameter-plist))
tbl)
(setq p (org-plist-delete p :block))
(setq p (plist-put p :tstart clocktable-start))
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
(when (and (eq org-agenda-clockreport-mode 'with-filter)
(setq filter (or org-agenda-tag-filter-while-redo
(get 'org-agenda-tag-filter :preset-filter))))
(setq p (plist-put p :tags (mapconcat (lambda (x)
(if (string-match "[<>=]" x)
""
x))
filter ""))))
(setq tbl (apply 'org-get-clocktable p))
(insert tbl)))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(unless (and (pos-visible-in-window-p (point-min))
(pos-visible-in-window-p (point-max)))
(goto-char (1- (point-max)))
(recenter -1)
(if (not (pos-visible-in-window-p (or start-pos 1)))
(progn
(goto-char (or start-pos 1))
(recenter 1))))
(goto-char (or start-pos 1))
(add-text-properties (point-min) (point-max) '(org-agenda-type agenda))
(if (eq org-agenda-show-log-scoped 'clockcheck)
(org-agenda-show-clocking-issues))
(org-finalize-agenda)
(setq buffer-read-only t)
(message ""))))
(defun org-agenda-ndays-to-span (n)
"Return a span symbol for a span of N days, or N if none matches."
@ -4111,7 +4128,7 @@ 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-agenda-prepare "SEARCH")
(org-compile-prefix-format 'search)
(org-set-sorting-strategy 'search)
(let* ((props (list 'face nil
@ -4304,7 +4321,7 @@ in `org-agenda-text-search-extra-files'."
(when rtnall
(insert (org-finalize-agenda-entries rtnall) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-fit-agenda-window))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max) '(org-agenda-type search))
(org-finalize-agenda)
(setq buffer-read-only t)))
@ -4315,14 +4332,14 @@ in `org-agenda-text-search-extra-files'."
(defvar org-last-arg nil)
;;;###autoload
(defun org-todo-list (arg)
(defun org-todo-list (&optional arg)
"Show all (not done) TODO entries from all agenda file in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
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-agenda-prepare "TODO")
(org-compile-prefix-format 'todo)
(org-set-sorting-strategy 'todo)
(if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
@ -4379,7 +4396,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(when rtnall
(insert (org-finalize-agenda-entries rtnall) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-fit-agenda-window))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max) '(org-agenda-type todo))
(org-finalize-agenda)
(setq buffer-read-only t)))
@ -4400,7 +4417,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(setq match nil))
(setq matcher (org-make-tags-matcher match)
match (car matcher) matcher (cdr matcher))
(org-prepare-agenda (concat "TAGS " match))
(org-agenda-prepare (concat "TAGS " match))
(org-compile-prefix-format 'tags)
(org-set-sorting-strategy 'tags)
(setq org-agenda-query-string match)
@ -4450,7 +4467,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(when rtnall
(insert (org-finalize-agenda-entries rtnall) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-fit-agenda-window))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max) '(org-agenda-type tags))
(org-finalize-agenda)
(setq buffer-read-only t)))
@ -4648,7 +4665,7 @@ of what a project is and how to check if it stuck, customize the variable
(todo (nth 1 org-stuck-projects))
(todo-wds (if (member "*" todo)
(progn
(org-prepare-agenda-buffers (org-agenda-files
(org-agenda-prepare-buffers (org-agenda-files
nil 'ifmode))
(org-delete-all
org-done-keywords-for-agenda
@ -4853,7 +4870,7 @@ function from a program - use `org-agenda-get-day-entries' instead."
(> (- time
org-diary-last-run-time)
3))
(org-prepare-agenda-buffers files))
(org-agenda-prepare-buffers files))
(setq org-diary-last-run-time time)
;; If this is called during org-agenda, don't return any entries to
;; the calendar. Org Agenda will list these entries itself.
@ -9155,7 +9172,7 @@ to override `appt-message-warning-time'."
(files (org-agenda-files 'unrestricted)) entries file
(org-agenda-buffer nil))
;; Get all entries which may contain an appt
(org-prepare-agenda-buffers files)
(org-agenda-prepare-buffers files)
(while (setq file (pop files))
(setq entries
(delq nil

View File

@ -2213,7 +2213,7 @@ the currently selected interval size."
;; we collect from several files
(let* ((files scope)
file)
(org-prepare-agenda-buffers files)
(org-agenda-prepare-buffers files)
(while (setq file (pop files))
(with-current-buffer (find-buffer-visiting file)
(save-excursion
@ -2222,7 +2222,7 @@ the currently selected interval size."
;; Just from the current file
(save-restriction
;; get the right range into the restriction
(org-prepare-agenda-buffers (list (buffer-file-name)))
(org-agenda-prepare-buffers (list (buffer-file-name)))
(cond
((not scope)) ; use the restriction as it is now
((eq scope 'file) (widen))

View File

@ -256,7 +256,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'."
If COMBINE is non-nil, combine all calendar entries into a single large
file and store it under the name `org-combined-agenda-icalendar-file'."
(save-excursion
(org-prepare-agenda-buffers files)
(org-agenda-prepare-buffers files)
(let* ((dir (org-export-directory
:ical (list :publishing-directory
org-export-publishing-directory)))

View File

@ -418,7 +418,7 @@ agenda view showing the flagged items."
org-mobile-directory))
file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds)
(org-prepare-agenda-buffers (mapcar 'car files-alist))
(org-agenda-prepare-buffers (mapcar 'car files-alist))
(setq done-kwds (org-uniquify org-done-keywords-for-agenda))
(setq todo-kwds (org-delete-all
done-kwds

View File

@ -5064,7 +5064,7 @@ The following commands are available:
org-display-table 4
(vconcat (mapcar
(lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis))
org-ellipsis)))
org-ellipsis)))
(if (stringp org-ellipsis) org-ellipsis "..."))))
(setq buffer-display-table org-display-table))
(org-set-regexps-and-options)
@ -5083,18 +5083,15 @@ The following commands are available:
'local)
;; Check for running clock before killing a buffer
(org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
;; Paragraphs and auto-filling
(org-set-autofill-regexps)
;; Indentation.
(org-set-local 'indent-line-function 'org-indent-line)
(org-set-local 'indent-region-function 'org-indent-region)
;; Initialize radio targets.
(org-update-radio-target-regexp)
;; Comments
(org-set-local 'comment-use-syntax nil)
(org-set-local 'comment-start "# ")
(org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)")
(org-set-local 'comment-insert-comment-function 'org-insert-comment)
(org-set-local 'comment-region-function 'org-comment-or-uncomment-region)
(org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region)
;; Filling and auto-filling.
(org-setup-filling)
;; Comments.
(org-setup-comments-handling)
;; Beginning/end of defun
(org-set-local 'beginning-of-defun-function 'org-back-to-heading)
(org-set-local 'end-of-defun-function (lambda () (interactive) (org-end-of-subtree nil t)))
@ -13326,7 +13323,7 @@ MATCH can contain positive and negative selection of tags, like
If optional argument TODO-ONLY is non-nil, only select lines that are
also TODO lines."
(interactive "P")
(org-prepare-agenda-buffers (list (current-buffer)))
(org-agenda-prepare-buffers (list (current-buffer)))
(org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
@ -14259,7 +14256,7 @@ a *different* entry, you cannot use these techniques."
(if (not scope)
(progn
(org-prepare-agenda-buffers
(org-agenda-prepare-buffers
(list (buffer-file-name (current-buffer))))
(setq res (org-scan-tags func matcher todo-only start-level)))
;; Get the right scope
@ -14275,7 +14272,7 @@ a *different* entry, you cannot use these techniques."
(setq scope (list (buffer-file-name))))
((eq scope 'file-with-archives)
(setq scope (org-add-archive-files (list (buffer-file-name))))))
(org-prepare-agenda-buffers scope)
(org-agenda-prepare-buffers scope)
(while (setq file (pop scope))
(with-current-buffer (org-find-base-buffer-visiting file)
(save-excursion
@ -17060,7 +17057,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(with-current-buffer buf (save-buffer)))
(kill-buffer buf))))
(defun org-prepare-agenda-buffers (files)
(defun org-agenda-prepare-buffers (files)
"Create buffers for all agenda files, protect archived trees and comments."
(interactive)
(let ((pa '(:org-archived t))
@ -20986,14 +20983,22 @@ hierarchy of headlines by UP levels before marking the subtree."
;;; Filling
;; We use our own fill-paragraph and auto-fill functions. These
;; functions will shadow `fill-prefix' (computed internally with
;; `org-fill-context-prefix') and pass through to
;; `fill-region-as-paragraph' and `do-auto-fill' as appropriate.
;; We use our own fill-paragraph and auto-fill functions.
(defun org-set-autofill-regexps ()
;; `org-fill-paragraph' relies on adaptive filling and context
;; checking. Appropriate `fill-prefix' is computed with
;; `org-adaptive-fill-function'.
;; `org-auto-fill-function' takes care of auto-filling. It calls
;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with
;; `org-adaptive-fill-function' value. Internally,
;; `org-comment-line-break-function' breaks the line.
;; `org-setup-filling' installs filling and auto-filling related
;; variables during `org-mode' initialization.
(defun org-setup-filling ()
(interactive)
(org-set-local 'fill-paragraph-function 'org-fill-paragraph)
;; Prevent auto-fill from inserting unwanted new items.
(when (boundp 'fill-nobreak-predicate)
(org-set-local
@ -21002,6 +21007,8 @@ hierarchy of headlines by UP levels before marking the subtree."
(append fill-nobreak-predicate
'(org-fill-paragraph-separate-nobreak-p
org-fill-line-break-nobreak-p)))))
(org-set-local 'fill-paragraph-function 'org-fill-paragraph)
(org-set-local 'adaptive-fill-function 'org-adaptive-fill-function)
(org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
(org-set-local 'comment-line-break-function 'org-comment-line-break-function)
(org-set-local 'align-mode-rules-list
@ -21023,19 +21030,19 @@ hierarchy of headlines by UP levels before marking the subtree."
(declare-function message-in-body-p "message" ())
(defvar org-element--affiliated-re) ; From org-element.el
(defun org-fill-context-prefix (p)
"Compute a fill prefix for the line at point P.
(defun org-adaptive-fill-function ()
"Compute a fill prefix for the current line.
Return fill prefix, as a string, or nil if current line isn't
meant to be filled."
(org-with-wide-buffer
(unless (and (derived-mode-p 'message-mode) (not (message-in-body-p)))
;; FIXME: This is really the job of orgstruct++-mode
(goto-char p)
(beginning-of-line)
(let* ((element (org-element-at-point))
(let* ((p (line-beginning-position))
(element (save-excursion (beginning-of-line)
(org-element-at-point)))
(type (org-element-type element))
(post-affiliated
(progn
(save-excursion
(goto-char (org-element-property :begin element))
(while (looking-at org-element--affiliated-re) (forward-line))
(point))))
@ -21053,7 +21060,7 @@ meant to be filled."
(make-string (org-list-item-body-column
(org-element-property :begin parent))
? ))
((looking-at "\\s-+") (match-string 0))
((looking-at "[ \t]*") (match-string 0))
(t ""))))
(comment-block
;; Only fill contents if P is within block boundaries.
@ -21065,7 +21072,7 @@ meant to be filled."
(skip-chars-backward " \r\t\n")
(line-beginning-position))))
(when (and (>= p cbeg) (< p cend))
(if (looking-at "\\s-+") (match-string 0) ""))))))))))
(if (looking-at "[ \t]*") (match-string 0) ""))))))))))
(declare-function message-goto-body "message" ())
(defvar message-cite-prefix-regexp) ; From message.el
@ -21099,12 +21106,12 @@ a footnote definition, try to fill the first paragraph within."
(cadadr (assoc 'paragraph-separate org-fb-vars))))
(fill-paragraph))
(save-excursion
;; Move to end of line in order to get the first paragraph within
;; a plain list or a footnote definition.
;; Move to end of line in order to get the first paragraph
;; within a plain list or a footnote definition.
(end-of-line)
(let ((element (org-element-at-point)))
;; First check if point is in a blank line at the beginning of the
;; buffer. In that case, ignore filling.
;; First check if point is in a blank line at the beginning of
;; the buffer. In that case, ignore filling.
(if (< (point) (org-element-property :begin element)) t
(case (org-element-type element)
;; Align Org tables, leave table.el tables as-is.
@ -21113,8 +21120,8 @@ a footnote definition, try to fill the first paragraph within."
(when (eq (org-element-property :type element) 'org)
(org-table-align))
t)
;; Elements that may contain `line-break' type objects.
(paragraph
;; Paragraphs may contain `line-break' type objects.
(let ((beg (max (point-min)
(org-element-property :contents-begin element)))
(end (min (point-max)
@ -21131,20 +21138,20 @@ a footnote definition, try to fill the first paragraph within."
(re-search-forward
(concat "^" message-cite-prefix-regexp) end t))
(setq end (match-beginning 0))))
;; Fill paragraph, taking line breaks into consideration.
;; For that, slice the paragraph using line breaks as
;; separators, and fill the parts in reverse order to
;; avoid messing with markers.
;; Fill paragraph, taking line breaks into
;; consideration. For that, slice the paragraph
;; using line breaks as separators, and fill the
;; parts in reverse order to avoid messing with
;; markers.
(save-excursion
(goto-char end)
(mapc
(lambda (pos)
(let ((fill-prefix (org-fill-context-prefix pos)))
(fill-region-as-paragraph pos (point) justify))
(fill-region-as-paragraph pos (point) justify)
(goto-char pos))
;; Find the list of ending positions for line breaks
;; in the current paragraph. Add paragraph beginning
;; to include first slice.
;; Find the list of ending positions for line
;; breaks in the current paragraph. Add paragraph
;; beginning to include first slice.
(nreverse
(cons
beg
@ -21154,94 +21161,45 @@ a footnote definition, try to fill the first paragraph within."
'line-break
(lambda (lb) (org-element-property :end lb)))))))
t)))
;; Contents of `comment-block' type elements should be filled as
;; plain text.
;; Contents of `comment-block' type elements should be
;; filled as plain text, but only if point is within block
;; markers.
(comment-block
(let ((fill-prefix (org-fill-context-prefix (point))))
(save-excursion
(let* ((case-fold-search t)
(beg (save-excursion
(goto-char (org-element-property :begin element))
(re-search-forward "^[ \t]*#\\+begin_comment" nil t)
(forward-line)
(point)))
(end (save-excursion
(goto-char (org-element-property :end element))
(re-search-backward "^[ \t]*#\\+end_comment" nil t)
(line-beginning-position))))
(when (and (>= (point) beg) (< (point) end))
(fill-region-as-paragraph
(progn
(goto-char (org-element-property :begin element))
(while (looking-at org-element--affiliated-re)
(forward-line))
(forward-line)
(point))
(progn
(goto-char (org-element-property :end element))
(skip-chars-backward " \r\t\n")
(save-excursion
(end-of-line)
(re-search-backward "^[ \t]*$" beg 'move)
(line-beginning-position))
justify))) t)
;; Fill comments, indented or not.
(comment
(let ((fill-prefix (org-fill-context-prefix (point))))
(save-excursion
(fill-region-as-paragraph
(progn
(goto-char (org-element-property :begin element))
(while (looking-at org-element--affiliated-re)
(forward-line))
(point))
(progn
(goto-char (org-element-property :end element))
(skip-chars-backward " \r\t\n")
(line-end-position))))))
(save-excursion
(beginning-of-line)
(re-search-forward "^[ \t]*$" end 'move)
(line-beginning-position))
justify)))
t)
;; Fill comments.
(comment (fill-comment-paragraph justify))
;; Ignore every other element.
(otherwise t)))))))
(defun org-auto-fill-function ()
"Auto-fill function."
;; Check if auto-filling is meaningful before computing fill prefix.
;; Check if auto-filling is meaningful.
(let ((fc (current-fill-column)))
(when (and fc (> (current-column) fc))
(let ((fill-prefix (org-fill-context-prefix (point))))
(let ((fill-prefix (org-adaptive-fill-function)))
(when fill-prefix (do-auto-fill))))))
;;; Comments
;; We control comments everywhere. `org-comment-or-uncomment-region'
;; and `org-insert-comment' takes care of `comment-dwim' behaviour
;; while `org-comment-line-break-function' handles auto-filling in
;; a comment.
(defun org-insert-comment ()
"Insert an empty comment above current line.
If the line is empty, insert comment at its beginning."
(beginning-of-line)
(if (looking-at "\\s-*$") (replace-match "") (open-line 1))
(org-indent-line)
(insert "# "))
(defun org-comment-or-uncomment-region (beg end &rest ignore)
"Comment or uncomment each non-blank line in the region.
Uncomment each non-blank line between BEG and END if it only
contains commented lines. Otherwise, comment them."
(save-excursion
(goto-char beg)
(skip-chars-forward " \r\t\n" end)
(beginning-of-line)
(let ((uncommentp
;; UNCOMMENTP is non-nil when every non blank line between
;; BEG and END is a comment.
(save-excursion
(while (progn (and (not (eobp))
(let ((element (org-element-at-point)))
(and (eq (org-element-type element) 'comment)
(goto-char (org-element-property
:end element)))))))
(>= (point) end)))
;; Remove or adding comment markers is going to change end
;; position so make it a marker.
(end (copy-marker end)))
(while (< (point) end)
(unless (looking-at "\\s-*$")
(if (not uncommentp) (progn (back-to-indentation) (insert "# "))
;; Only comments and blank lines in region: uncomment it.
(looking-at "[ \t]*\\(# ?\\)")
(replace-match "" nil nil nil 1)))
(forward-line))
(set-marker end nil))))
(defun org-comment-line-break-function (&optional soft)
"Break line at point and indent, continuing comment if within one.
The inserted newline is marked hard if variable
@ -21254,6 +21212,93 @@ non-nil."
(insert-before-markers-and-inherit fill-prefix))
;;; Comments
;; Org comments syntax is quite complex. It requires the entire line
;; to be just a comment. Also, even with the right syntax at the
;; beginning of line, some some elements (i.e. verse-block or
;; example-block) don't accept comments. Usual Emacs comment commands
;; cannot cope with those requirements. Therefore, Org replaces them.
;; Org still relies on `comment-dwim', but cannot trust
;; `comment-only-p'. So, `comment-region-function' and
;; `uncomment-region-function' both point
;; to`org-comment-or-uncomment-region'. Eventually,
;; `org-insert-comment' takes care of insertion of comments at the
;; beginning of line.
;; `org-setup-comments-handling' install comments related variables
;; during `org-mode' initialization.
(defun org-setup-comments-handling ()
(interactive)
(org-set-local 'comment-use-syntax nil)
(org-set-local 'comment-start "# ")
(org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)")
(org-set-local 'comment-insert-comment-function 'org-insert-comment)
(org-set-local 'comment-region-function 'org-comment-or-uncomment-region)
(org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region))
(defun org-insert-comment ()
"Insert an empty comment above current line.
If the line is empty, insert comment at its beginning."
(beginning-of-line)
(if (looking-at "\\s-*$") (replace-match "") (open-line 1))
(org-indent-line)
(insert "# "))
(defvar comment-empty-lines) ; From newcomment.el.
(defun org-comment-or-uncomment-region (beg end &rest ignore)
"Comment or uncomment each non-blank line in the region.
Uncomment each non-blank line between BEG and END if it only
contains commented lines. Otherwise, comment them."
(save-restriction
;; Restrict region
(narrow-to-region (save-excursion (goto-char beg)
(skip-chars-forward " \r\t\n" end)
(line-beginning-position))
(save-excursion (goto-char end)
(skip-chars-backward " \r\t\n" beg)
(line-end-position)))
(let ((uncommentp
;; UNCOMMENTP is non-nil when every non blank line between
;; BEG and END is a comment.
(save-excursion
(goto-char (point-min))
(while (and (not (eobp))
(let ((element (org-element-at-point)))
(and (eq (org-element-type element) 'comment)
(goto-char (min (point-max)
(org-element-property
:end element)))))))
(eobp))))
(if uncommentp
;; Only blank lines and comments in region: uncomment it.
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
(replace-match "" nil nil nil 1))
(forward-line)))
;; Comment each line in region.
(let ((min-indent (point-max)))
;; First find the minimum indentation across all lines.
(save-excursion
(goto-char (point-min))
(while (and (not (eobp)) (not (zerop min-indent)))
(unless (looking-at "[ \t]*$")
(setq min-indent (min min-indent (current-indentation))))
(forward-line)))
;; Then loop over all lines.
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
(org-move-to-column min-indent t)
(insert comment-start))
(forward-line))))))))
;;; Other stuff.
(defun org-toggle-fixed-width-section (arg)