forked from mirrors/org-mode
Merge branch 'maint'
This commit is contained in:
Bastien Guerry
commit
0a78e90362
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
281
lisp/org.el
281
lisp/org.el
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue