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-28 13:39:45 +02:00
parent 9b8b72c269 d2b807b1a6
commit 0a78e90362
7 changed files with 389 additions and 326 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
contrib/lisp/org2rem.el
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 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'." file and store it under the name `org-combined-agenda-remind-file'."
(save-excursion (save-excursion
(org-prepare-agenda-buffers files) (org-agenda-prepare-buffers files)
(let* ((dir (org-export-directory (let* ((dir (org-export-directory
:ical (list :publishing-directory :ical (list :publishing-directory
org-export-publishing-directory))) org-export-publishing-directory)))

7
doc/org.texi
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 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 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 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 @end table
You can also define custom commands that will be accessible through the 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. This is a globally available command, and also available in the agenda menu.
@tsubheading{Exporting to a file} @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 exporting agenda views
@cindex agenda views, exporting @cindex agenda views, exporting
@vindex org-agenda-exporter-settings @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 you want to do this only occasionally, use the command
@table @kbd @table @kbd
@orgcmd{C-x C-w,org-write-agenda} @orgcmd{C-x C-w,org-agenda-write}
@cindex exporting agenda views @cindex exporting agenda views
@cindex agenda views, exporting @cindex agenda views, exporting
@vindex org-agenda-exporter-settings @vindex org-agenda-exporter-settings

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

4
lisp/org-clock.el
View File

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

2
lisp/org-icalendar.el
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 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'." file and store it under the name `org-combined-agenda-icalendar-file'."
(save-excursion (save-excursion
(org-prepare-agenda-buffers files) (org-agenda-prepare-buffers files)
(let* ((dir (org-export-directory (let* ((dir (org-export-directory
:ical (list :publishing-directory :ical (list :publishing-directory
org-export-publishing-directory))) org-export-publishing-directory)))

2
lisp/org-mobile.el
View File

@ -418,7 +418,7 @@ agenda view showing the flagged items."
org-mobile-directory)) org-mobile-directory))
file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) 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 done-kwds (org-uniquify org-done-keywords-for-agenda))
(setq todo-kwds (org-delete-all (setq todo-kwds (org-delete-all
done-kwds done-kwds

281
lisp/org.el
View File

@ -5064,7 +5064,7 @@ The following commands are available:
org-display-table 4 org-display-table 4
(vconcat (mapcar (vconcat (mapcar
(lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis))
org-ellipsis))) org-ellipsis)))
(if (stringp org-ellipsis) org-ellipsis "...")))) (if (stringp org-ellipsis) org-ellipsis "..."))))
(setq buffer-display-table org-display-table)) (setq buffer-display-table org-display-table))
(org-set-regexps-and-options) (org-set-regexps-and-options)
@ -5083,18 +5083,15 @@ The following commands are available:
'local) 'local)
;; Check for running clock before killing a buffer ;; Check for running clock before killing a buffer
(org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
;; Paragraphs and auto-filling ;; Indentation.
(org-set-autofill-regexps)
(org-set-local 'indent-line-function 'org-indent-line) (org-set-local 'indent-line-function 'org-indent-line)
(org-set-local 'indent-region-function 'org-indent-region) (org-set-local 'indent-region-function 'org-indent-region)
;; Initialize radio targets.
(org-update-radio-target-regexp) (org-update-radio-target-regexp)
;; Comments ;; Filling and auto-filling.
(org-set-local 'comment-use-syntax nil) (org-setup-filling)
(org-set-local 'comment-start "# ") ;; Comments.
(org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)") (org-setup-comments-handling)
(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)
;; Beginning/end of defun ;; Beginning/end of defun
(org-set-local 'beginning-of-defun-function 'org-back-to-heading) (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))) (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 If optional argument TODO-ONLY is non-nil, only select lines that are
also TODO lines." also TODO lines."
(interactive "P") (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)) (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
(defalias 'org-tags-sparse-tree 'org-match-sparse-tree) (defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
@ -14259,7 +14256,7 @@ a *different* entry, you cannot use these techniques."
(if (not scope) (if (not scope)
(progn (progn
(org-prepare-agenda-buffers (org-agenda-prepare-buffers
(list (buffer-file-name (current-buffer)))) (list (buffer-file-name (current-buffer))))
(setq res (org-scan-tags func matcher todo-only start-level))) (setq res (org-scan-tags func matcher todo-only start-level)))
;; Get the right scope ;; Get the right scope
@ -14275,7 +14272,7 @@ a *different* entry, you cannot use these techniques."
(setq scope (list (buffer-file-name)))) (setq scope (list (buffer-file-name))))
((eq scope 'file-with-archives) ((eq scope 'file-with-archives)
(setq scope (org-add-archive-files (list (buffer-file-name)))))) (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)) (while (setq file (pop scope))
(with-current-buffer (org-find-base-buffer-visiting file) (with-current-buffer (org-find-base-buffer-visiting file)
(save-excursion (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))) (with-current-buffer buf (save-buffer)))
(kill-buffer buf)))) (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." "Create buffers for all agenda files, protect archived trees and comments."
(interactive) (interactive)
(let ((pa '(:org-archived t)) (let ((pa '(:org-archived t))
@ -20986,14 +20983,22 @@ hierarchy of headlines by UP levels before marking the subtree."
;;; Filling ;;; Filling
;; We use our own fill-paragraph and auto-fill functions. These ;; We use our own fill-paragraph and auto-fill functions.
;; 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.
(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) (interactive)
(org-set-local 'fill-paragraph-function 'org-fill-paragraph)
;; Prevent auto-fill from inserting unwanted new items. ;; Prevent auto-fill from inserting unwanted new items.
(when (boundp 'fill-nobreak-predicate) (when (boundp 'fill-nobreak-predicate)
(org-set-local (org-set-local
@ -21002,6 +21007,8 @@ hierarchy of headlines by UP levels before marking the subtree."
(append fill-nobreak-predicate (append fill-nobreak-predicate
'(org-fill-paragraph-separate-nobreak-p '(org-fill-paragraph-separate-nobreak-p
org-fill-line-break-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 'normal-auto-fill-function 'org-auto-fill-function)
(org-set-local 'comment-line-break-function 'org-comment-line-break-function) (org-set-local 'comment-line-break-function 'org-comment-line-break-function)
(org-set-local 'align-mode-rules-list (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" ()) (declare-function message-in-body-p "message" ())
(defvar org-element--affiliated-re) ; From org-element.el (defvar org-element--affiliated-re) ; From org-element.el
(defun org-fill-context-prefix (p) (defun org-adaptive-fill-function ()
"Compute a fill prefix for the line at point P. "Compute a fill prefix for the current line.
Return fill prefix, as a string, or nil if current line isn't Return fill prefix, as a string, or nil if current line isn't
meant to be filled." meant to be filled."
(org-with-wide-buffer (org-with-wide-buffer
(unless (and (derived-mode-p 'message-mode) (not (message-in-body-p))) (unless (and (derived-mode-p 'message-mode) (not (message-in-body-p)))
;; FIXME: This is really the job of orgstruct++-mode ;; FIXME: This is really the job of orgstruct++-mode
(goto-char p) (let* ((p (line-beginning-position))
(beginning-of-line) (element (save-excursion (beginning-of-line)
(let* ((element (org-element-at-point)) (org-element-at-point)))
(type (org-element-type element)) (type (org-element-type element))
(post-affiliated (post-affiliated
(progn (save-excursion
(goto-char (org-element-property :begin element)) (goto-char (org-element-property :begin element))
(while (looking-at org-element--affiliated-re) (forward-line)) (while (looking-at org-element--affiliated-re) (forward-line))
(point)))) (point))))
@ -21053,7 +21060,7 @@ meant to be filled."
(make-string (org-list-item-body-column (make-string (org-list-item-body-column
(org-element-property :begin parent)) (org-element-property :begin parent))
? )) ? ))
((looking-at "\\s-+") (match-string 0)) ((looking-at "[ \t]*") (match-string 0))
(t "")))) (t ""))))
(comment-block (comment-block
;; Only fill contents if P is within block boundaries. ;; Only fill contents if P is within block boundaries.
@ -21065,7 +21072,7 @@ meant to be filled."
(skip-chars-backward " \r\t\n") (skip-chars-backward " \r\t\n")
(line-beginning-position)))) (line-beginning-position))))
(when (and (>= p cbeg) (< p cend)) (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" ()) (declare-function message-goto-body "message" ())
(defvar message-cite-prefix-regexp) ; From message.el (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)))) (cadadr (assoc 'paragraph-separate org-fb-vars))))
(fill-paragraph)) (fill-paragraph))
(save-excursion (save-excursion
;; Move to end of line in order to get the first paragraph within ;; Move to end of line in order to get the first paragraph
;; a plain list or a footnote definition. ;; within a plain list or a footnote definition.
(end-of-line) (end-of-line)
(let ((element (org-element-at-point))) (let ((element (org-element-at-point)))
;; First check if point is in a blank line at the beginning of the ;; First check if point is in a blank line at the beginning of
;; buffer. In that case, ignore filling. ;; the buffer. In that case, ignore filling.
(if (< (point) (org-element-property :begin element)) t (if (< (point) (org-element-property :begin element)) t
(case (org-element-type element) (case (org-element-type element)
;; Align Org tables, leave table.el tables as-is. ;; 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) (when (eq (org-element-property :type element) 'org)
(org-table-align)) (org-table-align))
t) t)
;; Elements that may contain `line-break' type objects.
(paragraph (paragraph
;; Paragraphs may contain `line-break' type objects.
(let ((beg (max (point-min) (let ((beg (max (point-min)
(org-element-property :contents-begin element))) (org-element-property :contents-begin element)))
(end (min (point-max) (end (min (point-max)
@ -21131,20 +21138,20 @@ a footnote definition, try to fill the first paragraph within."
(re-search-forward (re-search-forward
(concat "^" message-cite-prefix-regexp) end t)) (concat "^" message-cite-prefix-regexp) end t))
(setq end (match-beginning 0)))) (setq end (match-beginning 0))))
;; Fill paragraph, taking line breaks into consideration. ;; Fill paragraph, taking line breaks into
;; For that, slice the paragraph using line breaks as ;; consideration. For that, slice the paragraph
;; separators, and fill the parts in reverse order to ;; using line breaks as separators, and fill the
;; avoid messing with markers. ;; parts in reverse order to avoid messing with
;; markers.
(save-excursion (save-excursion
(goto-char end) (goto-char end)
(mapc (mapc
(lambda (pos) (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)) (goto-char pos))
;; Find the list of ending positions for line breaks ;; Find the list of ending positions for line
;; in the current paragraph. Add paragraph beginning ;; breaks in the current paragraph. Add paragraph
;; to include first slice. ;; beginning to include first slice.
(nreverse (nreverse
(cons (cons
beg beg
@ -21154,94 +21161,45 @@ a footnote definition, try to fill the first paragraph within."
'line-break 'line-break
(lambda (lb) (org-element-property :end lb))))))) (lambda (lb) (org-element-property :end lb)))))))
t))) t)))
;; Contents of `comment-block' type elements should be filled as ;; Contents of `comment-block' type elements should be
;; plain text. ;; filled as plain text, but only if point is within block
;; markers.
(comment-block (comment-block
(let ((fill-prefix (org-fill-context-prefix (point)))) (let* ((case-fold-search t)
(save-excursion (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 (fill-region-as-paragraph
(progn (save-excursion
(goto-char (org-element-property :begin element)) (end-of-line)
(while (looking-at org-element--affiliated-re) (re-search-backward "^[ \t]*$" beg 'move)
(forward-line))
(forward-line)
(point))
(progn
(goto-char (org-element-property :end element))
(skip-chars-backward " \r\t\n")
(line-beginning-position)) (line-beginning-position))
justify))) t) (save-excursion
;; Fill comments, indented or not. (beginning-of-line)
(comment (re-search-forward "^[ \t]*$" end 'move)
(let ((fill-prefix (org-fill-context-prefix (point)))) (line-beginning-position))
(save-excursion justify)))
(fill-region-as-paragraph t)
(progn ;; Fill comments.
(goto-char (org-element-property :begin element)) (comment (fill-comment-paragraph justify))
(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))))))
;; Ignore every other element. ;; Ignore every other element.
(otherwise t))))))) (otherwise t)))))))
(defun org-auto-fill-function () (defun org-auto-fill-function ()
"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))) (let ((fc (current-fill-column)))
(when (and fc (> (current-column) fc)) (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)))))) (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) (defun org-comment-line-break-function (&optional soft)
"Break line at point and indent, continuing comment if within one. "Break line at point and indent, continuing comment if within one.
The inserted newline is marked hard if variable The inserted newline is marked hard if variable
@ -21254,6 +21212,93 @@ non-nil."
(insert-before-markers-and-inherit fill-prefix)) (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. ;;; Other stuff.
(defun org-toggle-fixed-width-section (arg) (defun org-toggle-fixed-width-section (arg)