;;; org-agenda.el --- Dynamic task and appointment lists for Org
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 7.7
;;
;; This file is part of GNU Emacs.
;;
;;; Commentary:
;; This file contains the code for creating and using the Agenda for Org-mode.
+;;
+;; The functions `org-batch-agenda', `org-batch-agenda-csv', and
+;; `org-batch-store-agenda-views' are implemented as macros to provide
+;; a convenient way for extracting agenda information from the command
+;; line. The Lisp does not evaluate parameters of a macro call; thus
+;; it is not necessary to quote the parameters passed to one of those
+;; functions. E.g. you can write:
+;;
+;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)'
+;;
+;; To export an agenda spanning 7 days. If `org-batch-agenda' would
+;; have been implemented as a regular function you'd have to quote the
+;; symbol org-agenda-span. Moreover: To use a symbol as parameter
+;; value you would have to double quote the symbol.
+;;
+;; This is a hack, but it works even when running Org byte-compiled.
+;;
;;; Code:
(declare-function calendar-julian-date-string "cal-julian" (&optional date))
(declare-function calendar-mayan-date-string "cal-mayan" (&optional date))
(declare-function calendar-persian-date-string "cal-persia" (&optional date))
+(declare-function calendar-check-holidays "holidays" (date))
+
(declare-function org-datetree-find-date-create "org-datetree"
(date &optional keep-restriction))
(declare-function org-columns-quit "org-colview" ())
(declare-function org-is-habit-p "org-habit" (&optional pom))
(declare-function org-habit-parse-todo "org-habit" (&optional pom))
(declare-function org-habit-get-priority "org-habit" (habit &optional moment))
+(declare-function org-pop-to-buffer-same-window "org-compat"
+ (&optional buffer-or-name norecord label))
(defvar calendar-mode-map)
(defvar org-clock-current-task) ; defined in org-clock.el
(const user-defined-up) (const user-defined-down))
"Sorting choices.")
+;; Keep custom values for `org-agenda-filter-preset' compatible with
+;; the new variable `org-agenda-tag-filter-preset'.
+(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+
(defconst org-agenda-custom-commands-local-options
`(repeat :tag "Local settings for this command. Remember to quote values"
(choice :tag "Setting"
(list :tag "Deadline Warning days"
(const org-deadline-warning-days)
(integer :value 1))
+ (list :tag "Category filter preset"
+ (const org-agenda-category-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+category or -category"))))
(list :tag "Tags filter preset"
- (const org-agenda-filter-preset)
+ (const org-agenda-tag-filter-preset)
(list
(const :format "" quote)
(repeat
(string :tag "+tag or -tag"))))
(list :tag "Set daily/weekly entry types"
(const org-agenda-entry-types)
- (set :greedy t :value (:deadline :scheduled :timestamp :sexp)
- (const :deadline)
- (const :scheduled)
- (const :timestamp)
- (const :sexp)))
+ (list
+ (const :format "" quote)
+ (set :greedy t :value (:deadline :scheduled :timestamp :sexp)
+ (const :deadline)
+ (const :scheduled)
+ (const :timestamp)
+ (const :sexp))))
(list :tag "Standard skipping condition"
:value (org-agenda-skip-function '(org-agenda-skip-entry-if))
(const org-agenda-skip-function)
`org-agenda-custom-commands'.")
-(defcustom org-agenda-custom-commands nil
+(defcustom org-agenda-custom-commands '(("n" "Agenda and all TODO's"
+ ((agenda "") (alltodo))))
"Custom commands for the agenda.
These commands will be offered on the splash screen displayed by the
agenda dispatcher \\[org-agenda]. Each entry is a list like this:
desc A description string to be displayed in the dispatcher menu.
cmd An agenda command, similar to the above. However, tree commands
- are no allowed, but instead you can get agenda and global todo list.
+ are not allowed, but instead you can get agenda and global todo list.
So valid commands for a set are:
(agenda \"\" settings)
(alltodo \"\" settings)
to make his option also apply to the tags-todo list."
:group 'org-agenda-skip
:group 'org-agenda-todo-list
+ :version "24.1"
:type '(choice
(const :tag "Ignore future timestamp todos" future)
(const :tag "Ignore past or present timestamp todos" past)
because you will take care of it on the day when scheduled."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
+ :version "24.1"
:type '(choice
- (const :tag "Alwas show prewarning" nil)
+ (const :tag "Always show prewarning" nil)
(const :tag "Remove prewarning if entry is scheduled" t)
(integer :tag "Restart prewarning N days before deadline")))
-(defcustom org-agenda-skip-additional-timestamps-same-entry t
+(defcustom org-agenda-skip-additional-timestamps-same-entry nil
"When nil, multiple same-day timestamps in entry make multiple agenda lines.
When non-nil, after the search for timestamps has matched once in an
entry, the rest of the entry will not be searched."
:group 'org-agenda-todo-list
:type '(choice
(const :tag "Do not dim" nil)
- (const :tag "Dim to a grey face" t)
+ (const :tag "Dim to a gray face" t)
(const :tag "Make invisible" invisible)))
(defcustom org-timeline-show-empty-dates 3
Setting it to nil is good if matcher strings are very long and/or if
you want to use two-column display (see `org-agenda-menu-two-column')."
:group 'org-agenda
+ :version "24.1"
:type 'boolean)
(defcustom org-agenda-menu-two-column nil
If you use this, you probably want to set `org-agenda-menu-show-matcher'
to nil."
:group 'org-agenda
+ :version "24.1"
:type 'boolean)
(defcustom org-finalize-agenda-hook nil
:group 'org-agenda-startup
:type 'boolean)
+(defcustom org-agenda-follow-indirect nil
+ "Non-nil means `org-agenda-follow-mode' displays only the
+current item's tree, in an indirect buffer."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'boolean)
+
(defcustom org-agenda-show-outline-path t
"Non-nil means show outline path in echo area after line motion."
:group 'org-agenda-startup
"Non-nil means use leading zero for military times in agenda.
For example, 9:30am would become 09:30 rather than 9:30."
:group 'org-agenda-daily/weekly
+ :version "24.1"
:type 'boolean)
(defcustom org-agenda-timegrid-use-ampm nil
"When set, show AM/PM style timestamps on the timegrid."
:group 'org-agenda
+ :version "24.1"
:type 'boolean)
(defun org-agenda-time-of-day-to-ampm (time)
(const :tag "Saturday" 6)
(const :tag "Sunday" 0)))
+(defcustom org-agenda-move-date-from-past-immediately-to-today t
+ "Non-nil means jump to today when moving a past date forward in time.
+When using S-right in the agenda to move a a date forward, and the date
+stamp currently points to the past, the first key press will move it
+to today. WHen nil, just move one day forward even if the date stays
+in the past."
+ :group 'org-agenda-daily/weekly
+ :version "24.1"
+ :type 'boolean)
+
(defcustom org-agenda-include-diary nil
"If non-nil, include in the agenda entries from the Emacs Calendar's diary.
Custom commands can set this variable in the options section."
"If non-nil, include entries within their deadline warning period.
Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
- :type 'boolean)
-
-(defcustom org-agenda-include-all-todo nil
- "Set means weekly/daily agenda will always contain all TODO entries.
-The TODO entries will be listed at the top of the agenda, before
-the entries for specific days.
-This option is deprecated, it is better to define a block agenda instead."
- :group 'org-agenda-daily/weekly
+ :version "24.1"
:type 'boolean)
(defcustom org-agenda-repeating-timestamp-show-all t
:short-face face for clock intervals that are too short"
:group 'org-agenda-daily/weekly
:group 'org-clock
+ :version "24.1"
:type 'plist)
(defcustom org-agenda-log-mode-add-notes t
is a regexp marked with braces like \"{abc}\", this will also switch to
boolean search."
:group 'org-agenda-search-view
+ :version "24.1"
:type 'boolean)
(if (fboundp 'defvaralias)
"Non-nil means, search words must be matches as complete words.
When nil, they may also match part of a word."
:group 'org-agenda-search-view
+ :version "24.1"
:type 'boolean)
(defgroup org-agenda-time-grid nil
(defcustom org-agenda-show-current-time-in-grid t
"Non-nil means show the current time in the time grid."
:group 'org-agenda-time-grid
+ :version "24.1"
:type 'boolean)
(defcustom org-agenda-current-time-string
"now - - - - - - - - - - - - - - - - - - - - - - - - -"
"The string for the current time marker in the agenda."
:group 'org-agenda-time-grid
+ :version "24.1"
:type 'string)
(defgroup org-agenda-sorting nil
(tags . " %i %-12:c")
(search . " %i %-12:c"))
"Format specifications for the prefix of items in the agenda views.
-An alist with five entries, each for the different agenda types. The
-keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.
+An alist with five entries, each for the different agenda types. The
+keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.
The values are format strings.
This format works similar to a printf format, with the following meaning:
- %c the category of the item, \"Diary\" for entries from the diary,
+ %c the category of the item, \"Diary\" for entries from the diary,
or as given by the CATEGORY keyword or derived from the file name
+ %e the effort required by the item
%i the icon category of the item, see `org-agenda-category-icon-alist'
%T the last tag of the item (ignore inherited tags, which come first)
%t the HH:MM time-of-day specification if one applies to the entry
and a whitespace/punctuation character just before the final letter.
If the first character after `%' is a question mark, the entire field
-will only be included if the corresponding value applies to the current
-entry. This is useful for fields which should have fixed width when
-present, but zero width when absent. For example, \"%?-12t\" will
-result in a 12 character time field if a time of the day is specified,
+will only be included if the corresponding value applies to the current
+entry. This is useful for fields which should have fixed width when
+present, but zero width when absent. For example, \"%?-12t\" will
+result in a 12 character time field if a time of the day is specified,
but will completely disappear in entries which do not contain a time.
If there is punctuation or whitespace character just before the final
\"Diary: \" if the category is \"Diary\". If the category were be
empty, no additional colon would be inserted.
-The default value for the agenda sublist is \" %-12:c%?-12t% s\",
+The default value for the agenda sublist is \" %-12:c%?-12t% s\",
which means:
- Indent the line with two space characters
"Text preceding item pulled into the agenda by inactive time stamps.
These entries are added to the agenda when pressing \"[\"."
:group 'org-agenda-line-format
+ :version "24.1"
:type '(list
(string :tag "Scheduled today ")
(string :tag "Scheduled previously")))
"Non-nil means remove time ranges specifications in agenda
items that span on several days."
:group 'org-agenda-line-format
+ :version "24.1"
:type 'boolean)
(defcustom org-agenda-default-appointment-duration nil
returns a face, or nil if does not want to specify a face and let
the normal rules apply."
:group 'org-agenda-line-format
+ :version "24.1"
:type 'function)
(defcustom org-agenda-category-icon-alist nil
the icon should be displayed.
FILE-OR-DATA either a file path or a string containing image data.
-The other fields can be omited safely if not needed:
+The other fields can be omitted safely if not needed:
TYPE indicates the image type.
DATA-P is a boolean indicating whether the FILE-OR-DATA string is
image data.
(\"Emacs\" '(space . (:width (16))))"
:group 'org-agenda-line-format
+ :version "24.1"
:type '(alist :key-type (string :tag "Regexp matching category")
:value-type (choice (list :tag "Icon"
(string :tag "File or data")
(?C bulk-cut))
With selected entries in an agenda buffer, `B R' will call
-the custom function `set-category' on the selected entries.
+the custom function `set-category' on the selected entries.
Note that functions in this alist don't need to be quoted."
:type 'alist
+ :version "24.1"
:group 'org-agenda)
(eval-when-compile
If STRING is non-nil, the text property will be fetched from position 0
in that string. If STRING is nil, it will be fetched from the beginning
of the current line."
- `(let ((marker (get-text-property (if string 0 (point-at-bol))
- 'org-hd-marker string)))
- (with-current-buffer (marker-buffer marker)
- (save-excursion
- (goto-char marker)
- ,@body))))
+ (org-with-gensyms (marker)
+ `(let ((,marker (get-text-property (if string 0 (point-at-bol))
+ 'org-hd-marker ,string)))
+ (with-current-buffer (marker-buffer ,marker)
+ (save-excursion
+ (goto-char ,marker)
+ ,@body)))))
+(def-edebug-spec org-agenda-with-point-at-orig-entry (form body))
(defun org-add-agenda-custom-command (entry)
"Replace or add a command in `org-agenda-custom-commands'.
(org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property)
(org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
(org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
-(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda)
+(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write)
(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
(org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority)
(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
+(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
:keys "v A"]
"--"
["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
- ["Write view to file" org-write-agenda t]
+ ["Write view to file" org-agenda-write t]
["Rebuild buffer" org-agenda-redo t]
["Save all Org-mode Buffers" org-save-all-org-buffers t]
"--"
nil 'face 'org-warning)))))))
t t))
((equal keys "L")
- (unless (org-mode-p)
+ (unless (eq major-mode 'org-mode)
(error "This is not an Org-mode file"))
(unless restriction
(put 'org-agenda-files 'org-restrict (list bfn))
"The user interface for selecting an agenda command."
(catch 'exit
(let* ((bfn (buffer-file-name (buffer-base-buffer)))
- (restrict-ok (and bfn (org-mode-p)))
+ (restrict-ok (and bfn (eq major-mode 'org-mode)))
(region-p (org-region-active-p))
(custom org-agenda-custom-commands)
(selstring "")
longer string it is used as a tags/todo match string.
Parameters are alternating variable names and values that will be bound
before running the agenda command."
- (let (pars)
- (while parameters
- (push (list (pop parameters) (if parameters (pop parameters))) pars))
+ (org-eval-in-environment (org-make-parameter-alist parameters)
(if (> (length cmd-key) 2)
- (eval (list 'let (nreverse pars)
- (list 'org-tags-view nil cmd-key)))
- (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
- (set-buffer org-agenda-buffer-name)
- (princ (org-encode-for-stdout (buffer-string)))))
-
-;(defun org-encode-for-stdout (string)
-; (if (fboundp 'encode-coding-string)
-; (encode-coding-string string buffer-file-coding-system)
-; string))
-
-(defun org-encode-for-stdout (string)
- string)
+ (org-tags-view nil cmd-key)
+ (org-agenda nil cmd-key)))
+ (set-buffer org-agenda-buffer-name)
+ (princ (buffer-string)))
+(def-edebug-spec org-batch-agenda (form &rest sexp))
(defvar org-agenda-info nil)
priority-l The priority letter if any was given
priority-n The computed numerical priority
agenda-day The day in the agenda where this is listed"
-
- (let (pars)
- (while parameters
- (push (list (pop parameters) (if parameters (pop parameters))) pars))
- (push (list 'org-agenda-remove-tags t) pars)
+ (org-eval-in-environment (append '((org-agenda-remove-tags t))
+ (org-make-parameter-alist parameters))
(if (> (length cmd-key) 2)
- (eval (list 'let (nreverse pars)
- (list 'org-tags-view nil cmd-key)))
- (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key))))
- (set-buffer org-agenda-buffer-name)
- (let* ((lines (org-split-string (buffer-string) "\n"))
- line)
- (while (setq line (pop lines))
- (catch 'next
- (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
- (setq org-agenda-info
- (org-fix-agenda-info (text-properties-at 0 line)))
- (princ
- (org-encode-for-stdout
- (mapconcat 'org-agenda-export-csv-mapper
- '(org-category txt type todo tags date time extra
- priority-letter priority agenda-day)
- ",")))
- (princ "\n"))))))
+ (org-tags-view nil cmd-key)
+ (org-agenda nil cmd-key)))
+ (set-buffer org-agenda-buffer-name)
+ (let* ((lines (org-split-string (buffer-string) "\n"))
+ line)
+ (while (setq line (pop lines))
+ (catch 'next
+ (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
+ (setq org-agenda-info
+ (org-fix-agenda-info (text-properties-at 0 line)))
+ (princ
+ (mapconcat 'org-agenda-export-csv-mapper
+ '(org-category txt type todo tags date time extra
+ priority-letter priority agenda-day)
+ ","))
+ (princ "\n")))))
+(def-edebug-spec org-batch-agenda-csv (form &rest sexp))
(defun org-fix-agenda-info (props)
"Make sure all properties on an agenda item have a canonical form.
(interactive)
(eval (list 'org-batch-store-agenda-views)))
-;; FIXME, why is this a macro?????
;;;###autoload
(defmacro org-batch-store-agenda-views (&rest parameters)
"Run all custom agenda commands that have a file argument."
(let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
(pop-up-frames nil)
(dir default-directory)
- pars cmd thiscmdkey files opts cmd-or-set)
- (while parameters
- (push (list (pop parameters) (if parameters (pop parameters))) pars))
- (setq pars (reverse pars))
+ (pars (org-make-parameter-alist parameters))
+ cmd thiscmdkey files opts cmd-or-set)
(save-window-excursion
(while cmds
(setq cmd (pop cmds)
files (nth (if (listp cmd-or-set) 4 5) cmd))
(if (stringp files) (setq files (list files)))
(when files
- (eval (list 'let (append org-agenda-exporter-settings opts pars)
- (list 'org-agenda nil thiscmdkey)))
+ (org-eval-in-environment (append org-agenda-exporter-settings
+ opts pars)
+ (org-agenda nil thiscmdkey))
(set-buffer org-agenda-buffer-name)
(while files
- (eval (list 'let (append org-agenda-exporter-settings opts pars)
- (list 'org-write-agenda
- (expand-file-name (pop files) dir) nil t))))
+ (org-eval-in-environment (append org-agenda-exporter-settings
+ opts pars)
+ (org-agenda-write (expand-file-name (pop files) dir) nil t)))
(and (get-buffer org-agenda-buffer-name)
(kill-buffer org-agenda-buffer-name)))))))
+(def-edebug-spec org-batch-store-agenda-views (&rest sexp))
(defun org-agenda-mark-header-line (pos)
"Mark the line at POS as an agenda structure header."
'org-agenda-title-append org-agenda-title-append))))
(defvar org-mobile-creating-agendas)
-(defun org-write-agenda (file &optional open nosettings)
+(defvar org-agenda-write-buffer-name "Agenda View")
+(defun org-agenda-write (file &optional open nosettings)
"Write the current buffer (an agenda view) as a file.
Depending on the extension of the file name, plain text (.txt),
HTML (.html or .htm) or Postscript (.ps) is produced.
(let ((bs (copy-sequence (buffer-string))) beg)
(org-agenda-unmark-filtered-text)
(with-temp-buffer
- (rename-buffer "Agenda View" t)
+ (rename-buffer org-agenda-write-buffer-name t)
(set-buffer-modified-p nil)
(insert bs)
(org-agenda-remove-marked-text 'org-filtered)
(set-buffer org-agenda-buffer-name))
(when open (org-open-file file)))
-(defvar org-agenda-filter-overlays nil)
+(defvar org-agenda-tag-filter-overlays nil)
+(defvar org-agenda-cat-filter-overlays nil)
(defun org-agenda-mark-filtered-text ()
"Mark all text hidden by filtering with a text property."
(put-text-property
(overlay-start o) (overlay-end o)
'org-filtered t)))
- org-agenda-filter-overlays)))
+ (append org-agenda-tag-filter-overlays
+ org-agenda-cat-filter-overlays))))
(defun org-agenda-unmark-filtered-text ()
"Remove the filtering text property."
(let (txt drawer-re kwd-time-re ind)
(save-excursion
(with-current-buffer (marker-buffer marker)
- (if (not (org-mode-p))
+ (if (not (eq major-mode 'org-mode))
(setq txt "")
(save-excursion
(save-restriction
(defun org-check-for-org-mode ()
"Make sure current buffer is in org-mode. Error if not."
- (or (org-mode-p)
+ (or (eq major-mode 'org-mode)
(error "Cannot execute org-mode agenda command on buffer in %s"
major-mode)))
(defvar org-pre-agenda-window-conf nil)
(defvar org-agenda-columns-active nil)
(defvar org-agenda-name nil)
-(defvar org-agenda-filter nil)
-(defvar org-agenda-filter-while-redo nil)
-(defvar org-agenda-filter-preset nil
+(defvar org-agenda-tag-filter nil)
+(defvar org-agenda-category-filter nil)
+(defvar org-agenda-tag-filter-while-redo nil)
+(defvar org-agenda-tag-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single tag preceded
by \"+\" or \"-\".
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
+(defvar org-agenda-category-filter-preset nil
+ "A preset of the category filter used for secondary agenda filtering.
+This must be a list of strings, each string must be a single category
+preceded by \"+\" or \"-\".
+This variable should not be set directly, but agenda custom commands can
+bind it in the options section. The preset filter is a global property of
+the entire agenda view. In a block agenda, it will not work reliably to
+define a filter for one of the individual blocks. You need to set it in
+the global options and expect it to be applied to the entire view.")
+
(defun org-prepare-agenda (&optional name)
(setq org-todo-keywords-for-agenda nil)
- (setq org-done-keywords-for-agenda nil)
(setq org-drawers-for-agenda nil)
(unless org-agenda-persistent-filter
- (setq org-agenda-filter nil))
- (put 'org-agenda-filter :preset-filter org-agenda-filter-preset)
+ (setq org-agenda-tag-filter nil
+ org-agenda-category-filter nil))
+ (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset)
+ (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset)
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
(make-string (window-width) org-agenda-block-separator))
"\n"))
(narrow-to-region (point) (point-max)))
+ (setq org-done-keywords-for-agenda nil)
(org-agenda-reset-markers)
(setq org-agenda-contributing-files nil)
(setq org-agenda-columns-active nil)
(awin (select-window awin))
((not (setq org-pre-agenda-window-conf (current-window-configuration))))
((equal org-agenda-window-setup 'current-window)
- (switch-to-buffer abuf))
+ (org-pop-to-buffer-same-window abuf))
((equal org-agenda-window-setup 'other-window)
(org-switch-to-buffer-other-window abuf))
((equal org-agenda-window-setup 'other-frame)
;; additional test in case agenda is invoked from within agenda
;; buffer via elisp link
(unless (equal (current-buffer) abuf)
- (switch-to-buffer abuf)))
+ (org-pop-to-buffer-same-window abuf)))
(setq buffer-read-only nil)
(let ((inhibit-read-only t)) (erase-buffer))
(org-agenda-mode)
(org-habit-insert-consistency-graphs))
(run-hooks 'org-finalize-agenda-hook)
(setq org-agenda-type (org-get-at-bol 'org-agenda-type))
- (when (or org-agenda-filter (get 'org-agenda-filter :preset-filter))
- (org-agenda-filter-apply org-agenda-filter))
+ (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter))
+ (org-agenda-filter-apply org-agenda-category-filter 'category))
)))
(defun org-agenda-mark-clocking-task ()
(setq org-blocked-by-checkboxes nil invis1 invis)
(let ((marker (org-get-at-bol 'org-hd-marker)))
(when (and marker
- (not (with-current-buffer (marker-buffer marker)
- (save-excursion
- (goto-char marker)
- (if (org-entry-get nil "NOBLOCKING")
- t ;; Never block this entry
- (run-hook-with-args-until-failure
- 'org-blocker-hook
- (list :type 'todo-state-change
- :position marker
- :from 'todo
- :to 'done)))))))
+ (with-current-buffer (marker-buffer marker)
+ (save-excursion (goto-char marker)
+ (org-entry-blocked-p))))
(if org-blocked-by-checkboxes (setq invis1 nil))
(setq b (if invis1
(max (point-min) (1- (point-at-bol)))
(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
-(defun org-timeline (&optional include-all)
+(defun org-timeline (&optional dotodo)
"Show a time-sorted view of the entries in the current org file.
Only entries with a time stamp of today or later will be listed. With
\\[universal-argument] prefix, all unfinished TODO items will also be shown,
(org-compile-prefix-format 'timeline)
(org-set-sorting-strategy 'timeline)
(let* ((dopast t)
- (dotodo include-all)
(doclosed org-agenda-show-log)
(entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
(current-buffer))))
(setq org-agenda-redo-command
(list 'progn
(list 'org-switch-to-buffer-other-window (current-buffer))
- (list 'org-timeline (list 'quote include-all))))
+ (list 'org-timeline (list 'quote dotodo))))
(if (not dopast)
;; Remove past dates from the list of dates.
(setq day-numbers (delq nil (mapcar (lambda(x)
(let ((re (concat
(if pre-re pre-re "")
(if inactive org-ts-regexp-both org-ts-regexp)))
- dates dates1 date day day1 day2 ts1 ts2)
+ dates dates1 date day day1 day2 ts1 ts2 pos)
(if force-today
(setq dates (list (org-today))))
(save-excursion
(goto-char beg)
(while (re-search-forward re end t)
(setq day (time-to-days (org-time-string-to-time
- (substring (match-string 1) 0 10))))
+ (substring (match-string 1) 0 10)
+ (current-buffer) (match-beginning 0))))
(or (memq day dates) (push day dates)))
(unless no-ranges
(goto-char beg)
(while (re-search-forward org-tr-regexp end t)
+ (setq pos (match-beginning 0))
(setq ts1 (substring (match-string 1) 0 10)
ts2 (substring (match-string 2) 0 10)
- day1 (time-to-days (org-time-string-to-time ts1))
- day2 (time-to-days (org-time-string-to-time ts2)))
+ day1 (time-to-days (org-time-string-to-time
+ ts1 (current-buffer) pos))
+ day2 (time-to-days (org-time-string-to-time
+ ts2 (current-buffer) pos)))
(while (< (setq day1 (1+ day1)) day2)
(or (memq day1 dates) (push day1 dates)))))
(setq dates (sort dates '<))
(defvar org-starting-day nil) ; local variable in the agenda buffer
(defvar org-agenda-current-span nil
"The current span used in the agenda view.") ; local variable in the agenda buffer
-(defvar org-include-all-loc nil) ; local variable
+(defvar org-arg-loc nil) ; local variable
(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
"List of types searched for when creating the daily/weekly agenda.
the daily/weekly agenda, see `org-agenda-skip-function'.")
;;;###autoload
-(defun org-agenda-list (&optional include-all start-day span)
+(defun org-agenda-list (&optional arg start-day span)
"Produce a daily/weekly view from all files in variable `org-agenda-files'.
The view will be for the current day or week, but from the overview buffer
you will be able to go to other days/weeks.
With a numeric prefix argument in an interactive call, the agenda will
-span INCLUDE-ALL days. Lisp programs should instead specify SPAN to change
+span ARG days. Lisp programs should instead specify SPAN to change
the number of days. SPAN defaults to `org-agenda-span'.
START-DAY defaults to TODAY, or to the most recent match for the weekday
given in `org-agenda-start-on-weekday'."
(interactive "P")
- (if (and (integerp include-all) (> include-all 0))
- (setq span include-all include-all nil))
+ (if (and (integerp arg) (> arg 0))
+ (setq span arg arg nil))
(setq start-day (or start-day org-agenda-start-day))
(if org-agenda-overriding-arguments
- (setq include-all (car 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 include-all start-day span))
+ (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
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 include-all) start-day (list 'quote span)))
+ (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))
clocktable-end (1+ (or (org-last day-numbers) 0)))
(org-prepare-agenda "Day/Week")
(org-set-local 'org-starting-day (car day-numbers))
- (org-set-local 'org-include-all-loc include-all)
+ (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))
(setq rtn (apply 'org-agenda-get-day-entries
file date
org-agenda-entry-types)))))
- (setq rtnall (append rtnall rtn))))
+ (setq rtnall (append rtnall rtn)))) ;; all entries
(if org-agenda-include-diary
(let ((org-agenda-search-headline-for-time t))
(require 'diary-lib)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt)
(when todayp
(put-text-property s (1- (point)) 'org-today t))
- (if rtnall (insert
+ (if rtnall (insert ;; all entries
(org-finalize-agenda-entries
(org-agenda-add-time-grid-maybe
rtnall ndays todayp))
(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-filter-while-redo
- (get 'org-agenda-filter :preset-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)
""
(full-words org-agenda-search-view-force-full-words)
(org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
regexp rtn rtnall files file pos
- marker category tags c neg re boolean
+ marker category org-category-pos tags c neg re boolean
ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
(unless (and (not edit-at)
(stringp string)
(if (not regexps+)
(setq regexp org-outline-regexp-bol)
(setq regexp (pop regexps+))
- (if hdl-only (setq regexp (concat "^" org-outline-regexp ".*?"
+ (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
regexp))))
(setq files (org-agenda-files nil 'ifmode))
(when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
file))))
(with-current-buffer buffer
(with-syntax-table (org-search-syntax-table)
- (unless (org-mode-p)
+ (unless (eq major-mode 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
(let ((case-fold-search t))
(save-excursion
org-agenda-restrict-end)
(widen))
(goto-char (point-min))
- (unless (or (org-on-heading-p)
+ (unless (or (org-at-heading-p)
(outline-next-heading))
(throw 'nextfile t))
(goto-char (max (point-min) (1- (point))))
(goto-char beg)
(setq marker (org-agenda-new-marker (point))
category (org-get-category)
+ org-category-pos (get-text-property (point) 'org-category-position)
tags (org-get-tags-at (point))
- txt (org-format-agenda-item
+ txt (org-agenda-format-item
""
(buffer-substring-no-properties
beg1 (point-at-eol))
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
'priority 1000 'org-category category
+ 'org-category-position org-category-pos
'type "search")
(push txt ee)
(goto-char (1- end))))))))))
(format "ORG-AGENDA-ERROR: No such org-file %s" file))
rtnall (append rtnall rtn))
(with-current-buffer buffer
- (unless (org-mode-p)
+ (unless (eq major-mode 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
(save-excursion
(save-restriction
(defun org-agenda-skip-if (subtree conditions)
"Checks current entity for CONDITIONS.
If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only
-the entry, i.e. the text before the next heading is checked.
+the entry (i.e. the text before the next heading) is checked.
CONDITIONS is a list of symbols, boolean OR is used to combine the results
from different tests. Valid conditions are:
would skip all entries with \"TODO\" or \"WAITING\" keywords.
-Instead of a list a keyword class may be given
+Instead of a list, a keyword class may be given. For example:
(org-agenda-skip-entry-if 'nottodo 'done)
would skip entries that haven't been marked with any of \"DONE\"
-keywords. Possible classes are: `todo', `done', `any'.
+keywords. Possible classes are: `todo', `done', `any'.
If any of these conditions is met, this function returns the end point of
the entity, causing the search to continue from there. This is a function
(stringp (nth 1 m))
(not (re-search-forward (nth 1 m) end t)))
(and (or
- (setq m (memq 'todo conditions))
- (setq m (memq 'nottodo conditions)))
+ (setq m (memq 'nottodo conditions))
+ (setq m (memq 'todo conditions)))
(org-agenda-skip-if-todo m end)))
end)))
"\\)\\>"))
(tags (nth 2 org-stuck-projects))
(tags-re (if (member "*" tags)
- (org-re (concat org-outline-regexp-bol
- ".*:[[:alnum:]_@#%]+:[ \t]*$"))
+ (concat org-outline-regexp-bol
+ (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$"))
(if tags
(concat org-outline-regexp-bol
".*:\\("
(setq entries
(mapcar
(lambda (x)
- (setq x (org-format-agenda-item "" x "Diary" nil 'time))
+ (setq x (org-agenda-format-item "" x "Diary" nil 'time))
;; Extend the text properties to the beginning of the line
(org-add-props x (text-properties-at (1- (length x)) x)
'type "diary" 'date date 'face 'org-agenda-diary))
;; If file does not exist, make sure an error message ends up in diary
(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
(with-current-buffer buffer
- (unless (org-mode-p)
+ (unless (eq major-mode 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
(let ((case-fold-search nil))
(save-excursion
(setq results (append results rtn))))))))
results))))
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
(defun org-agenda-get-todos ()
"Return the TODO information for agenda display."
(let* ((props (list 'face nil
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
- (regexp (concat "^\\*+[ \t]+\\("
- (if org-select-this-todo-keyword
- (if (equal org-select-this-todo-keyword "*")
- org-todo-regexp
- (concat "\\<\\("
- (mapconcat 'identity (org-split-string org-select-this-todo-keyword "|") "\\|")
- "\\)\\>"))
- org-not-done-regexp)
- "[^\n\r]*\\)"))
- marker priority category tags todo-state
+ (regexp (format org-heading-keyword-regexp-format
+ (cond
+ ((and org-select-this-todo-keyword
+ (equal org-select-this-todo-keyword "*"))
+ org-todo-regexp)
+ (org-select-this-todo-keyword
+ (concat "\\("
+ (mapconcat 'identity
+ (org-split-string
+ org-select-this-todo-keyword
+ "|")
+ "\\|") "\\)"))
+ (t org-not-done-regexp))))
+ marker priority category org-category-pos tags todo-state
ee txt beg end)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(goto-char (1+ beg))
(or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
(throw :skip nil)))
- (goto-char (match-beginning 1))
+ (goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category)
- txt (match-string 1)
+ org-category-pos (get-text-property (point) 'org-category-position)
+ txt (org-trim
+ (buffer-substring (match-beginning 2) (match-end 0)))
tags (org-get-tags-at (point))
- txt (org-format-agenda-item "" txt category tags)
+ txt (org-agenda-format-item "" txt category tags)
priority (1+ (org-get-priority txt))
todo-state (org-get-todo-state))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'priority priority 'org-category category
+ 'org-category-position org-category-pos
'type "todo" 'todo-state todo-state)
(push txt ee)
(if org-agenda-todo-list-sublevels
- (goto-char (match-end 1))
+ (goto-char (match-end 2))
(org-end-of-subtree 'invisible))))
(nreverse ee)))
(defun org-agenda-get-timestamps ()
"Return the date stamp information for agenda display."
- (let* ((props (list 'face nil
+ (let* ((props (list 'face 'org-agenda-calendar-event
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
"\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
marker hdmarker deadlinep scheduledp clockp closedp inactivep
- donep tmp priority category ee txt timestr tags b0 b3 e3 head
- todo-state end-of-match show-all)
+ donep tmp priority category org-category-pos ee txt timestr tags
+ b0 b3 e3 head todo-state end-of-match show-all)
(goto-char (point-min))
(while (setq end-of-match (re-search-forward regexp nil t))
(setq b0 (match-beginning 0)
(org-agenda-skip)
(if (and (match-end 1)
(not (= d1 (org-time-string-to-absolute
- (match-string 1) d1 nil show-all))))
+ (match-string 1) d1 nil show-all
+ (current-buffer) b0))))
(throw :skip nil))
(if (and e3
(not (org-diary-sexp-entry (buffer-substring b3 e3) "" date)))
;; substring should only run to end of time stamp
(setq timestr (substring timestr 0 (match-end 0))))
(setq marker (org-agenda-new-marker b0)
- category (org-get-category b0))
+ category (org-get-category b0)
+ org-category-pos (get-text-property b0 'org-category-position))
(save-excursion
(if (not (re-search-backward org-outline-regexp-bol nil t))
(setq txt org-agenda-no-heading-message)
tags (org-get-tags-at))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
(setq head (or (match-string 1) ""))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(if inactivep org-agenda-inactive-leader nil)
head category tags timestr
remove-re)))
'org-marker marker 'org-hd-marker hdmarker)
(org-add-props txt nil 'priority priority
'org-category category 'date date
+ 'org-category-position org-category-pos
'todo-state todo-state
'type "timestamp")
(push txt ee))
(defun org-agenda-get-sexps ()
"Return the sexp information for agenda display."
(require 'diary-lib)
- (let* ((props (list 'mouse-face 'highlight
+ (let* ((props (list 'face 'org-agenda-calendar-sexp
+ 'mouse-face 'highlight
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(")
- marker category ee txt tags entry result beg b sexp sexp-entry
- todo-state)
+ marker category org-category-pos ee txt tags entry
+ result beg b sexp sexp-entry todo-state)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
(when result
(setq marker (org-agenda-new-marker beg)
category (org-get-category beg)
+ org-category-pos (get-text-property beg 'org-category-position)
todo-state (org-get-todo-state))
(dolist (r (if (stringp result)
(setq txt r)
(setq txt "SEXP entry returned empty string"))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
"" txt category tags 'time))
(org-add-props txt props 'org-marker marker)
(org-add-props txt nil
'org-category category 'date date 'todo-state todo-state
+ 'org-category-position org-category-pos
'type "sexp")
(push txt ee)))))
(nreverse ee)))
;; Define the` org-class' function
(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
"Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
-DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS
-is any number of ISO weeks in the block period for which the item should
-be skipped."
+DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
+SKIP-WEEKS is any number of ISO weeks in the block period for which the
+item should be skipped. If any of the SKIP-WEEKS arguments is the symbol
+`holidays', then any date that is known by the Emacs calendar to be a
+holiday will also be skipped."
(let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
(d (calendar-absolute-from-gregorian date)))
(progn
(require 'cal-iso)
(not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
+ (not (and (memq 'holidays skip-weeks)
+ (calendar-check-holidays date)))
entry)))
(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
(nth 2 date1) (car date1) (nth 1 date1)
(nth 2 date2) (car date2) (nth 1 date2)
dayname skip-weeks)))
+(make-obsolete 'org-diary-class 'org-class "")
(defalias 'org-get-closed 'org-agenda-get-progress)
(defun org-agenda-get-progress ()
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))))
(org-agenda-search-headline-for-time nil)
- marker hdmarker priority category tags closedp statep clockp state
- ee txt extra timestr rest clocked)
+ marker hdmarker priority category org-category-pos tags closedp
+ statep clockp state ee txt extra timestr rest clocked)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
clockp (not (or closedp statep))
state (and statep (match-string 2))
category (org-get-category (match-beginning 0))
- timestr (buffer-substring (match-beginning 0) (point-at-eol))
- )
+ org-category-pos (get-text-property (match-beginning 0) 'org-category-position)
+ timestr (buffer-substring (match-beginning 0) (point-at-eol)))
(when (string-match "\\]" timestr)
;; substring should only run to end of time stamp
(setq rest (substring timestr (match-end 0))
timestr (substring timestr 0 (match-end 0)))
(if (and (not closedp) (not statep)
- (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest))
+ (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
+ rest))
(progn (setq timestr (concat (substring timestr 0 -1)
"-" (match-string 1 rest) "]"))
(setq clocked (match-string 2 rest)))
(setq txt (concat (substring txt 0 (match-beginning 1))
" - " extra " " (match-string 2 txt)))
(setq txt (concat txt " - " extra))))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(cond
(closedp "Closed: ")
(statep (concat "State: (" state ")"))
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
'priority priority 'org-category category
+ 'org-category-position org-category-pos
'type "closed" 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee))
"\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
(tlstart 0.)
(tlend 0.)
- (maxtime (org-hh:mm-string-to-minutes
+ (maxtime (org-hh:mm-string-to-minutes
(or (plist-get pl :max-duration) "24:00")))
- (mintime (org-hh:mm-string-to-minutes
+ (mintime (org-hh:mm-string-to-minutes
(or (plist-get pl :min-duration) 0)))
(maxgap (org-hh:mm-string-to-minutes
;; default 30:00 means never complain
(regexp org-deadline-time-regexp)
(todayp (org-agenda-todayp date)) ; DATE bound by calendar
(d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
- d2 diff dfrac wdays pos pos1 category tags
- suppress-prewarning
- ee txt head face s todo-state show-all upcomingp donep timestr)
+ d2 diff dfrac wdays pos pos1 category org-category-pos
+ tags suppress-prewarning ee txt head face s todo-state
+ show-all upcomingp donep timestr)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(setq suppress-prewarning nil)
(member todo-state
org-agenda-repeating-timestamp-show-all))
d2 (org-time-string-to-absolute
- (match-string 1) d1 'past show-all)
+ (match-string 1) d1 'past show-all
+ (current-buffer) pos)
diff (- d2 d1)
wdays (if suppress-prewarning
(let ((org-deadline-warning-days suppress-prewarning))
(org-get-wdays s))
(org-get-wdays s))
- dfrac (/ (* 1.0 (- wdays diff)) (max wdays 1))
+ dfrac (- 1 (/ (* 1.0 diff) (max wdays 1)))
upcomingp (and todayp (> diff 0)))
;; When to show a deadline in the calendar:
;; If the expiration is within wdays warning time.
(or org-agenda-skip-deadline-if-done
(not (= diff 0))))
(setq txt nil)
- (setq category (org-get-category))
+ (setq category (org-get-category)
+ org-category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-end 0))
(setq timestr
(concat (substring s (match-beginning 1)) " "))
(setq timestr 'time))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(if (= diff 0)
(car org-agenda-deadline-leaders)
(if (functionp
head category tags
(if (not (= diff 0)) nil timestr)))))
(when txt
- (setq face (org-agenda-deadline-face dfrac wdays))
+ (setq face (org-agenda-deadline-face dfrac))
(org-add-props txt props
'org-marker (org-agenda-new-marker pos)
'org-hd-marker (org-agenda-new-marker pos1)
'priority (+ (- diff)
(org-get-priority txt))
'org-category category
+ 'org-category-position org-category-pos
'todo-state todo-state
'type (if upcomingp "upcoming-deadline" "deadline")
'date (if upcomingp date d2)
(push txt ee))))))
(nreverse ee)))
-(defun org-agenda-deadline-face (fraction &optional wdays)
+(defun org-agenda-deadline-face (fraction)
"Return the face to displaying a deadline item.
FRACTION is what fraction of the head-warning time has passed."
- (if (equal wdays 0) (setq fraction 1.))
(let ((faces org-agenda-deadline-faces) f)
(catch 'exit
(while (setq f (pop faces))
0 'org-hd-marker a))
(cons (marker-position mm) a)))
deadline-results))
- d2 diff pos pos1 category tags donep
+ d2 diff pos pos1 category org-category-pos tags donep
ee txt head pastschedp todo-state face timestr s habitp show-all)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(member todo-state
org-agenda-repeating-timestamp-show-all))
d2 (org-time-string-to-absolute
- (match-string 1) d1 'past show-all)
+ (match-string 1) d1 'past show-all
+ (current-buffer) pos)
diff (- d2 d1))
(setq pastschedp (and todayp (< diff 0)))
;; When to show a scheduled item in the calendar:
(setq txt nil)
(setq habitp (and (functionp 'org-is-habit-p)
(org-is-habit-p)))
- (setq category (org-get-category))
+ (setq category (org-get-category)
+ org-category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-end 0))
(setq timestr
(concat (substring s (match-beginning 1)) " "))
(setq timestr 'time))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(if (= diff 0)
(car org-agenda-scheduled-leaders)
(format (nth 1 org-agenda-scheduled-leaders)
(org-habit-get-priority habitp)
(+ 94 (- 5 diff) (org-get-priority txt)))
'org-category category
+ 'org-category-position org-category-pos
'org-habit-p habitp
'todo-state todo-state)
(push txt ee))))))
(abbreviate-file-name buffer-file-name))))
(regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date))
- marker hdmarker ee txt d1 d2 s1 s2 category todo-state tags pos
- head donep)
+ marker hdmarker ee txt d1 d2 s1 s2 category org-category-pos
+ todo-state tags pos head donep)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
(end-time (match-string 2)))
(setq s1 (match-string 1)
s2 (match-string 2)
- d1 (time-to-days (org-time-string-to-time s1))
- d2 (time-to-days (org-time-string-to-time s2)))
+ d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos))
+ d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos)))
(if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
;; Only allow days between the limits, because the normal
;; date stamps will catch the limits.
(if (and donep org-agenda-skip-timestamp-if-done)
(throw :skip t))
(setq marker (org-agenda-new-marker (point)))
- (setq category (org-get-category))
+ (setq category (org-get-category)
+ org-category-pos (get-text-property (point) 'org-category-position))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(setq txt org-agenda-no-heading-message)
(goto-char (match-beginning 0))
"--"
"<" (regexp-quote s2) ".*?>")
nil)))
- (setq txt (org-format-agenda-item
+ (setq txt (org-agenda-format-item
(format
(nth (if (= d1 d2) 0 1)
org-agenda-timerange-leaders)
(1+ (- d0 d1)) (1+ (- d2 d1)))
head category tags
- (cond ((= d1 d0)
+ (cond ((and (= d1 d0) (= d2 d0))
+ (concat "<" start-time ">--<" end-time ">"))
+ ((= d1 d0)
(concat "<" start-time ">"))
((= d2 d0)
(concat "<" end-time ">"))
'org-marker marker 'org-hd-marker hdmarker
'type "block" 'date date
'todo-state todo-state
- 'priority (org-get-priority txt) 'org-category category)
+ 'priority (org-get-priority txt) 'org-category category
+ 'org-category-position org-category-pos)
(push txt ee))))
(goto-char pos)))
;; Sort the entries by expiration date.
(return (cadr entry))
(return (apply 'create-image (cdr entry)))))))
-(defun org-format-agenda-item (extra txt &optional category tags dotime
+(defun org-agenda-format-item (extra txt &optional category tags dotime
remove-re habitp)
"Format TXT to be inserted into the agenda buffer.
In particular, it adds the prefix and corresponding text properties. EXTRA
(time-of-day (and dotime (org-get-time-of-day ts)))
stamp plain s0 s1 s2 rtn srp l
duration thecategory)
- (and (org-mode-p) buffer-file-name
+ (and (eq major-mode 'org-mode) buffer-file-name
(add-to-list 'org-agenda-contributing-files buffer-file-name))
(when (and dotime time-of-day)
;; Extract starting and ending time and move them to prefix
(concat (make-string (max (- 50 (length txt)) 1) ?\ )
(match-string 2 txt))
t t txt))))
- (when (org-mode-p)
+ (when (eq major-mode 'org-mode)
(setq effort
(condition-case nil
(org-get-effort
(while (setq time (pop gridtimes))
(unless (and remove (member time have))
(setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
- (push (org-format-agenda-item
+ (push (org-agenda-format-item
nil string "" nil
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property
2 (length (car new)) 'face 'org-time-grid (car new))))
(when (and todayp org-agenda-show-current-time-in-grid)
- (push (org-format-agenda-item
+ (push (org-agenda-format-item
nil
org-agenda-current-time-string
"" nil
The resulting form is returned and stored in the variable
`org-prefix-format-compiled'."
(setq org-prefix-has-time nil org-prefix-has-tag nil
- org-prefix-category-length nil org-prefix-has-effort nil)
+ org-prefix-category-length nil
+ org-prefix-has-effort nil)
(let ((s (cond
((stringp org-agenda-prefix-format)
org-agenda-prefix-format)
(defun org-agenda-highlight-todo (x)
(let ((org-done-keywords org-done-keywords-for-agenda)
(case-fold-search nil)
- re)
+ re)
(if (eq x 'line)
(save-excursion
(beginning-of-line 1)
(let ((pl (text-property-any 0 (length x) 'org-heading t x)))
(setq re (get-text-property 0 'org-todo-regexp x))
(when (and re
+ ;; Test `pl' because if there's no heading content,
+ ;; there's no point matching to highlight. Note
+ ;; that if we didn't test `pl' first, and there
+ ;; happened to be no keyword from `org-todo-regexp'
+ ;; on this heading line, then the `equal' comparison
+ ;; afterwards would spuriously succeed in the case
+ ;; where `pl' is nil -- causing an args-out-of-range
+ ;; error when we try to add text properties to text
+ ;; that isn't there.
+ pl
(equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
- x (or pl 0)) pl))
+ x pl) pl))
(add-text-properties
(or (match-end 1) (match-end 0)) (match-end 0)
(list 'face (org-get-todo-face (match-string 2 x)))
- x)
+ x)
(when (match-end 1)
(setq x (concat (substring x 0 (match-end 1))
(format org-agenda-todo-keyword-format
(match-string 2 x))
- (org-add-props " " (text-properties-at 0 x))
- (substring x (match-end 3)))))))
+ (org-add-props " " (text-properties-at 0 x))
+ (substring x (match-end 3)))))))
x)))
(defsubst org-cmp-priority (a b)
(t nil))))
(defsubst org-cmp-effort (a b)
- "Compare the priorities of string A and B."
+ "Compare the effort values of string A and B."
(let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
(ea (or (get-text-property 1 'effort-minutes a) def))
(eb (or (get-text-property 1 'effort-minutes b) def)))
When this is the global TODO list, a prefix argument will be interpreted."
(interactive)
(let* ((org-agenda-keep-modes t)
- (filter org-agenda-filter)
- (preset (get 'org-agenda-filter :preset-filter))
- (org-agenda-filter-while-redo (or filter preset))
+ (tag-filter org-agenda-tag-filter)
+ (tag-preset (get 'org-agenda-tag-filter :preset-filter))
+ (cat-filter org-agenda-category-filter)
+ (cat-preset (get 'org-agenda-category-filter :preset-filter))
+ (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
(lprops (get 'org-agenda-redo-command 'org-lprops)))
- (put 'org-agenda-filter :preset-filter nil)
+ (put 'org-agenda-tag-filter :preset-filter nil)
+ (put 'org-agenda-category-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(org-let lprops '(eval org-agenda-redo-command))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil)
(message "Rebuilding agenda buffer...done")
- (put 'org-agenda-filter :preset-filter preset)
- (and (or filter preset) (org-agenda-filter-apply filter))
+ (put 'org-agenda-tag-filter :preset-filter tag-preset)
+ (put 'org-agenda-category-filter :preset-filter cat-preset)
+ (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag))
+ (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category))
(and cols (org-called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(recenter window-line)))
-
(defvar org-global-tags-completion-table nil)
(defvar org-agenda-filter-form nil)
+(defvar org-agenda-filtered-by-category nil)
+
+(defun org-agenda-filter-by-category (strip)
+ "Keep only those lines in the agenda buffer that have a specific category.
+The category is that of the current line."
+ (interactive "P")
+ (if org-agenda-filtered-by-category
+ (org-agenda-filter-show-all-cat)
+ (let ((cat (org-no-properties (get-text-property (point) 'org-category))))
+ (if cat (org-agenda-filter-apply
+ (list (concat (if strip "-" "+") cat)) 'category)
+ (error "No category at point")))))
+
(defun org-agenda-filter-by-tag (strip &optional char narrow)
"Keep only those lines in the agenda buffer that have a specific tag.
The tag is selected with its fast selection letter, as configured.
(effort-op org-agenda-filter-effort-default-operator)
(effort-prompt "")
(inhibit-read-only t)
- (current org-agenda-filter)
+ (current org-agenda-tag-filter)
maybe-refresh a n tag)
(unless char
(message
"%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
(if narrow "Narrow" "Filter") tag-chars
(if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char)))
+ (setq char (read-char-exclusive)))
(when (member char '(?+ ?-))
;; Narrowing down
(cond ((equal char ?-) (setq strip t narrow t))
((equal char ?+) (setq strip nil narrow t)))
(message
"Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
- (setq char (read-char)))
+ (setq char (read-char-exclusive)))
(when (member char '(?< ?> ?= ??))
;; An effort operator
(setq effort-op (char-to-string char))
(if (= i 9) "0" (int-to-string (1+ i)))
"]" (nth i efforts))))
(message "Effort%s: %s " effort-op effort-prompt)
- (setq char (read-char))
+ (setq char (read-char-exclusive))
(when (or (< char ?0) (> char ?9))
(error "Need 1-9,0 to select effort" ))))
(when (equal char ?\t)
"Tag: " org-global-tags-completion-table))))
(cond
((equal char ?\r)
- (org-agenda-filter-by-tag-show-all)
+ (org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
- (setq org-agenda-filter '())
+ (setq org-agenda-tag-filter '())
(dolist (tag (org-agenda-get-represented-tags))
(let ((modifier (funcall org-agenda-auto-exclude-function tag)))
(if modifier
- (push modifier org-agenda-filter))))
- (if (not (null org-agenda-filter))
- (org-agenda-filter-apply org-agenda-filter)))
+ (push modifier org-agenda-tag-filter))))
+ (if (not (null org-agenda-tag-filter))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
(setq maybe-refresh t))
((equal char ?/)
- (org-agenda-filter-by-tag-show-all)
- (when (get 'org-agenda-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-filter))
+ (org-agenda-filter-show-all-tag)
+ (when (get 'org-agenda-tag-filter :preset-filter)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (setq maybe-refresh t))
+ ((equal char ?. )
+ (setq org-agenda-tag-filter
+ (mapcar (lambda(tag) (concat "+" tag))
+ (org-get-at-bol 'tags)))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)
(setq maybe-refresh t))
((or (equal char ?\ )
(setq a (rassoc char alist))
(setq tag "?eff")
a (cons tag nil))
(and tag (setq a (cons tag nil))))
- (org-agenda-filter-by-tag-show-all)
+ (org-agenda-filter-show-all-tag)
(setq tag (car a))
- (setq org-agenda-filter
+ (setq org-agenda-tag-filter
(cons (concat (if strip "-" "+") tag)
(if narrow current nil)))
- (org-agenda-filter-apply org-agenda-filter)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)
(setq maybe-refresh t))
(t (error "Invalid tag selection character %c" char)))
(when (and maybe-refresh
tags))
(defun org-agenda-filter-by-tag-refine (strip &optional char)
- "Refine the current filter. See `org-agenda-filter-by-tag."
+ "Refine the current filter. See `org-agenda-filter-by-tag'."
(interactive "P")
(org-agenda-filter-by-tag strip char 'refine))
(defun org-agenda-filter-make-matcher ()
- "Create the form that tests a line for the agenda filter."
+ "Create the form that tests a line for agenda filter."
(let (f f1)
- (dolist (x (append (get 'org-agenda-filter :preset-filter)
- org-agenda-filter))
+ ;; first compute the tag-filter matcher
+ (dolist (x (delete-dups
+ (append (get 'org-agenda-tag-filter
+ :preset-filter) org-agenda-tag-filter)))
(if (member x '("-" "+"))
(setq f1 (if (equal x "-") 'tags '(not tags)))
(if (string-match "[<=>?]" x)
(if (equal (string-to-char x) ?-)
(setq f1 (list 'not f1))))
(push f1 f))
+ ;; then compute the category-filter matcher
+ (dolist (x (delete-dups
+ (append (get 'org-agenda-category-filter
+ :preset-filter) org-agenda-category-filter)))
+ (if (equal "-" (substring x 0 1))
+ (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
+ (setq f1 (list 'equal (substring x 1) 'cat)))
+ (push f1 f))
(cons 'and (nreverse f))))
(defun org-agenda-filter-effort-form (e)
(funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
value))))
-(defun org-agenda-filter-apply (filter)
+(defun org-agenda-filter-apply (filter type)
"Set FILTER as the new agenda filter and apply it."
- (let (tags)
- (setq org-agenda-filter filter
- org-agenda-filter-form (org-agenda-filter-make-matcher))
+ (let (tags cat)
+ (if (eq type 'tag)
+ (setq org-agenda-tag-filter filter)
+ (setq org-agenda-category-filter filter))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher))
+ (if (and (eq type 'category)
+ (not (equal (substring (car filter) 0 1) "-")))
+ ;; Only set `org-agenda-filtered-by-category' to t
+ ;; when a unique category is used as the filter
+ (setq org-agenda-filtered-by-category t))
(org-agenda-set-mode-name)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags (org-get-at-bol 'tags)) ; used in eval
+ (setq tags (org-get-at-bol 'tags) ; used in eval
+ cat (get-text-property (point) 'org-category))
(if (not (eval org-agenda-filter-form))
- (org-agenda-filter-by-tag-hide-line))
+ (org-agenda-filter-hide-line type))
(beginning-of-line 2))
(beginning-of-line 2))))
(if (get-char-property (point) 'invisible)
- (org-agenda-previous-line))))
+ (ignore-errors (org-agenda-previous-line)))))
-(defun org-agenda-filter-by-tag-hide-line ()
+(defun org-agenda-filter-hide-line (type)
(let (ov)
(setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
(point-at-eol)))
(overlay-put ov 'invisible t)
- (overlay-put ov 'type 'tags-filter)
- (push ov org-agenda-filter-overlays)))
+ (overlay-put ov 'type type)
+ (if (eq type 'tag)
+ (push ov org-agenda-tag-filter-overlays)
+ (push ov org-agenda-cat-filter-overlays))))
(defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
(setq pos (or pos (point)))
(save-excursion
(dolist (ov (overlays-at pos))
(when (and (overlay-get ov 'invisible)
- (eq (overlay-get ov 'type) 'tags-filter))
+ (eq (overlay-get ov 'type) 'tag))
(goto-char pos)
(if (< (overlay-start ov) (point-at-eol))
(move-overlay ov (point-at-eol)
(overlay-end ov)))))))
-(defun org-agenda-filter-by-tag-show-all ()
- (mapc 'delete-overlay org-agenda-filter-overlays)
- (setq org-agenda-filter-overlays nil)
- (setq org-agenda-filter nil)
- (setq org-agenda-filter-form nil)
+(defun org-agenda-filter-show-all-tag nil
+ (mapc 'delete-overlay org-agenda-tag-filter-overlays)
+ (setq org-agenda-tag-filter-overlays nil
+ org-agenda-tag-filter nil
+ org-agenda-filter-form nil)
+ (org-agenda-set-mode-name))
+
+(defun org-agenda-filter-show-all-cat nil
+ (mapc 'delete-overlay org-agenda-cat-filter-overlays)
+ (setq org-agenda-cat-filter-overlays nil
+ org-agenda-filtered-by-category nil
+ org-agenda-category-filter nil
+ org-agenda-filter-form nil)
(org-agenda-set-mode-name))
(defun org-agenda-manipulate-query-add ()
(interactive)
(setq org-agenda-follow-mode (not org-agenda-follow-mode))
(org-agenda-set-mode-name)
- (if (and org-agenda-follow-mode (org-get-at-bol 'org-marker))
- (org-agenda-show))
+ (org-agenda-do-context-action)
(message "Follow mode is %s"
(if org-agenda-follow-mode "on" "off")))
((eq org-agenda-show-log 'clockcheck) " ClkCk")
(org-agenda-show-log " Log")
(t ""))
- (if (or org-agenda-filter (get 'org-agenda-filter
+ (if (or org-agenda-category-filter (get 'org-agenda-category-filter
+ :preset-filter))
+ '(:eval (org-propertize
+ (concat " <"
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-category-filter :preset-filter)
+ org-agenda-category-filter)
+ "")
+ ">")
+ 'face 'org-agenda-filter-category
+ 'help-echo "Category used in filtering"))
+ "")
+ (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter
:preset-filter))
- (concat " {" (mapconcat
- 'identity
- (append (get 'org-agenda-filter
- :preset-filter)
- org-agenda-filter) "") "}")
+ '(:eval (org-propertize
+ (concat " {"
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-tag-filter :preset-filter)
+ org-agenda-tag-filter)
+ "")
+ "}")
+ 'face 'org-agenda-filter-tags
+ 'help-echo "Tags used in filtering"))
"")
(if org-agenda-archives-mode
(if (eq org-agenda-archives-mode t)
(defun org-agenda-do-context-action ()
"Show outline path and, maybe, follow mode window."
(let ((m (org-get-at-bol 'org-marker)))
- (if (and org-agenda-follow-mode m)
- (org-agenda-show))
- (if (and m org-agenda-show-outline-path)
- (org-with-point-at m
- (org-display-outline-path t)))))
+ (when (and (markerp m) (marker-buffer m))
+ (and org-agenda-follow-mode
+ (if org-agenda-follow-indirect
+ (org-agenda-tree-to-indirect-buffer)
+ (org-agenda-show)))
+ (and org-agenda-show-outline-path
+ (org-with-point-at m (org-display-outline-path t))))))
(defun org-agenda-show-priority ()
"Show the priority of the current item.
(widen)
(push-mark)
(goto-char pos)
- (when (org-mode-p)
+ (when (eq major-mode 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)
(with-current-buffer buffer
(save-excursion
(goto-char pos)
- (if (and (org-mode-p) (not (member type '("sexp"))))
+ (if (and (eq major-mode 'org-mode) (not (member type '("sexp"))))
(setq dbeg (progn (org-back-to-heading t) (point))
dend (org-end-of-subtree t t))
(setq dbeg (point-at-bol)
(pos (marker-position marker)))
(org-with-remote-undo buffer
(with-current-buffer buffer
- (if (org-mode-p)
+ (if (eq major-mode 'org-mode)
(if (and confirm
(not (y-or-n-p "Archive this subtree or entry? ")))
(error "Abort")
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
- (switch-to-buffer buffer)
+ (org-pop-to-buffer-same-window buffer)
(and delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
- (when (org-mode-p)
+ (when (eq major-mode 'org-mode)
(org-show-context 'agenda)
(save-excursion
(and (outline-next-heading)
With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't
use the dedicated frame)."
(interactive)
+ (if (and current-prefix-arg (listp current-prefix-arg))
+ (org-agenda-do-tree-to-indirect-buffer)
+ (let ((agenda-window (selected-window))
+ (indirect-window
+ (and org-last-indirect-buffer
+ (get-buffer-window org-last-indirect-buffer))))
+ (save-window-excursion (org-agenda-do-tree-to-indirect-buffer))
+ (unwind-protect
+ (progn
+ (unless (and indirect-window (window-live-p indirect-window))
+ (setq indirect-window (split-window agenda-window)))
+ (select-window indirect-window)
+ (switch-to-buffer org-last-indirect-buffer :norecord)
+ (fit-window-to-buffer indirect-window))
+ (select-window (get-buffer-window org-agenda-buffer-name))))))
+
+(defun org-agenda-do-tree-to-indirect-buffer ()
+ "Same as `org-agenda-tree-to-indirect-buffer' without saving window."
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
&optional fixface just-this)
"Change all lines in the agenda buffer which match HDMARKER.
The new content of the line will be NEWHEAD (as modified by
-`org-format-agenda-item'). HDMARKER is checked with
+`org-agenda-format-item'). HDMARKER is checked with
`equal' against all `org-hd-marker' text properties in the file.
If FIXFACE is non-nil, the face of each item is modified according to
the new TODO state.
(save-excursion
(save-restriction
(widen)
- (org-format-agenda-item (org-get-at-bol 'extra)
+ (org-agenda-format-item (org-get-at-bol 'extra)
newhead cat tags dotime)))))
pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
undone-face (org-get-at-bol 'undone-face)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
- (pos (marker-position marker)))
+ (pos (marker-position marker))
+ cdate today)
(org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (if (not (org-at-timestamp-p))
- (error "Cannot find time stamp"))
- (org-timestamp-change arg (or what 'day)))
- (org-agenda-show-new-time marker org-last-changed-timestamp))
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (if (not (org-at-timestamp-p))
+ (error "Cannot find time stamp"))
+ (when (and org-agenda-move-date-from-past-immediately-to-today
+ (equal arg 1)
+ (or (not what) (eq what 'day))
+ (not (save-match-data (org-at-date-range-p))))
+ (setq cdate (org-parse-time-string (match-string 0) 'nodefault)
+ cdate (calendar-absolute-from-gregorian
+ (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
+ today (org-today))
+ (if (> today cdate)
+ ;; immediately shift to today
+ (setq arg (- today cdate))))
+ (org-timestamp-change arg (or what 'day))
+ (when (and (org-at-date-range-p)
+ (re-search-backward org-tr-regexp-both (point-at-bol)))
+ (let ((end org-last-changed-timestamp))
+ (org-timestamp-change arg (or what 'day))
+ (setq org-last-changed-timestamp
+ (concat org-last-changed-timestamp "--" end)))))
+ (org-agenda-show-new-time marker org-last-changed-timestamp))
(message "Time stamp changed to %s" org-last-changed-timestamp)))
(defun org-agenda-date-earlier (arg &optional what)
(defcustom org-agenda-insert-diary-extract-time nil
"Non-nil means extract any time specification from the diary entry."
:group 'org-agenda
+ :version "24.1"
:type 'boolean)
(defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
((eq type 'anniversary)
(or (re-search-forward "^*[ \t]+Anniversaries" nil t)
(progn
- (or (org-on-heading-p t)
+ (or (org-at-heading-p t)
(progn
(outline-next-heading)
(insert "* Anniversaries\n\n")
(org-agenda-time-leading-zero t)
fmt time time2)
(if org-agenda-insert-diary-extract-time
- ;; Use org-format-agenda-item to parse text for a time-range and
+ ;; Use org-agenda-format-item to parse text for a time-range and
;; remove it. FIXME: This is a hack, we should refactor
;; that function to make time extraction available separately
- (setq fmt (org-format-agenda-item nil text nil nil t)
+ (setq fmt (org-agenda-format-item nil text nil nil t)
time (get-text-property 0 'time fmt)
time2 (if (> (length time) 0)
;; split-string removes trailing ...... if
(defun org-agenda-bulk-mark (&optional arg)
"Mark the entry at point for future bulk action."
(interactive "p")
- (dotimes (i (max arg 1))
+ (dotimes (i (or arg 1))
(unless (org-get-at-bol 'org-agenda-diary-link)
(let* ((m (org-get-at-bol 'org-hd-marker))
ov)
(defun org-agenda-bulk-mark-regexp (regexp)
"Mark entries match REGEXP."
(interactive "sMark entries matching regexp: ")
- (let (entries-marked)
+ (let ((entries-marked 0))
(save-excursion
(goto-char (point-min))
(goto-char (next-single-property-change (point) 'txt))
(while (re-search-forward regexp nil t)
(when (string-match regexp (get-text-property (point) 'txt))
- (setq entries-marked (+ entries-marked 1))
+ (setq entries-marked (1+ entries-marked))
(call-interactively 'org-agenda-bulk-mark))))
(if (not entries-marked)
(message "No entry matching this regexp."))))
(progn (message "Skipping removed entry at %s" e)
(setq cntskip (1+ cntskip)))
(goto-char pos)
- (eval cmd)
+ (let (org-loop-over-headlines-in-active-region)
+ (eval cmd))
(setq org-agenda-bulk-marked-entries
(delete e org-agenda-bulk-marked-entries))
(setq cnt (1+ cnt))))
(org-agenda-remove-flag hdmarker)
(let ((win (get-buffer-window "*Flagging Note*")))
(and win (delete-window win)))
- (message "Entry unflaged"))
+ (message "Entry unflagged"))
(setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
(unless note
(error "No flagging note"))
(org-entry-delete nil "THEFLAGGINGNOTE")
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead marker)
- (message "Entry unflaged")))
+ (message "Entry unflagged")))
(defun org-agenda-get-any-marker (&optional pos)
(or (get-text-property (or pos (point-at-bol)) 'org-hd-marker)
(defvar appt-time-msg-list)
;;;###autoload
-(defun org-agenda-to-appt (&optional refresh filter)
+(defun org-agenda-to-appt (&optional refresh filter &rest args)
"Activate appointments found in `org-agenda-files'.
With a \\[universal-argument] prefix, refresh the list of
appointments.
If FILTER is a string, use this string as a regular expression
for filtering entries out.
+If FILTER is a function, filter out entries against which
+calling the function returns nil. This function takes one
+argument: an entry from `org-agenda-get-day-entries'.
+
FILTER can also be an alist with the car of each cell being
either 'headline or 'category. For example:
(category \"Work\"))
will only add headlines containing IMPORTANT or headlines
-belonging to the \"Work\" category."
+belonging to the \"Work\" category.
+
+ARGS are symbols indicating what kind of entries to consider.
+By default `org-agenda-to-appt' will use :deadline, :scheduled
+and :timestamp entries. See the docstring of `org-diary' for
+details and examples."
(interactive "P")
(if refresh (setq appt-time-msg-list nil))
(if (eq filter t)
(setq filter (read-from-minibuffer "Regexp filter: ")))
(let* ((cnt 0) ; count added events
+ (scope (or args '(:deadline :scheduled :timestamp)))
(org-agenda-new-buffers nil)
(org-deadline-warning-days 0)
;; Do not use `org-today' here because appt only takes
(org-prepare-agenda-buffers files)
(while (setq file (pop files))
(setq entries
- (append entries
- (org-agenda-get-day-entries
- file today :timestamp :scheduled :deadline))))
- (setq entries (delq nil entries))
+ (delq nil
+ (append entries
+ (apply 'org-agenda-get-day-entries
+ file today scope)))))
;; Map thru entries and find if we should filter them out
(mapc
(lambda(x)
(tod (get-text-property 1 'time-of-day x))
(ok (or (null filter)
(and (stringp filter) (string-match filter evt))
+ (and (functionp filter) (funcall filter x))
(and (listp filter)
- (or (string-match
- (cadr (assoc 'category filter)) cat)
- (string-match
- (cadr (assoc 'headline filter)) evt))))))
+ (let ((cat-filter (cadr (assoc 'category filter)))
+ (evt-filter (cadr (assoc 'headline filter))))
+ (or (and (stringp cat-filter)
+ (string-match cat-filter cat))
+ (and (stringp evt-filter)
+ (string-match evt-filter evt))))))))
;; FIXME: Shall we remove text-properties for the appt text?
;; (setq evt (set-text-properties 0 (length evt) nil evt))
(when (and ok tod)
date)))
(eq date today)))
-(provide 'org-agenda)
-
+(defun org-agenda-todo-yesterday (&optional arg)
+ "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday"
+ (interactive "P")
+ (let* ((hour (third (decode-time
+ (org-current-time))))
+ (org-extend-today-until (1+ hour)))
+ (org-agenda-todo arg)))
+(provide 'org-agenda)
;;; org-agenda.el ends here
HCoop / bpt / emacs.git / blobdiff