|
@@ -3867,166 +3867,174 @@ given in `org-agenda-start-on-weekday'."
|
|
|
(interactive "P")
|
|
|
(if (and (integerp arg) (> arg 0))
|
|
|
(setq span arg arg nil))
|
|
|
- (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-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-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 ""))))
|
|
|
|
|
|
(defun org-agenda-ndays-to-span (n)
|
|
|
"Return a span symbol for a span of N days, or N if none matches."
|