diff options
Diffstat (limited to 'elpa/org-9.5.2/org-agenda.el')
| -rw-r--r-- | elpa/org-9.5.2/org-agenda.el | 10892 |
1 files changed, 10892 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/org-agenda.el b/elpa/org-9.5.2/org-agenda.el new file mode 100644 index 0000000..59bdd5b --- /dev/null +++ b/elpa/org-9.5.2/org-agenda.el @@ -0,0 +1,10892 @@ +;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*- + +;; Copyright (C) 2004-2021 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten.dominik@gmail.com> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains the code for creating and using the Agenda for Org. +;; +;; 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: + +(require 'cl-lib) +(require 'ol) +(require 'org) +(require 'org-macs) +(require 'org-refile) + +(declare-function diary-add-to-list "diary-lib" + (date string specifier &optional marker globcolor literal)) +(declare-function calendar-iso-to-absolute "cal-iso" (date)) +(declare-function calendar-astro-date-string "cal-julian" (&optional date)) +(declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) +(declare-function calendar-chinese-date-string "cal-china" (&optional date)) +(declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) +(declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) +(declare-function calendar-french-date-string "cal-french" (&optional date)) +(declare-function calendar-goto-date "cal-move" (date)) +(declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) +(declare-function calendar-islamic-date-string "cal-islam" (&optional date)) +(declare-function calendar-iso-date-string "cal-iso" (&optional date)) +(declare-function calendar-iso-from-absolute "cal-iso" (date)) +(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-columns-remove-overlays "org-colview" ()) +(declare-function org-datetree-find-date-create "org-datetree" + (date &optional keep-restriction)) +(declare-function org-columns-quit "org-colview" ()) +(declare-function diary-date-display-form "diary-lib" (&optional type)) +(declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file)) +(declare-function org-habit-insert-consistency-graphs + "org-habit" (&optional line)) +(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-agenda-columns "org-colview" ()) +(declare-function org-add-archive-files "org-archive" (files)) +(declare-function org-capture "org-capture" (&optional goto keys)) +(declare-function org-clock-modify-effort-estimate "org-clock" (&optional value)) + +(defvar calendar-mode-map) +(defvar org-clock-current-task) +(defvar org-current-tag-alist) +(defvar org-mobile-force-id-on-agenda-items) +(defvar org-habit-show-habits) +(defvar org-habit-show-habits-only-for-today) +(defvar org-habit-show-all-today) +(defvar org-habit-scheduled-past-days) + +;; Defined somewhere in this file, but used before definition. +(defvar org-agenda-buffer-name "*Org Agenda*") +(defvar org-agenda-overriding-header nil) +(defvar org-agenda-title-append nil) +;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el +;; (with-no-warnings (defvar date)) ;; unprefixed, from calendar.el +(defvar original-date) ; dynamically scoped, calendar.el does scope this + +(defvar org-agenda-undo-list nil + "List of undoable operations in the agenda since last refresh.") +(defvar org-agenda-pending-undo-list nil + "In a series of undo commands, this is the list of remaining undo items.") + +(defcustom org-agenda-confirm-kill 1 + "When set, remote killing from the agenda buffer needs confirmation. +When t, a confirmation is always needed. When a number N, confirmation is +only needed when the text to be killed contains more than N non-white lines." + :group 'org-agenda + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (integer :tag "When more than N lines"))) + +(defcustom org-agenda-compact-blocks nil + "Non-nil means make the block agenda more compact. +This is done globally by leaving out lines like the agenda span +name and week number or the separator lines." + :group 'org-agenda + :type 'boolean) + +(defcustom org-agenda-block-separator ?= + "The separator between blocks in the agenda. +If this is a string, it will be used as the separator, with a newline added. +If it is a character, it will be repeated to fill the window width. +If nil the separator is disabled. In `org-agenda-custom-commands' this +addresses the separator between the current and the previous block." + :group 'org-agenda + :type '(choice + (const :tag "Disabled" nil) + (character) + (string))) + +(defgroup org-agenda-export nil + "Options concerning exporting agenda views in Org mode." + :tag "Org Agenda Export" + :group 'org-agenda) + +(defcustom org-agenda-with-colors t + "Non-nil means use colors in agenda views." + :group 'org-agenda-export + :type 'boolean) + +(defcustom org-agenda-exporter-settings nil + ;; FIXME: Do we really want to evaluate those settings and thus force + ;; the user to use `quote' all the time? + "Alist of variable/value pairs that should be active during agenda export. +This is a good place to set options for ps-print and for htmlize. +Note that the way this is implemented, the values will be evaluated +before assigned to the variables. So make sure to quote values you do +*not* want evaluated, for example + + (setq org-agenda-exporter-settings + \\='((ps-print-color-p \\='black-white)))" + :group 'org-agenda-export + :type '(repeat + (list + (variable) + (sexp :tag "Value")))) + +(defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) + "Hook run in a temporary buffer before writing the agenda to an export file. +A useful function for this hook is `org-agenda-add-entry-text'." + :group 'org-agenda-export + :type 'hook + :options '(org-agenda-add-entry-text)) + +(defcustom org-agenda-add-entry-text-maxlines 0 + "Maximum number of entry text lines to be added to agenda. +This is only relevant when `org-agenda-add-entry-text' is part of +`org-agenda-before-write-hook', which is the default. +When this is 0, nothing will happen. When it is greater than 0, it +specifies the maximum number of lines that will be added for each entry +that is listed in the agenda view. + +Note that this variable is not used during display, only when exporting +the agenda. For agenda display, see the variables `org-agenda-entry-text-mode' +and `org-agenda-entry-text-maxlines'." + :group 'org-agenda + :type 'integer) + +(defcustom org-agenda-add-entry-text-descriptive-links t + "Non-nil means export org-links as descriptive links in agenda added text. +This variable applies to the text added to the agenda when +`org-agenda-add-entry-text-maxlines' is larger than 0. +When this variable is nil, the URL will (also) be shown." + :group 'org-agenda + :type 'boolean) + +(defcustom org-agenda-export-html-style nil + "The style specification for exported HTML Agenda files. +If this variable contains a string, it will replace the default <style> +section as produced by `htmlize'. +Since there are different ways of setting style information, this variable +needs to contain the full HTML structure to provide a style, including the +surrounding HTML tags. The style specifications should include definitions +the fonts used by the agenda, here is an example: + + <style type=\"text/css\"> + p { font-weight: normal; color: gray; } + .org-agenda-structure { + font-size: 110%; + color: #003399; + font-weight: 600; + } + .org-todo { + color: #cc6666; + font-weight: bold; + } + .org-agenda-done { + color: #339933; + } + .org-done { + color: #339933; + } + .title { text-align: center; } + .todo, .deadline { color: red; } + .done { color: green; } + </style> + +or, if you want to keep the style in a file, + + <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> + +As the value of this option simply gets inserted into the HTML <head> header, +you can \"misuse\" it to also add other text to the header." + :group 'org-agenda-export + :group 'org-export-html + :type '(choice + (const nil) + (string))) + +(defcustom org-agenda-persistent-filter nil + "When set, keep filters from one agenda view to the next." + :group 'org-agenda + :type 'boolean) + +(defgroup org-agenda-custom-commands nil + "Options concerning agenda views in Org mode." + :tag "Org Agenda Custom Commands" + :group 'org-agenda) + +(defconst org-sorting-choice + '(choice + (const time-up) (const time-down) + (const timestamp-up) (const timestamp-down) + (const scheduled-up) (const scheduled-down) + (const deadline-up) (const deadline-down) + (const ts-up) (const ts-down) + (const tsia-up) (const tsia-down) + (const category-keep) (const category-up) (const category-down) + (const tag-down) (const tag-up) + (const priority-up) (const priority-down) + (const todo-state-up) (const todo-state-down) + (const effort-up) (const effort-down) + (const habit-up) (const habit-down) + (const alpha-up) (const alpha-down) + (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) +(defvaralias 'org-agenda-filter 'org-agenda-tag-filter) + +(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) + "List of types searched for when creating the daily/weekly agenda. +This variable is a list of symbols that controls the types of +items that appear in the daily/weekly agenda. Allowed symbols in this +list are + + :timestamp List items containing a date stamp or date range matching + the selected date. This includes sexp entries in angular + brackets. + + :sexp List entries resulting from plain diary-like sexps. + + :deadline List deadline due on that date. When the date is today, + also list any deadlines past due, or due within + `org-deadline-warning-days'. + + :deadline* Same as above, but only include the deadline if it has an + hour specification as [h]h:mm. + + :scheduled List all items which are scheduled for the given date. + The diary for *today* also contains items which were + scheduled earlier and are not yet marked DONE. + + :scheduled* Same as above, but only include the scheduled item if it + has an hour specification as [h]h:mm. + +By default, all four non-starred types are turned on. + +When :scheduled* or :deadline* are included, :schedule or :deadline +will be ignored. + +Never set this variable globally using `setq', because then it +will apply to all future agenda commands. Instead, bind it with +`let' to scope it dynamically into the agenda-constructing +command. A good way to set it is through options in +`org-agenda-custom-commands'. For a more flexible (though +somewhat less efficient) way of determining what is included in +the daily/weekly agenda, see `org-agenda-skip-function'.") + +(defconst org-agenda-custom-commands-local-options + `(repeat :tag "Local settings for this command. Remember to quote values" + (choice :tag "Setting" + (list :tag "Heading for this block" + (const org-agenda-overriding-header) + (string :tag "Headline")) + (list :tag "Files to be searched" + (const org-agenda-files) + (list + (const :format "" quote) + (repeat (file)))) + (list :tag "Sorting strategy" + (const org-agenda-sorting-strategy) + (list + (const :format "" quote) + (repeat + ,org-sorting-choice))) + (list :tag "Prefix format" + (const org-agenda-prefix-format :value " %-12:c%?-12t% s") + (string)) + (list :tag "Number of days in agenda" + (const org-agenda-span) + (list + (const :format "" quote) + (choice (const :tag "Day" day) + (const :tag "Week" week) + (const :tag "Fortnight" fortnight) + (const :tag "Month" month) + (const :tag "Year" year) + (integer :tag "Custom")))) + (list :tag "Fixed starting date" + (const org-agenda-start-day) + (string :value "2007-11-01")) + (list :tag "Start on day of week" + (const org-agenda-start-on-weekday) + (choice :value 1 + (const :tag "Today" nil) + (integer :tag "Weekday No."))) + (list :tag "Include data from diary" + (const org-agenda-include-diary) + (boolean)) + (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-tag-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+tag or -tag")))) + (list :tag "Effort filter preset" + (const org-agenda-effort-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+=10 or -=10 or +<10 or ->10")))) + (list :tag "Regexp filter preset" + (const org-agenda-regexp-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+regexp or -regexp")))) + (list :tag "Set daily/weekly entry types" + (const org-agenda-entry-types) + (list + (const :format "" quote) + (set :greedy t :value ,org-agenda-entry-types + (const :deadline) + (const :scheduled) + (const :deadline*) + (const :scheduled*) + (const :timestamp) + (const :sexp)))) + (list :tag "Columns format" + (const org-overriding-columns-format) + (string :tag "Format")) + (list :tag "Standard skipping condition" + :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) + (const org-agenda-skip-function) + (list + (const :format "" quote) + (list + (choice + :tag "Skipping range" + (const :tag "Skip entry" org-agenda-skip-entry-if) + (const :tag "Skip subtree" org-agenda-skip-subtree-if)) + (repeat :inline t :tag "Conditions for skipping" + (choice + :tag "Condition type" + (list :tag "Regexp matches" :inline t + (const :format "" regexp) + (regexp)) + (list :tag "Regexp does not match" :inline t + (const :format "" notregexp) + (regexp)) + (list :tag "TODO state is" :inline t + (const todo) + (choice + (const :tag "Any not-done state" todo) + (const :tag "Any done state" done) + (const :tag "Any state" any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) + (list :tag "TODO state is not" :inline t + (const nottodo) + (choice + (const :tag "Any not-done state" todo) + (const :tag "Any done state" done) + (const :tag "Any state" any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) + (const :tag "scheduled" scheduled) + (const :tag "not scheduled" notscheduled) + (const :tag "deadline" deadline) + (const :tag "no deadline" notdeadline) + (const :tag "timestamp" timestamp) + (const :tag "no timestamp" nottimestamp)))))) + (list :tag "Non-standard skipping condition" + :value (org-agenda-skip-function) + (const org-agenda-skip-function) + (sexp :tag "Function or form (quoted!)")) + (list :tag "Any variable" + (variable :tag "Variable") + (sexp :tag "Value (sexp)")))) + "Selection of examples for agenda command settings. +This will be spliced into the custom type of +`org-agenda-custom-commands'.") + + +(defcustom org-agenda-custom-commands + '(("n" "Agenda and all TODOs" ((agenda "") (alltodo "")))) + "Custom commands for the agenda. +\\<org-mode-map> +These commands will be offered on the splash screen displayed by the +agenda dispatcher `\\[org-agenda]'. Each entry is a list like this: + + (key desc type match settings files) + +key The key (one or more characters as a string) to be associated + with the command. +desc A description of the command, when omitted or nil, a default + description is built using MATCH. +type The command type, any of the following symbols: + agenda The daily/weekly agenda. + todo Entries with a specific TODO keyword, in all agenda files. + search Entries containing search words entry or headline. + tags Tags/Property/TODO match in all agenda files. + tags-todo Tags/P/T match in all agenda files, TODO entries only. + todo-tree Sparse tree of specific TODO keyword in *current* file. + tags-tree Sparse tree with all tags matches in *current* file. + occur-tree Occur sparse tree for *current* file. + ... A user-defined function. +match What to search for: + - a single keyword for TODO keyword searches + - a tags/property/todo match expression for searches + - a word search expression for text searches. + - a regular expression for occur searches + For all other commands, this should be the empty string. +settings A list of option settings, similar to that in a let form, so like + this: ((opt1 val1) (opt2 val2) ...). The values will be + evaluated at the moment of execution, so quote them when needed. +files A list of files to write the produced agenda buffer to with + the command `org-store-agenda-views'. + If a file name ends in \".html\", an HTML version of the buffer + is written out. If it ends in \".ps\", a postscript version is + produced. Otherwise, only the plain text is written to the file. + +You can also define a set of commands, to create a composite agenda buffer. +In this case, an entry looks like this: + + (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files) + +where + +desc A description string to be displayed in the dispatcher menu. +cmd An agenda command, similar to the above. However, tree commands + are not allowed, but instead you can get agenda and global todo list. + So valid commands for a set are: + (agenda \"\" settings) + (alltodo \"\" settings) + (stuck \"\" settings) + (todo \"match\" settings files) + (search \"match\" settings files) + (tags \"match\" settings files) + (tags-todo \"match\" settings files) + +Each command can carry a list of options, and another set of options can be +given for the whole set of commands. Individual command options take +precedence over the general options. + +When using several characters as key to a command, the first characters +are prefix commands. For the dispatcher to display useful information, you +should provide a description for the prefix, like + + (setq org-agenda-custom-commands + \\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" + (\"hl\" tags \"+HOME+Lisa\") + (\"hp\" tags \"+HOME+Peter\") + (\"hk\" tags \"+HOME+Kim\")))" + :group 'org-agenda-custom-commands + :type `(repeat + (choice :value ("x" "Describe command here" tags "" nil) + (list :tag "Single command" + (string :tag "Access Key(s) ") + (option (string :tag "Description")) + (choice + (const :tag "Agenda" agenda) + (const :tag "TODO list" alltodo) + (const :tag "Search words" search) + (const :tag "Stuck projects" stuck) + (const :tag "Tags/Property match (all agenda files)" tags) + (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) + (const :tag "TODO keyword search (all agenda files)" todo) + (const :tag "Tags sparse tree (current buffer)" tags-tree) + (const :tag "TODO keyword tree (current buffer)" todo-tree) + (const :tag "Occur tree (current buffer)" occur-tree) + (sexp :tag "Other, user-defined function")) + (string :tag "Match (only for some commands)") + ,org-agenda-custom-commands-local-options + (option (repeat :tag "Export" (file :tag "Export to")))) + (list :tag "Command series, all agenda files" + (string :tag "Access Key(s)") + (string :tag "Description ") + (repeat :tag "Component" + (choice + (list :tag "Agenda" + (const :format "" agenda) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "TODO list (all keywords)" + (const :format "" alltodo) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "Search words" + (const :format "" search) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Stuck projects" + (const :format "" stuck) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "Tags/Property match (all agenda files)" + (const :format "" tags) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Tags/Property match of TODO entries (all agenda files)" + (const :format "" tags-todo) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "TODO keyword search" + (const :format "" todo) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Other, user-defined function" + (symbol :tag "function") + (string :tag "Match") + ,org-agenda-custom-commands-local-options))) + + (repeat :tag "Settings for entire command set" + (list (variable :tag "Any variable") + (sexp :tag "Value"))) + (option (repeat :tag "Export" (file :tag "Export to")))) + (cons :tag "Prefix key documentation" + (string :tag "Access Key(s)") + (string :tag "Description "))))) + +(defcustom org-agenda-query-register ?o + "The register holding the current query string. +The purpose of this is that if you construct a query string interactively, +you can then use it to define a custom command." + :group 'org-agenda-custom-commands + :type 'character) + +(defcustom org-stuck-projects + '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") + "How to identify stuck projects. +This is a list of four items: +1. A tags/todo/property matcher string that is used to identify a project. + See the manual for a description of tag and property searches. + The entire tree below a headline matched by this is considered one project. +2. A list of TODO keywords identifying non-stuck projects. + If the project subtree contains any headline with one of these todo + keywords, the project is considered to be not stuck. If you specify + \"*\" as a keyword, any TODO keyword will mark the project unstuck. +3. A list of tags identifying non-stuck projects. + If the project subtree contains any headline with one of these tags, + the project is considered to be not stuck. If you specify \"*\" as + a tag, any tag will mark the project unstuck. Note that this is about + the explicit presence of a tag somewhere in the subtree, inherited + tags do not count here. If inherited tags make a project not stuck, + use \"-TAG\" in the tags part of the matcher under (1.) above. +4. An arbitrary regular expression matching non-stuck projects. + +If the project turns out to be not stuck, search continues also in the +subtree to see if any of the subtasks have project status. + +See also the variable `org-tags-match-list-sublevels' which applies +to projects matched by this search as well. + +After defining this variable, you may use `org-agenda-list-stuck-projects' +\(bound to `\\[org-agenda] #') to produce the list." + :group 'org-agenda-custom-commands + :type '(list + (string :tag "Tags/TODO match to identify a project") + (repeat :tag "Projects are *not* stuck if they have an entry with \ +TODO keyword any of" (string)) + (repeat :tag "Projects are *not* stuck if they have an entry with \ +TAG being any of" (string)) + (regexp :tag "Projects are *not* stuck if this regexp matches inside \ +the subtree"))) + +(defgroup org-agenda-skip nil + "Options concerning skipping parts of agenda files." + :tag "Org Agenda Skip" + :group 'org-agenda) + +(defcustom org-agenda-skip-function-global nil + "Function to be called at each match during agenda construction. +If this function returns nil, the current match should not be skipped. +If the function decided to skip an agenda match, is must return the +buffer position from which the search should be continued. +This may also be a Lisp form, which will be evaluated. + +This variable will be applied to every agenda match, including +tags/property searches and TODO lists. So try to make the test function +do its checking as efficiently as possible. To implement a skipping +condition just for specific agenda commands, use the variable +`org-agenda-skip-function' which can be set in the options section +of custom agenda commands." + :group 'org-agenda-skip + :type 'sexp) + +(defgroup org-agenda-daily/weekly nil + "Options concerning the daily/weekly agenda." + :tag "Org Agenda Daily/Weekly" + :group 'org-agenda) +(defgroup org-agenda-todo-list nil + "Options concerning the global todo list agenda view." + :tag "Org Agenda Todo List" + :group 'org-agenda) +(defgroup org-agenda-match-view nil + "Options concerning the general tags/property/todo match agenda view." + :tag "Org Agenda Match View" + :group 'org-agenda) +(defgroup org-agenda-search-view nil + "Options concerning the search agenda view." + :tag "Org Agenda Search View" + :group 'org-agenda) + +(defvar org-agenda-archives-mode nil + "Non-nil means the agenda will include archived items. +If this is the symbol `trees', trees in the selected agenda scope +that are marked with the ARCHIVE tag will be included anyway. When this is +t, also all archive files associated with the current selection of agenda +files will be included.") + +(defcustom org-agenda-restriction-lock-highlight-subtree t + "Non-nil means highlight the whole subtree when restriction is active. +Otherwise only highlight the headline. Highlighting the whole subtree is +useful to ensure no edits happen beyond the restricted region." + :group 'org-agenda + :type 'boolean) + +(defcustom org-agenda-skip-comment-trees t + "Non-nil means skip trees that start with the COMMENT keyword. +When nil, these trees are also scanned by agenda commands." + :group 'org-agenda-skip + :type 'boolean) + +(defcustom org-agenda-todo-list-sublevels t + "Non-nil means check also the sublevels of a TODO entry for TODO entries. +When nil, the sublevels of a TODO entry are not checked, resulting in +potentially much shorter TODO lists." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :type 'boolean) + +(defcustom org-agenda-todo-ignore-with-date nil + "Non-nil means don't show entries with a date in the global todo list. +You can use this if you prefer to mark mere appointments with a TODO keyword, +but don't want them to show up in the TODO list. +When this is set, it also covers deadlines and scheduled items, the settings +of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' +will be ignored. +See also the variable `org-agenda-tags-todo-honor-ignore-options'." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :type 'boolean) + +(defcustom org-agenda-todo-ignore-timestamp nil + "Non-nil means don't show entries with a timestamp. +This applies when creating the global todo list. +Valid values are: + +past Don't show entries for today or in the past. + +future Don't show entries with a timestamp in the future. + The idea behind this is that if it has a future + timestamp, you don't want to think about it until the + date. + +all Don't show any entries with a timestamp in the global todo list. + The idea behind this is that by setting a timestamp, you + have already \"taken care\" of this item. + +This variable can also have an integer as a value. If positive (N), +todos with a timestamp N or more days in the future will be ignored. If +negative (-N), todos with a timestamp N or more days in the past will be +ignored. If 0, todos with a timestamp either today or in the future will +be ignored. For example, a value of -1 will exclude todos with a +timestamp in the past (yesterday or earlier), while a value of 7 will +exclude todos with a timestamp a week or more in the future. + +See also `org-agenda-todo-ignore-with-date'. +See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want +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) + (const :tag "Ignore all timestamp todos" all) + (const :tag "Show timestamp todos" nil) + (integer :tag "Ignore if N or more days in past(-) or future(+)."))) + +(defcustom org-agenda-todo-ignore-scheduled nil + "Non-nil means, ignore some scheduled TODO items when making TODO list. +This applies when creating the global todo list. +Valid values are: + +past Don't show entries scheduled today or in the past. + +future Don't show entries scheduled in the future. + The idea behind this is that by scheduling it, you don't want to + think about it until the scheduled date. + +all Don't show any scheduled entries in the global todo list. + The idea behind this is that by scheduling it, you have already + \"taken care\" of this item. + +t Same as `all', for backward compatibility. + +This variable can also have an integer as a value. See +`org-agenda-todo-ignore-timestamp' for more details. + +See also `org-agenda-todo-ignore-with-date'. +See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want +to make his option also apply to the tags-todo list." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :type '(choice + (const :tag "Ignore future-scheduled todos" future) + (const :tag "Ignore past- or present-scheduled todos" past) + (const :tag "Ignore all scheduled todos" all) + (const :tag "Ignore all scheduled todos (compatibility)" t) + (const :tag "Show scheduled todos" nil) + (integer :tag "Ignore if N or more days in past(-) or future(+)."))) + +(defcustom org-agenda-todo-ignore-deadlines nil + "Non-nil means ignore some deadline TODO items when making TODO list. + +There are different motivations for using different values, please think +carefully when configuring this variable. + +This applies when creating the global TODO list. + +Valid values are: + +near Don't show near deadline entries. A deadline is near when it is + closer than `org-deadline-warning-days' days. The idea behind this + is that such items will appear in the agenda anyway. + +far Don't show TODO entries where a deadline has been defined, but + is not going to happen anytime soon. This is useful if you want to use + the TODO list to figure out what to do now. + +past Don't show entries with a deadline timestamp for today or in the past. + +future Don't show entries with a deadline timestamp in the future, not even + when they become `near' ones. Use it with caution. + +all Ignore all TODO entries that do have a deadline. + +t Same as `near', for backward compatibility. + +This variable can also have an integer as a value. See +`org-agenda-todo-ignore-timestamp' for more details. + +See also `org-agenda-todo-ignore-with-date'. +See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want +to make his option also apply to the tags-todo list." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :type '(choice + (const :tag "Ignore near deadlines" near) + (const :tag "Ignore near deadlines (compatibility)" t) + (const :tag "Ignore far deadlines" far) + (const :tag "Ignore all TODOs with a deadlines" all) + (const :tag "Show all TODOs, even if they have a deadline" nil) + (integer :tag "Ignore if N or more days in past(-) or future(+)."))) + +(defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil + "Time unit to use when possibly ignoring an agenda item. + +See the docstring of various `org-agenda-todo-ignore-*' options. +The default is to compare time stamps using days. An item is thus +considered to be in the future if it is at least one day after today. +Non-nil means to compare time stamps using seconds. An item is then +considered future if it has a time value later than current time." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Compare time with days" nil) + (const :tag "Compare time with seconds" t))) + +(defcustom org-agenda-tags-todo-honor-ignore-options nil + "Non-nil means honor todo-list ignores options also in tags-todo search. +The variables + `org-agenda-todo-ignore-with-date', + `org-agenda-todo-ignore-timestamp', + `org-agenda-todo-ignore-scheduled', + `org-agenda-todo-ignore-deadlines' +make the global TODO list skip entries that have time stamps of certain +kinds. If this option is set, the same options will also apply for the +tags-todo search, which is the general tags/property matcher +restricted to unfinished TODO entries only." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :group 'org-agenda-match-view + :type 'boolean) + +(defcustom org-agenda-skip-scheduled-if-done nil + "Non-nil means don't show scheduled items in agenda when they are done. +This is relevant for the daily/weekly agenda, not for the TODO list. It +applies only to the actual date of the scheduling. Warnings about an item +with a past scheduling dates are always turned off when the item is DONE." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil + "Non-nil means skip scheduling line if same entry shows because of deadline. + +In the agenda of today, an entry can show up multiple times +because it is both scheduled and has a nearby deadline, and maybe +a plain time stamp as well. + +When this variable is nil, the entry will be shown several times. + +When set to t, then only the deadline is shown and the fact that +the entry is scheduled today or was scheduled previously is not +shown. + +When set to the symbol `not-today', skip scheduled previously, +but not scheduled today. + +When set to the symbol `repeated-after-deadline', skip scheduled +items if they are repeated beyond the current deadline." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Not when scheduled today" not-today) + (const :tag "When repeated past deadline" repeated-after-deadline))) + +(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil + "Non-nil means skip timestamp line if same entry shows because of deadline. +In the agenda of today, an entry can show up multiple times +because it has both a plain timestamp and has a nearby deadline. +When this variable is t, then only the deadline is shown and the +fact that the entry has a timestamp for or including today is not +shown. When this variable is nil, the entry will be shown +several times." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :version "24.1" + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t))) + +(defcustom org-agenda-skip-deadline-if-done nil + "Non-nil means don't show deadlines when the corresponding item is done. +When nil, the deadline is still shown and should give you a happy feeling. +This is relevant for the daily/weekly agenda. It applies only to the +actual date of the deadline. Warnings about approaching and past-due +deadlines are always turned off when the item is DONE." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil + "Non-nil means skip deadline prewarning when entry is also scheduled. +This will apply on all days where a prewarning for the deadline would +be shown, but not at the day when the entry is actually due. On that day, +the deadline will be shown anyway. +This variable may be set to nil, t, the symbol `pre-scheduled', +or a number which will then give the number of days before the actual +deadline when the prewarnings should resume. The symbol `pre-scheduled' +eliminates the deadline prewarning only prior to the scheduled date. +This can be used in a workflow where the first showing of the deadline will +trigger you to schedule it, and then you don't want to be reminded of it +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 "Always show prewarning" nil) + (const :tag "Remove prewarning prior to scheduled date" pre-scheduled) + (const :tag "Remove prewarning if entry is scheduled" t) + (integer :tag "Restart prewarning N days before deadline"))) + +(defcustom org-agenda-skip-scheduled-delay-if-deadline nil + "Non-nil means skip scheduled delay when entry also has a deadline. +This variable may be set to nil, t, the symbol `post-deadline', +or a number which will then give the number of days after the actual +scheduled date when the delay should expire. The symbol `post-deadline' +eliminates the schedule delay when the date is posterior to the deadline." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Always honor delay" nil) + (const :tag "Ignore delay if posterior to the deadline" post-deadline) + (const :tag "Ignore delay if entry has a deadline" t) + (integer :tag "Honor delay up until N days after the scheduled date"))) + +(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-skip + :type 'boolean) + +(defcustom org-agenda-skip-timestamp-if-done nil + "Non-nil means don't select item by timestamp or -range if it is DONE." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-dim-blocked-tasks t + "Non-nil means dim blocked tasks in the agenda display. +This causes some overhead during agenda construction, but if you +have turned on `org-enforce-todo-dependencies', +`org-enforce-todo-checkbox-dependencies', or any other blocking +mechanism, this will create useful feedback in the agenda. + +Instead of t, this variable can also have the value `invisible'. +Then blocked tasks will be invisible and only become visible when +they become unblocked. An exemption to this behavior is when a task is +blocked because of unchecked checkboxes below it. Since checkboxes do +not show up in the agenda views, making this task invisible you remove any +trace from agenda views that there is something to do. Therefore, a task +that is blocked because of checkboxes will never be made invisible, it +will only be dimmed." + :group 'org-agenda-daily/weekly + :group 'org-agenda-todo-list + :version "24.3" + :type '(choice + (const :tag "Do not dim" nil) + (const :tag "Dim to a gray face" t) + (const :tag "Make invisible" invisible))) + +(defgroup org-agenda-startup nil + "Options concerning initial settings in the Agenda in Org Mode." + :tag "Org Agenda Startup" + :group 'org-agenda) + +(defcustom org-agenda-menu-show-matcher t + "Non-nil means show the match string in the agenda dispatcher menu. +When nil, the matcher string is not shown, but is put into the help-echo +property so than moving the mouse over the command shows it. +Setting it to nil is good if matcher strings are very long and/or if +you want to use two-columns display (see `org-agenda-menu-two-columns')." + :group 'org-agenda + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-menu-two-columns nil + "Non-nil means, use two columns to show custom commands in the dispatcher. +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-agenda-finalize-hook nil + "Hook run just before displaying an agenda buffer. +The buffer is still writable when the hook is called. + +You can modify some of the buffer substrings but you should be +extra careful not to modify the text properties of the agenda +headlines as the agenda display heavily relies on them." + :group 'org-agenda-startup + :type 'hook) + +(defcustom org-agenda-filter-hook nil + "Hook run just after filtering with `org-agenda-filter'." + :group 'org-agenda-startup + :package-version '(Org . "9.4") + :type 'hook) + +(defcustom org-agenda-mouse-1-follows-link nil + "Non-nil means mouse-1 on a link will follow the link in the agenda. +A longer mouse click will still set point. Needs to be set +before org.el is loaded." + :group 'org-agenda-startup + :type 'boolean) + +(defcustom org-agenda-start-with-follow-mode nil + "The initial value of follow mode in a newly created agenda window." + :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 + :type 'boolean) + +(defcustom org-agenda-start-with-entry-text-mode nil + "The initial value of entry-text-mode in a newly created agenda window." + :group 'org-agenda-startup + :type 'boolean) + +(defcustom org-agenda-entry-text-maxlines 5 + "Number of text lines to be added when `E' is pressed in the agenda. + +Note that this variable only used during agenda display. To add entry text +when exporting the agenda, configure the variable +`org-agenda-add-entry-text-maxlines'." + :group 'org-agenda + :type 'integer) + +(defcustom org-agenda-entry-text-exclude-regexps nil + "List of regular expressions to clean up entry text. +The complete matches of all regular expressions in this list will be +removed from entry text before it is shown in the agenda." + :group 'org-agenda + :type '(repeat (regexp))) + +(defcustom org-agenda-entry-text-leaders " > " + "Text prepended to the entry text in agenda buffers." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda + :type 'string) + +(defvar org-agenda-entry-text-cleanup-hook nil + "Hook that is run after basic cleanup of entry text to be shown in agenda. +This cleanup is done in a temporary buffer, so the function may inspect and +change the entire buffer. +Some default stuff like drawers and scheduling/deadline dates will already +have been removed when this is called, as will any matches for regular +expressions listed in `org-agenda-entry-text-exclude-regexps'.") + +(defvar org-agenda-include-inactive-timestamps nil + "Non-nil means include inactive time stamps in agenda. +Dynamically scoped.") + +(defgroup org-agenda-windows nil + "Options concerning the windows used by the Agenda in Org Mode." + :tag "Org Agenda Windows" + :group 'org-agenda) + +(defcustom org-agenda-window-setup 'reorganize-frame + "How the agenda buffer should be displayed. +Possible values for this option are: + +current-window Show agenda in the current window, keeping all other windows. +other-window Use `switch-to-buffer-other-window' to display agenda. +only-window Show agenda, deleting all other windows. +reorganize-frame Show only two windows on the current frame, the current + window and the agenda. +other-frame Use `switch-to-buffer-other-frame' to display agenda. + Also, when exiting the agenda, kill that frame. +other-tab Use `switch-to-buffer-other-tab' to display the + agenda, making use of the `tab-bar-mode' introduced + in Emacs version 27.1. Also, kill that tab when + exiting the agenda view. + +See also the variable `org-agenda-restore-windows-after-quit'." + :group 'org-agenda-windows + :type '(choice + (const current-window) + (const other-frame) + (const other-tab) + (const other-window) + (const only-window) + (const reorganize-frame)) + :package-version '(Org . "9.4")) + +(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) + "The min and max height of the agenda window as a fraction of frame height. +The value of the variable is a cons cell with two numbers between 0 and 1. +It only matters if `org-agenda-window-setup' is `reorganize-frame'." + :group 'org-agenda-windows + :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) + +(defcustom org-agenda-restore-windows-after-quit nil + "Non-nil means restore window configuration upon exiting agenda. +Before the window configuration is changed for displaying the +agenda, the current status is recorded. When the agenda is +exited with `q' or `x' and this option is set, the old state is +restored. If `org-agenda-window-setup' is `other-frame' or +`other-tab', the value of this option will be ignored." + :group 'org-agenda-windows + :type 'boolean) + +(defcustom org-agenda-span 'week + "Number of days to include in overview display. +Can be day, week, month, year, or any number of days. +Custom commands can set this variable in the options section." + :group 'org-agenda-daily/weekly + :type '(choice (const :tag "Day" day) + (const :tag "Week" week) + (const :tag "Fortnight" fortnight) + (const :tag "Month" month) + (const :tag "Year" year) + (integer :tag "Custom"))) + +(defcustom org-agenda-start-on-weekday 1 + "Non-nil means start the overview always on the specified weekday. +0 denotes Sunday, 1 denotes Monday, etc. +When nil, always start on the current day. +Custom commands can set this variable in the options section." + :group 'org-agenda-daily/weekly + :type '(choice (const :tag "Today" nil) + (integer :tag "Weekday No."))) + +(defcustom org-agenda-show-all-dates t + "Non-nil means `org-agenda' shows every day in the selected range. +When nil, only the days which actually have entries are shown." + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-format-date 'org-agenda-format-date-aligned + "Format string for displaying dates in the agenda. +Used by the daily/weekly agenda. This should be a format string +understood by `format-time-string', or a function returning the +formatted date as a string. The function must take a single +argument, a calendar-style date list like (month day year)." + :group 'org-agenda-daily/weekly + :type '(choice + (string :tag "Format string") + (function :tag "Function"))) + +(defun org-agenda-end-of-line () + "Go to the end of visible line." + (interactive) + (goto-char (line-end-position))) + +(defun org-agenda-format-date-aligned (date) + "Format a DATE string for display in the daily/weekly agenda. +This function makes sure that dates are aligned for easy reading." + (require 'cal-iso) + (let* ((dayname (calendar-day-name date)) + (day (cadr date)) + (day-of-week (calendar-day-of-week date)) + (month (car date)) + (monthname (calendar-month-name month)) + (year (nth 2 date)) + (iso-week (org-days-to-iso-week + (calendar-absolute-from-gregorian date))) + ;; (weekyear (cond ((and (= month 1) (>= iso-week 52)) + ;; (1- year)) + ;; ((and (= month 12) (<= iso-week 1)) + ;; (1+ year)) + ;; (t year))) + (weekstring (if (= day-of-week 1) + (format " W%02d" iso-week) + ""))) + (format "%-10s %2d %s %4d%s" + dayname day monthname year weekstring))) + +(defcustom org-agenda-time-leading-zero nil + "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) + "Convert TIME of a string like \"13:45\" to an AM/PM style time string." + (let* ((hour-number (string-to-number (substring time 0 -3))) + (minute (substring time -2)) + (ampm "am")) + (cond + ((equal hour-number 12) + (setq ampm "pm")) + ((> hour-number 12) + (setq ampm "pm") + (setq hour-number (- hour-number 12)))) + (concat + (if org-agenda-time-leading-zero + (format "%02d" hour-number) + (format "%02s" (number-to-string hour-number))) + ":" minute ampm))) + +(defun org-agenda-time-of-day-to-ampm-maybe (time) + "Conditionally convert TIME to AM/PM format. +This is based on `org-agenda-timegrid-use-ampm'." + (if org-agenda-timegrid-use-ampm + (org-agenda-time-of-day-to-ampm time) + time)) + +(defcustom org-agenda-weekend-days '(6 0) + "Which days are weekend? +These days get the special face `org-agenda-date-weekend' in the agenda." + :group 'org-agenda-daily/weekly + :type '(set :greedy t + (const :tag "Monday" 1) + (const :tag "Tuesday" 2) + (const :tag "Wednesday" 3) + (const :tag "Thursday" 4) + (const :tag "Friday" 5) + (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 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-diary-file 'diary-file + "File to which to add new entries with the `i' key in agenda and calendar. +When this is the symbol `diary-file', the functionality in the Emacs +calendar will be used to add entries to the `diary-file'. But when this +points to a file, `org-agenda-diary-entry' will be used instead." + :group 'org-agenda + :type '(choice + (const :tag "The standard Emacs diary file" diary-file) + (file :tag "Special Org file diary entries"))) + +(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." + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-include-deadlines t + "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 + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-show-future-repeats t + "Non-nil shows repeated entries in the future part of the agenda. +When set to the symbol `next' only the first future repeat is shown." + :group 'org-agenda-daily/weekly + :type '(choice + (const :tag "Show all repeated entries" t) + (const :tag "Show next repeated entry" next) + (const :tag "Do not show repeated entries" nil)) + :version "26.1" + :package-version '(Org . "9.1") + :safe #'symbolp) + +(defcustom org-agenda-prefer-last-repeat nil + "Non-nil sets date for repeated entries to their last repeat. + +When nil, display SCHEDULED and DEADLINE dates at their base +date, and in today's agenda, as a reminder. Display plain +time-stamps, on the other hand, at every repeat date in the past +in addition to the base date. + +When non-nil, show a repeated entry at its latest repeat date, +possibly being today even if it wasn't marked as done. This +setting is useful if you do not always mark repeated entries as +done and, yet, consider that reaching repeat date starts the task +anew. + +When set to a list of strings, prefer last repeats only for +entries with these TODO keywords." + :group 'org-agenda-daily/weekly + :type '(choice + (const :tag "Prefer last repeat" t) + (const :tag "Prefer base date" nil) + (repeat :tag "Prefer last repeat for entries with these TODO keywords" + (string :tag "TODO keyword"))) + :version "26.1" + :package-version '(Org . "9.1") + :safe (lambda (x) (or (booleanp x) (consp x)))) + +(defcustom org-scheduled-past-days 10000 + "Number of days to continue listing scheduled items not marked DONE. +When an item is scheduled on a date, it shows up in the agenda on +this day and will be listed until it is marked done or for the +number of days given here." + :group 'org-agenda-daily/weekly + :type 'integer + :safe 'integerp) + +(defcustom org-deadline-past-days 10000 + "Number of days to warn about missed deadlines. +When an item has deadline on a date, it shows up in the agenda on +this day and will appear as a reminder until it is marked DONE or +for the number of days given here." + :group 'org-agenda-daily/weekly + :type 'integer + :version "26.1" + :package-version '(Org . "9.1") + :safe 'integerp) + +(defcustom org-agenda-log-mode-items '(closed clock) + "List of items that should be shown in agenda log mode. +\\<org-agenda-mode-map>\ +This list may contain the following symbols: + + closed Show entries that have been closed on that day. + clock Show entries that have received clocked time on that day. + state Show all logged state changes. +Note that instead of changing this variable, you can also press \ +`\\[universal-argument] \\[org-agenda-log-mode]' in +the agenda to display all available LOG items temporarily." + :group 'org-agenda-daily/weekly + :type '(set :greedy t (const closed) (const clock) (const state))) + +(defcustom org-agenda-clock-consistency-checks + '(:max-duration "10:00" :min-duration 0 :max-gap "0:05" + :gap-ok-around ("4:00") + :default-face ((:background "DarkRed") (:foreground "white")) + :overlap-face nil :gap-face nil :no-end-time-face nil + :long-face nil :short-face nil) + "This is a property list, with the following keys: + +:max-duration Mark clocking chunks that are longer than this time. + This is a time string like \"HH:MM\", or the number + of minutes as an integer. + +:min-duration Mark clocking chunks that are shorter that this. + This is a time string like \"HH:MM\", or the number + of minutes as an integer. + +:max-gap Mark gaps between clocking chunks that are longer than + this duration. A number of minutes, or a string + like \"HH:MM\". + +:gap-ok-around List of times during the day which are usually not working + times. When a gap is detected, but the gap contains any + of these times, the gap is *not* reported. For example, + if this is (\"4:00\" \"13:00\") then gaps that contain + 4:00 in the morning (i.e. the night) and 13:00 + (i.e. a typical lunch time) do not cause a warning. + You should have at least one time during the night in this + list, or otherwise the first task each morning will trigger + a warning because it follows a long gap. + +Furthermore, the following properties can be used to define faces for +issue display. + +:default-face the default face, if the specific face is undefined +:overlap-face face for overlapping clocks +:gap-face face for gaps between clocks +:no-end-time-face face for incomplete clocks +:long-face face for clock intervals that are too long +: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 + "Non-nil means add first line of notes to log entries in agenda views. +If a log item like a state change or a clock entry is associated with +notes, the first line of these notes will be added to the entry in the +agenda display." + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-start-with-log-mode nil + "The initial value of log-mode in a newly created agenda window. +See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further +explanations on the possible values." + :group 'org-agenda-startup + :group 'org-agenda-daily/weekly + :type '(choice (const :tag "Don't show log items" nil) + (const :tag "Show only log items" only) + (const :tag "Show all possible log items" clockcheck) + (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'" + (choice (const :tag "Show closed log items" closed) + (const :tag "Show clocked log items" clock) + (const :tag "Show all logged state changes" state))))) + +(defcustom org-agenda-start-with-clockreport-mode nil + "The initial value of clockreport-mode in a newly created agenda window." + :group 'org-agenda-startup + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2) + "Property list with parameters for the clocktable in clockreport mode. +This is the display mode that shows a clock table in the daily/weekly +agenda, the properties for this dynamic block can be set here. +The usual clocktable parameters are allowed here, but you cannot set +the properties :name, :tstart, :tend, :block, and :scope - these will +be overwritten to make sure the content accurately reflects the +current display in the agenda." + :group 'org-agenda-daily/weekly + :type 'plist) + +(defvaralias 'org-agenda-search-view-search-words-only + 'org-agenda-search-view-always-boolean) + +(defcustom org-agenda-search-view-always-boolean nil + "Non-nil means the search string is interpreted as individual parts. + +The search string for search view can either be interpreted as a phrase, +or as a list of snippets that define a boolean search for a number of +strings. + +When this is non-nil, the string will be split on whitespace, and each +snippet will be searched individually, and all must match in order to +select an entry. A snippet is then a single string of non-white +characters, or a string in double quotes, or a regexp in {} braces. +If a snippet is preceded by \"-\", the snippet must *not* match. +\"+\" is syntactic sugar for positive selection. Each snippet may +be found as a full word or a partial word, but see the variable +`org-agenda-search-view-force-full-words'. + +When this is nil, search will look for the entire search phrase as one, +with each space character matching any amount of whitespace, including +line breaks. + +Even when this is nil, you can still switch to Boolean search dynamically +by preceding the first snippet with \"+\" or \"-\". If the first snippet +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) + +(defcustom org-agenda-search-view-force-full-words nil + "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) + +(defcustom org-agenda-search-view-max-outline-level 0 + "Maximum outline level to display in search view. +E.g. when this is set to 1, the search view will only +show headlines of level 1. When set to 0, the default +value, don't limit agenda view by outline level." + :group 'org-agenda-search-view + :version "26.1" + :package-version '(Org . "8.3") + :type 'integer) + +(defgroup org-agenda-time-grid nil + "Options concerning the time grid in the Org Agenda." + :tag "Org Agenda Time Grid" + :group 'org-agenda) + +(defcustom org-agenda-search-headline-for-time t + "Non-nil means search headline for a time-of-day. +If the headline contains a time-of-day in one format or another, it will +be used to sort the entry into the time sequence of items for a day. +Some people have time stamps in the headline that refer to the creation +time or so, and then this produces an unwanted side effect. If this is +the case for your, use this variable to turn off searching the headline +for a time." + :group 'org-agenda-time-grid + :type 'boolean) + +(defcustom org-agenda-use-time-grid t + "Non-nil means show a time grid in the agenda schedule. +A time grid is a set of lines for specific times (like every two hours between +8:00 and 20:00). The items scheduled for a day at specific times are +sorted in between these lines. +For details about when the grid will be shown, and what it will look like, see +the variable `org-agenda-time-grid'." + :group 'org-agenda-time-grid + :type 'boolean) + +(defcustom org-agenda-time-grid + '((daily today require-timed) + (800 1000 1200 1400 1600 1800 2000) + "......" + "----------------") + + "The settings for time grid for agenda display. +This is a list of four items. The first item is again a list. It contains +symbols specifying conditions when the grid should be displayed: + + daily if the agenda shows a single day + weekly if the agenda shows an entire week + today show grid on current date, independent of daily/weekly display + require-timed show grid only if at least one item has a time specification + remove-match skip grid times already present in an entry + +The second item is a list of integers, indicating the times that +should have a grid line. + +The third item is a string which will be placed right after the +times that have a grid line. + +The fourth item is a string placed after the grid times. This +will align with agenda items." + :group 'org-agenda-time-grid + :type + '(list + (set :greedy t :tag "Grid Display Options" + (const :tag "Show grid in single day agenda display" daily) + (const :tag "Show grid in weekly agenda display" weekly) + (const :tag "Always show grid for today" today) + (const :tag "Show grid only if any timed entries are present" + require-timed) + (const :tag "Skip grid times already present in an entry" + remove-match)) + (repeat :tag "Grid Times" (integer :tag "Time")) + (string :tag "Grid String (after agenda times)") + (string :tag "Grid String (aligns with agenda items)"))) + +(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 + "Options concerning sorting in the Org Agenda." + :tag "Org Agenda Sorting" + :group 'org-agenda) + +(defcustom org-agenda-sorting-strategy + '((agenda habit-down time-up priority-down category-keep) + (todo priority-down category-keep) + (tags priority-down category-keep) + (search category-keep)) + "Sorting structure for the agenda items of a single day. +This is a list of symbols which will be used in sequence to determine +if an entry should be listed before another entry. The following +symbols are recognized: + +time-up Put entries with time-of-day indications first, early first. +time-down Put entries with time-of-day indications first, late first. +timestamp-up Sort by any timestamp, early first. +timestamp-down Sort by any timestamp, late first. +scheduled-up Sort by scheduled timestamp, early first. +scheduled-down Sort by scheduled timestamp, late first. +deadline-up Sort by deadline timestamp, early first. +deadline-down Sort by deadline timestamp, late first. +ts-up Sort by active timestamp, early first. +ts-down Sort by active timestamp, late first. +tsia-up Sort by inactive timestamp, early first. +tsia-down Sort by inactive timestamp, late first. +category-keep Keep the default order of categories, corresponding to the + sequence in `org-agenda-files'. +category-up Sort alphabetically by category, A-Z. +category-down Sort alphabetically by category, Z-A. +tag-up Sort alphabetically by last tag, A-Z. +tag-down Sort alphabetically by last tag, Z-A. +priority-up Sort numerically by priority, high priority last. +priority-down Sort numerically by priority, high priority first. +todo-state-up Sort by todo state, tasks that are done last. +todo-state-down Sort by todo state, tasks that are done first. +effort-up Sort numerically by estimated effort, high effort last. +effort-down Sort numerically by estimated effort, high effort first. +user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. +user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. +habit-up Put entries that are habits first. +habit-down Put entries that are habits last. +alpha-up Sort headlines alphabetically. +alpha-down Sort headlines alphabetically, reversed. + +The different possibilities will be tried in sequence, and testing stops +if one comparison returns a \"not-equal\". For example, the default + '(time-up category-keep priority-down) +means: Pull out all entries having a specified time of day and sort them, +in order to make a time schedule for the current day the first thing in the +agenda listing for the day. Of the entries without a time indication, keep +the grouped in categories, don't sort the categories, but keep them in +the sequence given in `org-agenda-files'. Within each category sort by +priority. + +Leaving out `category-keep' would mean that items will be sorted across +categories by priority. + +Instead of a single list, this can also be a set of list for specific +contents, with a context symbol in the car of the list, any of +`agenda', `todo', `tags', `search' for the corresponding agenda views. + +Custom commands can bind this variable in the options section." + :group 'org-agenda-sorting + :type `(choice + (repeat :tag "General" ,org-sorting-choice) + (list :tag "Individually" + (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) + (repeat ,org-sorting-choice)) + (cons (const :tag "Strategy for TODO lists" todo) + (repeat ,org-sorting-choice)) + (cons (const :tag "Strategy for Tags matches" tags) + (repeat ,org-sorting-choice)) + (cons (const :tag "Strategy for search matches" search) + (repeat ,org-sorting-choice))))) + +(defcustom org-agenda-cmp-user-defined nil + "A function to define the comparison `user-defined'. +This function must receive two arguments, agenda entry a and b. +If a>b, return +1. If a<b, return -1. If they are equal as seen by +the user comparison, return nil. +When this is defined, you can make `user-defined-up' and `user-defined-down' +part of an agenda sorting strategy." + :group 'org-agenda-sorting + :type 'symbol) + +(defcustom org-agenda-sort-notime-is-late t + "Non-nil means items without time are considered late. +This is only relevant for sorting. When t, items which have no explicit +time like 15:30 will be considered as 99:01, i.e. later than any items which +do have a time. When nil, the default time is before 0:00. You can use this +option to decide if the schedule for today should come before or after timeless +agenda entries." + :group 'org-agenda-sorting + :type 'boolean) + +(defcustom org-agenda-sort-noeffort-is-high t + "Non-nil means items without effort estimate are sorted as high effort. +This also applies when filtering an agenda view with respect to the +< or > effort operator. Then, tasks with no effort defined will be treated +as tasks with high effort. +When nil, such items are sorted as 0 minutes effort." + :group 'org-agenda-sorting + :type 'boolean) + +(defgroup org-agenda-line-format nil + "Options concerning the entry prefix in the Org agenda display." + :tag "Org Agenda Line Format" + :group 'org-agenda) + +(defcustom org-agenda-prefix-format + '((agenda . " %i %-12:c%?-12t% s") + (todo . " %i %-12:c") + (tags . " %i %-12:c") + (search . " %i %-12:c")) + "Format specifications for the prefix of items in the agenda views. + +An alist with one entry per agenda type. The keys of the +sublists are `agenda', `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, + or as given by the CATEGORY keyword or derived from the file name + %e the effort required by the item + %l the level of the item (insert X space(s) if item is of level X) + %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 + %s Scheduling/Deadline information, a short string + %b show breadcrumbs, i.e., the names of the higher levels + %(expression) Eval EXPRESSION and replace the control string + by the result + +All specifiers work basically like the standard `%s' of printf, but may +contain two additional characters: a question mark just after the `%' +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, +but will completely disappear in entries which do not contain a time. + +If there is punctuation or whitespace character just before the +final format letter, this character will be appended to the field +value if the value is not empty. For example, the format +\"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If +the category is empty, no additional colon is inserted. + +The default value for the agenda sublist is \" %-12:c%?-12t% s\", +which means: + +- Indent the line with two space characters +- Give the category a 12 chars wide field, padded with whitespace on + the right (because of `-'). Append a colon if there is a category + (because of `:'). +- If there is a time-of-day, put it into a 12 chars wide field. If no + time, don't put in an empty field, just skip it (because of '?'). +- Finally, put the scheduling information. + +See also the variables `org-agenda-remove-times-when-in-prefix' and +`org-agenda-remove-tags'. + +Custom commands can set this variable in the options section." + :type '(choice + (string :tag "General format") + (list :greedy t :tag "View dependent" + (cons (const agenda) (string :tag "Format")) + (cons (const todo) (string :tag "Format")) + (cons (const tags) (string :tag "Format")) + (cons (const search) (string :tag "Format")))) + :group 'org-agenda-line-format + :version "26.1" + :package-version '(Org . "9.1")) + +(defcustom org-agenda-breadcrumbs-separator "->" + "The separator of breadcrumbs in agenda lines." + :group 'org-agenda-line-format + :package-version '(Org . "9.3") + :type 'string + :safe #'stringp) + +(defvar org-prefix-format-compiled nil + "The compiled prefix format and associated variables. +This is a list where first element is a list of variable bindings, and second +element is the compiled format expression. See the variable +`org-agenda-prefix-format'.") + +(defcustom org-agenda-todo-keyword-format "%-1s" + "Format for the TODO keyword in agenda lines. +Set this to something like \"%-12s\" if you want all TODO keywords +to occupy a fixed space in the agenda display." + :group 'org-agenda-line-format + :type 'string) + +(defcustom org-agenda-diary-sexp-prefix nil + "A regexp that matches part of a diary sexp entry +which should be treated as scheduling/deadline information in +`org-agenda'. + +For example, you can use this to extract the `diary-remind-message' from +`diary-remind' entries." + :group 'org-agenda-line-format + :type '(choice (const :tag "None" nil) (regexp :tag "Regexp"))) + +(defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") + "Text preceding timerange entries in the agenda view. +This is a list with two strings. The first applies when the range +is entirely on one day. The second applies if the range spans several days. +The strings may have two \"%d\" format specifiers which will be filled +with the sequence number of the days, and the total number of days in the +range, respectively." + :group 'org-agenda-line-format + :type '(list + (string :tag "Deadline today ") + (choice :tag "Deadline relative" + (string :tag "Format string") + (function)))) + +(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") + "Text preceding scheduled items in the agenda view. +This is a list with two strings. The first applies when the item is +scheduled on the current day. The second applies when it has been scheduled +previously, it may contain a %d indicating that this is the nth time that +this item is scheduled, due to automatic rescheduling of unfinished items +for the following day. So this number is one larger than the number of days +that passed since this item was scheduled first." + :group 'org-agenda-line-format + :version "24.4" + :package-version '(Org . "8.0") + :type '(list + (string :tag "Scheduled today ") + (string :tag "Scheduled previously"))) + +(defcustom org-agenda-inactive-leader "[" + "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 'string) + +(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ") + "Text preceding deadline items in the agenda view. +This is a list with three strings. The first applies when the item has its +deadline on the current day. The second applies when the deadline is in the +future, the third one when it is in the past. The strings may contain %d +to capture the number of days." + :group 'org-agenda-line-format + :version "24.4" + :package-version '(Org . "8.0") + :type '(list + (string :tag "Deadline today ") + (string :tag "Deadline in the future ") + (string :tag "Deadline in the past "))) + +(defcustom org-agenda-remove-times-when-in-prefix t + "Non-nil means remove duplicate time specifications in agenda items. +When the format `org-agenda-prefix-format' contains a `%t' specifier, a +time-of-day specification in a headline or diary entry is extracted and +placed into the prefix. If this option is non-nil, the original specification +\(a timestamp or -range, or just a plain time(range) specification like +11:30-4pm) will be removed for agenda display. This makes the agenda less +cluttered. +The option can be t or nil. It may also be the symbol `beg', indicating +that the time should only be removed when it is located at the beginning of +the headline/diary entry." + :group 'org-agenda-line-format + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "When at beginning of entry" beg))) + +(defcustom org-agenda-remove-timeranges-from-blocks nil + "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 + "Default duration for appointments that only have a starting time. +When nil, no duration is specified in such cases. +When non-nil, this must be the number of minutes, e.g. 60 for one hour." + :group 'org-agenda-line-format + :type '(choice + (integer :tag "Minutes") + (const :tag "No default duration"))) + +(defcustom org-agenda-show-inherited-tags t + "Non-nil means show inherited tags in each agenda line. + +When this option is set to `always', it takes precedence over +`org-agenda-use-tag-inheritance' and inherited tags are shown +in every agenda. + +When this option is set to t (the default), inherited tags are +shown when they are available, i.e. when the value of +`org-agenda-use-tag-inheritance' enables tag inheritance for the +given agenda type. + +This can be set to a list of agenda types in which the agenda +must display the inherited tags. Available types are `todo', +`agenda' and `search'. + +When set to nil, never show inherited tags in agenda lines." + :group 'org-agenda-line-format + :group 'org-agenda + :version "24.3" + :type '(choice + (const :tag "Show inherited tags when available" t) + (const :tag "Always show inherited tags" always) + (repeat :tag "Show inherited tags only in selected agenda types" + (symbol :tag "Agenda type")))) + +(defcustom org-agenda-use-tag-inheritance '(todo search agenda) + "List of agenda view types where to use tag inheritance. + +In tags/tags-todo/tags-tree agenda views, tag inheritance is +controlled by `org-use-tag-inheritance'. In other agenda types, +`org-use-tag-inheritance' is not used for the selection of the +agenda entries. Still, you may want the agenda to be aware of +the inherited tags anyway, e.g. for later tag filtering. + +Allowed value are `todo', `search' and `agenda'. + +This variable has no effect if `org-agenda-show-inherited-tags' +is set to `always'. In that case, the agenda is aware of those +tags. + +The default value sets tags in every agenda type. Setting this +option to nil will speed up non-tags agenda view a lot." + :group 'org-agenda + :version "26.1" + :package-version '(Org . "9.1") + :type '(choice + (const :tag "Use tag inheritance in all agenda types" t) + (repeat :tag "Use tag inheritance in selected agenda types" + (symbol :tag "Agenda type")))) + +(defcustom org-agenda-hide-tags-regexp nil + "Regular expression used to filter away specific tags in agenda views. +This means that these tags will be present, but not be shown in the agenda +line. Secondary filtering will still work on the hidden tags. +Nil means don't hide any tags." + :group 'org-agenda-line-format + :type '(choice + (const :tag "Hide none" nil) + (regexp :tag "Regexp "))) + +(defvaralias 'org-agenda-remove-tags-when-in-prefix + 'org-agenda-remove-tags) + +(defcustom org-agenda-remove-tags nil + "Non-nil means remove the tags from the headline copy in the agenda. +When this is the symbol `prefix', only remove tags when +`org-agenda-prefix-format' contains a `%T' specifier." + :group 'org-agenda-line-format + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "When prefix format contains %T" prefix))) + +(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) + +(defcustom org-agenda-tags-column 'auto + "Shift tags in agenda items to this column. +If set to `auto', tags will be automatically aligned to the right +edge of the window. + +If set to a positive number, tags will be left-aligned to that +column. If set to a negative number, tags will be right-aligned +to that column. For example, -80 works well for a normal 80 +character screen." + :group 'org-agenda-line-format + :type '(choice + (const :tag "Automatically align to right edge of window" auto) + (integer :tag "Specific column" -80)) + :package-version '(Org . "9.1") + :version "26.1") + +(defcustom org-agenda-fontify-priorities 'cookies + "Non-nil means highlight low and high priorities in agenda. +When t, the highest priority entries are bold, lowest priority italic. +However, settings in `org-priority-faces' will overrule these faces. +When this variable is the symbol `cookies', only fontify the +cookies, not the entire task. +This may also be an association list of priority faces, whose +keys are the character values of `org-priority-highest', +`org-priority-default', and `org-priority-lowest' (the default values +are ?A, ?B, and ?C, respectively). The face may be a named face, a +color as a string, or a list like `(:background \"Red\")'. +If it is a color, the variable `org-faces-easy-properties' +determines if it is a foreground or a background color." + :group 'org-agenda-line-format + :type '(choice + (const :tag "Never" nil) + (const :tag "Defaults" t) + (const :tag "Cookies only" cookies) + (repeat :tag "Specify" + (list (character :tag "Priority" :value ?A) + (choice :tag "Face " + (string :tag "Color") + (sexp :tag "Face")))))) + +(defcustom org-agenda-day-face-function nil + "Function called to determine what face should be used to display a day. +The only argument passed to that function is the day. It should +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 '(choice (const nil) (function))) + +(defcustom org-agenda-category-icon-alist nil + "Alist of category icon to be displayed in agenda views. + +Each entry should have the following format: + + (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS) + +Where CATEGORY-REGEXP is a regexp matching the categories where +the icon should be displayed. +FILE-OR-DATA either a file path or a string containing image data. + +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. +PROPS are additional image attributes to assign to the image, +like, e.g. `:ascent center'. + + (\"Org\" \"/path/to/icon.png\" nil nil :ascent center) + +If you want to set the display properties yourself, just put a +list as second element: + + (CATEGORY-REGEXP (MY PROPERTY LIST)) + +For example, to display a 16px horizontal space for Emacs +category, you can use: + + (\"Emacs\" \\='(space . (:width (16))))" + :group 'org-agenda-line-format + :version "24.1" + :type '(alist :key-type (regexp :tag "Regexp matching category") + :value-type (choice (list :tag "Icon" + (string :tag "File or data") + (symbol :tag "Type") + (boolean :tag "Data?") + (repeat :tag "Extra image properties" :inline t sexp)) + (list :tag "Display properties" sexp)))) + +(defgroup org-agenda-column-view nil + "Options concerning column view in the agenda." + :tag "Org Agenda Column View" + :group 'org-agenda) + +(defcustom org-agenda-view-columns-initially nil + "When non-nil, switch to columns view right after creating the agenda." + :group 'org-agenda-column-view + :type 'boolean + :version "26.1" + :package-version '(Org . "9.0") + :safe #'booleanp) + +(defcustom org-agenda-columns-show-summaries t + "Non-nil means show summaries for columns displayed in the agenda view." + :group 'org-agenda-column-view + :type 'boolean) + +(defcustom org-agenda-columns-compute-summary-properties t + "Non-nil means recompute all summary properties before column view. +When column view in the agenda is listing properties that have a summary +operator, it can go to all relevant buffers and recompute the summaries +there. This can mean overhead for the agenda column view, but is necessary +to have thing up to date. +As a special case, a CLOCKSUM property also makes sure that the clock +computations are current." + :group 'org-agenda-column-view + :type 'boolean) + +(defcustom org-agenda-columns-add-appointments-to-effort-sum nil + "Non-nil means the duration of an appointment will add to day effort. +The property to which appointment durations will be added is the one given +in the option `org-effort-property'. If an appointment does not have +an end time, `org-agenda-default-appointment-duration' will be used. If that +is not set, an appointment without end time will not contribute to the time +estimate." + :group 'org-agenda-column-view + :type 'boolean) + +(defcustom org-agenda-auto-exclude-function nil + "A function called with a tag to decide if it is filtered on \ +\\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] RET'. +The sole argument to the function, which is called once for each +possible tag, is a string giving the name of the tag. The +function should return either nil if the tag should be included +as normal, \"-<TAG>\" to exclude the tag, or \"+<TAG>\" to exclude +lines not carrying this tag. +Note that for the purpose of tag filtering, only the lower-case version of +all tags will be considered, so that this function will only ever see +the lower-case version of all tags." + :group 'org-agenda + :type '(choice (const nil) (function))) + +(defcustom org-agenda-bulk-custom-functions nil + "Alist of characters and custom functions for bulk actions. +For example, this value makes those two functions available: + + \\='((?R set-category) + (?C bulk-cut)) + +With selected entries in an agenda buffer, `B R' will call +the custom function `set-category' on the selected entries. +Note that functions in this alist don't need to be quoted. + +You can also specify a function which collects arguments to be +used for each call to your bulk custom function. The argument +collecting function will be run once and should return a list of +arguments to pass to the bulk function. For example: + + \\='((?R set-category get-category)) + +Now, `B R' will call the custom `get-category' which would prompt +the user once for a category. That category is then passed as an +argument to `set-category' for each entry it's called against." + :type + '(alist :key-type character + :value-type + (group (function :tag "Bulk Custom Function") + (choice (function :tag "Bulk Custom Argument Function") + (const :tag "No Bulk Custom Argument Function" nil)))) + :package-version '(Org . "9.5") + :group 'org-agenda) + +(defmacro org-agenda-with-point-at-orig-entry (string &rest body) + "Execute BODY with point at location given by `org-hd-marker' property. +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." + (declare (debug t)) + (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))))) + +(defun org-add-agenda-custom-command (entry) + "Replace or add a command in `org-agenda-custom-commands'. +This is mostly for hacking and trying a new command - once the command +works you probably want to add it to `org-agenda-custom-commands' for good." + (let ((ass (assoc (car entry) org-agenda-custom-commands))) + (if ass + (setcdr ass (cdr entry)) + (push entry org-agenda-custom-commands)))) + +(defmacro org-agenda--insert-overriding-header (default) + "Insert header into agenda view. +The inserted header depends on `org-agenda-overriding-header'. +If the empty string, don't insert a header. If any other string, +insert it as a header. If nil, insert DEFAULT, which should +evaluate to a string. If a function, call it and insert the +string that it returns." + (declare (debug (form)) (indent defun)) + `(cond + ((not org-agenda-overriding-header) (insert ,default)) + ((equal org-agenda-overriding-header "") nil) + ((stringp org-agenda-overriding-header) + (insert (propertize org-agenda-overriding-header + 'face 'org-agenda-structure) + "\n")) + ((functionp org-agenda-overriding-header) + (insert (funcall org-agenda-overriding-header))) + (t (user-error "Invalid value for `org-agenda-overriding-header': %S" + org-agenda-overriding-header)))) + +;;; Define the org-agenda-mode + +(defvaralias 'org-agenda-keymap 'org-agenda-mode-map) +(defvar org-agenda-mode-map (make-sparse-keymap) + "Keymap for `org-agenda-mode'.") + +(org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line) + +(defvar org-agenda-menu) ; defined later in this file. +(defvar org-agenda-restrict nil) ; defined later in this file. +(defvar org-agenda-follow-mode nil) +(defvar org-agenda-entry-text-mode nil) +(defvar org-agenda-clockreport-mode nil) +(defvar org-agenda-show-log nil + "When non-nil, show the log in the agenda. +Do not set this directly; instead use +`org-agenda-start-with-log-mode', which see.") +(defvar org-agenda-redo-command nil) +(defvar org-agenda-query-string nil) +(defvar org-agenda-mode-hook nil + "Hook run after `org-agenda-mode' is turned on. +The buffer is still writable when this hook is called.") +(defvar org-agenda-type nil) +(defvar org-agenda-force-single-file nil) +(defvar org-agenda-bulk-marked-entries nil + "List of markers that refer to marked entries in the agenda.") +(defvar org-agenda-current-date nil + "Active date when building the agenda.") + +;;; Multiple agenda buffers support + +(defcustom org-agenda-sticky nil + "Non-nil means agenda q key will bury agenda buffers. +Agenda commands will then show existing buffer instead of generating new ones. +When nil, `q' will kill the single agenda buffer." + :group 'org-agenda + :version "24.3" + :type 'boolean) + + +;;;###autoload +(defun org-toggle-sticky-agenda (&optional arg) + "Toggle `org-agenda-sticky'." + (interactive "P") + (let ((new-value (if arg + (> (prefix-numeric-value arg) 0) + (not org-agenda-sticky)))) + (if (equal new-value org-agenda-sticky) + (and (called-interactively-p 'interactive) + (message "Sticky agenda was already %s" + (if org-agenda-sticky "enabled" "disabled"))) + (setq org-agenda-sticky new-value) + (org-agenda-kill-all-agenda-buffers) + (and (called-interactively-p 'interactive) + (message "Sticky agenda %s" + (if org-agenda-sticky "enabled" "disabled")))))) + +(defvar org-agenda-buffer nil + "Agenda buffer currently being generated.") + +(defvar org-agenda-last-prefix-arg nil) +(defvar org-agenda-this-buffer-name nil) +(defvar org-agenda-doing-sticky-redo nil) +(defvar org-agenda-this-buffer-is-sticky nil) +(defvar org-agenda-last-indirect-buffer nil + "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.") + +(defconst org-agenda-local-vars + '(org-agenda-this-buffer-name + org-agenda-undo-list + org-agenda-pending-undo-list + org-agenda-follow-mode + org-agenda-entry-text-mode + org-agenda-clockreport-mode + org-agenda-show-log + org-agenda-redo-command + org-agenda-query-string + org-agenda-type + org-agenda-bulk-marked-entries + org-agenda-undo-has-started-in + org-agenda-info + org-agenda-pre-window-conf + org-agenda-columns-active + org-agenda-tag-filter + org-agenda-category-filter + org-agenda-top-headline-filter + org-agenda-regexp-filter + org-agenda-effort-filter + org-agenda-markers + org-agenda-last-search-view-search-was-boolean + org-agenda-last-indirect-buffer + org-agenda-filtered-by-category + org-agenda-filter-form + org-agenda-cycle-counter + org-agenda-last-prefix-arg) + "Variables that must be local in agenda buffers to allow multiple buffers.") + +(defun org-agenda-mode () + "Mode for time-sorted view on action items in Org files. + +The following commands are available: + +\\{org-agenda-mode-map}" + (interactive) + (ignore-errors (require 'face-remap)) + (let ((agenda-local-vars-to-keep + '(text-scale-mode-amount + text-scale-mode + text-scale-mode-lighter + face-remapping-alist)) + (save (buffer-local-variables))) + (kill-all-local-variables) + (cl-flet ((reset-saved (var-set) + "Reset variables in VAR-SET to possibly stored value in SAVE." + (dolist (elem save) + (pcase elem + (`(,var . ,val) ;ignore unbound variables + (when (and val (memq var var-set)) + (set var val))))))) + (cond (org-agenda-doing-sticky-redo + ;; Refreshing sticky agenda-buffer + ;; + ;; Preserve the value of `org-agenda-local-vars' variables. + (mapc #'make-local-variable org-agenda-local-vars) + (reset-saved org-agenda-local-vars) + (setq-local org-agenda-this-buffer-is-sticky t)) + (org-agenda-sticky + ;; Creating a sticky Agenda buffer for the first time + (mapc #'make-local-variable org-agenda-local-vars) + (setq-local org-agenda-this-buffer-is-sticky t)) + (t + ;; Creating a non-sticky agenda buffer + (setq-local org-agenda-this-buffer-is-sticky nil))) + (mapc #'make-local-variable agenda-local-vars-to-keep) + (reset-saved agenda-local-vars-to-keep))) + (setq org-agenda-undo-list nil + org-agenda-pending-undo-list nil + org-agenda-bulk-marked-entries nil) + (setq major-mode 'org-agenda-mode) + ;; Keep global-font-lock-mode from turning on font-lock-mode + (setq-local font-lock-global-modes (list 'not major-mode)) + (setq mode-name "Org-Agenda") + (setq indent-tabs-mode nil) + (use-local-map org-agenda-mode-map) + (when org-startup-truncated (setq truncate-lines t)) + (setq-local line-move-visual nil) + (add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local) + (add-hook 'pre-command-hook #'org-unhighlight nil 'local) + ;; Make sure properties are removed when copying text + (if (boundp 'filter-buffer-substring-functions) + (add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (substring-no-properties (funcall fun start end delete))) + nil t) + ;; Emacs >= 24.4. + (add-function :filter-return (local 'filter-buffer-substring-function) + #'substring-no-properties)) + (unless org-agenda-keep-modes + (setq org-agenda-follow-mode org-agenda-start-with-follow-mode + org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode + org-agenda-show-log org-agenda-start-with-log-mode + org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode)) + (add-to-invisibility-spec '(org-filtered)) + (add-to-invisibility-spec '(org-link)) + (easy-menu-change + '("Agenda") "Agenda Files" + (append + (list + (vector + (if (get 'org-agenda-files 'org-restrict) + "Restricted to single file" + "Edit File List") + '(org-edit-agenda-file-list) + (not (get 'org-agenda-files 'org-restrict))) + "--") + (mapcar #'org-file-menu-entry (org-agenda-files)))) + (org-agenda-set-mode-name) + (run-mode-hooks 'org-agenda-mode-hook)) + +(substitute-key-definition #'undo #'org-agenda-undo + org-agenda-mode-map global-map) +(org-defkey org-agenda-mode-map "\C-i" #'org-agenda-goto) +(org-defkey org-agenda-mode-map [(tab)] #'org-agenda-goto) +(org-defkey org-agenda-mode-map "\C-m" #'org-agenda-switch-to) +(org-defkey org-agenda-mode-map "\C-k" #'org-agenda-kill) +(org-defkey org-agenda-mode-map "\C-c\C-w" #'org-agenda-refile) +(org-defkey org-agenda-mode-map [(meta down)] #'org-agenda-drag-line-forward) +(org-defkey org-agenda-mode-map [(meta up)] #'org-agenda-drag-line-backward) +(org-defkey org-agenda-mode-map "m" #'org-agenda-bulk-mark) +(org-defkey org-agenda-mode-map "\M-m" #'org-agenda-bulk-toggle) +(org-defkey org-agenda-mode-map "*" #'org-agenda-bulk-mark-all) +(org-defkey org-agenda-mode-map "\M-*" #'org-agenda-bulk-toggle-all) +(org-defkey org-agenda-mode-map "#" #'org-agenda-dim-blocked-tasks) +(org-defkey org-agenda-mode-map "%" #'org-agenda-bulk-mark-regexp) +(org-defkey org-agenda-mode-map "u" #'org-agenda-bulk-unmark) +(org-defkey org-agenda-mode-map "U" #'org-agenda-bulk-unmark-all) +(org-defkey org-agenda-mode-map "B" #'org-agenda-bulk-action) +(org-defkey org-agenda-mode-map "k" #'org-agenda-capture) +(org-defkey org-agenda-mode-map "A" #'org-agenda-append-agenda) +(org-defkey org-agenda-mode-map "\C-c\C-x!" #'org-reload) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" #'org-agenda-archive-default) +(org-defkey org-agenda-mode-map "\C-c\C-xa" #'org-agenda-toggle-archive-tag) +(org-defkey org-agenda-mode-map "\C-c\C-xA" #'org-agenda-archive-to-archive-sibling) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" #'org-agenda-archive) +(org-defkey org-agenda-mode-map "\C-c$" #'org-agenda-archive) +(org-defkey org-agenda-mode-map "$" #'org-agenda-archive) +(org-defkey org-agenda-mode-map "\C-c\C-o" #'org-agenda-open-link) +(org-defkey org-agenda-mode-map " " #'org-agenda-show-and-scroll-up) +(org-defkey org-agenda-mode-map [backspace] #'org-agenda-show-scroll-down) +(org-defkey org-agenda-mode-map "\d" #'org-agenda-show-scroll-down) +(org-defkey org-agenda-mode-map [(control shift right)] #'org-agenda-todo-nextset) +(org-defkey org-agenda-mode-map [(control shift left)] #'org-agenda-todo-previousset) +(org-defkey org-agenda-mode-map "\C-c\C-xb" #'org-agenda-tree-to-indirect-buffer) +(org-defkey org-agenda-mode-map "o" #'delete-other-windows) +(org-defkey org-agenda-mode-map "L" #'org-agenda-recenter) +(org-defkey org-agenda-mode-map "\C-c\C-t" #'org-agenda-todo) +(org-defkey org-agenda-mode-map "t" #'org-agenda-todo) +(org-defkey org-agenda-mode-map "a" #'org-agenda-archive-default-with-confirmation) +(org-defkey org-agenda-mode-map ":" #'org-agenda-set-tags) +(org-defkey org-agenda-mode-map "\C-c\C-q" #'org-agenda-set-tags) +(org-defkey org-agenda-mode-map "." #'org-agenda-goto-today) +(org-defkey org-agenda-mode-map "j" #'org-agenda-goto-date) +(org-defkey org-agenda-mode-map "d" #'org-agenda-day-view) +(org-defkey org-agenda-mode-map "w" #'org-agenda-week-view) +(org-defkey org-agenda-mode-map "y" #'org-agenda-year-view) +(org-defkey org-agenda-mode-map "\C-c\C-z" #'org-agenda-add-note) +(org-defkey org-agenda-mode-map "z" #'org-agenda-add-note) +(org-defkey org-agenda-mode-map [(shift right)] #'org-agenda-do-date-later) +(org-defkey org-agenda-mode-map [(shift left)] #'org-agenda-do-date-earlier) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] #'org-agenda-do-date-later) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] #'org-agenda-do-date-earlier) +(org-defkey org-agenda-mode-map ">" #'org-agenda-date-prompt) +(org-defkey org-agenda-mode-map "\C-c\C-s" #'org-agenda-schedule) +(org-defkey org-agenda-mode-map "\C-c\C-d" #'org-agenda-deadline) +(let ((l '(1 2 3 4 5 6 7 8 9 0))) + (while l (org-defkey org-agenda-mode-map + (number-to-string (pop l)) #'digit-argument))) +(org-defkey org-agenda-mode-map "F" #'org-agenda-follow-mode) +(org-defkey org-agenda-mode-map "R" #'org-agenda-clockreport-mode) +(org-defkey org-agenda-mode-map "E" #'org-agenda-entry-text-mode) +(org-defkey org-agenda-mode-map "l" #'org-agenda-log-mode) +(org-defkey org-agenda-mode-map "v" #'org-agenda-view-mode-dispatch) +(org-defkey org-agenda-mode-map "D" #'org-agenda-toggle-diary) +(org-defkey org-agenda-mode-map "!" #'org-agenda-toggle-deadlines) +(org-defkey org-agenda-mode-map "G" #'org-agenda-toggle-time-grid) +(org-defkey org-agenda-mode-map "r" #'org-agenda-redo) +(org-defkey org-agenda-mode-map "g" #'org-agenda-redo-all) +(org-defkey org-agenda-mode-map "e" #'org-agenda-set-effort) +(org-defkey org-agenda-mode-map "\C-c\C-xe" #'org-agenda-set-effort) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-e" + #'org-clock-modify-effort-estimate) +(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 "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-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 "T" #'org-agenda-show-tags) +(org-defkey org-agenda-mode-map "n" #'org-agenda-next-line) +(org-defkey org-agenda-mode-map "p" #'org-agenda-previous-line) +(org-defkey org-agenda-mode-map "N" #'org-agenda-next-item) +(org-defkey org-agenda-mode-map "P" #'org-agenda-previous-item) +(substitute-key-definition #'next-line #'org-agenda-next-line + org-agenda-mode-map global-map) +(substitute-key-definition #'previous-line #'org-agenda-previous-line + org-agenda-mode-map global-map) +(org-defkey org-agenda-mode-map "\C-c\C-a" #'org-attach) +(org-defkey org-agenda-mode-map "\C-c\C-n" #'org-agenda-next-date-line) +(org-defkey org-agenda-mode-map "\C-c\C-p" #'org-agenda-previous-date-line) +(org-defkey org-agenda-mode-map "\C-c," #'org-agenda-priority) +(org-defkey org-agenda-mode-map "," #'org-agenda-priority) +(org-defkey org-agenda-mode-map "i" #'org-agenda-diary-entry) +(org-defkey org-agenda-mode-map "c" #'org-agenda-goto-calendar) +(org-defkey org-agenda-mode-map "C" #'org-agenda-convert-date) +(org-defkey org-agenda-mode-map "M" #'org-agenda-phases-of-moon) +(org-defkey org-agenda-mode-map "S" #'org-agenda-sunrise-sunset) +(org-defkey org-agenda-mode-map "h" #'org-agenda-holidays) +(org-defkey org-agenda-mode-map "H" #'org-agenda-holidays) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-i" #'org-agenda-clock-in) +(org-defkey org-agenda-mode-map "I" #'org-agenda-clock-in) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-o" #'org-agenda-clock-out) +(org-defkey org-agenda-mode-map "O" #'org-agenda-clock-out) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" #'org-agenda-clock-cancel) +(org-defkey org-agenda-mode-map "X" #'org-agenda-clock-cancel) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" #'org-clock-goto) +(org-defkey org-agenda-mode-map "J" #'org-agenda-clock-goto) +(org-defkey org-agenda-mode-map "+" #'org-agenda-priority-up) +(org-defkey org-agenda-mode-map "-" #'org-agenda-priority-down) +(org-defkey org-agenda-mode-map [(shift up)] #'org-agenda-priority-up) +(org-defkey org-agenda-mode-map [(shift down)] #'org-agenda-priority-down) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] #'org-agenda-priority-up) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] #'org-agenda-priority-down) +(org-defkey org-agenda-mode-map "f" #'org-agenda-later) +(org-defkey org-agenda-mode-map "b" #'org-agenda-earlier) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" #'org-agenda-columns) +(org-defkey org-agenda-mode-map "\C-c\C-x>" #'org-agenda-remove-restriction-lock) +(org-defkey org-agenda-mode-map "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda) +(org-defkey org-agenda-mode-map "[" #'org-agenda-manipulate-query-add) +(org-defkey org-agenda-mode-map "]" #'org-agenda-manipulate-query-subtract) +(org-defkey org-agenda-mode-map "{" #'org-agenda-manipulate-query-add-re) +(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-effort) +(org-defkey org-agenda-mode-map "=" #'org-agenda-filter-by-regexp) +(org-defkey org-agenda-mode-map "/" #'org-agenda-filter) +(org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all) +(org-defkey org-agenda-mode-map "~" #'org-agenda-limit-interactively) +(org-defkey org-agenda-mode-map "<" #'org-agenda-filter-by-category) +(org-defkey org-agenda-mode-map "^" #'org-agenda-filter-by-top-headline) +(org-defkey org-agenda-mode-map ";" #'org-timer-set-timer) +(org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop) +(org-defkey 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) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" #'org-mobile-push) +(org-defkey org-agenda-mode-map "\C-c\C-xI" #'org-info-find-node) +(org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse) +(org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse) +(org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block) +(org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block) +(org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c) + +(when org-agenda-mouse-1-follows-link + (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) + +(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu." + '("Agenda" + ("Agenda Files") + "--" + ("Agenda Dates" + ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)] + ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] + ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] + ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)]) + "--" + ("View" + ["Day View" org-agenda-day-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'day) + :keys "v d (or just d)"] + ["Week View" org-agenda-week-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'week) + :keys "v w"] + ["Fortnight View" org-agenda-fortnight-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'fortnight) + :keys "v t"] + ["Month View" org-agenda-month-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'month) + :keys "v m"] + ["Year View" org-agenda-year-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'year) + :keys "v y"] + "--" + ["Include Diary" org-agenda-toggle-diary + :style toggle :selected org-agenda-include-diary + :active (org-agenda-check-type nil 'agenda)] + ["Include Deadlines" org-agenda-toggle-deadlines + :style toggle :selected org-agenda-include-deadlines + :active (org-agenda-check-type nil 'agenda)] + ["Use Time Grid" org-agenda-toggle-time-grid + :style toggle :selected org-agenda-use-time-grid + :active (org-agenda-check-type nil 'agenda)] + "--" + ["Show clock report" org-agenda-clockreport-mode + :style toggle :selected org-agenda-clockreport-mode + :active (org-agenda-check-type nil 'agenda)] + ["Show some entry text" org-agenda-entry-text-mode + :style toggle :selected org-agenda-entry-text-mode + :active t] + "--" + ["Show Logbook entries" org-agenda-log-mode + :style toggle :selected org-agenda-show-log + :active (org-agenda-check-type nil 'agenda) + :keys "v l (or just l)"] + ["Include archived trees" org-agenda-archives-mode + :style toggle :selected org-agenda-archives-mode :active t + :keys "v a"] + ["Include archive files" (org-agenda-archives-mode t) + :style toggle :selected (eq org-agenda-archives-mode t) :active t + :keys "v A"] + "--" + ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) + ("Filter current view" + ["with generic interface" org-agenda-filter t] + "--" + ["by category at cursor" org-agenda-filter-by-category t] + ["by tag" org-agenda-filter-by-tag t] + ["by effort" org-agenda-filter-by-effort t] + ["by regexp" org-agenda-filter-by-regexp t] + ["by top-level headline" org-agenda-filter-by-top-headline t] + "--" + ["Remove all filtering" org-agenda-filter-remove-all t] + "--" + ["limit" org-agenda-limit-interactively t]) + ["Rebuild buffer" org-agenda-redo t] + ["Write view to file" org-agenda-write t] + ["Save all Org buffers" org-save-all-org-buffers t] + "--" + ["Show original entry" org-agenda-show t] + ["Go To (other window)" org-agenda-goto t] + ["Go To (this window)" org-agenda-switch-to t] + ["Capture with cursor date" org-agenda-capture t] + ["Follow Mode" org-agenda-follow-mode + :style toggle :selected org-agenda-follow-mode :active t] + ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] + "--" + ("TODO" + ["Cycle TODO" org-agenda-todo t] + ["Next TODO set" org-agenda-todo-nextset t] + ["Previous TODO set" org-agenda-todo-previousset t] + ["Add note" org-agenda-add-note t]) + ("Archive/Refile/Delete" + ["Archive default" org-agenda-archive-default t] + ["Archive default" org-agenda-archive-default-with-confirmation t] + ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] + ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] + ["Archive subtree" org-agenda-archive t] + "--" + ["Refile" org-agenda-refile t] + "--" + ["Delete subtree" org-agenda-kill t]) + ("Bulk action" + ["Mark entry" org-agenda-bulk-mark t] + ["Mark all" org-agenda-bulk-mark-all t] + ["Unmark entry" org-agenda-bulk-unmark t] + ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"] + ["Toggle mark" org-agenda-bulk-toggle t] + ["Toggle all" org-agenda-bulk-toggle-all t] + ["Mark regexp" org-agenda-bulk-mark-regexp t]) + ["Act on all marked" org-agenda-bulk-action t] + "--" + ("Tags and Properties" + ["Show all Tags" org-agenda-show-tags t] + ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] + ["Change tag in region" org-agenda-set-tags (org-region-active-p)] + "--" + ["Column View" org-columns t]) + ("Deadline/Schedule" + ["Schedule" org-agenda-schedule t] + ["Set Deadline" org-agenda-deadline t] + "--" + ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)] + ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)] + ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"] + ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"] + ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"] + ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"] + ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)]) + ("Clock and Effort" + ["Clock in" org-agenda-clock-in t] + ["Clock out" org-agenda-clock-out t] + ["Clock cancel" org-agenda-clock-cancel t] + ["Goto running clock" org-clock-goto t] + "--" + ["Set Effort" org-agenda-set-effort t] + ["Change clocked effort" org-clock-modify-effort-estimate + (org-clock-is-active)]) + ("Priority" + ["Set Priority" org-agenda-priority t] + ["Increase Priority" org-agenda-priority-up t] + ["Decrease Priority" org-agenda-priority-down t] + ["Show Priority" org-priority-show t]) + ("Calendar/Diary" + ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)] + ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)] + ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)] + ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)] + ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)] + ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)] + "--" + ["Create iCalendar File" org-icalendar-combine-agenda-files t]) + "--" + ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] + "--" + ("MobileOrg" + ["Push Files and Views" org-mobile-push t] + ["Get Captured and Flagged" org-mobile-pull t] + ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"] + ["Show note / unflag" org-agenda-show-the-flagging-note t] + "--" + ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) + "--" + ["Quit" org-agenda-quit t] + ["Exit and Release Buffers" org-agenda-exit t] + )) + +;;; Agenda undo + +(defvar org-agenda-allow-remote-undo t + "Non-nil means allow remote undo from the agenda buffer.") +(defvar org-agenda-undo-has-started-in nil + "Buffers that have already seen `undo-start' in the current undo sequence.") + +(defun org-agenda-undo () + "Undo a remote editing step in the agenda. +This undoes changes both in the agenda buffer and in the remote buffer +that have been changed along." + (interactive) + (or org-agenda-allow-remote-undo + (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo")) + (when (not (eq this-command last-command)) + (setq org-agenda-undo-has-started-in nil + org-agenda-pending-undo-list org-agenda-undo-list)) + (when (not org-agenda-pending-undo-list) + (user-error "No further undo information")) + (let* ((entry (pop org-agenda-pending-undo-list)) + buf line cmd rembuf) + (setq cmd (pop entry) line (pop entry)) + (setq rembuf (nth 2 entry)) + (org-with-remote-undo rembuf + (while (bufferp (setq buf (pop entry))) + (when (pop entry) + (with-current-buffer buf + (let (;; (last-undo-buffer buf) + (inhibit-read-only t)) + (unless (memq buf org-agenda-undo-has-started-in) + (push buf org-agenda-undo-has-started-in) + (make-local-variable 'pending-undo-list) + (undo-start)) + (while (and pending-undo-list + (listp pending-undo-list) + (not (car pending-undo-list))) + (pop pending-undo-list)) + (undo-more 1)))))) + (org-goto-line line) + (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) + +(defun org-verify-change-for-undo (l1 l2) + "Verify that a real change occurred between the undo lists L1 and L2." + (while (and l1 (listp l1) (null (car l1))) (pop l1)) + (while (and l2 (listp l2) (null (car l2))) (pop l2)) + (not (eq l1 l2))) + +;;; Agenda dispatch + +(defvar org-agenda-restrict-begin (make-marker)) +(defvar org-agenda-restrict-end (make-marker)) +(defvar org-agenda-last-dispatch-buffer nil) +(defvar org-agenda-overriding-restriction nil) + +(defcustom org-agenda-custom-commands-contexts nil + "Alist of custom agenda keys and contextual rules. + +For example, if you have a custom agenda command \"p\" and you +want this command to be accessible only from plain text files, +use this: + + \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\")))) + +Here are the available contexts definitions: + + in-file: command displayed only in matching files + in-mode: command displayed only in matching modes + not-in-file: command not displayed in matching files + not-in-mode: command not displayed in matching modes + in-buffer: command displayed only in matching buffers +not-in-buffer: command not displayed in matching buffers + [function]: a custom function taking no argument + +If you define several checks, the agenda command will be +accessible if there is at least one valid check. + +You can also bind a key to another agenda custom command +depending on contextual rules. + + \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\")))) + +Here it means: in .txt files, use \"p\" as the key for the +agenda command otherwise associated with \"q\". (The command +originally associated with \"q\" is not displayed to avoid +duplicates.)" + :version "24.3" + :group 'org-agenda-custom-commands + :type '(repeat (list :tag "Rule" + (string :tag " Agenda key") + (string :tag "Replace by command") + (repeat :tag "Available when" + (choice + (cons :tag "Condition" + (choice + (const :tag "In file" in-file) + (const :tag "Not in file" not-in-file) + (const :tag "In buffer" in-buffer) + (const :tag "Not in buffer" not-in-buffer) + (const :tag "In mode" in-mode) + (const :tag "Not in mode" not-in-mode)) + (regexp)) + (function :tag "Custom function")))))) + +(defcustom org-agenda-max-entries nil + "Maximum number of entries to display in an agenda. +This can be nil (no limit) or an integer or an alist of agenda +types with an associated number of entries to display in this +type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of entries") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search)) + (integer :tag "Max number of entries"))))) + +(defcustom org-agenda-max-todos nil + "Maximum number of TODOs to display in an agenda. +This can be nil (no limit) or an integer or an alist of agenda +types with an associated number of entries to display in this +type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of TODOs") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search)) + (integer :tag "Max number of TODOs"))))) + +(defcustom org-agenda-max-tags nil + "Maximum number of tagged entries to display in an agenda. +This can be nil (no limit) or an integer or an alist of agenda +types with an associated number of entries to display in this +type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of tagged entries") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search)) + (integer :tag "Max number of tagged entries"))))) + +(defcustom org-agenda-max-effort nil + "Maximum cumulated effort duration for the agenda. +This can be nil (no limit) or a number of minutes (as an integer) +or an alist of agenda types with an associated number of minutes +to limit entries to in this type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of minutes") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search)) + (integer :tag "Max number of minutes"))))) + +(defvar org-agenda-keep-restricted-file-list nil) +(defvar org-keys nil) +(defvar org-match nil) +;;;###autoload +(defun org-agenda (&optional arg keys restriction) + "Dispatch agenda commands to collect entries to the agenda buffer. +Prompts for a command to execute. Any prefix arg will be passed +on to the selected command. The default selections are: + +a Call `org-agenda-list' to display the agenda for current day or week. +t Call `org-todo-list' to display the global todo list. +T Call `org-todo-list' to display the global todo list, select only + entries with a specific TODO keyword (the user gets a prompt). +m Call `org-tags-view' to display headlines with tags matching + a condition (the user is prompted for the condition). +M Like `m', but select only TODO entries, no ordinary headlines. +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. + Press several times to get the desired effect. +> Remove a previous restriction. +# List \"stuck\" projects. +! Configure what \"stuck\" means. +C Configure custom agenda commands. + +More commands can be added by configuring the variable +`org-agenda-custom-commands'. In particular, specific tags and TODO keyword +searches can be pre-defined in this way. + +If the current buffer is in Org mode and visiting a file, you can also +first press `<' once to indicate that the agenda should be temporarily +\(until the next use of `\\[org-agenda]') restricted to the current file. +Pressing `<' twice means to restrict to the current subtree or region +\(if active)." + (interactive "P") + (catch 'exit + (let* ((org-keys keys) + (prefix-descriptions nil) + (org-agenda-buffer-name org-agenda-buffer-name) + (org-agenda-window-setup (if (equal (buffer-name) + org-agenda-buffer-name) + 'current-window + org-agenda-window-setup)) + (org-agenda-custom-commands-orig org-agenda-custom-commands) + (org-agenda-custom-commands + ;; normalize different versions + (delq nil + (mapcar + (lambda (x) + (cond ((stringp (cdr x)) + (push x prefix-descriptions) + nil) + ((stringp (nth 1 x)) x) + ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) + (t (cons (car x) (cons "" (cdr x)))))) + org-agenda-custom-commands))) + (org-agenda-custom-commands + (org-contextualize-keys + org-agenda-custom-commands org-agenda-custom-commands-contexts)) + ;; (buf (current-buffer)) + (bfn (buffer-file-name (buffer-base-buffer))) + entry type org-match lprops ans) ;; key + ;; Turn off restriction unless there is an overriding one, + (unless org-agenda-overriding-restriction + (unless org-agenda-keep-restricted-file-list + ;; There is a request to keep the file list in place + (put 'org-agenda-files 'org-restrict nil)) + (setq org-agenda-restrict nil) + (move-marker org-agenda-restrict-begin nil) + (move-marker org-agenda-restrict-end nil)) + ;; Delete old local properties + (put 'org-agenda-redo-command 'org-lprops nil) + ;; Delete previously set last-arguments + (put 'org-agenda-redo-command 'last-args nil) + ;; Remember where this call originated + (setq org-agenda-last-dispatch-buffer (current-buffer)) + (unless org-keys + (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) + org-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. + (when org-agenda-sticky + (setq org-agenda-buffer-name + (format "*Org Agenda(%s)*" org-keys))) + ;; Establish the restriction, if any + (when (and (not org-agenda-overriding-restriction) restriction) + (put 'org-agenda-files 'org-restrict (list bfn)) + (cond + ((eq restriction 'region) + (setq org-agenda-restrict (current-buffer)) + (move-marker org-agenda-restrict-begin (region-beginning)) + (move-marker org-agenda-restrict-end (region-end))) + ((eq restriction 'subtree) + (save-excursion + (setq org-agenda-restrict (current-buffer)) + (org-back-to-heading t) + (move-marker org-agenda-restrict-begin (point)) + (move-marker org-agenda-restrict-end + (progn (org-end-of-subtree t))))) + ((and (eq restriction 'buffer) + (or (< 1 (point-min)) + (< (point-max) (1+ (buffer-size))))) + (setq org-agenda-restrict (current-buffer)) + (move-marker org-agenda-restrict-begin (point-min)) + (move-marker org-agenda-restrict-end (point-max))))) + + ;; For example the todo list should not need it (but does...) + (cond + ((setq entry (assoc org-keys org-agenda-custom-commands)) + (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) + (progn + ;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars) + ;; to some of the local variables? There's no doc about + ;; that for `org-agenda-custom-commands'. + (setq type (nth 2 entry) org-match (eval (nth 3 entry) t) + lprops (nth 4 entry)) + (when org-agenda-sticky + (setq org-agenda-buffer-name + (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match)) + (format "*Org Agenda(%s)*" org-keys)))) + (put 'org-agenda-redo-command 'org-lprops lprops) + (cl-progv + (mapcar #'car lprops) + (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) + (pcase type + (`agenda + (org-agenda-list current-prefix-arg)) + (`agenda* + (org-agenda-list current-prefix-arg nil nil t)) + (`alltodo + (org-todo-list current-prefix-arg)) + (`search + (org-search-view current-prefix-arg org-match nil)) + (`stuck + (org-agenda-list-stuck-projects current-prefix-arg)) + (`tags + (org-tags-view current-prefix-arg org-match)) + (`tags-todo + (org-tags-view '(4) org-match)) + (`todo + (org-todo-list org-match)) + (`tags-tree + (org-check-for-org-mode) + (org-match-sparse-tree current-prefix-arg org-match)) + (`todo-tree + (org-check-for-org-mode) + (org-occur (concat "^" org-outline-regexp "[ \t]*" + (regexp-quote org-match) "\\>"))) + (`occur-tree + (org-check-for-org-mode) + (org-occur org-match)) + ((pred functionp) + (funcall type org-match)) + ;; FIXME: Will signal an error since it's not `functionp'! + ((pred fboundp) (funcall type org-match)) + (_ (user-error "Invalid custom agenda command type %s" type))))) + (org-agenda-run-series (nth 1 entry) (cddr entry)))) + ((equal org-keys "C") + (setq org-agenda-custom-commands org-agenda-custom-commands-orig) + (customize-variable 'org-agenda-custom-commands)) + ((equal org-keys "a") (call-interactively 'org-agenda-list)) + ((equal org-keys "s") (call-interactively 'org-search-view)) + ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4)))) + ((equal org-keys "t") (call-interactively 'org-todo-list)) + ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) + ((equal org-keys "m") (call-interactively 'org-tags-view)) + ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) + ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) + ((equal org-keys "?") (org-tags-view nil "+FLAGGED") + (add-hook + 'post-command-hook + (lambda () + (unless (current-message) + (let* ((m (org-agenda-get-any-marker)) + (note (and m (org-entry-get m "THEFLAGGINGNOTE")))) + (when note + (message "FLAGGING-NOTE ([?] for more info): %s" + (org-add-props + (replace-regexp-in-string + "\\\\n" "//" + (copy-sequence note)) + nil 'face 'org-warning)))))) + t t)) + ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) + ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) + ((equal org-keys "!") (customize-variable 'org-stuck-projects)) + (t (user-error "Invalid agenda key")))))) + +(defvar org-agenda-multi) + +(defun org-agenda-append-agenda () + "Append another agenda view to the current one. +This function allows interactive building of block agendas. +Agenda views are separated by `org-agenda-block-separator'." + (interactive) + (unless (derived-mode-p 'org-agenda-mode) + (user-error "Can only append from within agenda buffer")) + (let ((org-agenda-multi t)) + (org-agenda) + (widen) + (org-agenda-finalize) + (setq buffer-read-only t) + (org-agenda-fit-window-to-buffer))) + +(defun org-agenda-normalize-custom-commands (cmds) + "Normalize custom commands CMDS." + (delq nil + (mapcar + (lambda (x) + (cond ((stringp (cdr x)) nil) + ((stringp (nth 1 x)) x) + ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) + (t (cons (car x) (cons "" (cdr x)))))) + cmds))) + +(defun org-agenda-get-restriction-and-command (prefix-descriptions) + "The user interface for selecting an agenda command." + (catch 'exit + (let* ((bfn (buffer-file-name (buffer-base-buffer))) + (restrict-ok (and bfn (derived-mode-p 'org-mode))) + (region-p (org-region-active-p)) + (custom org-agenda-custom-commands) + (selstring "") + restriction second-time + c entry key type match prefixes rmheader header-end custom1 desc + line lines left right n n1) + (save-window-excursion + (delete-other-windows) + (org-switch-to-buffer-other-window " *Agenda Commands*") + (erase-buffer) + (insert (eval-when-compile + (let ((header + (copy-sequence + "Press key for an agenda command: +-------------------------------- < Buffer, subtree/region restriction +a Agenda for current week or day > Remove restriction +t List of all TODO entries e Export agenda views +m Match a TAGS/PROP/TODO query T Entries with special TODO kwd +s Search for keywords M Like m, but only TODO entries +/ Multi-occur S Like s, but only TODO entries +? Find :FLAGGED: entries C Configure custom agenda commands +* Toggle sticky agenda views # List stuck projects (!=configure) +")) + (start 0)) + (while (string-match + "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" + header start) + (setq start (match-end 0)) + (add-text-properties (match-beginning 2) (match-end 2) + '(face bold) header)) + header))) + (setq header-end (point-marker)) + (while t + (setq custom1 custom) + (when (eq rmheader t) + (org-goto-line 1) + (re-search-forward ":" nil t) + (delete-region (match-end 0) (point-at-eol)) + (forward-char 1) + (looking-at "-+") + (delete-region (match-end 0) (point-at-eol)) + (move-marker header-end (match-end 0))) + (goto-char header-end) + (delete-region (point) (point-max)) + + ;; Produce all the lines that describe custom commands and prefixes + (setq lines nil) + (while (setq entry (pop custom1)) + (setq key (car entry) desc (nth 1 entry) + type (nth 2 entry) + match (nth 3 entry)) + (if (> (length key) 1) + (cl-pushnew (string-to-char key) prefixes :test #'equal) + (setq line + (format + "%-4s%-14s" + (org-add-props (copy-sequence key) + '(face bold)) + (cond + ((string-match "\\S-" desc) desc) + ((eq type 'agenda) "Agenda for current week or day") + ((eq type 'agenda*) "Appointments for current week or day") + ((eq type 'alltodo) "List of all TODO entries") + ((eq type 'search) "Word search") + ((eq type 'stuck) "List of stuck projects") + ((eq type 'todo) "TODO keyword") + ((eq type 'tags) "Tags query") + ((eq type 'tags-todo) "Tags (TODO)") + ((eq type 'tags-tree) "Tags tree") + ((eq type 'todo-tree) "TODO kwd tree") + ((eq type 'occur-tree) "Occur tree") + ((functionp type) (if (symbolp type) + (symbol-name type) + "Lambda expression")) + (t "???")))) + (cond + ((not (org-string-nw-p match)) nil) + (org-agenda-menu-show-matcher + (setq line + (concat line ": " + (cond + ((stringp match) + (propertize match 'face 'org-warning)) + ((listp type) + (format "set of %d commands" (length type))))))) + (t + (org-add-props line nil 'help-echo (concat "Matcher: " match)))) + (push line lines))) + (setq lines (nreverse lines)) + (when prefixes + (mapc (lambda (x) + (push + (format "%s %s" + (org-add-props (char-to-string x) + nil 'face 'bold) + (or (cdr (assoc (concat selstring + (char-to-string x)) + prefix-descriptions)) + "Prefix key")) + lines)) + prefixes)) + + ;; Check if we should display in two columns + (if org-agenda-menu-two-columns + (progn + (setq n (length lines) + n1 (+ (/ n 2) (mod n 2)) + right (nthcdr n1 lines) + left (copy-sequence lines)) + (setcdr (nthcdr (1- n1) left) nil)) + (setq left lines right nil)) + (while left + (insert "\n" (pop left)) + (when right + (if (< (current-column) 40) + (move-to-column 40 t) + (insert " ")) + (insert (pop right)))) + + ;; Make the window the right size + (goto-char (point-min)) + (if second-time + (when (not (pos-visible-in-window-p (point-max))) + (org-fit-window-to-buffer)) + (setq second-time t) + (org-fit-window-to-buffer)) + + ;; Hint to navigation if window too small for all information + (setq header-line-format + (when (not (pos-visible-in-window-p (point-max))) + "Use C-v, M-v, C-n or C-p to navigate.")) + + ;; Ask for selection + (cl-loop + do (progn + (message "Press key for agenda command%s:" + (if (or restrict-ok org-agenda-overriding-restriction) + (if org-agenda-overriding-restriction + " (restriction lock active)" + (if restriction + (format " (restricted to %s)" restriction) + " (unrestricted)")) + "")) + (setq c (read-char-exclusive))) + until (not (memq c '(14 16 22 134217846))) + do (org-scroll c)) + + (message "") + (cond + ((assoc (char-to-string c) custom) + (setq selstring (concat selstring (char-to-string c))) + (throw 'exit (cons selstring restriction))) + ((memq c prefixes) + (setq selstring (concat selstring (char-to-string c)) + prefixes nil + rmheader (or rmheader t) + custom (delq nil (mapcar + (lambda (x) + (if (or (= (length (car x)) 1) + (/= (string-to-char (car x)) c)) + nil + (cons (substring (car x) 1) (cdr x)))) + custom)))) + ((eq c ?*) + (call-interactively 'org-toggle-sticky-agenda) + (sit-for 2)) + ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) + (message "Restriction is only possible in Org buffers") + (ding) (sit-for 1)) + ((eq c ?1) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction 'buffer)) + ((eq c ?0) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction (if region-p 'region 'subtree))) + ((eq c ?<) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction + (cond + ((eq restriction 'buffer) + (if region-p 'region 'subtree)) + ((memq restriction '(subtree region)) + nil) + (t 'buffer)))) + ((eq c ?>) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction nil)) + ((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) + (org-agenda-get-restriction-and-command prefix-descriptions)) + + ((equal c ?q) (user-error "Abort")) + (t (user-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) + (if (and (= (cdr org-agenda-window-frame-fractions) 1.0) + (= (car org-agenda-window-frame-fractions) 1.0)) + (delete-other-windows) + (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-cmd nil) +(defvar org-agenda-overriding-cmd nil) +(defvar org-agenda-overriding-arguments nil) +(defvar org-agenda-overriding-cmd-arguments nil) + +(defun org-let (list &rest body) ;FIXME: So many kittens are suffering here. + (declare (indent 1) (obsolete cl-progv "2021")) + (eval (cons 'let (cons list body)))) + +(defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go? + (declare (indent 2) (obsolete cl-progv "2021")) + (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) + +(defun org-agenda-run-series (name series) + "Run agenda NAME as a SERIES of agenda commands." + (let* ((gprops (nth 1 series)) + (gvars (mapcar #'car gprops)) + (gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops))) + (cl-progv gvars gvals (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) + (with-no-warnings + (defvar match)) ;Used via the `eval' below. + (let* ((org-agenda-multi t) + ;; FIXME: Redo should contain lists of (FUNS . ARGS) rather + ;; than expressions, so you don't need to `quote' the args + ;; and you just need to `apply' instead of `eval' when using it. + (redo (list 'org-agenda-run-series name (list 'quote series))) + (cmds (car series)) + match + org-cmd type lprops) + (while (setq org-cmd (pop cmds)) + (setq type (car org-cmd)) + (setq match (eval (nth 1 org-cmd) t)) + (setq lprops (nth 2 org-cmd)) + (let ((org-agenda-overriding-arguments + (if (eq org-agenda-overriding-cmd org-cmd) + (or org-agenda-overriding-arguments + org-agenda-overriding-cmd-arguments))) + (lvars (mapcar #'car lprops)) + (lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops))) + (cl-progv (append gvars lvars) (append gvals lvals) + (pcase type + (`agenda + (call-interactively 'org-agenda-list)) + (`agenda* + (funcall 'org-agenda-list nil nil t)) + (`alltodo + (call-interactively 'org-todo-list)) + (`search + (org-search-view current-prefix-arg match nil)) + (`stuck + (call-interactively 'org-agenda-list-stuck-projects)) + (`tags + (org-tags-view current-prefix-arg match)) + (`tags-todo + (org-tags-view '(4) match)) + (`todo + (org-todo-list match)) + ((pred fboundp) + (funcall type match)) + (_ (error "Invalid type in command series")))))) + (widen) + (let ((inhibit-read-only t)) + (add-text-properties (point-min) (point-max) + `(org-series t org-series-redo-cmd ,redo))) + (setq org-agenda-redo-command redo) + (goto-char (point-min))) + (org-agenda-fit-window-to-buffer) + (cl-progv gvars gvals (org-agenda-finalize)))) + +(defun org-agenda--split-plist (plist) + ;; We could/should arguably use `map-keys' and `map-values'. + (let (keys vals) + (while plist + (push (pop plist) keys) + (push (pop plist) vals)) + (cons (nreverse keys) (nreverse vals)))) + +;;;###autoload +(defmacro org-batch-agenda (cmd-key &rest parameters) + "Run an agenda command in batch mode and send the result to STDOUT. +If CMD-KEY is a string of length 1, it is used as a key in +`org-agenda-custom-commands' and triggers this command. If it is a +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." + (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) + `(org--batch-agenda ,cmd-key ',vars (list ,@exps)))) + +(defun org--batch-agenda (cmd-key vars vals) + ;; `org-batch-agenda' is a macro because every other "parameter" is + ;; a variable name rather than an expression to evaluate. Yuck! + (cl-progv vars vals + (let (org-agenda-sticky) + (if (> (length cmd-key) 1) + (org-tags-view nil cmd-key) + (org-agenda nil cmd-key)))) + (set-buffer org-agenda-buffer-name) + (princ (buffer-string))) + +(defvar org-agenda-info nil) + +;;;###autoload +(defmacro org-batch-agenda-csv (cmd-key &rest parameters) + "Run an agenda command in batch mode and send the result to STDOUT. +If CMD-KEY is a string of length 1, it is used as a key in +`org-agenda-custom-commands' and triggers this command. If it is a +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. + +The output gives a line for each selected agenda item. Each +item is a list of comma-separated values, like this: + +category,head,type,todo,tags,date,time,extra,priority-l,priority-n + +category The category of the item +head The headline, without TODO kwd, TAGS and PRIORITY +type The type of the agenda entry, can be + todo selected in TODO match + tagsmatch selected in tags match + diary imported from diary + deadline a deadline on given date + scheduled scheduled on given date + timestamp entry has timestamp on given date + closed entry was closed on given date + upcoming-deadline warning about deadline + past-scheduled forwarded scheduled item + block entry has date block including g. date +todo The todo keyword, if any +tags All tags including inherited ones, separated by colons +date The relevant date, like 2007-2-14 +time The time, like 15:00-16:50 +extra String with extra planning info +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" + (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) + `(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps)))) + +(defun org--batch-agenda-csv (cmd-key vars vals) + ;; `org-batch-agenda-csv' is a macro because every other "parameter" is + ;; a variable name rather than an expression to evaluate. Yuck! + (let ((org-agenda-remove-tags t)) + (cl-progv vars vals + ;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)? + (if (> (length cmd-key) 2) + (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"))) + (dolist (line lines) + (when (get-text-property 0 'org-category line) + (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"))))) + +(defun org-fix-agenda-info (props) + "Make sure all properties on an agenda item have a canonical form. +This ensures the export commands can easily use it." + (let (tmp re) + (when (setq tmp (plist-get props 'tags)) + (setq props (plist-put props 'tags (mapconcat #'identity tmp ":")))) + (when (setq tmp (plist-get props 'date)) + (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) + (let ((calendar-date-display-form '(year "-" month "-" day))) + '((format "%4d, %9s %2s, %4s" dayname monthname day year)) + + (setq tmp (calendar-date-string tmp))) + (setq props (plist-put props 'date tmp))) + (when (setq tmp (plist-get props 'day)) + (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) + (let ((calendar-date-display-form '(year "-" month "-" day))) + (setq tmp (calendar-date-string tmp))) + (setq props (plist-put props 'day tmp)) + (setq props (plist-put props 'agenda-day tmp))) + (when (setq tmp (plist-get props 'txt)) + (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) + (plist-put props 'priority-letter (match-string 1 tmp)) + (setq tmp (replace-match "" t t tmp))) + (when (and (setq re (plist-get props 'org-todo-regexp)) + (setq re (concat "\\`\\.*" re " ?")) + (let ((case-fold-search nil)) (string-match re tmp))) + (plist-put props 'todo (match-string 1 tmp)) + (setq tmp (replace-match "" t t tmp))) + (plist-put props 'txt tmp))) + props) + +(defun org-agenda-export-csv-mapper (prop) + (let ((res (plist-get org-agenda-info prop))) + (setq res + (cond + ((not res) "") + ((stringp res) res) + (t (prin1-to-string res)))) + (org-trim (replace-regexp-in-string "," ";" res nil t)))) + +;;;###autoload +(defun org-store-agenda-views (&rest _parameters) + "Store agenda views." + (interactive) + (org--batch-store-agenda-views nil nil)) + +;;;###autoload +(defmacro org-batch-store-agenda-views (&rest parameters) + "Run all custom agenda commands that have a file argument." + (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) + `(org--batch-store-agenda-views ',vars (list ,@exps)))) + +(defun org--batch-store-agenda-views (vars vals) + (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) + (pop-up-frames nil) + (dir default-directory) + cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) + (save-window-excursion + (while cmds + (setq cmd (pop cmds) + thiscmdkey (car cmd) + 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) + files (nth (if (listp cmd-or-set) 4 5) cmd)) + (if (stringp files) (setq files (list files))) + (when files + (let* ((opts (append org-agenda-exporter-settings opts)) + (vars (append (mapcar #'car opts) vars)) + (vals (append (mapcar (lambda (binding) (eval (cadr binding) t)) + opts) + vals))) + (cl-progv vars vals + (org-agenda nil thiscmdkey)) + (set-buffer bufname) + (while files + (cl-progv vars vals + (org-agenda-write (expand-file-name (pop files) dir) + nil t bufname)))) + (and (get-buffer bufname) + (kill-buffer bufname))))))) + +(defvar org-agenda-current-span nil + "The current span used in the agenda view.") ; local variable in the agenda buffer +(defun org-agenda-mark-header-line (pos) + "Mark the line at POS as an agenda structure header." + (save-excursion + (goto-char pos) + (put-text-property (point-at-bol) (point-at-eol) + 'org-agenda-structural-header t) + (when org-agenda-title-append + (put-text-property (point-at-bol) (point-at-eol) + 'org-agenda-title-append org-agenda-title-append)))) + +(defvar org-mobile-creating-agendas) ; defined in org-mobile.el +(defvar org-agenda-write-buffer-name "Agenda View") +(defun org-agenda-write (file &optional open nosettings agenda-bufname) + "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), PDF (.pdf) or Postscript (.ps) is produced. +If the extension is .ics, translate visible agenda into iCalendar +format. If the extension is .org, collect all subtrees +corresponding to the agenda entries and add them in an .org file. + +With prefix argument OPEN, open the new file immediately. If +NOSETTINGS is given, do not scope the settings of +`org-agenda-exporter-settings' into the export commands. This is +used when the settings have already been scoped and we do not +wish to overrule other, higher priority settings. If +AGENDA-BUFFER-NAME is provided, use this as the buffer name for +the agenda to write." + (interactive "FWrite agenda to file: \nP") + (if (or (not (file-writable-p file)) + (and (file-exists-p file) + (if (called-interactively-p 'any) + (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) + (user-error "Cannot write agenda to file %s" file)) + (cl-progv + (if nosettings nil (mapcar #'car org-agenda-exporter-settings)) + (if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t)) + org-agenda-exporter-settings)) + (save-excursion + (save-window-excursion + (let ((bs (copy-sequence (buffer-string))) + (extension (file-name-extension file)) + (default-directory (file-name-directory file)) + ) ;; beg content + (with-temp-buffer + (rename-buffer org-agenda-write-buffer-name t) + (set-buffer-modified-p nil) + (insert bs) + (org-agenda-remove-marked-text 'invisible 'org-filtered) + (run-hooks 'org-agenda-before-write-hook) + (cond + ((bound-and-true-p org-mobile-creating-agendas) + (org-mobile-write-agenda-for-mobile file)) + ((string= "org" extension) + (let (content p m message-log-max) + (goto-char (point-min)) + (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) + (goto-char p) + (setq m (get-text-property (point) 'org-hd-marker)) + (when m + (push (with-current-buffer (marker-buffer m) + (goto-char m) + (org-copy-subtree 1 nil t t) + org-subtree-clip) + content))) + (find-file file) + (erase-buffer) + (dolist (s content) (org-paste-subtree 1 s)) + (write-file file) + (kill-buffer (current-buffer)) + (message "Org file written to %s" file))) + ((member extension '("html" "htm")) + (or (require 'htmlize nil t) + (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) + (declare-function htmlize-buffer "htmlize" (&optional buffer)) + (set-buffer (htmlize-buffer (current-buffer))) + (when org-agenda-export-html-style + ;; replace <style> section with org-agenda-export-html-style + (goto-char (point-min)) + (kill-region (- (search-forward "<style") 6) + (search-forward "</style>")) + (insert org-agenda-export-html-style)) + (write-file file) + (kill-buffer (current-buffer)) + (message "HTML written to %s" file)) + ((string= "ps" extension) + (require 'ps-print) + (ps-print-buffer-with-faces file) + (message "Postscript written to %s" file)) + ((string= "pdf" extension) + (require 'ps-print) + (ps-print-buffer-with-faces + (concat (file-name-sans-extension file) ".ps")) + (call-process "ps2pdf" nil nil nil + (expand-file-name + (concat (file-name-sans-extension file) ".ps")) + (expand-file-name file)) + (delete-file (concat (file-name-sans-extension file) ".ps")) + (message "PDF written to %s" file)) + ((string= "ics" extension) + (require 'ox-icalendar) + (declare-function org-icalendar-export-current-agenda + "ox-icalendar" (file)) + (org-icalendar-export-current-agenda (expand-file-name file))) + (t + (let ((bs (buffer-string))) + (find-file file) + (erase-buffer) + (insert bs) + (save-buffer 0) + (kill-buffer (current-buffer)) + (message "Plain text written to %s" file)))))))) + (set-buffer (or agenda-bufname + ;; FIXME: I'm pretty sure called-interactively-p + ;; doesn't do what we want here! + (and (called-interactively-p 'any) (buffer-name)) + org-agenda-buffer-name))) + (when open (org-open-file file))) + +(defun org-agenda-remove-marked-text (property &optional value) + "Delete all text marked with VALUE of PROPERTY. +VALUE defaults to t." + (let (beg) + (setq value (or value t)) + (while (setq beg (text-property-any (point-min) (point-max) + property value)) + (delete-region + beg (or (next-single-property-change beg property) + (point-max)))))) + +(defun org-agenda-add-entry-text () + "Add entry text to agenda lines. +This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the +entry text following headings shown in the agenda. +Drawers will be excluded, also the line with scheduling/deadline info." + (when (and (> org-agenda-add-entry-text-maxlines 0) + (not (bound-and-true-p org-mobile-creating-agendas))) + (let (m txt) + (goto-char (point-min)) + (while (not (eobp)) + (if (not (setq m (org-get-at-bol 'org-hd-marker))) + (beginning-of-line 2) + (setq txt (org-agenda-get-some-entry-text + m org-agenda-add-entry-text-maxlines " > ")) + (end-of-line 1) + (if (string-match "\\S-" txt) + (insert "\n" txt) + (or (eobp) (forward-char 1)))))))) + +(defun org-agenda-get-some-entry-text (marker n-lines &optional indent + &rest keep) + "Extract entry text from MARKER, at most N-LINES lines. +This will ignore drawers etc, just get the text. +If INDENT is given, prefix every line with this string. If KEEP is +given, it is a list of symbols, defining stuff that should not be +removed from the entry content. Currently only `planning' is allowed here." + (let (txt drawer-re kwd-time-re ind) + (save-excursion + (with-current-buffer (marker-buffer marker) + (if (not (derived-mode-p 'org-mode)) + (setq txt "") + (org-with-wide-buffer + (goto-char marker) + (end-of-line 1) + (setq txt (buffer-substring + (min (1+ (point)) (point-max)) + (progn (outline-next-heading) (point))) + drawer-re org-drawer-regexp + kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp + ".*\n?")) + (with-temp-buffer + (insert txt) + (when org-agenda-add-entry-text-descriptive-links + (goto-char (point-min)) + (while (org-activate-links (point-max)) + (goto-char (match-end 0)))) + (goto-char (point-min)) + (while (re-search-forward org-link-bracket-re (point-max) t) + (set-text-properties (match-beginning 0) (match-end 0) + nil)) + (goto-char (point-min)) + (while (re-search-forward drawer-re nil t) + (delete-region + (match-beginning 0) + (progn (re-search-forward + "^[ \t]*:END:.*\n?" nil 'move) + (point)))) + (unless (member 'planning keep) + (goto-char (point-min)) + (while (re-search-forward kwd-time-re nil t) + (replace-match ""))) + (goto-char (point-min)) + (when org-agenda-entry-text-exclude-regexps + (let ((re-list org-agenda-entry-text-exclude-regexps) re) + (while (setq re (pop re-list)) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (replace-match ""))))) + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (when (looking-at "[ \t\n]+\\'") (replace-match "")) + + ;; find and remove min common indentation + (goto-char (point-min)) + (untabify (point-min) (point-max)) + (setq ind (current-indentation)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (setq ind (min ind (current-indentation)))) + (beginning-of-line 2)) + (goto-char (point-min)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (move-to-column ind) + (delete-region (point-at-bol) (point))) + (beginning-of-line 2)) + + (run-hooks 'org-agenda-entry-text-cleanup-hook) + + (goto-char (point-min)) + (when indent + (while (and (not (eobp)) (re-search-forward "^" nil t)) + (replace-match indent t t))) + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (goto-char (point-max)) + (when (> (org-current-line) + n-lines) + (org-goto-line (1+ n-lines)) + (backward-char 1)) + (setq txt (buffer-substring (point-min) (point)))))))) + txt)) + +(defun org-check-for-org-mode () + "Make sure current buffer is in Org mode. Error if not." + (or (derived-mode-p 'org-mode) + (error "Cannot execute Org agenda command on buffer in %s" + major-mode))) + +;;; Agenda prepare and finalize + +(defvar org-agenda-multi nil) ; dynamically scoped +(defvar org-agenda-pre-window-conf nil) +(defvar org-agenda-columns-active nil) +(defvar org-agenda-name nil) +(defvar org-agenda-tag-filter nil) +(defvar org-agenda-category-filter nil) +(defvar org-agenda-regexp-filter nil) +(defvar org-agenda-effort-filter nil) +(defvar org-agenda-top-headline-filter nil) + +(defvar org-agenda-represented-categories nil + "Cache for the list of all categories in the agenda.") +(defvar org-agenda-represented-tags nil + "Cache for the list of all categories in the agenda.") +(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 \"-\". +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.") + +(defconst org-agenda-filter-variables + '((category . org-agenda-category-filter) + (tag . org-agenda-tag-filter) + (effort . org-agenda-effort-filter) + (regexp . org-agenda-regexp-filter)) + "Alist of filter types and associated variables.") +(defun org-agenda-filter-any () + "Is any filter active?" + (cl-some (lambda (x) + (or (symbol-value (cdr x)) + (get :preset-filter x))) + org-agenda-filter-variables)) + +(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.") + +(defvar org-agenda-regexp-filter-preset nil + "A preset of the regexp filter used for secondary agenda filtering. +This must be a list of strings, each string must be a single regexp +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.") + +(defvar org-agenda-effort-filter-preset nil + "A preset of the effort condition used for secondary agenda filtering. +This must be a list of strings, each string must be a single regexp +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-agenda-use-sticky-p () + "Return non-nil if an agenda buffer named +`org-agenda-buffer-name' exists and should be shown instead of +generating a new one." + (and + ;; turned off by user + org-agenda-sticky + ;; For multi-agenda buffer already exists + (not org-agenda-multi) + ;; buffer found + (get-buffer org-agenda-buffer-name) + ;; C-u parameter is same as last call + (with-current-buffer (get-buffer org-agenda-buffer-name) + (and + (equal current-prefix-arg + org-agenda-last-prefix-arg) + ;; In case user turned stickiness on, while having existing + ;; Agenda buffer active, don't reuse that buffer, because it + ;; does not have org variables local + org-agenda-this-buffer-is-sticky)))) + +(defvar org-agenda-buffer-tmp-name nil) + +(defun org-agenda--get-buffer-name (sticky-name) + (or org-agenda-buffer-tmp-name + (and org-agenda-doing-sticky-redo org-agenda-buffer-name) + sticky-name + "*Org Agenda*")) + +(defun org-agenda-prepare-window (abuf filter-alist) + "Setup agenda buffer in the window. +ABUF is the buffer for the agenda window. +FILTER-ALIST is an alist of filters we need to apply when +`org-agenda-persistent-filter' is non-nil." + (let* ((awin (get-buffer-window abuf)) wconf) + (cond + ((equal (current-buffer) abuf) nil) + (awin (select-window awin)) + ((not (setq wconf (current-window-configuration)))) + ((eq org-agenda-window-setup 'current-window) + (pop-to-buffer-same-window abuf)) + ((eq org-agenda-window-setup 'other-window) + (org-switch-to-buffer-other-window abuf)) + ((eq org-agenda-window-setup 'other-frame) + (switch-to-buffer-other-frame abuf)) + ((eq org-agenda-window-setup 'other-tab) + (if (fboundp 'switch-to-buffer-other-tab) + (switch-to-buffer-other-tab abuf) + (user-error "Your version of Emacs does not have tab bar support"))) + ((eq org-agenda-window-setup 'only-window) + (delete-other-windows) + (pop-to-buffer-same-window abuf)) + ((eq org-agenda-window-setup 'reorganize-frame) + (delete-other-windows) + (org-switch-to-buffer-other-window abuf))) + (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist))) + (setq org-agenda-category-filter (cdr (assq 'cat filter-alist))) + (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist))) + (setq org-agenda-regexp-filter (cdr (assq 're filter-alist))) + ;; Additional test in case agenda is invoked from within agenda + ;; buffer via elisp link. + (unless (equal (current-buffer) abuf) + (pop-to-buffer-same-window abuf)) + (setq org-agenda-pre-window-conf + (or wconf org-agenda-pre-window-conf)))) + +(defun org-agenda-prepare (&optional name) + (let ((filter-alist (when org-agenda-persistent-filter + (with-current-buffer + (get-buffer-create org-agenda-buffer-name) + `((tag . ,org-agenda-tag-filter) + (re . ,org-agenda-regexp-filter) + (effort . ,org-agenda-effort-filter) + (cat . ,org-agenda-category-filter)))))) + (if (org-agenda-use-sticky-p) + (progn + (put 'org-agenda-tag-filter :preset-filter nil) + (put 'org-agenda-category-filter :preset-filter nil) + (put 'org-agenda-regexp-filter :preset-filter nil) + (put 'org-agenda-effort-filter :preset-filter nil) + ;; Popup existing buffer + (org-agenda-prepare-window (get-buffer org-agenda-buffer-name) + filter-alist) + (message "Sticky Agenda buffer, use `r' to refresh") + (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) + (put 'org-agenda-tag-filter :preset-filter + org-agenda-tag-filter-preset) + (put 'org-agenda-category-filter :preset-filter + org-agenda-category-filter-preset) + (put 'org-agenda-regexp-filter :preset-filter + org-agenda-regexp-filter-preset) + (put 'org-agenda-effort-filter :preset-filter + org-agenda-effort-filter-preset) + (if org-agenda-multi + (progn + (setq buffer-read-only nil) + (goto-char (point-max)) + (unless (or (bobp) org-agenda-compact-blocks + (not org-agenda-block-separator)) + (insert "\n" + (if (stringp org-agenda-block-separator) + org-agenda-block-separator + (make-string (window-width) org-agenda-block-separator)) + "\n")) + (narrow-to-region (point) (point-max))) + (setq org-done-keywords-for-agenda nil) + ;; Setting any org variables that are in org-agenda-local-vars + ;; list need to be done after the prepare call + (org-agenda-prepare-window + (get-buffer-create org-agenda-buffer-name) filter-alist) + (setq buffer-read-only nil) + (org-agenda-reset-markers) + (let ((inhibit-read-only t)) (erase-buffer)) + (org-agenda-mode) + (setq org-agenda-buffer (current-buffer)) + (setq org-agenda-contributing-files nil) + (setq org-agenda-columns-active nil) + (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 + (org-uniquify org-done-keywords-for-agenda)) + (setq org-agenda-last-prefix-arg current-prefix-arg) + (setq org-agenda-this-buffer-name org-agenda-buffer-name) + (and name (not org-agenda-name) + (setq-local org-agenda-name name))) + (setq buffer-read-only nil)))) + +(defvar org-overriding-columns-format) +(defvar org-local-columns-format) +(defun org-agenda-finalize () + "Finishing touch for the agenda buffer. +This function is called just before displaying the agenda. If +you want to add your own functions to the finalization of the +agenda display, configure `org-agenda-finalize-hook'." + (unless org-agenda-multi + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (save-excursion + (while (org-activate-links (point-max)) + (goto-char (match-end 0)))) + (unless (eq org-agenda-remove-tags t) + (org-agenda-align-tags)) + (unless org-agenda-with-colors + (remove-text-properties (point-min) (point-max) '(face nil))) + (when (bound-and-true-p org-overriding-columns-format) + (setq-local org-local-columns-format + org-overriding-columns-format)) + (when org-agenda-view-columns-initially + (org-agenda-columns)) + (when org-agenda-fontify-priorities + (org-agenda-fontify-priorities)) + (when (and org-agenda-dim-blocked-tasks org-blocker-hook) + (org-agenda-dim-blocked-tasks)) + (org-agenda-mark-clocking-task) + (when org-agenda-entry-text-mode + (org-agenda-entry-text-hide) + (org-agenda-entry-text-show)) + (when (and (featurep 'org-habit) + (save-excursion (next-single-property-change (point-min) 'org-habit-p))) + (org-habit-insert-consistency-graphs)) + (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) + (unless (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq org-agenda-type org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (and (listp org-agenda-use-tag-inheritance) + (not (memq org-agenda-type + org-agenda-use-tag-inheritance)))))) + (let (mrk) + (save-excursion + (goto-char (point-min)) + (while (equal (forward-line) 0) + (when (setq mrk (get-text-property (point) 'org-hd-marker)) + (put-text-property (point-at-bol) (point-at-eol) + 'tags + (org-with-point-at mrk + (org-get-tags)))))))) + (setq org-agenda-represented-tags nil + org-agenda-represented-categories nil) + (when org-agenda-top-headline-filter + (org-agenda-filter-top-headline-apply + org-agenda-top-headline-filter)) + (when org-agenda-tag-filter + (org-agenda-filter-apply org-agenda-tag-filter 'tag t)) + (when (get 'org-agenda-tag-filter :preset-filter) + (org-agenda-filter-apply + (get 'org-agenda-tag-filter :preset-filter) 'tag t)) + (when org-agenda-category-filter + (org-agenda-filter-apply org-agenda-category-filter 'category)) + (when (get 'org-agenda-category-filter :preset-filter) + (org-agenda-filter-apply + (get 'org-agenda-category-filter :preset-filter) 'category)) + (when org-agenda-regexp-filter + (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) + (when (get 'org-agenda-regexp-filter :preset-filter) + (org-agenda-filter-apply + (get 'org-agenda-regexp-filter :preset-filter) 'regexp)) + (when org-agenda-effort-filter + (org-agenda-filter-apply org-agenda-effort-filter 'effort)) + (when (get 'org-agenda-effort-filter :preset-filter) + (org-agenda-filter-apply + (get 'org-agenda-effort-filter :preset-filter) 'effort)) + (add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local)) + (run-hooks 'org-agenda-finalize-hook)))) + +(defun org-agenda-mark-clocking-task () + "Mark the current clock entry in the agenda if it is present." + ;; We need to widen when `org-agenda-finalize' is called from + ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in'). + (when (bound-and-true-p org-clock-current-task) + (save-restriction + (widen) + (org-agenda-unmark-clocking-task) + (when (marker-buffer org-clock-hd-marker) + (save-excursion + (goto-char (point-min)) + (let (s ov) + (while (setq s (next-single-property-change (point) 'org-hd-marker)) + (goto-char s) + (when (equal (org-get-at-bol 'org-hd-marker) + org-clock-hd-marker) + (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol)))) + (overlay-put ov 'type 'org-agenda-clocking) + (overlay-put ov 'face 'org-agenda-clocking) + (overlay-put ov 'help-echo + "The clock is running in this item"))))))))) + +(defun org-agenda-unmark-clocking-task () + "Unmark the current clocking task." + (mapc (lambda (o) + (when (eq (overlay-get o 'type) 'org-agenda-clocking) + (delete-overlay o))) + (overlays-in (point-min) (point-max)))) + +(defun org-agenda-fontify-priorities () + "Make highest priority lines bold, and lowest italic." + (interactive) + (mapc (lambda (o) (when (eq (overlay-get o 'org-type) 'org-priority) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) + (save-excursion + (let (b e p ov h l) + (goto-char (point-min)) + (while (re-search-forward org-priority-regexp nil t) + (setq h (or (get-char-property (point) 'org-priority-highest) + org-priority-highest) + l (or (get-char-property (point) 'org-priority-lowest) + org-priority-lowest) + p (string-to-char (match-string 2)) + b (match-beginning 1) + e (if (eq org-agenda-fontify-priorities 'cookies) + (1+ (match-end 2)) + (point-at-eol)) + ov (make-overlay b e)) + (overlay-put + ov 'face + (let ((special-face + (cond ((org-face-from-face-or-color + 'priority 'org-priority + (cdr (assoc p org-priority-faces)))) + ((and (listp org-agenda-fontify-priorities) + (org-face-from-face-or-color + 'priority 'org-priority + (cdr (assoc p org-agenda-fontify-priorities))))) + ((equal p l) 'italic) + ((equal p h) 'bold)))) + (if special-face (list special-face 'org-priority) 'org-priority))) + (overlay-put ov 'org-type 'org-priority))))) + +(defvar org-depend-tag-blocked) + +(defun org-agenda-dim-blocked-tasks (&optional _invisible) + "Dim currently blocked TODOs in the agenda display. +When INVISIBLE is non-nil, hide currently blocked TODO instead of +dimming them." ;FIXME: The arg isn't used, actually! + (interactive "P") + (when (called-interactively-p 'interactive) + (message "Dim or hide blocked tasks...")) + (dolist (o (overlays-in (point-min) (point-max))) + (when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face) + (delete-overlay o))) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (while (let ((pos (text-property-not-all + (point) (point-max) 'org-todo-blocked nil))) + (when pos (goto-char pos))) + (let* ((invisible + (eq (org-get-at-bol 'org-todo-blocked) 'invisible)) + (todo-blocked + (eq (org-get-at-bol 'org-filter-type) 'todo-blocked)) + (ov (make-overlay (if invisible + (line-end-position 0) + (line-beginning-position)) + (line-end-position)))) + (when todo-blocked + (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) + (when invisible + (org-agenda-filter-hide-line 'todo-blocked))) + (if (= (point-max) (line-end-position)) + (goto-char (point-max)) + (move-beginning-of-line 2))))) + (when (called-interactively-p 'interactive) + (message "Dim or hide blocked tasks...done"))) + +(defun org-agenda--mark-blocked-entry (entry) + "If ENTRY is blocked, mark it for fontification or invisibility. + +If the header at `org-hd-marker' is blocked according to +`org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is +'invisible and the header is not blocked by checkboxes, set the +text property `org-todo-blocked' to `invisible', otherwise set it +to t." + (when (get-text-property 0 'todo-state entry) + (let ((entry-marker (get-text-property 0 'org-hd-marker entry)) + (org-blocked-by-checkboxes nil) + ;; Necessary so that `org-entry-blocked-p' does not change + ;; the buffer. + (org-depend-tag-blocked nil)) + (when entry-marker + (let ((blocked + (with-current-buffer (marker-buffer entry-marker) + (save-excursion + (goto-char entry-marker) + (org-entry-blocked-p))))) + (when blocked + (let ((really-invisible + (and (not org-blocked-by-checkboxes) + (eq org-agenda-dim-blocked-tasks 'invisible)))) + (put-text-property + 0 (length entry) 'org-todo-blocked + (if really-invisible 'invisible t) + entry) + (put-text-property + 0 (length entry) 'org-filter-type 'todo-blocked entry))))))) + entry) + +(defvar org-agenda-skip-function nil + "Function to be called at each match during agenda construction. +If this function returns nil, the current match should not be skipped. +Otherwise, the function must return a position from where the search +should be continued. +This may also be a Lisp form, it will be evaluated. +Never set this variable using `setq' or so, because then it will apply +to all future agenda commands. If you do want a global skipping condition, +use the option `org-agenda-skip-function-global' instead. +The correct usage for `org-agenda-skip-function' is to bind it with +`let' to scope it dynamically into the agenda-constructing command. +A good way to set it is through options in `org-agenda-custom-commands'.") + +(defun org-agenda-skip () + "Throw to `:skip' in places that should be skipped. +Also moves point to the end of the skipped region, so that search can +continue from there." + (let ((p (point-at-bol)) to) + (when (or + (save-excursion (goto-char p) (looking-at comment-start-skip)) + (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) + (or (and (get-text-property p :org-archived) + (org-end-of-subtree t)) + (and (member org-archive-tag org-file-tags) + (goto-char (point-max))))) + (and org-agenda-skip-comment-trees + (get-text-property p :org-comment) + (org-end-of-subtree t)) + (and (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global) + (org-agenda-skip-eval org-agenda-skip-function))) + (goto-char to)) + (org-in-src-block-p t)) + (throw :skip t)))) + +(defun org-agenda-skip-eval (form) + "If FORM is a function or a list, call (or eval) it and return the result. +`save-excursion' and `save-match-data' are wrapped around the call, so point +and match data are returned to the previous state no matter what these +functions do." + (let (fp) + (and form + (or (setq fp (functionp form)) + (consp form)) + (save-excursion + (save-match-data + (if fp + (funcall form) + (eval form t))))))) + +(defvar org-agenda-markers nil + "List of all currently active markers created by `org-agenda'.") +(defvar org-agenda-last-marker-time (float-time) + "Creation time of the last agenda marker.") + +(defun org-agenda-new-marker (&optional pos) + "Return a new agenda marker. +Marker is at point, or at POS if non-nil. Org mode keeps a list +of these markers and resets them when they are no longer in use." + (let ((m (copy-marker (or pos (point)) t))) + (setq org-agenda-last-marker-time (float-time)) + (if org-agenda-buffer + (with-current-buffer org-agenda-buffer + (push m org-agenda-markers)) + (push m org-agenda-markers)) + m)) + +(defun org-agenda-reset-markers () + "Reset markers created by `org-agenda'." + (while org-agenda-markers + (move-marker (pop org-agenda-markers) nil))) + +(defun org-agenda-save-markers-for-cut-and-paste (beg end) + "Save relative positions of markers in region. +This check for agenda markers in all agenda buffers currently active." + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'org-agenda-mode) + (mapc (lambda (m) (org-check-and-save-marker m beg end)) + org-agenda-markers))))) + +;;; Entry text mode + +(defun org-agenda-entry-text-show-here () + "Add some text from the entry as context to the current line." + (let (m txt o) + (setq m (org-get-at-bol 'org-hd-marker)) + (unless (marker-buffer m) + (error "No marker points to an entry here")) + (setq txt (concat "\n" (org-no-properties + (org-agenda-get-some-entry-text + m org-agenda-entry-text-maxlines + org-agenda-entry-text-leaders)))) + (when (string-match "\\S-" txt) + (setq o (make-overlay (point-at-bol) (point-at-eol))) + (overlay-put o 'evaporate t) + (overlay-put o 'org-overlay-type 'agenda-entry-content) + (overlay-put o 'after-string txt)))) + +(defun org-agenda-entry-text-show () + "Add entry context for all agenda lines." + (interactive) + (save-excursion + (goto-char (point-max)) + (beginning-of-line 1) + (while (not (bobp)) + (when (org-get-at-bol 'org-hd-marker) + (org-agenda-entry-text-show-here)) + (beginning-of-line 0)))) + +(defun org-agenda-entry-text-hide () + "Remove any shown entry context." + (mapc (lambda (o) + (when (eq (overlay-get o 'org-overlay-type) + 'agenda-entry-content) + (delete-overlay o))) + (overlays-in (point-min) (point-max)))) + +(defun org-agenda-get-day-face (date) + "Return the face DATE should be displayed with." + (cond ((and (functionp org-agenda-day-face-function) + (funcall org-agenda-day-face-function date))) + ((and (org-agenda-today-p date) + (memq (calendar-day-of-week date) org-agenda-weekend-days)) + 'org-agenda-date-weekend-today) + ((org-agenda-today-p date) 'org-agenda-date-today) + ((memq (calendar-day-of-week date) org-agenda-weekend-days) + 'org-agenda-date-weekend) + (t 'org-agenda-date))) + +(defvar org-agenda-show-log-scoped) + +;;; Agenda Daily/Weekly + +(defvar org-agenda-start-day nil ; dynamically scoped parameter + "Start day for the agenda view. +Custom commands can set this variable in the options section. +This is usually a string like \"2007-11-01\", \"+2d\" or any other +input allowed when reading a date through the Org calendar. +See the docstring of `org-read-date' for details.") +(defvar org-starting-day nil) ; local variable in the agenda buffer +(defvar org-arg-loc nil) ; local variable + +;;;###autoload +(defun org-agenda-list (&optional arg start-day span with-hour) + "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 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'. + +When WITH-HOUR is non-nil, only include scheduled and deadline +items if they have an hour specification like [h]h:mm." + (interactive "P") + (when 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))) + (when (and (integerp arg) (> arg 0)) + (setq span arg arg nil)) + (when (numberp span) + (unless (< 0 span) + (user-error "Agenda creation impossible for this span(=%d days)" span))) + (catch 'exit + (setq org-agenda-buffer-name + (org-agenda--get-buffer-name + (and org-agenda-sticky + (cond ((and org-keys (stringp org-match)) + (format "*Org Agenda(%s:%s)*" org-keys org-match)) + (org-keys + (format "*Org Agenda(%s)*" org-keys)) + (t "*Org Agenda(a)*"))))) + (org-agenda-prepare "Day/Week") + (setq start-day (or start-day org-agenda-start-day)) + (when (stringp start-day) + ;; Convert to an absolute day number + (setq start-day (time-to-days (org-read-date nil t start-day)))) + (org-compile-prefix-format 'agenda) + (org-set-sorting-strategy 'agenda) + (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span))) + (today (org-today)) + (sd (or start-day today)) + (ndays (org-agenda-span-to-ndays span sd)) + (org-agenda-start-on-weekday + (and (or (eq ndays 7) (eq ndays 14)) + 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 rtn rtnall file date d start-pos end-pos todayp ;; e + clocktable-start clocktable-end) ;; filter + (setq org-agenda-redo-command + (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour)) + (dotimes (_ (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))) + (setq-local org-starting-day (car day-numbers)) + (setq-local org-arg-loc arg) + (setq-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)) + (org-agenda--insert-overriding-header + (concat (org-agenda-span-name span) + "-agenda" + (cond ((<= 350 (- d2 d1)) "") + ((= w1 w2) (format " (W%02d)" w1)) + (t (format " (W%02d-W%02d)" w1 w2))) + ":\n"))) + ;; Add properties if we actually inserted a header. + (when (> (point) s) + (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)) + (when (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)) + ;; Starred types override non-starred equivalents + (when (member :deadline* org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :deadline org-agenda-entry-types))) + (when (member :scheduled* org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :scheduled org-agenda-entry-types))) + ;; Honor with-hour + (when with-hour + (when (member :deadline org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :deadline org-agenda-entry-types)) + (push :deadline* org-agenda-entry-types)) + (when (member :scheduled org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :scheduled org-agenda-entry-types)) + (push :scheduled* org-agenda-entry-types))) + (unless org-agenda-include-deadlines + (setq org-agenda-entry-types + (delq :deadline* (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 + (when 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)))) + (when (or rtnall org-agenda-show-all-dates) + (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)) + (when rtnall (insert ;; all entries + (org-agenda-finalize-entries rtnall 'agenda) + "\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)) + (setq tbl (apply #'org-clock-get-clocktable p)) + (insert tbl))) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (unless (or (not (get-buffer-window org-agenda-buffer-name)) + (and (pos-visible-in-window-p (point-min)) + (pos-visible-in-window-p (point-max)))) + (goto-char (1- (point-max))) + (recenter -1) + (when (not (pos-visible-in-window-p (or start-pos 1))) + (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 + org-last-args (,arg ,start-day ,span) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (when (eq org-agenda-show-log-scoped 'clockcheck) + (org-agenda-show-clocking-issues)) + (org-agenda-finalize) + (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." + (cond ((symbolp n) n) + ((= n 1) 'day) + ((= n 7) 'week) + ((= n 14) 'fortnight) + (t n))) + +(defun org-agenda-span-to-ndays (span &optional start-day) + "Return ndays from SPAN, possibly starting at START-DAY. +START-DAY is an absolute time value." + (cond ((numberp span) span) + ((eq span 'day) 1) + ((eq span 'week) 7) + ((eq span 'fortnight) 14) + ((eq span 'month) + (let ((date (calendar-gregorian-from-absolute start-day))) + (calendar-last-day-of-month (car date) (cl-caddr date)))) + ((eq span 'year) + (let ((date (calendar-gregorian-from-absolute start-day))) + (if (calendar-leap-year-p (cl-caddr date)) 366 365))))) + +(defun org-agenda-span-name (span) + "Return a SPAN name." + (if (null span) + "" + (if (symbolp span) + (capitalize (symbol-name span)) + (format "%d days" span)))) + +;;; Agenda word search + +(defvar org-agenda-search-history nil) + +(defvar org-search-syntax-table nil + "Special syntax table for Org search. +In this table, we have single quotes not as word constituents, to +that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") + +(defvar org-mode-syntax-table) ; From org.el +(defun org-search-syntax-table () + (unless org-search-syntax-table + (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) + (modify-syntax-entry ?' "." org-search-syntax-table) + (modify-syntax-entry ?` "." org-search-syntax-table)) + org-search-syntax-table) + +(defvar org-agenda-last-search-view-search-was-boolean nil) + +;;;###autoload +(defun org-search-view (&optional todo-only string edit-at) + "Show all entries that contain a phrase or words or regular expressions. + +With optional prefix argument TODO-ONLY, only consider entries that are +TODO entries. The argument STRING can be used to pass a default search +string into this function. If EDIT-AT is non-nil, it means that the +user should get a chance to edit this string, with cursor at position +EDIT-AT. + +The search string can be viewed either as a phrase that should be found as +is, or it can be broken into a number of snippets, each of which must match +in a Boolean way to select an entry. The default depends on the variable +`org-agenda-search-view-always-boolean'. +Even if this is turned off (the default) you can always switch to +Boolean search dynamically by preceding the first word with \"+\" or \"-\". + +The default is a direct search of the whole phrase, where each space in +the search string can expand to an arbitrary amount of whitespace, +including newlines. + +If using a Boolean search, the search string is split on whitespace and +each snippet is searched separately, with logical AND to select an entry. +Words prefixed with a minus must *not* occur in the entry. Words without +a prefix or prefixed with a plus must occur in the entry. Matching is +case-insensitive. Words are enclosed by word delimiters (i.e. they must +match whole words, not parts of a word) if +`org-agenda-search-view-force-full-words' is set (default is nil). + +Boolean search snippets enclosed by curly braces are interpreted as +regular expressions that must or (when preceded with \"-\") must not +match in the entry. Snippets enclosed into double quotes will be taken +as a whole, to include whitespace. + +- If the search string starts with an asterisk, search only in headlines. +- If (possibly after the leading star) the search string starts with an + exclamation mark, this also means to look at TODO entries only, an effect + that can also be achieved with a prefix argument. +- If (possibly after star and exclamation mark) the search string starts + with a colon, this will mean that the (non-regexp) snippets of the + Boolean search must match as full words. + +This command searches the agenda files, and in addition the files +listed in `org-agenda-text-search-extra-files' unless a restriction lock +is active." + (interactive "P") + (when org-agenda-overriding-arguments + (setq todo-only (car org-agenda-overriding-arguments) + string (nth 1 org-agenda-overriding-arguments) + edit-at (nth 2 org-agenda-overriding-arguments))) + (let* ((props (list 'face nil + 'done-face 'org-agenda-done + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'mouse-face 'highlight + 'help-echo "mouse-2 or RET jump to location")) + (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 inherited-tags + marker category level tags c neg re boolean + ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) + (unless (and (not edit-at) + (stringp string) + (string-match "\\S-" string)) + (setq string (read-string + (if org-agenda-search-view-always-boolean + "[+-]Word/{Regexp} ...: " + "Phrase or [+-]Word/{Regexp} ...: ") + (cond + ((integerp edit-at) (cons string edit-at)) + (edit-at string)) + 'org-agenda-search-history))) + (catch 'exit + (setq org-agenda-buffer-name + (org-agenda--get-buffer-name + (and org-agenda-sticky + (if (stringp string) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "S") "s")) + string) + (format "*Org Agenda(%s)*" + (or (and todo-only "S") "s")))))) + (org-agenda-prepare "SEARCH") + (org-compile-prefix-format 'search) + (org-set-sorting-strategy 'search) + (setq org-agenda-redo-command + (list 'org-search-view (if todo-only t nil) + (list 'if 'current-prefix-arg nil string))) + (setq org-agenda-query-string string) + (if (equal (string-to-char string) ?*) + (setq hdl-only t + words (substring string 1)) + (setq words string)) + (when (equal (string-to-char words) ?!) + (setq todo-only t + words (substring words 1))) + (when (equal (string-to-char words) ?:) + (setq full-words t + words (substring words 1))) + (when (or org-agenda-search-view-always-boolean + (member (string-to-char words) '(?- ?+ ?\{))) + (setq boolean t)) + (setq words (split-string words)) + (let (www w) + (while (setq w (pop words)) + (while (and (string-match "\\\\\\'" w) words) + (setq w (concat (substring w 0 -1) " " (pop words)))) + (push w www)) + (setq words (nreverse www) www nil) + (while (setq w (pop words)) + (when (and (string-match "\\`[-+]?{" w) + (not (string-match "}\\'" w))) + (while (and words (not (string-match "}\\'" (car words)))) + (setq w (concat w " " (pop words)))) + (setq w (concat w " " (pop words)))) + (push w www)) + (setq words (nreverse www))) + (setq org-agenda-last-search-view-search-was-boolean boolean) + (when boolean + (let (wds w) + (while (setq w (pop words)) + (when (or (equal (substring w 0 1) "\"") + (and (> (length w) 1) + (member (substring w 0 1) '("+" "-")) + (equal (substring w 1 2) "\""))) + (while (and words (not (equal (substring w -1) "\""))) + (setq w (concat w " " (pop words))))) + (and (string-match "\\`\\([-+]?\\)\"" w) + (setq w (replace-match "\\1" nil nil w))) + (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) + (push w wds)) + (setq words (nreverse wds)))) + (if boolean + (mapc (lambda (w) + (setq c (string-to-char w)) + (if (equal c ?-) + (setq neg t w (substring w 1)) + (if (equal c ?+) + (setq neg nil w (substring w 1)) + (setq neg nil))) + (if (string-match "\\`{.*}\\'" w) + (setq re (substring w 1 -1)) + (if full-words + (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) + (setq re (regexp-quote (downcase w))))) + (if neg (push re regexps-) (push re regexps+))) + words) + (push (mapconcat #'regexp-quote words "\\s-+") + regexps+)) + (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) + (if (not regexps+) + (setq regexp org-outline-regexp-bol) + (setq regexp (pop regexps+)) + (when hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" + regexp)))) + (setq files (org-agenda-files nil 'ifmode)) + ;; Add `org-agenda-text-search-extra-files' unless there is some + ;; restriction. + (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) + (pop org-agenda-text-search-extra-files) + (unless (get 'org-agenda-files 'org-restrict) + (setq files (org-add-archive-files files)))) + ;; Uniquify files. However, let `org-check-agenda-file' handle + ;; non-existent ones. + (setq files (cl-remove-duplicates + (append files org-agenda-text-search-extra-files) + :test (lambda (a b) + (and (file-exists-p a) + (file-exists-p b) + (file-equal-p a b)))) + rtnall nil) + (while (setq file (pop files)) + (setq ee nil) + (catch 'nextfile + (org-check-agenda-file file) + (setq buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + (unless buffer + ;; If file does not exist, make sure an error message is sent + (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" + file)))) + (with-current-buffer buffer + (with-syntax-table (org-search-syntax-table) + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in Org mode" file)) + (let ((case-fold-search t)) + (save-excursion + (save-restriction + (if (eq buffer org-agenda-restrict) + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + (goto-char (point-min)) + (unless (or (org-at-heading-p) + (outline-next-heading)) + (throw 'nextfile t)) + (goto-char (max (point-min) (1- (point)))) + (while (re-search-forward regexp nil t) + (org-back-to-heading t) + (while (and (not (zerop org-agenda-search-view-max-outline-level)) + (> (org-reduced-level (org-outline-level)) + org-agenda-search-view-max-outline-level) + (forward-line -1) + (org-back-to-heading t))) + (skip-chars-forward "* ") + (setq beg (point-at-bol) + beg1 (point) + end (progn + (outline-next-heading) + (while (and (not (zerop org-agenda-search-view-max-outline-level)) + (> (org-reduced-level (org-outline-level)) + org-agenda-search-view-max-outline-level) + (forward-line 1) + (outline-next-heading))) + (point))) + + (catch :skip + (goto-char beg) + (org-agenda-skip) + (setq str (buffer-substring-no-properties + (point-at-bol) + (if hdl-only (point-at-eol) end))) + (mapc (lambda (wr) (when (string-match wr str) + (goto-char (1- end)) + (throw :skip t))) + regexps-) + (mapc (lambda (wr) (unless (string-match wr str) + (goto-char (1- end)) + (throw :skip t))) + (if todo-only + (cons (concat "^\\*+[ \t]+" + org-not-done-regexp) + regexps+) + regexps+)) + (goto-char beg) + (setq marker (org-agenda-new-marker (point)) + category (org-get-category) + level (make-string (org-reduced-level (org-outline-level)) ? ) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'todo org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'todo org-agenda-use-tag-inheritance)))) + tags (org-get-tags nil (not inherited-tags)) + txt (org-agenda-format-item + "" + (buffer-substring-no-properties + beg1 (point-at-eol)) + level category tags t)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker + 'org-todo-regexp org-todo-regexp + 'level level + 'org-complex-heading-regexp org-complex-heading-regexp + 'priority 1000 + 'type "search") + (push txt ee) + (goto-char (1- end)))))))))) + (setq rtn (nreverse ee)) + (setq rtnall (append rtnall rtn))) + (org-agenda--insert-overriding-header + (with-temp-buffer + (insert "Search words: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure)) + (setq pos (point)) + (insert string "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter)) + (setq pos (point)) + (unless org-agenda-multi + (insert (substitute-command-keys "\\<org-agenda-mode-map>\ +Press `\\[org-agenda-manipulate-query-add]', \ +`\\[org-agenda-manipulate-query-subtract]' to add/sub word, \ +`\\[org-agenda-manipulate-query-add-re]', \ +`\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \ +`\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n")) + (add-text-properties pos (1- (point)) + (list 'face 'org-agenda-structure-secondary))) + (buffer-string))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall 'search) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type search + org-last-args (,todo-only ,string ,edit-at) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) + +;;; Agenda TODO list + +(defun org-agenda-propertize-selected-todo-keywords (keywords) + "Use `org-todo-keyword-faces' for the selected todo KEYWORDS." + (concat + (if (or (equal keywords "ALL") (not keywords)) + (propertize "ALL" 'face 'org-agenda-structure-filter) + (mapconcat + (lambda (kw) + (propertize kw 'face (list (org-get-todo-face kw) 'org-agenda-structure))) + (org-split-string keywords "|") + "|")) + "\n")) + +(defvar org-select-this-todo-keyword nil) +(defvar org-last-arg nil) + +(defvar crm-separator) + +;;;###autoload +(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") + (when org-agenda-overriding-arguments + (setq arg org-agenda-overriding-arguments)) + (when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) + (let* ((today (org-today)) + (date (calendar-gregorian-from-absolute today)) + (completion-ignore-case t) + kwds org-select-this-todo-keyword rtn rtnall files file pos) + (catch 'exit + (setq org-agenda-buffer-name + (org-agenda--get-buffer-name + (and org-agenda-sticky + (if (stringp org-select-this-todo-keyword) + (format "*Org Agenda(%s:%s)*" (or org-keys "t") + org-select-this-todo-keyword) + (format "*Org Agenda(%s)*" (or org-keys "t")))))) + (org-agenda-prepare "TODO") + (setq kwds org-todo-keywords-for-agenda + org-select-this-todo-keyword (if (stringp arg) arg + (and (integerp arg) + (> arg 0) + (nth (1- arg) kwds)))) + (when (equal arg '(4)) + (setq org-select-this-todo-keyword + (mapconcat #'identity + (let ((crm-separator "|")) + (completing-read-multiple + "Keyword (or KWD1|KWD2|...): " + (mapcar #'list kwds) nil nil)) + "|"))) + (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) + (org-compile-prefix-format 'todo) + (org-set-sorting-strategy 'todo) + (setq org-agenda-redo-command + `(org-todo-list (or (and (numberp current-prefix-arg) + current-prefix-arg) + ,org-select-this-todo-keyword + current-prefix-arg ,arg))) + (setq files (org-agenda-files nil 'ifmode) + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (setq rtn (org-agenda-get-day-entries file date :todo)) + (setq rtnall (append rtnall rtn)))) + (org-agenda--insert-overriding-header + (with-temp-buffer + (insert "Global list of TODO items of type: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading + (concat "ToDo: " + (or org-select-this-todo-keyword "ALL")))) + (org-agenda-mark-header-line (point-min)) + (insert (org-agenda-propertize-selected-todo-keywords + org-select-this-todo-keyword)) + (setq pos (point)) + (unless org-agenda-multi + (insert (substitute-command-keys "Press \ +\\<org-agenda-mode-map>`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \ +to search again: (0)[ALL]")) + (let ((n 0)) + (dolist (k kwds) + (let ((s (format "(%d)%s" (cl-incf n) k))) + (when (> (+ (current-column) (string-width s) 1) (window-width)) + (insert "\n ")) + (insert " " s)))) + (insert "\n")) + (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary)) + (buffer-string))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall 'todo) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type todo + org-last-args ,arg + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) + +;;; Agenda tags match + +;;;###autoload +(defun org-tags-view (&optional todo-only match) + "Show all headlines for all `org-agenda-files' matching a TAGS criterion. +The prefix arg TODO-ONLY limits the search to TODO entries." + (interactive "P") + (when org-agenda-overriding-arguments + (setq todo-only (car org-agenda-overriding-arguments) + match (nth 1 org-agenda-overriding-arguments))) + (let* ((org-tags-match-list-sublevels + org-tags-match-list-sublevels) + (completion-ignore-case t) + (org--matcher-tags-todo-only todo-only) + rtn rtnall files file pos matcher + buffer) + (when (and (stringp match) (not (string-match "\\S-" match))) + (setq match nil)) + (catch 'exit + (setq org-agenda-buffer-name + (org-agenda--get-buffer-name + (and org-agenda-sticky + (if (stringp match) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "M") "m")) + match) + (format "*Org Agenda(%s)*" + (or (and todo-only "M") "m")))))) + (setq matcher (org-make-tags-matcher match)) + ;; Prepare agendas (and `org-tag-alist-for-agenda') before + ;; expanding tags within `org-make-tags-matcher' + (org-agenda-prepare (concat "TAGS " match)) + (setq match (car matcher) + matcher (cdr matcher)) + (org-compile-prefix-format 'tags) + (org-set-sorting-strategy 'tags) + (setq org-agenda-query-string match) + (setq org-agenda-redo-command + (list 'org-tags-view + `(quote ,org--matcher-tags-todo-only) + `(if current-prefix-arg nil ,org-agenda-query-string))) + (setq files (org-agenda-files nil 'ifmode) + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (setq buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + (if (not buffer) + ;; If file does not exist, error message to agenda + (setq rtn (list + (format "ORG-AGENDA-ERROR: No such org-file %s" file)) + rtnall (append rtnall rtn)) + (with-current-buffer buffer + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in Org mode" file)) + (save-excursion + (save-restriction + (if (eq buffer org-agenda-restrict) + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + (setq rtn (org-scan-tags 'agenda + matcher + org--matcher-tags-todo-only)) + (setq rtnall (append rtnall rtn)))))))) + (org-agenda--insert-overriding-header + (with-temp-buffer + (insert "Headlines with TAGS match: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading + (concat "Match: " match))) + (setq pos (point)) + (insert match "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter)) + (setq pos (point)) + (unless org-agenda-multi + (insert (substitute-command-keys + "Press \ +\\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \ +to search again\n"))) + (add-text-properties pos (1- (point)) + (list 'face 'org-agenda-structure-secondary)) + (buffer-string))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall 'tags) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties + (point-min) (point-max) + `(org-agenda-type tags + org-last-args (,org--matcher-tags-todo-only ,match) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) + +;;; Agenda Finding stuck projects + +(defvar org-agenda-skip-regexp nil + "Regular expression used in skipping subtrees for the agenda. +This is basically a temporary global variable that can be set and then +used by user-defined selections using `org-agenda-skip-function'.") + +(defvar org-agenda-overriding-header nil + "When set during agenda, todo and tags searches it replaces the header. +If an empty string, no header will be inserted. If any other +string, it will be inserted as a header. If a function, insert +the string returned by the function as a header. If nil, a +header will be generated automatically according to the command. +This variable should not be set directly, but custom commands can +bind it in the options section.") + +(defun org-agenda-skip-entry-if (&rest conditions) + "Skip entry if any of CONDITIONS is true. +See `org-agenda-skip-if' for details." + (org-agenda-skip-if nil conditions)) + +(defun org-agenda-skip-subtree-if (&rest conditions) + "Skip subtree if any of CONDITIONS is true. +See `org-agenda-skip-if' for details." + (org-agenda-skip-if t conditions)) + +(defun org-agenda-skip-if (subtree conditions) + "Check 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. + +CONDITIONS is a list of symbols, boolean OR is used to combine the results +from different tests. Valid conditions are: + +scheduled Check if there is a scheduled cookie +notscheduled Check if there is no scheduled cookie +deadline Check if there is a deadline +notdeadline Check if there is no deadline +timestamp Check if there is a timestamp (also deadline or scheduled) +nottimestamp Check if there is no timestamp (also deadline or scheduled) +regexp Check if regexp matches +notregexp Check if regexp does not match. +todo Check if TODO keyword matches +nottodo Check if TODO keyword does not match + +The regexp is taken from the conditions list, it must come right after +the `regexp' or `notregexp' element. + +`todo' and `nottodo' accept as an argument a list of todo +keywords, which may include \"*\" to match any todo keyword. + + (org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\")) + +would skip all entries with \"TODO\" or \"WAITING\" keywords. + +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'. + +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 +that can be put into `org-agenda-skip-function' for the duration of a command." + (org-back-to-heading t) + (let* (;; (beg (point)) + (end (if subtree (save-excursion (org-end-of-subtree t) (point)) + (org-entry-end-position))) + (planning-end (if subtree end (line-end-position 2))) + m) + (and + (or (and (memq 'scheduled conditions) + (re-search-forward org-scheduled-time-regexp planning-end t)) + (and (memq 'notscheduled conditions) + (not + (save-excursion + (re-search-forward org-scheduled-time-regexp planning-end t)))) + (and (memq 'deadline conditions) + (re-search-forward org-deadline-time-regexp planning-end t)) + (and (memq 'notdeadline conditions) + (not + (save-excursion + (re-search-forward org-deadline-time-regexp planning-end t)))) + (and (memq 'timestamp conditions) + (re-search-forward org-ts-regexp end t)) + (and (memq 'nottimestamp conditions) + (not (save-excursion (re-search-forward org-ts-regexp end t)))) + (and (setq m (memq 'regexp conditions)) + (stringp (nth 1 m)) + (re-search-forward (nth 1 m) end t)) + (and (setq m (memq 'notregexp conditions)) + (stringp (nth 1 m)) + (not (save-excursion (re-search-forward (nth 1 m) end t)))) + (and (or + (setq m (memq 'nottodo conditions)) + (setq m (memq 'todo-unblocked conditions)) + (setq m (memq 'nottodo-unblocked conditions)) + (setq m (memq 'todo conditions))) + (org-agenda-skip-if-todo m end))) + end))) + +(defun org-agenda-skip-if-todo (args end) + "Helper function for `org-agenda-skip-if', do not use it directly. +ARGS is a list with first element either `todo', `nottodo', +`todo-unblocked' or `nottodo-unblocked'. The remainder is either +a list of TODO keywords, or a state symbol `todo' or `done' or +`any'." + (let ((todo-re + (concat "^\\*+[ \t]+" + (regexp-opt + (pcase args + (`(,_ todo) + (org-delete-all org-done-keywords + (copy-sequence org-todo-keywords-1))) + (`(,_ done) org-done-keywords) + (`(,_ any) org-todo-keywords-1) + (`(,_ ,(pred atom)) + (error "Invalid TODO class or type: %S" args)) + (`(,_ ,(pred (member "*"))) org-todo-keywords-1) + (`(,_ ,todo-list) todo-list)) + 'words)))) + (pcase args + (`(todo . ,_) + (let (case-fold-search) (re-search-forward todo-re end t))) + (`(nottodo . ,_) + (not (let (case-fold-search) (re-search-forward todo-re end t)))) + (`(todo-unblocked . ,_) + (catch :unblocked + (while (let (case-fold-search) (re-search-forward todo-re end t)) + (when (org-entry-blocked-p) (throw :unblocked t))) + nil)) + (`(nottodo-unblocked . ,_) + (catch :unblocked + (while (let (case-fold-search) (re-search-forward todo-re end t)) + (when (org-entry-blocked-p) (throw :unblocked nil))) + t)) + (`(,type . ,_) (error "Unknown TODO skip type: %S" type))))) + +;;;###autoload +(defun org-agenda-list-stuck-projects (&rest _ignore) + "Create agenda view for projects that are stuck. +Stuck projects are project that have no next actions. For the definitions +of what a project is and how to check if it stuck, customize the variable +`org-stuck-projects'." + (interactive) + (let* ((org-agenda-overriding-header + (or org-agenda-overriding-header "List of stuck projects: ")) + (matcher (nth 0 org-stuck-projects)) + (todo (nth 1 org-stuck-projects)) + (tags (nth 2 org-stuck-projects)) + (gen-re (org-string-nw-p (nth 3 org-stuck-projects))) + (todo-wds + (if (not (member "*" todo)) todo + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) + (org-delete-all org-done-keywords-for-agenda + (copy-sequence org-todo-keywords-for-agenda)))) + (todo-re (and todo + (format "^\\*+[ \t]+\\(%s\\)\\>" + (mapconcat #'identity todo-wds "\\|")))) + (tags-re (cond ((null tags) nil) + ((member "*" tags) org-tag-line-re) + (tags + (let ((other-tags (format "\\(?:%s:\\)*" org-tag-re))) + (concat org-outline-regexp-bol + ".*?[ \t]:" + other-tags + (regexp-opt tags t) + ":" other-tags "[ \t]*$"))) + (t nil))) + (re-list (delq nil (list todo-re tags-re gen-re))) + (skip-re + (if (null re-list) + (error "Missing information to identify unstuck projects") + (mapconcat #'identity re-list "\\|"))) + (org-agenda-skip-function + ;; Skip entry if `org-agenda-skip-regexp' matches anywhere + ;; in the subtree. + (lambda () + (and (save-excursion + (let ((case-fold-search nil)) + (re-search-forward + skip-re (save-excursion (org-end-of-subtree t)) t))) + (progn (outline-next-heading) (point)))))) + (org-tags-view nil matcher) + (setq org-agenda-buffer-name (buffer-name)) + (with-current-buffer org-agenda-buffer-name + (setq org-agenda-redo-command + `(org-agenda-list-stuck-projects ,current-prefix-arg)) + (let ((inhibit-read-only t)) + (add-text-properties + (point-min) (point-max) + `(org-redo-cmd ,org-agenda-redo-command)))))) + +;;; Diary integration + +(defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. +(defvar diary-list-entries-hook) +(defvar diary-time-regexp) +(defvar diary-modify-entry-list-string-function) +(defvar diary-file-name-prefix) +(defvar diary-display-function) + +(defun org-get-entries-from-diary (date) + "Get the (Emacs Calendar) diary entries for DATE." + (require 'diary-lib) + (declare-function diary-fancy-display "diary-lib" ()) + (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") + (diary-display-function #'diary-fancy-display) + (pop-up-frames nil) + (diary-list-entries-hook + (cons 'org-diary-default-entry diary-list-entries-hook)) + (diary-file-name-prefix nil) ; turn this feature off + (diary-modify-entry-list-string-function + #'org-modify-diary-entry-string) + (diary-time-regexp (concat "^" diary-time-regexp)) + entries + (org-disable-agenda-to-diary t)) + (save-excursion + (save-window-excursion + (diary-list-entries date 1))) + (if (not (get-buffer diary-fancy-buffer)) + (setq entries nil) + (with-current-buffer diary-fancy-buffer + (setq buffer-read-only nil) + (if (zerop (buffer-size)) + ;; No entries + (setq entries nil) + ;; Omit the date and other unnecessary stuff + (org-agenda-cleanup-fancy-diary) + ;; Add prefix to each line and extend the text properties + (if (zerop (buffer-size)) + (setq entries nil) + (setq entries (buffer-substring (point-min) (- (point-max) 1))) + (setq entries + (with-temp-buffer + (insert entries) (goto-char (point-min)) + (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t) + (unless (save-match-data (string-match diary-time-regexp (match-string 1))) + (replace-match (concat "; " (match-string 1))))) + (buffer-string))))) + (set-buffer-modified-p nil) + (kill-buffer diary-fancy-buffer))) + (when entries + (setq entries (org-split-string entries "\n")) + (setq entries + (mapcar + (lambda (x) + (setq x (org-agenda-format-item "" x nil "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)) + entries))))) + +(defvar org-agenda-cleanup-fancy-diary-hook nil + "Hook run when the fancy diary buffer is cleaned up.") + +(defun org-agenda-cleanup-fancy-diary () + "Remove unwanted stuff in buffer created by `fancy-diary-display'. +This gets rid of the date, the underline under the date, and the +dummy entry installed by Org mode to ensure non-empty diary for +each date. It also removes lines that contain only whitespace." + (goto-char (point-min)) + (if (looking-at ".*?:[ \t]*") + (progn + (replace-match "") + (re-search-forward "\n=+$" nil t) + (replace-match "") + (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) + (re-search-forward "\n=+$" nil t) + (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) + (goto-char (point-min)) + (while (re-search-forward "^ +\n" nil t) + (replace-match "")) + (goto-char (point-min)) + (when (re-search-forward "^Org mode dummy\n?" nil t) + (replace-match "")) + (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) + +(defun org-modify-diary-entry-string (string) + "Add text properties to string, allowing Org to act on it." + (org-add-props string nil + 'mouse-face 'highlight + 'help-echo (if buffer-file-name + (format "mouse-2 or RET jump to diary file %s" + (abbreviate-file-name buffer-file-name)) + "") + 'org-agenda-diary-link t + 'org-marker (org-agenda-new-marker (point-at-bol)))) + +(defun org-diary-default-entry () + "Add a dummy entry to the diary. +Needed to avoid empty dates which mess up holiday display." + ;; Catch the error if dealing with the new add-to-diary-alist + (when org-disable-agenda-to-diary + (diary-add-to-list original-date "Org mode dummy" ""))) + +(defvar org-diary-last-run-time nil) + +;;;###autoload +(defun org-diary (&rest args) + "Return diary information from org files. +This function can be used in a \"sexp\" diary entry in the Emacs calendar. +It accesses org files and extracts information from those files to be +listed in the diary. The function accepts arguments specifying what +items should be listed. For a list of arguments allowed here, see the +variable `org-agenda-entry-types'. + +The call in the diary file should look like this: + + &%%(org-diary) ~/path/to/some/orgfile.org + +Use a separate line for each org file to check. Or, if you omit the file name, +all files listed in `org-agenda-files' will be checked automatically: + + &%%(org-diary) + +If you don't give any arguments (as in the example above), the default value +of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). +So the example above may also be written as + + &%%(org-diary :deadline :timestamp :sexp :scheduled) + +The function expects the lisp variables `entry' and `date' to be provided +by the caller, because this is how the calendar works. Don't use this +function from a program - use `org-agenda-get-day-entries' instead." + (with-no-warnings (defvar date) (defvar entry)) + (when (> (- (float-time) + org-agenda-last-marker-time) + 5) + ;; I am not sure if this works with sticky agendas, because the marker + ;; list is then no longer a global variable. + (org-agenda-reset-markers)) + (org-compile-prefix-format 'agenda) + (org-set-sorting-strategy 'agenda) + (setq args (or args org-agenda-entry-types)) + (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) + (list entry) + (org-agenda-files t))) + (time (float-time)) + file rtn results) + (when (or (not org-diary-last-run-time) + (> (- time + org-diary-last-run-time) + 3)) + (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. + (when org-disable-agenda-to-diary (setq files nil)) + (while (setq file (pop files)) + (setq rtn (apply #'org-agenda-get-day-entries file date args)) + (setq results (append results rtn))) + (when results + (setq results + (mapcar (lambda (i) (replace-regexp-in-string + org-link-bracket-re "\\2" i)) + results)) + (concat (org-agenda-finalize-entries results) "\n")))) + +;;; Agenda entry finders + +(defun org-agenda--timestamp-to-absolute (&rest args) + "Call `org-time-string-to-absolute' with ARGS. +However, throw `:skip' whenever an error is raised." + (condition-case e + (apply #'org-time-string-to-absolute args) + (org-diary-sexp-no-match (throw :skip nil)) + (error + (message "%s; Skipping entry" (error-message-string e)) + (throw :skip nil)))) + +(defun org-agenda-get-day-entries (file date &rest args) + "Does the work for `org-diary' and `org-agenda'. +FILE is the path to a file to be checked for entries. DATE is date like +the one returned by `calendar-current-date'. ARGS are symbols indicating +which kind of entries should be extracted. For details about these, see +the documentation of `org-diary'." + (let* ((org-startup-folded nil) + (org-startup-align-all-tables nil) + (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file) + (error "No such file %s" file)))) + (if (not buffer) + ;; If file does not exist, signal it in diary nonetheless. + (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) + (with-current-buffer buffer + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in Org mode" file)) + (setq org-agenda-buffer (or org-agenda-buffer buffer)) + (setf org-agenda-current-date date) + (save-excursion + (save-restriction + (if (eq buffer org-agenda-restrict) + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + ;; Rationalize ARGS. Also make sure `:deadline' comes + ;; first in order to populate DEADLINES before passing it. + ;; + ;; We use `delq' since `org-uniquify' duplicates ARGS, + ;; guarding us from modifying `org-agenda-entry-types'. + (setf args (org-uniquify (or args org-agenda-entry-types))) + (when (and (memq :scheduled args) (memq :scheduled* args)) + (setf args (delq :scheduled* args))) + (cond + ((memq :deadline args) + (setf args (cons :deadline + (delq :deadline (delq :deadline* args))))) + ((memq :deadline* args) + (setf args (cons :deadline* (delq :deadline* args))))) + ;; Collect list of headlines. Return them flattened. + (let ((case-fold-search nil) results deadlines) + (org-dlet + ((date date)) + (dolist (arg args (apply #'nconc (nreverse results))) + (pcase arg + ((and :todo (guard (org-agenda-today-p date))) + (push (org-agenda-get-todos) results)) + (:timestamp + (push (org-agenda-get-blocks) results) + (push (org-agenda-get-timestamps deadlines) results)) + (:sexp + (push (org-agenda-get-sexps) results)) + (:scheduled + (push (org-agenda-get-scheduled deadlines) results)) + (:scheduled* + (push (org-agenda-get-scheduled deadlines t) results)) + (:closed + (push (org-agenda-get-progress) results)) + (:deadline + (setf deadlines (org-agenda-get-deadlines)) + (push deadlines results)) + (:deadline* + (setf deadlines (org-agenda-get-deadlines t)) + (push deadlines results)))))))))))) + +(defsubst org-em (x y list) + "Is X or Y a member of LIST?" + (or (memq x list) (memq y list))) + +(defvar org-heading-keyword-regexp-format) ; defined in org.el +(defvar org-agenda-sorting-strategy-selected nil) + +(defun org-agenda-entry-get-agenda-timestamp (pom) + "Retrieve timestamp information for sorting agenda views. +Given a point or marker POM, returns a cons cell of the timestamp +and the timestamp type relevant for the sorting strategy in +`org-agenda-sorting-strategy-selected'." + (let (ts ts-date-type) + (save-match-data + (cond ((org-em 'scheduled-up 'scheduled-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get pom "SCHEDULED") + ts-date-type " scheduled")) + ((org-em 'deadline-up 'deadline-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get pom "DEADLINE") + ts-date-type " deadline")) + ((org-em 'ts-up 'ts-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get pom "TIMESTAMP") + ts-date-type " timestamp")) + ((org-em 'tsia-up 'tsia-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get pom "TIMESTAMP_IA") + ts-date-type " timestamp_ia")) + ((org-em 'timestamp-up 'timestamp-down + org-agenda-sorting-strategy-selected) + (setq ts (or (org-entry-get pom "SCHEDULED") + (org-entry-get pom "DEADLINE") + (org-entry-get pom "TIMESTAMP") + (org-entry-get pom "TIMESTAMP_IA")) + ts-date-type "")) + (t (setq ts-date-type ""))) + (cons (when ts (ignore-errors (org-time-string-to-absolute ts))) + ts-date-type)))) + +(defun org-agenda-get-todos () + "Return the TODO information for agenda display." + (let* ((props (list 'face nil + 'done-face 'org-agenda-done + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (case-fold-search nil) + (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 level tags todo-state + ts-date ts-date-type ts-date-pair + ee txt beg end inherited-tags todo-state-end-pos) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (save-match-data + (beginning-of-line) + (org-agenda-skip) + (setq beg (point) end (save-excursion (outline-next-heading) (point))) + (unless (and (setq todo-state (org-get-todo-state)) + (setq todo-state-end-pos (match-end 2))) + (goto-char end) + (throw :skip nil)) + (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end) + (goto-char (1+ beg)) + (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) + (throw :skip nil))) + (goto-char (match-beginning 2)) + (setq marker (org-agenda-new-marker (match-beginning 0)) + category (org-get-category) + ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) + ts-date (car ts-date-pair) + ts-date-type (cdr ts-date-pair) + txt (org-trim (buffer-substring (match-beginning 2) (match-end 0))) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'todo org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'todo org-agenda-use-tag-inheritance)))) + tags (org-get-tags nil (not inherited-tags)) + level (make-string (org-reduced-level (org-outline-level)) ? ) + txt (org-agenda-format-item "" txt level category tags t) + priority (1+ (org-get-priority txt))) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker + 'priority priority + 'level level + 'ts-date ts-date + 'type (concat "todo" ts-date-type) 'todo-state todo-state) + (push txt ee) + (if org-agenda-todo-list-sublevels + (goto-char todo-state-end-pos) + (org-end-of-subtree 'invisible)))) + (nreverse ee))) + +(defun org-agenda-todo-custom-ignore-p (time n) + "Check whether timestamp is farther away than n number of days. +This function is invoked if `org-agenda-todo-ignore-deadlines', +`org-agenda-todo-ignore-scheduled' or +`org-agenda-todo-ignore-timestamp' is set to an integer." + (let ((days (org-time-stamp-to-now + time org-agenda-todo-ignore-time-comparison-use-seconds))) + (if (>= n 0) + (>= days n) + (<= days n)))) + +;;;###autoload +(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item + (&optional end) + "Do we have a reason to ignore this TODO entry because it has a time stamp?" + (when (or org-agenda-todo-ignore-with-date + org-agenda-todo-ignore-scheduled + org-agenda-todo-ignore-deadlines + org-agenda-todo-ignore-timestamp) + (setq end (or end (save-excursion (outline-next-heading) (point)))) + (save-excursion + (or (and org-agenda-todo-ignore-with-date + (re-search-forward org-ts-regexp end t)) + (and org-agenda-todo-ignore-scheduled + (re-search-forward org-scheduled-time-regexp end t) + (cond + ((eq org-agenda-todo-ignore-scheduled 'future) + (> (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) + ((eq org-agenda-todo-ignore-scheduled 'past) + (<= (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) + ((numberp org-agenda-todo-ignore-scheduled) + (org-agenda-todo-custom-ignore-p + (match-string 1) org-agenda-todo-ignore-scheduled)) + (t))) + (and org-agenda-todo-ignore-deadlines + (re-search-forward org-deadline-time-regexp end t) + (cond + ((eq org-agenda-todo-ignore-deadlines 'all) t) + ((eq org-agenda-todo-ignore-deadlines 'far) + (not (org-deadline-close-p (match-string 1)))) + ((eq org-agenda-todo-ignore-deadlines 'future) + (> (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) + ((eq org-agenda-todo-ignore-deadlines 'past) + (<= (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) + ((numberp org-agenda-todo-ignore-deadlines) + (org-agenda-todo-custom-ignore-p + (match-string 1) org-agenda-todo-ignore-deadlines)) + (t (org-deadline-close-p (match-string 1))))) + (and org-agenda-todo-ignore-timestamp + (let ((buffer (current-buffer)) + (regexp + (concat + org-scheduled-time-regexp "\\|" org-deadline-time-regexp)) + (start (point))) + ;; Copy current buffer into a temporary one + (with-temp-buffer + (insert-buffer-substring buffer start end) + (goto-char (point-min)) + ;; Delete SCHEDULED and DEADLINE items + (while (re-search-forward regexp end t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-min)) + ;; No search for timestamp left + (when (re-search-forward org-ts-regexp nil t) + (cond + ((eq org-agenda-todo-ignore-timestamp 'future) + (> (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) + ((eq org-agenda-todo-ignore-timestamp 'past) + (<= (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) + 0)) + ((numberp org-agenda-todo-ignore-timestamp) + (org-agenda-todo-custom-ignore-p + (match-string 1) org-agenda-todo-ignore-timestamp)) + (t)))))))))) + +(defun org-agenda-get-timestamps (&optional deadlines) + "Return the date stamp information for agenda display. +Optional argument DEADLINES is a list of deadline items to be +displayed in agenda view." + (with-no-warnings (defvar date)) + (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 + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to Org file %s" + (abbreviate-file-name buffer-file-name)))) + (current (calendar-absolute-from-gregorian date)) + (today (org-today)) + (deadline-position-alist + (mapcar (lambda (d) + (let ((m (get-text-property 0 'org-hd-marker d))) + (and m (marker-position m)))) + deadlines)) + ;; Match time-stamps set to current date, time-stamps with + ;; a repeater, and S-exp time-stamps. + (regexp + (concat + (if org-agenda-include-inactive-timestamps "[[<]" "<") + (regexp-quote + (substring + (format-time-string + (car org-time-stamp-formats) + (encode-time ; DATE bound by calendar + 0 0 0 (nth 1 date) (car date) (nth 2 date))) + 1 11)) + "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" + "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) + timestamp-items) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + ;; Skip date ranges, scheduled and deadlines, which are handled + ;; specially. Also skip time-stamps before first headline as + ;; there would be no entry to add to the agenda. Eventually, + ;; ignore clock entries. + (catch :skip + (save-match-data + (when (or (org-at-date-range-p) + (org-at-planning-p) + (org-before-first-heading-p) + (and org-agenda-include-inactive-timestamps + (org-at-clock-log-p))) + (throw :skip nil)) + (org-agenda-skip)) + (let* ((pos (match-beginning 0)) + (repeat (match-string 1)) + (sexp-entry (match-string 3)) + (time-stamp (if (or repeat sexp-entry) (match-string 0) + (save-excursion + (goto-char pos) + (looking-at org-ts-regexp-both) + (match-string 0)))) + (todo-state (org-get-todo-state)) + (warntime (get-text-property (point) 'org-appt-warntime)) + (done? (member todo-state org-done-keywords))) + ;; Possibly skip done tasks. + (when (and done? org-agenda-skip-timestamp-if-done) + (throw :skip t)) + ;; S-exp entry doesn't match current day: skip it. + (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date))) + (throw :skip nil)) + (when repeat + (let* ((past + ;; A repeating time stamp is shown at its base + ;; date and every repeated date up to TODAY. If + ;; `org-agenda-prefer-last-repeat' is non-nil, + ;; however, only the last repeat before today + ;; (inclusive) is shown. + (org-agenda--timestamp-to-absolute + repeat + (if (or (> current today) + (eq org-agenda-prefer-last-repeat t) + (member todo-state org-agenda-prefer-last-repeat)) + today + current) + 'past (current-buffer) pos)) + (future + ;; Display every repeated date past TODAY + ;; (exclusive) unless + ;; `org-agenda-show-future-repeats' is nil. If + ;; this variable is set to `next', only display + ;; the first repeated date after TODAY + ;; (exclusive). + (cond + ((<= current today) past) + ((not org-agenda-show-future-repeats) past) + (t + (let ((base (if (eq org-agenda-show-future-repeats 'next) + (1+ today) + current))) + (org-agenda--timestamp-to-absolute + repeat base 'future (current-buffer) pos)))))) + (when (and (/= current past) (/= current future)) + (throw :skip nil)))) + (save-excursion + (re-search-backward org-outline-regexp-bol nil t) + ;; Possibly skip time-stamp when a deadline is set. + (when (and org-agenda-skip-timestamp-if-deadline-is-shown + (assq (point) deadline-position-alist)) + (throw :skip nil)) + (let* ((category (org-get-category pos)) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (consp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags nil (not inherited-tags))) + (level (make-string (org-reduced-level (org-outline-level)) + ?\s)) + (head (and (looking-at "\\*+[ \t]+\\(.*\\)") + (match-string 1))) + (inactive? (= (char-after pos) ?\[)) + (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p))) + (item + (org-agenda-format-item + (and inactive? org-agenda-inactive-leader) + head level category tags time-stamp org-ts-regexp habit?))) + (org-add-props item props + 'priority (if habit? + (org-habit-get-priority (org-habit-parse-todo)) + (org-get-priority item)) + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker) + 'date date + 'level level + 'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat) + current) + 'todo-state todo-state + 'warntime warntime + 'type "timestamp") + (push item timestamp-items)))) + (when org-agenda-skip-additional-timestamps-same-entry + (outline-next-heading)))) + (nreverse timestamp-items))) + +(defun org-agenda-get-sexps () + "Return the sexp information for agenda display." + (require 'diary-lib) + (with-no-warnings (defvar date) (defvar entry)) + (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 "^&?%%(") + ;; FIXME: Is this `entry' binding intended to be dynamic, + ;; so as to "hide" any current binding for it? + marker category extra level ee txt tags entry + result beg b sexp sexp-entry todo-state warntime inherited-tags) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (org-agenda-skip) + (setq beg (match-beginning 0)) + (goto-char (1- (match-end 0))) + (setq b (point)) + (forward-sexp 1) + (setq sexp (buffer-substring b (point))) + (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)") + (org-trim (match-string 1)) + "")) + (setq result (org-diary-sexp-entry sexp sexp-entry date)) + (when result + (setq marker (org-agenda-new-marker beg) + level (make-string (org-reduced-level (org-outline-level)) ? ) + category (org-get-category beg) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda org-agenda-use-tag-inheritance)))) + tags (org-get-tags nil (not inherited-tags)) + todo-state (org-get-todo-state) + warntime (get-text-property (point) 'org-appt-warntime) + extra nil) + + (dolist (r (if (stringp result) + (list result) + result)) ;; we expect a list here + (when (and org-agenda-diary-sexp-prefix + (string-match org-agenda-diary-sexp-prefix r)) + (setq extra (match-string 0 r) + r (replace-match "" nil nil r))) + (if (string-match "\\S-" r) + (setq txt r) + (setq txt "SEXP entry returned empty string")) + (setq txt (org-agenda-format-item extra txt level category tags 'time)) + (org-add-props txt props 'org-marker marker + 'date date 'todo-state todo-state + 'level level 'type "sexp" 'warntime warntime) + (push txt ee))))) + (nreverse ee))) + +;; Calendar sanity: define some functions that are independent of +;; `calendar-date-style'. +(defun org-anniversary (year month day &optional mark) + "Like `diary-anniversary', but with fixed (ISO) order of arguments." + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-anniversary year month day mark)))) +(defun org-cyclic (N year month day &optional mark) + "Like `diary-cyclic', but with fixed (ISO) order of arguments." + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-cyclic N year month day mark)))) +(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark) + "Like `diary-block', but with fixed (ISO) order of arguments." + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-block Y1 M1 D1 Y2 M2 D2 mark)))) +(defun org-date (year month day &optional mark) + "Like `diary-date', but with fixed (ISO) order of arguments." + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-date year month day mark)))) + +;; 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. 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. If SKIP-WEEKS arguments are holiday strings, +then those holidays will be skipped." + (with-no-warnings (defvar date) (defvar entry)) + (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)) + (h (when skip-weeks (calendar-check-holidays date)))) + (and + (<= date1 d) + (<= d date2) + (= (calendar-day-of-week date) dayname) + (or (not skip-weeks) + (progn + (require 'cal-iso) + (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) + (not (or (and h (memq 'holidays skip-weeks)) + (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) + entry))) + +(defalias 'org-get-closed #'org-agenda-get-progress) +(defun org-agenda-get-progress () + "Return the logged TODO entries for agenda display." + (with-no-warnings (defvar date)) + (let* ((props (list 'mouse-face 'highlight + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (items (if (consp org-agenda-show-log-scoped) + org-agenda-show-log-scoped + (if (eq org-agenda-show-log-scoped 'clockcheck) + '(clock) + org-agenda-log-mode-items))) + (parts + (delq nil + (list + (when (memq 'closed items) (concat "\\<" org-closed-string)) + (when (memq 'clock items) (concat "\\<" org-clock-string)) + (when (memq 'state items) + (format "- +State \"%s\".*?" org-todo-regexp))))) + (parts-re (if parts (mapconcat #'identity parts "\\|") + (error "`org-agenda-log-mode-items' is empty"))) + (regexp (concat + "\\(" parts-re "\\)" + " *\\[" + (regexp-quote + (substring + (format-time-string + (car org-time-stamp-formats) + (encode-time ; DATE bound by calendar + 0 0 0 (nth 1 date) (car date) (nth 2 date))) + 1 11)))) + (org-agenda-search-headline-for-time nil) + marker hdmarker priority category level tags closedp type + statep clockp state ee txt extra timestr rest clocked inherited-tags) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (org-agenda-skip) + (setq marker (org-agenda-new-marker (match-beginning 0)) + closedp (equal (match-string 1) org-closed-string) + statep (equal (string-to-char (match-string 1)) ?-) + 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))) + (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)) + (progn (setq timestr (concat (substring timestr 0 -1) + "-" (match-string 1 rest) "]")) + (setq clocked (match-string 2 rest))) + (setq clocked "-"))) + (save-excursion + (setq extra + (cond + ((not org-agenda-log-mode-add-notes) nil) + (statep + (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") + (match-string 1))) + (clockp + (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") + (match-string 1))))) + (if (not (re-search-backward org-outline-regexp-bol nil t)) + (throw :skip nil) + (goto-char (match-beginning 0)) + (setq hdmarker (org-agenda-new-marker) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'todo org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'todo org-agenda-use-tag-inheritance)))) + tags (org-get-tags nil (not inherited-tags)) + level (make-string (org-reduced-level (org-outline-level)) ? )) + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (setq txt (match-string 1)) + (when extra + (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt) + (setq txt (concat (substring txt 0 (match-beginning 1)) + " - " extra " " (match-string 2 txt))) + (setq txt (concat txt " - " extra)))) + (setq txt (org-agenda-format-item + (cond + (closedp "Closed: ") + (statep (concat "State: (" state ")")) + (t (concat "Clocked: (" clocked ")"))) + txt level category tags timestr))) + (setq type (cond (closedp "closed") + (statep "state") + (t "clock"))) + (setq priority 100000) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done + 'priority priority 'level level + 'type type 'date date + 'undone-face 'org-warning 'done-face 'org-agenda-done) + (push txt ee)) + (goto-char (point-at-eol)))) + (nreverse ee))) + +(defun org-agenda-show-clocking-issues () + "Add overlays, showing issues with clocking. +See also the user option `org-agenda-clock-consistency-checks'." + (interactive) + (let* ((pl org-agenda-clock-consistency-checks) + (re (concat "^[ \t]*" + org-clock-string + "[ \t]+" + "\\(\\[.*?\\]\\)" ; group 1 is first stamp + "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second + (tlstart 0.) + (tlend 0.) + (maxtime (org-duration-to-minutes + (or (plist-get pl :max-duration) "24:00"))) + (mintime (org-duration-to-minutes + (or (plist-get pl :min-duration) 0))) + (maxgap (org-duration-to-minutes + ;; default 30:00 means never complain + (or (plist-get pl :max-gap) "30:00"))) + (gapok (mapcar #'org-duration-to-minutes + (plist-get pl :gap-ok-around))) + (def-face (or (plist-get pl :default-face) + '((:background "DarkRed") (:foreground "white")))) + issue face m te ts dt ov) + (goto-char (point-min)) + (while (re-search-forward " Clocked: +(\\(?:-\\|\\([0-9]+:[0-9]+\\)\\))" nil t) + (setq issue nil face def-face) + (catch 'next + (setq m (org-get-at-bol 'org-marker) + te nil ts nil) + (unless (and m (markerp m)) + (setq issue "No valid clock line") (throw 'next t)) + (org-with-point-at m + (save-excursion + (goto-char (point-at-bol)) + (unless (looking-at re) + (error "No valid Clock line") + (throw 'next t)) + (unless (match-end 3) + (setq issue + (format + "No end time: (%s)" + (org-duration-from-minutes + (floor + (- (float-time (org-current-time)) + (float-time (org-time-string-to-time (match-string 1)))) + 60))) + face (or (plist-get pl :no-end-time-face) face)) + (throw 'next t)) + (setq ts (match-string 1) + te (match-string 3) + ts (float-time (org-time-string-to-time ts)) + te (float-time (org-time-string-to-time te)) + dt (- te ts)))) + (cond + ((> dt (* 60 maxtime)) + ;; a very long clocking chunk + (setq issue (format "Clocking interval is very long: %s" + (org-duration-from-minutes (floor dt 60))) + face (or (plist-get pl :long-face) face))) + ((< dt (* 60 mintime)) + ;; a very short clocking chunk + (setq issue (format "Clocking interval is very short: %s" + (org-duration-from-minutes (floor dt 60))) + face (or (plist-get pl :short-face) face))) + ((and (> tlend 0) (< ts tlend)) + ;; Two clock entries are overlapping + (setq issue (format "Clocking overlap: %d minutes" + (/ (- tlend ts) 60)) + face (or (plist-get pl :overlap-face) face))) + ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap)))) + ;; There is a gap, lets see if we need to report it + (unless (org-agenda-check-clock-gap tlend ts gapok) + (setq issue (format "Clocking gap: %d minutes" + (/ (- ts tlend) 60)) + face (or (plist-get pl :gap-face) face)))) + (t nil))) + (setq tlend (or te tlend) tlstart (or ts tlstart)) + (when issue + ;; OK, there was some issue, add an overlay to show the issue + (setq ov (make-overlay (point-at-bol) (point-at-eol))) + (overlay-put ov 'before-string + (concat + (org-add-props + (format "%-43s" (concat " " issue)) + nil + 'face face) + "\n")) + (overlay-put ov 'evaporate t))))) + +(defun org-agenda-check-clock-gap (t1 t2 ok-list) + "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values." + (catch 'exit + (unless ok-list + ;; there are no OK times for gaps... + (throw 'exit nil)) + (when (> (- (/ t2 36000) (/ t1 36000)) 24) + ;; This is more than 24 hours, so it is OK. + ;; because we have at least one OK time, that must be in the + ;; 24 hour interval. + (throw 'exit t)) + ;; We have a shorter gap. + ;; Now we have to get the minute of the day when these times are + (let* ((t1dec (org-decode-time t1)) + (t2dec (org-decode-time t2)) + ;; compute the minute on the day + (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec)))) + (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec))))) + (when (< min2 min1) + ;; if min2 is smaller than min1, this means it is on the next day. + ;; Wrap it to after midnight. + (setq min2 (+ min2 1440))) + ;; Now check if any of the OK times is in the gap + (mapc (lambda (x) + ;; Wrap the time to after midnight if necessary + (when (< x min1) (setq x (+ x 1440))) + ;; Check if in interval + (and (<= min1 x) (>= min2 x) (throw 'exit t))) + ok-list) + ;; Nope, this gap is not OK + nil))) + +(defun org-agenda-get-deadlines (&optional with-hour) + "Return the deadline information for agenda display. +When WITH-HOUR is non-nil, only return deadlines with an hour +specification like [h]h:mm." + (with-no-warnings (defvar date)) + (let* ((props (list 'mouse-face 'highlight + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (regexp (if with-hour + org-deadline-time-hour-regexp + org-deadline-time-regexp)) + (today (org-today)) + (today? (org-agenda-today-p date)) ; DATE bound by calendar. + (current (calendar-absolute-from-gregorian date)) + deadline-items) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) + (org-agenda-skip) + (let* ((s (match-string 1)) + (pos (1- (match-beginning 1))) + (todo-state (save-match-data (org-get-todo-state))) + (done? (member todo-state org-done-keywords)) + (sexp? (string-prefix-p "%%" s)) + ;; DEADLINE is the deadline date for the entry. It is + ;; either the base date or the last repeat, according + ;; to `org-agenda-prefer-last-repeat'. + (deadline + (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + ((or (eq org-agenda-prefer-last-repeat t) + (member todo-state org-agenda-prefer-last-repeat)) + (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)) + (t (org-agenda--timestamp-to-absolute s)))) + ;; REPEAT is the future repeat closest from CURRENT, + ;; according to `org-agenda-show-future-repeats'. If + ;; the latter is nil, or if the time stamp has no + ;; repeat part, default to DEADLINE. + (repeat + (cond + (sexp? deadline) + ((<= current today) deadline) + ((not org-agenda-show-future-repeats) deadline) + (t + (let ((base (if (eq org-agenda-show-future-repeats 'next) + (1+ today) + current))) + (org-agenda--timestamp-to-absolute + s base 'future (current-buffer) pos))))) + (diff (- deadline current)) + (suppress-prewarning + (let ((scheduled + (and org-agenda-skip-deadline-prewarning-if-scheduled + (org-entry-get nil "SCHEDULED")))) + (cond + ((not scheduled) nil) + ;; The current item has a scheduled date, so + ;; evaluate its prewarning lead time. + ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) + ;; Use global prewarning-restart lead time. + org-agenda-skip-deadline-prewarning-if-scheduled) + ((eq org-agenda-skip-deadline-prewarning-if-scheduled + 'pre-scheduled) + ;; Set pre-warning to no earlier than SCHEDULED. + (min (- deadline + (org-agenda--timestamp-to-absolute scheduled)) + org-deadline-warning-days)) + ;; Set pre-warning to deadline. + (t 0)))) + (wdays (or suppress-prewarning (org-get-wdays s)))) + (cond + ;; Only display deadlines at their base date, at future + ;; repeat occurrences or in today agenda. + ((= current deadline) nil) + ((= current repeat) nil) + ((not today?) (throw :skip nil)) + ;; Upcoming deadline: display within warning period WDAYS. + ((> deadline current) (when (> diff wdays) (throw :skip nil))) + ;; Overdue deadline: warn about it for + ;; `org-deadline-past-days' duration. + (t (when (< org-deadline-past-days (- diff)) (throw :skip nil)))) + ;; Possibly skip done tasks. + (when (and done? + (or org-agenda-skip-deadline-if-done + (/= deadline current))) + (throw :skip nil)) + (save-excursion + (re-search-backward "^\\*+[ \t]+" nil t) + (goto-char (match-end 0)) + (let* ((category (org-get-category)) + (level (make-string (org-reduced-level (org-outline-level)) + ?\s)) + (head (buffer-substring (point) (line-end-position))) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags nil (not inherited-tags))) + (time + (cond + ;; No time of day designation if it is only + ;; a reminder. + ((and (/= current deadline) (/= current repeat)) nil) + ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (concat (substring s (match-beginning 1)) " ")) + (t 'time))) + (item + (org-agenda-format-item + ;; Insert appropriate suffixes before deadlines. + ;; Those only apply to today agenda. + (pcase-let ((`(,now ,future ,past) + org-agenda-deadline-leaders)) + (cond + ((and today? (< deadline today)) (format past (- diff))) + ((and today? (> deadline today)) (format future diff)) + (t now))) + head level category tags time)) + (face (org-agenda-deadline-face + (- 1 (/ (float diff) (max wdays 1))))) + (upcoming? (and today? (> deadline today))) + (warntime (get-text-property (point) 'org-appt-warntime))) + (org-add-props item props + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) + 'warntime warntime + 'level level + 'ts-date deadline + 'priority + ;; Adjust priority to today reminders about deadlines. + ;; Overdue deadlines get the highest priority + ;; increase, then imminent deadlines and eventually + ;; more distant deadlines. + (let ((adjust (if today? (- diff) 0))) + (+ adjust (org-get-priority item))) + 'todo-state todo-state + 'type (if upcoming? "upcoming-deadline" "deadline") + 'date (if upcoming? date deadline) + 'face (if done? 'org-agenda-done face) + 'undone-face face + 'done-face 'org-agenda-done) + (push item deadline-items)))))) + (nreverse deadline-items))) + +(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." + (assoc-default fraction org-agenda-deadline-faces #'<=)) + +(defun org-agenda-get-scheduled (&optional deadlines with-hour) + "Return the scheduled information for agenda display. +Optional argument DEADLINES is a list of deadline items to be +displayed in agenda view. When WITH-HOUR is non-nil, only return +scheduled items with an hour specification like [h]h:mm." + (with-no-warnings (defvar date)) + (let* ((props (list 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'done-face 'org-agenda-done + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to Org file %s" + (abbreviate-file-name buffer-file-name)))) + (regexp (if with-hour + org-scheduled-time-hour-regexp + org-scheduled-time-regexp)) + (today (org-today)) + (todayp (org-agenda-today-p date)) ; DATE bound by calendar. + (current (calendar-absolute-from-gregorian date)) + (deadline-pos + (mapcar (lambda (d) + (let ((m (get-text-property 0 'org-hd-marker d))) + (and m (marker-position m)))) + deadlines)) + scheduled-items) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) + (org-agenda-skip) + (let* ((s (match-string 1)) + (pos (1- (match-beginning 1))) + (todo-state (save-match-data (org-get-todo-state))) + (donep (member todo-state org-done-keywords)) + (sexp? (string-prefix-p "%%" s)) + ;; SCHEDULE is the scheduled date for the entry. It is + ;; either the bare date or the last repeat, according + ;; to `org-agenda-prefer-last-repeat'. + (schedule + (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + ((or (eq org-agenda-prefer-last-repeat t) + (member todo-state org-agenda-prefer-last-repeat)) + (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)) + (t (org-agenda--timestamp-to-absolute s)))) + ;; REPEAT is the future repeat closest from CURRENT, + ;; according to `org-agenda-show-future-repeats'. If + ;; the latter is nil, or if the time stamp has no + ;; repeat part, default to SCHEDULE. + (repeat + (cond + (sexp? schedule) + ((<= current today) schedule) + ((not org-agenda-show-future-repeats) schedule) + (t + (let ((base (if (eq org-agenda-show-future-repeats 'next) + (1+ today) + current))) + (org-agenda--timestamp-to-absolute + s base 'future (current-buffer) pos))))) + (diff (- current schedule)) + (warntime (get-text-property (point) 'org-appt-warntime)) + (pastschedp (< schedule today)) + (futureschedp (> schedule today)) + (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p))) + (suppress-delay + (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline + (org-entry-get nil "DEADLINE")))) + (cond + ((not deadline) nil) + ;; The current item has a deadline date, so + ;; evaluate its delay time. + ((integerp org-agenda-skip-scheduled-delay-if-deadline) + ;; Use global delay time. + (- org-agenda-skip-scheduled-delay-if-deadline)) + ((eq org-agenda-skip-scheduled-delay-if-deadline + 'post-deadline) + ;; Set delay to no later than DEADLINE. + (min (- schedule + (org-agenda--timestamp-to-absolute deadline)) + org-scheduled-delay-days)) + (t 0)))) + (ddays + (cond + ;; Nullify delay when a repeater triggered already + ;; and the delay is of the form --Xd. + ((and (string-match-p "--[0-9]+[hdwmy]" s) + (> schedule (org-agenda--timestamp-to-absolute s))) + 0) + (suppress-delay + (let ((org-scheduled-delay-days suppress-delay)) + (org-get-wdays s t t))) + (t (org-get-wdays s t))))) + ;; Display scheduled items at base date (SCHEDULE), today if + ;; scheduled before the current date, and at any repeat past + ;; today. However, skip delayed items and items that have + ;; been displayed for more than `org-scheduled-past-days'. + (unless (and todayp + habitp + (bound-and-true-p org-habit-show-all-today)) + (when (or (and (> ddays 0) (< diff ddays)) + (> diff (or (and habitp org-habit-scheduled-past-days) + org-scheduled-past-days)) + (> schedule current) + (and (/= current schedule) + (/= current today) + (/= current repeat))) + (throw :skip nil))) + ;; Possibly skip done tasks. + (when (and donep + (or org-agenda-skip-scheduled-if-done + (/= schedule current))) + (throw :skip nil)) + ;; Skip entry if it already appears as a deadline, per + ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This + ;; doesn't apply to habits. + (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown + ((guard + (or (not (memq (line-beginning-position 0) deadline-pos)) + habitp)) + nil) + (`repeated-after-deadline + (let ((deadline (time-to-days + (org-get-deadline-time (point))))) + (and (<= schedule deadline) (> current deadline)))) + (`not-today pastschedp) + (`t t) + (_ nil)) + (throw :skip nil)) + ;; Skip habits if `org-habit-show-habits' is nil, or if we + ;; only show them for today. Also skip done habits. + (when (and habitp + (or donep + (not (bound-and-true-p org-habit-show-habits)) + (and (not todayp) + (bound-and-true-p + org-habit-show-habits-only-for-today)))) + (throw :skip nil)) + (save-excursion + (re-search-backward "^\\*+[ \t]+" nil t) + (goto-char (match-end 0)) + (let* ((category (org-get-category)) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags nil (not inherited-tags))) + (level (make-string (org-reduced-level (org-outline-level)) + ?\s)) + (head (buffer-substring (point) (line-end-position))) + (time + (cond + ;; No time of day designation if it is only a + ;; reminder, except for habits, which always show + ;; the time of day. Habits are an exception + ;; because if there is a time of day, that is + ;; interpreted to mean they should usually happen + ;; then, even if doing the habit was missed. + ((and + (not habitp) + (/= current schedule) + (/= current repeat)) + nil) + ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (concat (substring s (match-beginning 1)) " ")) + (t 'time))) + (item + (org-agenda-format-item + (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders)) + ;; Show a reminder of a past scheduled today. + (if (and todayp pastschedp) + (format past diff) + first)) + head level category tags time nil habitp)) + (face (cond ((and (not habitp) pastschedp) + 'org-scheduled-previously) + ((and habitp futureschedp) + 'org-agenda-done) + (todayp 'org-scheduled-today) + (t 'org-scheduled))) + (habitp (and habitp (org-habit-parse-todo)))) + (org-add-props item props + 'undone-face face + 'face (if donep 'org-agenda-done face) + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) + 'type (if pastschedp "past-scheduled" "scheduled") + 'date (if pastschedp schedule date) + 'ts-date schedule + 'warntime warntime + 'level level + 'priority (if habitp (org-habit-get-priority habitp) + (+ 99 diff (org-get-priority item))) + 'org-habit-p habitp + 'todo-state todo-state) + (push item scheduled-items)))))) + (nreverse scheduled-items))) + +(defun org-agenda-get-blocks () + "Return the date-range information for agenda display." + (with-no-warnings (defvar date)) + (let* ((props (list 'face nil + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (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 + level todo-state tags pos head donep inherited-tags) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (org-agenda-skip) + (setq pos (point)) + (let ((start-time (match-string 1)) + (end-time (match-string 2))) + (setq s1 (match-string 1) + s2 (match-string 2) + d1 (time-to-days + (condition-case err + (org-time-string-to-time s1) + (error + (error + "Bad timestamp %S at %d in buffer %S\nError was: %s" + s1 + pos + (current-buffer) + (error-message-string err))))) + d2 (time-to-days + (condition-case err + (org-time-string-to-time s2) + (error + (error + "Bad timestamp %S at %d in buffer %S\nError was: %s" + s2 + pos + (current-buffer) + (error-message-string err)))))) + (when (and (> (- d0 d1) -1) (> (- d2 d0) -1)) + ;; Only allow days between the limits, because the normal + ;; date stamps will catch the limits. + (save-excursion + (setq todo-state (org-get-todo-state)) + (setq donep (member todo-state org-done-keywords)) + (when (and donep org-agenda-skip-timestamp-if-done) + (throw :skip t)) + (setq marker (org-agenda-new-marker (point)) + category (org-get-category)) + (if (not (re-search-backward org-outline-regexp-bol nil t)) + (throw :skip nil) + (goto-char (match-beginning 0)) + (setq hdmarker (org-agenda-new-marker (point)) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda org-agenda-use-tag-inheritance)))) + tags (org-get-tags nil (not inherited-tags))) + (setq level (make-string (org-reduced-level (org-outline-level)) ? )) + (looking-at "\\*+[ \t]+\\(.*\\)") + (setq head (match-string 1)) + (let ((remove-re + (if org-agenda-remove-timeranges-from-blocks + (concat + "<" (regexp-quote s1) ".*?>" + "--" + "<" (regexp-quote s2) ".*?>") + nil))) + (setq txt (org-agenda-format-item + (format + (nth (if (= d1 d2) 0 1) + org-agenda-timerange-leaders) + (1+ (- d0 d1)) (1+ (- d2 d1))) + head level category tags + (save-match-data + (let ((hhmm1 (and (string-match org-ts-regexp1 s1) + (match-string 6 s1))) + (hhmm2 (and (string-match org-ts-regexp1 s2) + (match-string 6 s2)))) + (cond ((string= hhmm1 hhmm2) + (concat "<" start-time ">--<" end-time ">")) + ((and (= d1 d0) (= d2 d0)) + (concat "<" start-time ">--<" end-time ">")) + ((= d1 d0) + (concat "<" start-time ">")) + ((= d2 d0) + (concat "<" end-time ">"))))) + remove-re)))) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker + 'type "block" 'date date + 'level level + 'todo-state todo-state + 'priority (org-get-priority txt)) + (push txt ee)))) + (goto-char pos))) + ;; Sort the entries by expiration date. + (nreverse ee))) + +;;; Agenda presentation and sorting + +(defvar org-prefix-has-time nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%t'.") +(defvar org-prefix-has-tag nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%T'.") +(defvar org-prefix-has-effort nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%e'.") +(defvar org-prefix-has-breadcrumbs nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%b'.") +(defvar org-prefix-category-length nil + "Used by `org-compile-prefix-format' to remember the category field width.") +(defvar org-prefix-category-max-length nil + "Used by `org-compile-prefix-format' to remember the category field width.") + +(defun org-agenda-get-category-icon (category) + "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." + (cl-dolist (entry org-agenda-category-icon-alist) + (when (string-match-p (car entry) category) + (if (listp (cadr entry)) + (cl-return (cadr entry)) + (cl-return (apply #'create-image (cdr entry))))))) + +(defun org-agenda-format-item (extra txt &optional with-level with-category tags dotime + remove-re habitp) + "Format TXT to be inserted into the agenda buffer. +In particular, add the prefix and corresponding text properties. + +EXTRA must be a string to replace the `%s' specifier in the prefix format. +WITH-LEVEL may be a string to replace the `%l' specifier. +WITH-CATEGORY (a string, a symbol or nil) may be used to overrule the default +category taken from local variable or file name. It will replace the `%c' +specifier in the format. +DOTIME, when non-nil, indicates that a time-of-day should be extracted from +TXT for sorting of this entry, and for the `%t' specifier in the format. +When DOTIME is a string, this string is searched for a time before TXT is. +TAGS can be the tags of the headline. +Any match of REMOVE-RE will be removed from TXT." + ;; We keep the org-prefix-* variable values along with a compiled + ;; formatter, so that multiple agendas existing at the same time do + ;; not step on each other toes. + ;; + ;; It was inconvenient to make these variables buffer local in + ;; Agenda buffers, because this function expects to be called with + ;; the buffer where item comes from being current, and not agenda + ;; buffer + (let* ((bindings (car org-prefix-format-compiled)) + (formatter (cadr org-prefix-format-compiled))) + (cl-loop for (var value) in bindings + do (set var value)) + (save-match-data + ;; Diary entries sometimes have extra whitespace at the beginning + (setq txt (org-trim txt)) + + ;; Fix the tags part in txt + (setq txt (org-agenda-fix-displayed-tags + txt tags + org-agenda-show-inherited-tags + org-agenda-hide-tags-regexp)) + + (with-no-warnings + ;; `time', `tag', `effort' are needed for the eval of the prefix format. + ;; Based on what I see in `org-compile-prefix-format', I added + ;; a few more. + (defvar breadcrumbs) (defvar category) (defvar category-icon) + (defvar effort) (defvar extra) + (defvar level) (defvar tag) (defvar time)) + (let* ((category (or with-category + (if buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ""))) + (category-icon (org-agenda-get-category-icon category)) + (category-icon (if category-icon + (propertize " " 'display category-icon) + "")) + (effort (and (not (string= txt "")) + (get-text-property 1 'effort txt))) + (tag (if tags (nth (1- (length tags)) tags) "")) + (time-grid-trailing-characters (nth 2 org-agenda-time-grid)) + (extra (or (and (not habitp) extra) "")) + time + (ts (when dotime (concat + (if (stringp dotime) dotime "") + (and org-agenda-search-headline-for-time txt)))) + (time-of-day (and dotime (org-get-time-of-day ts))) + stamp plain s0 s1 s2 rtn srp l + duration breadcrumbs) + (and (derived-mode-p '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 + (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) + (setq plain (string-match org-plain-time-of-day-regexp ts))) + (setq s0 (match-string 0 ts) + srp (and stamp (match-end 3)) + s1 (match-string (if plain 1 2) ts) + s2 (match-string (if plain 8 (if srp 4 6)) ts)) + + ;; If the times are in TXT (not in DOTIMES), and the prefix will list + ;; them, we might want to remove them there to avoid duplication. + ;; The user can turn this off with a variable. + (when (and org-prefix-has-time + org-agenda-remove-times-when-in-prefix (or stamp plain) + (string-match (concat (regexp-quote s0) " *") txt) + (not (equal ?\] (string-to-char (substring txt (match-end 0))))) + (if (eq org-agenda-remove-times-when-in-prefix 'beg) + (= (match-beginning 0) 0) + t)) + (setq txt (replace-match "" nil nil txt)))) + ;; Normalize the time(s) to 24 hour. + (when s1 (setq s1 (org-get-time-of-day s1 t))) + (when s2 (setq s2 (org-get-time-of-day s2 t))) + ;; Try to set s2 if s1 and + ;; `org-agenda-default-appointment-duration' are set + (when (and s1 (not s2) org-agenda-default-appointment-duration) + (setq s2 + (org-duration-from-minutes + (+ (org-duration-to-minutes s1 t) + org-agenda-default-appointment-duration) + nil t))) + ;; Compute the duration + (when s2 + (setq duration (- (org-duration-to-minutes s2) + (org-duration-to-minutes s1)))) + ;; Format S1 and S2 for display. + (when s1 (setq s1 (format "%5s" (org-get-time-of-day s1 'overtime)))) + (when s2 (setq s2 (org-get-time-of-day s2 'overtime)))) + (when (string-match org-tag-group-re txt) + ;; Tags are in the string + (if (or (eq org-agenda-remove-tags t) + (and org-agenda-remove-tags + org-prefix-has-tag)) + (setq txt (replace-match "" t t txt)) + (setq txt (replace-match + (concat (make-string (max (- 50 (length txt)) 1) ?\ ) + (match-string 1 txt)) + t t txt)))) + + (when remove-re + (while (string-match remove-re txt) + (setq txt (replace-match "" t t txt)))) + + ;; Set org-heading property on `txt' to mark the start of the + ;; heading. + (add-text-properties 0 (length txt) '(org-heading t) txt) + + ;; Prepare the variables needed in the eval of the compiled format + (when org-prefix-has-breadcrumbs + (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker) + (let ((s (org-format-outline-path (org-get-outline-path) + (1- (frame-width)) + nil org-agenda-breadcrumbs-separator))) + (if (eq "" s) "" (concat s org-agenda-breadcrumbs-separator)))))) + (setq time (cond (s2 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + "-" (org-agenda-time-of-day-to-ampm-maybe s2) + (when org-agenda-timegrid-use-ampm " "))) + (s1 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + (if org-agenda-timegrid-use-ampm + (concat time-grid-trailing-characters " ") + time-grid-trailing-characters))) + (t "")) + category (if (symbolp category) (symbol-name category) category) + level (or with-level "")) + (if (string-match org-link-bracket-re category) + (progn + (setq l (string-width (or (match-string 2) (match-string 1)))) + (when (< l (or org-prefix-category-length 0)) + (setq category (copy-sequence category)) + (org-add-props category nil + 'extra-space (make-string + (- org-prefix-category-length l 1) ?\ )))) + (when (and org-prefix-category-max-length + (>= (length category) org-prefix-category-max-length)) + (setq category (substring category 0 (1- org-prefix-category-max-length))))) + ;; Evaluate the compiled format + (setq rtn (concat (eval formatter t) txt)) + + ;; And finally add the text properties + (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) + (org-add-props rtn nil + 'org-category category + 'tags tags + 'org-priority-highest org-priority-highest + 'org-priority-lowest org-priority-lowest + 'time-of-day time-of-day + 'duration duration + 'breadcrumbs breadcrumbs + 'txt txt + 'level level + 'time time + 'extra extra + 'format org-prefix-format-compiled + 'dotime dotime))))) + +(defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) + "Remove tags string from TXT, and add a modified list of tags. +The modified list may contain inherited tags, and tags matched by +`org-agenda-hide-tags-regexp' will be removed." + (when (or add-inherited hide-re) + (when (string-match org-tag-group-re txt) + (setq txt (substring txt 0 (match-beginning 0)))) + (setq tags + (delq nil + (mapcar (lambda (tg) + (if (or (and hide-re (string-match hide-re tg)) + (and (not add-inherited) + (get-text-property 0 'inherited tg))) + nil + tg)) + tags))) + (when tags + (let ((have-i (get-text-property 0 'inherited (car tags))) + i) + (setq txt (concat txt " :" + (mapconcat + (lambda (x) + (setq i (get-text-property 0 'inherited x)) + (if (and have-i (not i)) + (progn + (setq have-i nil) + (concat ":" x)) + x)) + tags ":") + (if have-i "::" ":")))))) + txt) + +(defvar org-agenda-sorting-strategy) ;; because the def is in a let form + +(defun org-agenda-add-time-grid-maybe (list ndays todayp) + "Add a time-grid for agenda items which need it. + +LIST is the list of agenda items formatted by `org-agenda-list'. +NDAYS is the span of the current agenda view. +TODAYP is t when the current agenda view is on today." + (catch 'exit + (cond ((not org-agenda-use-time-grid) (throw 'exit list)) + ((and todayp (member 'today (car org-agenda-time-grid)))) + ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) + ((member 'weekly (car org-agenda-time-grid))) + (t (throw 'exit list))) + (let* ((have (delq nil (mapcar + (lambda (x) (get-text-property 1 'time-of-day x)) + list))) + (string (nth 3 org-agenda-time-grid)) + (gridtimes (nth 1 org-agenda-time-grid)) + (req (car org-agenda-time-grid)) + (remove (member 'remove-match req)) + new time) + (when (and (member 'require-timed req) (not have)) + ;; don't show empty grid + (throw 'exit list)) + (while (setq time (pop gridtimes)) + (unless (and remove (member time have)) + (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) + (push (org-agenda-format-item + nil string nil "" 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-agenda-format-item + nil org-agenda-current-time-string nil "" nil + (format-time-string "%H:%M ")) + new) + (put-text-property + 2 (length (car new)) 'face 'org-agenda-current-time (car new))) + + (if (member 'time-up org-agenda-sorting-strategy-selected) + (append new list) + (append list new))))) + +(defun org-compile-prefix-format (key) + "Compile the prefix format into a Lisp form that can be evaluated. +The resulting form and associated variable bindings 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-has-breadcrumbs nil) + (let ((s (cond + ((stringp org-agenda-prefix-format) + org-agenda-prefix-format) + ((assq key org-agenda-prefix-format) + (cdr (assq key org-agenda-prefix-format))) + (t " %-12:c%?-12t% s"))) + (start 0) + varform vars var c f opt) ;; e + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)" + s start) + (setq var (or (cdr (assoc (match-string 4 s) + '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) + ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs)))) + 'eval) + c (or (match-string 3 s) "") + opt (match-beginning 1) + start (1+ (match-beginning 0))) + (cl-case var + (time (setq org-prefix-has-time t)) + (tag (setq org-prefix-has-tag t)) + (effort (setq org-prefix-has-effort t)) + (breadcrumbs (setq org-prefix-has-breadcrumbs t))) + (setq f (concat "%" (match-string 2 s) "s")) + (when (eq var 'category) + (setq org-prefix-category-length + (floor (abs (string-to-number (match-string 2 s))))) + (setq org-prefix-category-max-length + (let ((x (match-string 2 s))) + (save-match-data + (and (string-match "\\.[0-9]+" x) + (string-to-number (substring (match-string 0 x) 1))))))) + (if (eq var 'eval) + (setq varform `(format ,f (org-eval ,(read (substring s (match-beginning 4)))))) + (if opt + (setq varform + `(if (member ,var '("" nil)) + "" + (format ,f (concat ,var ,c)))) + (setq varform + `(format ,f (if (member ,var '("" nil)) "" + (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) + (if (eq var 'eval) + (setf (substring s (match-beginning 0) + (+ (match-beginning 4) + (length (format "%S" (read (substring s (match-beginning 4))))))) + "%s") + (setq s (replace-match "%s" t nil s))) + (push varform vars)) + (setq vars (nreverse vars)) + (with-current-buffer (or org-agenda-buffer (current-buffer)) + (setq org-prefix-format-compiled + (list + `((org-prefix-has-time ,org-prefix-has-time) + (org-prefix-has-tag ,org-prefix-has-tag) + (org-prefix-category-length ,org-prefix-category-length) + (org-prefix-has-effort ,org-prefix-has-effort) + (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs)) + `(format ,s ,@vars)))))) + +(defun org-set-sorting-strategy (key) + (setq org-agenda-sorting-strategy-selected + (if (symbolp (car org-agenda-sorting-strategy)) + ;; the old format + org-agenda-sorting-strategy + (or (cdr (assq key org-agenda-sorting-strategy)) + (cdr (assq 'agenda org-agenda-sorting-strategy)) + '(time-up category-keep priority-down))))) + +(defun org-get-time-of-day (s &optional string) + "Check string S for a time of day. + +If found, return it as a military time number between 0 and 2400. +If not found, return nil. + +The optional STRING argument forces conversion into a 5 character wide string +HH:MM. When it is `overtime', any time above 24:00 is turned into \"+H:MM\" +where H:MM is the duration above midnight." + (let ((case-fold-search t) + (time-regexp + (rx word-start + (group (opt (any "012")) digit) ;group 1: hours + (or (and ":" (group (any "012345") digit) ;group 2: minutes + (opt (group (or "am" "pm")))) ;group 3: am/pm + ;; Special "HHam/pm" case. + (group-n 3 (or "am" "pm"))) + word-end))) + (save-match-data + (when (and (string-match time-regexp s) + (not (eq 'org-link (get-text-property 1 'face s)))) + (let ((hours + (let* ((ampm (and (match-end 3) (downcase (match-string 3 s)))) + (am-p (equal ampm "am"))) + (pcase (string-to-number (match-string 1 s)) + ((and (guard (not ampm)) h) h) + (12 (if am-p 0 12)) + (h (+ h (if am-p 0 12)))))) + (minutes + (if (match-end 2) + (string-to-number (match-string 2 s)) + 0))) + (pcase string + (`nil (+ minutes (* hours 100))) + ((and `overtime + (guard (or (> hours 24) + (and (= hours 24) + (> minutes 0))))) + (format "+%d:%02d" (- hours 24) minutes)) + ((guard org-agenda-time-leading-zero) + (format "%02d:%02d" hours minutes)) + (_ + (format "%d:%02d" hours minutes)))))))) + +(defvar org-agenda-before-sorting-filter-function nil + "Function to be applied to agenda items prior to sorting. +Prior to sorting also means just before they are inserted into the agenda. + +To aid sorting, you may revisit the original entries and add more text +properties which will later be used by the sorting functions. + +The function should take a string argument, an agenda line. +It has access to the text properties in that line, which contain among +other things, the property `org-hd-marker' that points to the entry +where the line comes from. Note that not all lines going into the agenda +have this property, only most. + +The function should return the modified string. It is probably best +to ONLY change text properties. + +You can also use this function as a filter, by returning nil for lines +you don't want to have in the agenda at all. For this application, you +could bind the variable in the options section of a custom command.") + +(defun org-agenda-finalize-entries (list &optional type) + "Sort, limit and concatenate the LIST of agenda items. +The optional argument TYPE tells the agenda type." + (let ((max-effort (cond ((listp org-agenda-max-effort) + (cdr (assoc type org-agenda-max-effort))) + (t org-agenda-max-effort))) + (max-todo (cond ((listp org-agenda-max-todos) + (cdr (assoc type org-agenda-max-todos))) + (t org-agenda-max-todos))) + (max-tags (cond ((listp org-agenda-max-tags) + (cdr (assoc type org-agenda-max-tags))) + (t org-agenda-max-tags))) + (max-entries (cond ((listp org-agenda-max-entries) + (cdr (assoc type org-agenda-max-entries))) + (t org-agenda-max-entries)))) + (when org-agenda-before-sorting-filter-function + (setq list + (delq nil + (mapcar + org-agenda-before-sorting-filter-function list)))) + (setq list (mapcar #'org-agenda-highlight-todo list) + list (mapcar #'identity (sort list #'org-entries-lessp))) + (when max-effort + (setq list (org-agenda-limit-entries + list 'effort-minutes max-effort + (lambda (e) (or e (if org-agenda-sort-noeffort-is-high + 32767 -1)))))) + (when max-todo + (setq list (org-agenda-limit-entries list 'todo-state max-todo))) + (when max-tags + (setq list (org-agenda-limit-entries list 'tags max-tags))) + (when max-entries + (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) + (when (and org-agenda-dim-blocked-tasks org-blocker-hook) + (setq list (mapcar #'org-agenda--mark-blocked-entry list))) + (mapconcat #'identity list "\n"))) + +(defun org-agenda-limit-entries (list prop limit &optional fn) + "Limit the number of agenda entries." + (let ((include (and limit (< limit 0)))) + (if limit + (let ((fun (or fn (lambda (p) (when p 1)))) + (lim 0)) + (delq nil + (mapcar + (lambda (e) + (let ((pval (funcall + fun (get-text-property (1- (length e)) + prop e)))) + (when pval (setq lim (+ lim pval))) + (cond ((and pval (<= lim (abs limit))) e) + ((and include (not pval)) e)))) + list))) + list))) + +(defun org-agenda-limit-interactively (remove) + "In agenda, interactively limit entries to various maximums." + (interactive "P") + (if remove + (progn (setq org-agenda-max-entries nil + org-agenda-max-todos nil + org-agenda-max-tags nil + org-agenda-max-effort nil) + (org-agenda-redo)) + (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) + (msg (cond ((= max ?E) "How many minutes? ") + ((= max ?e) "How many entries? ") + ((= max ?t) "How many TODO entries? ") + ((= max ?T) "How many tagged entries? ") + (t (user-error "Wrong input")))) + (num (string-to-number (read-from-minibuffer msg)))) + (cond ((equal max ?e) + (let ((org-agenda-max-entries num)) (org-agenda-redo))) + ((equal max ?t) + (let ((org-agenda-max-todos num)) (org-agenda-redo))) + ((equal max ?T) + (let ((org-agenda-max-tags num)) (org-agenda-redo))) + ((equal max ?E) + (let ((org-agenda-max-effort num)) (org-agenda-redo)))))) + (org-agenda-fit-window-to-buffer)) + +(defun org-agenda-highlight-todo (x) + (let ((org-done-keywords org-done-keywords-for-agenda) + (case-fold-search nil) + re) + (if (eq x 'line) + (save-excursion + (beginning-of-line 1) + (setq re (org-get-at-bol 'org-todo-regexp)) + (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point))) + (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) + (add-text-properties (match-beginning 0) (match-end 1) + (list 'face (org-get-todo-face 1))) + (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) + (delete-region (match-beginning 1) (1- (match-end 0))) + (goto-char (match-beginning 1)) + (insert (format org-agenda-todo-keyword-format s))))) + (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 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) + (when (match-end 1) + (setq x + (concat + (substring x 0 (match-end 1)) + (unless (string= org-agenda-todo-keyword-format "") + (format org-agenda-todo-keyword-format + (match-string 2 x))) + ;; Remove `display' property as the icon could leak + ;; on the white space. + (org-add-props " " (org-plist-delete (text-properties-at 0 x) + 'display)) + (substring x (match-end 3))))))) + x))) + +(defsubst org-cmp-values (a b property) + "Compare the numeric value of text PROPERTY for string A and B." + (let ((pa (or (get-text-property (1- (length a)) property a) 0)) + (pb (or (get-text-property (1- (length b)) property b) 0))) + (cond ((> pa pb) +1) + ((< pa pb) -1)))) + +(defsubst org-cmp-effort (a b) + "Compare the effort values of string A and B." + (let* ((def (if org-agenda-sort-noeffort-is-high 32767 -1)) + ;; `effort-minutes' property is not directly accessible from + ;; the strings, but is stored as a property in `txt'. + (ea (or (get-text-property + 0 'effort-minutes (get-text-property 0 'txt a)) + def)) + (eb (or (get-text-property + 0 'effort-minutes (get-text-property 0 'txt b)) + def))) + (cond ((> ea eb) +1) + ((< ea eb) -1)))) + +(defsubst org-cmp-category (a b) + "Compare the string values of categories of strings A and B." + (let ((ca (or (get-text-property (1- (length a)) 'org-category a) "")) + (cb (or (get-text-property (1- (length b)) 'org-category b) ""))) + (cond ((string-lessp ca cb) -1) + ((string-lessp cb ca) +1)))) + +(defsubst org-cmp-todo-state (a b) + "Compare the todo states of strings A and B." + (let* ((ma (or (get-text-property 1 'org-marker a) + (get-text-property 1 'org-hd-marker a))) + (mb (or (get-text-property 1 'org-marker b) + (get-text-property 1 'org-hd-marker b))) + (fa (and ma (marker-buffer ma))) + (fb (and mb (marker-buffer mb))) + (todo-kwds + (or (and fa (with-current-buffer fa org-todo-keywords-1)) + (and fb (with-current-buffer fb org-todo-keywords-1)))) + (ta (or (get-text-property 1 'todo-state a) "")) + (tb (or (get-text-property 1 'todo-state b) "")) + (la (- (length (member ta todo-kwds)))) + (lb (- (length (member tb todo-kwds)))) + (donepa (member ta org-done-keywords-for-agenda)) + (donepb (member tb org-done-keywords-for-agenda))) + (cond ((and donepa (not donepb)) -1) + ((and (not donepa) donepb) +1) + ((< la lb) -1) + ((< lb la) +1)))) + +(defsubst org-cmp-alpha (a b) + "Compare the headlines, alphabetically." + (let* ((pla (text-property-any 0 (length a) 'org-heading t a)) + (plb (text-property-any 0 (length b) 'org-heading t b)) + (ta (and pla (substring a pla))) + (tb (and plb (substring b plb))) + (case-fold-search nil)) + (when pla + (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") + ta) + (setq ta (substring ta (match-end 0)))) + (setq ta (downcase ta))) + (when plb + (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") + tb) + (setq tb (substring tb (match-end 0)))) + (setq tb (downcase tb))) + (cond ((not (or ta tb)) nil) + ((not ta) +1) + ((not tb) -1) + ((string-lessp ta tb) -1) + ((string-lessp tb ta) +1)))) + +(defsubst org-cmp-tag (a b) + "Compare the string values of the first tags of A and B." + (let ((ta (car (last (get-text-property 1 'tags a)))) + (tb (car (last (get-text-property 1 'tags b))))) + (cond ((not (or ta tb)) nil) + ((not ta) +1) + ((not tb) -1) + ((string-lessp ta tb) -1) + ((string-lessp tb ta) +1)))) + +(defsubst org-cmp-time (a b) + "Compare the time-of-day values of strings A and B." + (let* ((def (if org-agenda-sort-notime-is-late 9901 -1)) + (ta (or (get-text-property 1 'time-of-day a) def)) + (tb (or (get-text-property 1 'time-of-day b) def))) + (cond ((< ta tb) -1) + ((< tb ta) +1)))) + +(defsubst org-cmp-ts (a b type) + "Compare the timestamps values of entries A and B. +When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or +\"timestamp_ia\", compare within each of these type. When TYPE +is the empty string, compare all timestamps without respect of +their type." + (let* ((def (and (not org-agenda-sort-notime-is-late) -1)) + (ta (or (and (string-match type (or (get-text-property 1 'type a) "")) + (get-text-property 1 'ts-date a)) + def)) + (tb (or (and (string-match type (or (get-text-property 1 'type b) "")) + (get-text-property 1 'ts-date b)) + def))) + (cond ((if ta (and tb (< ta tb)) tb) -1) + ((if tb (and ta (< tb ta)) ta) +1)))) + +(defsubst org-cmp-habit-p (a b) + "Compare the todo states of strings A and B." + (let ((ha (get-text-property 1 'org-habit-p a)) + (hb (get-text-property 1 'org-habit-p b))) + (cond ((and ha (not hb)) -1) + ((and (not ha) hb) +1)))) + +(defun org-entries-lessp (a b) + "Predicate for sorting agenda entries." + ;; The following variables will be used when the form is evaluated. + ;; So even though the compiler complains, keep them. + (let ((ss org-agenda-sorting-strategy-selected)) + (org-dlet + ((timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) + (org-cmp-ts a b ""))) + (timestamp-down (if timestamp-up (- timestamp-up) nil)) + (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) + (org-cmp-ts a b "scheduled"))) + (scheduled-down (if scheduled-up (- scheduled-up) nil)) + (deadline-up (and (org-em 'deadline-up 'deadline-down ss) + (org-cmp-ts a b "deadline"))) + (deadline-down (if deadline-up (- deadline-up) nil)) + (tsia-up (and (org-em 'tsia-up 'tsia-down ss) + (org-cmp-ts a b "timestamp_ia"))) + (tsia-down (if tsia-up (- tsia-up) nil)) + (ts-up (and (org-em 'ts-up 'ts-down ss) + (org-cmp-ts a b "timestamp"))) + (ts-down (if ts-up (- ts-up) nil)) + (time-up (and (org-em 'time-up 'time-down ss) + (org-cmp-time a b))) + (time-down (if time-up (- time-up) nil)) + (stats-up (and (org-em 'stats-up 'stats-down ss) + (org-cmp-values a b 'org-stats))) + (stats-down (if stats-up (- stats-up) nil)) + (priority-up (and (org-em 'priority-up 'priority-down ss) + (org-cmp-values a b 'priority))) + (priority-down (if priority-up (- priority-up) nil)) + (effort-up (and (org-em 'effort-up 'effort-down ss) + (org-cmp-effort a b))) + (effort-down (if effort-up (- effort-up) nil)) + (category-up (and (or (org-em 'category-up 'category-down ss) + (memq 'category-keep ss)) + (org-cmp-category a b))) + (category-down (if category-up (- category-up) nil)) + (category-keep (if category-up +1 nil)) + (tag-up (and (org-em 'tag-up 'tag-down ss) + (org-cmp-tag a b))) + (tag-down (if tag-up (- tag-up) nil)) + (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) + (org-cmp-todo-state a b))) + (todo-state-down (if todo-state-up (- todo-state-up) nil)) + (habit-up (and (org-em 'habit-up 'habit-down ss) + (org-cmp-habit-p a b))) + (habit-down (if habit-up (- habit-up) nil)) + (alpha-up (and (org-em 'alpha-up 'alpha-down ss) + (org-cmp-alpha a b))) + (alpha-down (if alpha-up (- alpha-up) nil)) + (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) + user-defined-up user-defined-down) + (when (and need-user-cmp org-agenda-cmp-user-defined + (functionp org-agenda-cmp-user-defined)) + (setq user-defined-up + (funcall org-agenda-cmp-user-defined a b) + user-defined-down (if user-defined-up (- user-defined-up) nil))) + (cdr (assoc + (eval (cons 'or org-agenda-sorting-strategy-selected) t) + '((-1 . t) (1 . nil) (nil . nil))))))) + +;;; Agenda restriction lock + +(defvar org-agenda-restriction-lock-overlay (make-overlay 1 1) + "Overlay to mark the headline to which agenda commands are restricted.") +(overlay-put org-agenda-restriction-lock-overlay + 'face 'org-agenda-restriction-lock) +(overlay-put org-agenda-restriction-lock-overlay + 'help-echo "Agendas are currently limited to this subtree.") +(delete-overlay org-agenda-restriction-lock-overlay) + +(defun org-agenda-set-restriction-lock-from-agenda (arg) + "Set the restriction lock to the agenda item at point from within the agenda. +When called with a `\\[universal-argument]' prefix, restrict to +the file which contains the item. +Argument ARG is the prefix argument." + (interactive "P") + (unless (derived-mode-p 'org-agenda-mode) + (user-error "Not in an Org agenda buffer")) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (with-current-buffer buffer + (goto-char pos) + (org-agenda-set-restriction-lock arg)))) + +;;;###autoload +(defun org-agenda-set-restriction-lock (&optional type) + "Set restriction lock for agenda to current subtree or file. +When in a restricted subtree, remove it. + +The restriction will span over the entire file if TYPE is `file', +or if type is '(4), or if the cursor is before the first headline +in the file. Otherwise, only apply the restriction to the current +subtree." + (interactive "P") + (if (and org-agenda-overriding-restriction + (member org-agenda-restriction-lock-overlay + (overlays-at (point))) + (equal (overlay-start org-agenda-restriction-lock-overlay) + (point))) + (org-agenda-remove-restriction-lock 'noupdate) + (org-agenda-remove-restriction-lock 'noupdate) + (and (equal type '(4)) (setq type 'file)) + (setq type (cond + (type type) + ((org-at-heading-p) 'subtree) + ((condition-case nil (org-back-to-heading t) (error nil)) + 'subtree) + (t 'file))) + (if (eq type 'subtree) + (progn + (setq org-agenda-restrict (current-buffer)) + (setq org-agenda-overriding-restriction 'subtree) + (put 'org-agenda-files 'org-restrict + (list (buffer-file-name (buffer-base-buffer)))) + (org-back-to-heading t) + (move-overlay org-agenda-restriction-lock-overlay + (point) + (if org-agenda-restriction-lock-highlight-subtree + (save-excursion (org-end-of-subtree t t) (point)) + (point-at-eol))) + (move-marker org-agenda-restrict-begin (point)) + (move-marker org-agenda-restrict-end + (save-excursion (org-end-of-subtree t t))) + (message "Locking agenda restriction to subtree")) + (put 'org-agenda-files 'org-restrict + (list (buffer-file-name (buffer-base-buffer)))) + (setq org-agenda-restrict nil) + (setq org-agenda-overriding-restriction 'file) + (move-marker org-agenda-restrict-begin nil) + (move-marker org-agenda-restrict-end nil) + (message "Locking agenda restriction to file")) + (setq current-prefix-arg nil)) + (org-agenda-maybe-redo)) + +(defun org-agenda-remove-restriction-lock (&optional noupdate) + "Remove agenda restriction lock." + (interactive "P") + (if (not org-agenda-restrict) + (message "No agenda restriction to remove.") + (delete-overlay org-agenda-restriction-lock-overlay) + (delete-overlay org-speedbar-restriction-lock-overlay) + (setq org-agenda-overriding-restriction nil) + (setq org-agenda-restrict nil) + (put 'org-agenda-files 'org-restrict nil) + (move-marker org-agenda-restrict-begin nil) + (move-marker org-agenda-restrict-end nil) + (setq current-prefix-arg nil) + (message "Agenda restriction lock removed") + (or noupdate (org-agenda-maybe-redo)))) + +(defun org-agenda-maybe-redo () + "If there is any window showing the agenda view, update it." + (let ((w (get-buffer-window (or org-agenda-this-buffer-name + org-agenda-buffer-name) + t)) + (w0 (selected-window))) + (when w + (select-window w) + (org-agenda-redo) + (select-window w0) + (if org-agenda-overriding-restriction + (message "Agenda view shifted to new %s restriction" + org-agenda-overriding-restriction) + (message "Agenda restriction lock removed"))))) + +;;; Agenda commands + +(defun org-agenda-check-type (error &rest types) + "Check if agenda buffer or component is of allowed type. +If ERROR is non-nil, throw an error, otherwise just return nil. +Allowed types are `agenda' `todo' `tags' `search'." + (cond ((not org-agenda-type) + (error "No Org agenda currently displayed")) + ((memq org-agenda-type types) t) + (error + (error "Not allowed in '%s'-type agenda buffer or component" org-agenda-type)) + (t nil))) + +(defun org-agenda-Quit () + "Exit the agenda, killing the agenda buffer. +Like `org-agenda-quit', but kill the buffer even when +`org-agenda-sticky' is non-nil." + (interactive) + (org-agenda--quit)) + +(defun org-agenda-quit () + "Exit the agenda. + +When `org-agenda-sticky' is non-nil, bury the agenda buffer +instead of killing it. + +When `org-agenda-restore-windows-after-quit' is non-nil, restore +the pre-agenda window configuration. + +When column view is active, exit column view instead of the +agenda." + (interactive) + (org-agenda--quit org-agenda-sticky)) + +(defun org-agenda--quit (&optional bury) + (if org-agenda-columns-active + (org-columns-quit) + (let ((wconf org-agenda-pre-window-conf) + (buf (current-buffer)) + (org-agenda-last-indirect-window + (and (eq org-indirect-buffer-display 'other-window) + org-agenda-last-indirect-buffer + (get-buffer-window org-agenda-last-indirect-buffer)))) + (cond + ((eq org-agenda-window-setup 'other-frame) + (delete-frame)) + ((eq org-agenda-window-setup 'other-tab) + (if (fboundp 'tab-bar-close-tab) + (tab-bar-close-tab) + (user-error "Your version of Emacs does not have tab bar mode support"))) + ((and org-agenda-restore-windows-after-quit + wconf) + ;; Maybe restore the pre-agenda window configuration. Reset + ;; `org-agenda-pre-window-conf' before running + ;; `set-window-configuration', which loses the current buffer. + (setq org-agenda-pre-window-conf nil) + (set-window-configuration wconf)) + (t + (when org-agenda-last-indirect-window + (delete-window org-agenda-last-indirect-window)) + (and (not (eq org-agenda-window-setup 'current-window)) + (not (one-window-p)) + (delete-window)))) + (if bury + ;; Set the agenda buffer as the current buffer instead of + ;; passing it as an argument to `bury-buffer' so that + ;; `bury-buffer' removes it from the window. + (with-current-buffer buf + (bury-buffer)) + (kill-buffer buf) + (setq org-agenda-archives-mode nil + org-agenda-buffer nil))))) + +(defun org-agenda-exit () + "Exit the agenda, killing Org buffers loaded by the agenda. +Like `org-agenda-Quit', but kill any buffers that were created by +the agenda. Org buffers visited directly by the user will not be +touched. Also, exit the agenda even if it is in column view." + (interactive) + (when org-agenda-columns-active + (org-columns-quit)) + (org-release-buffers org-agenda-new-buffers) + (setq org-agenda-new-buffers nil) + (org-agenda-Quit)) + +(defun org-agenda-kill-all-agenda-buffers () + "Kill all buffers in `org-agenda-mode'. +This is used when toggling sticky agendas." + (interactive) + (let (blist) + (dolist (buf (buffer-list)) + (when (with-current-buffer buf (eq major-mode 'org-agenda-mode)) + (push buf blist))) + (mapc #'kill-buffer blist))) + +(defun org-agenda-execute (arg) + "Execute another agenda command, keeping same window. +So this is just a shortcut for \\<global-map>`\\[org-agenda]', available +in the agenda." + (interactive "P") + (let ((org-agenda-window-setup 'current-window)) + (org-agenda arg))) + +(defun org-agenda-redo (&optional all) + "Rebuild possibly ALL agenda view(s) in the current buffer." + (interactive "P") + (defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used? + (let* ((p (or (and (looking-at "\\'") (1- (point))) (point))) + (cpa (unless (eq all t) current-prefix-arg)) + (org-agenda-doing-sticky-redo org-agenda-sticky) + (org-agenda-sticky nil) + (org-agenda-buffer-name (or org-agenda-this-buffer-name + org-agenda-buffer-name)) + (org-agenda-keep-modes t) + (tag-filter org-agenda-tag-filter) + (tag-preset (get 'org-agenda-tag-filter :preset-filter)) + (top-hl-filter org-agenda-top-headline-filter) + (cat-filter org-agenda-category-filter) + (cat-preset (get 'org-agenda-category-filter :preset-filter)) + (re-filter org-agenda-regexp-filter) + (re-preset (get 'org-agenda-regexp-filter :preset-filter)) + (effort-filter org-agenda-effort-filter) + (effort-preset (get 'org-agenda-effort-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)) + (redo-cmd (get-text-property p 'org-redo-cmd)) + (last-args (get-text-property p 'org-last-args)) + (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd)) + (org-agenda-overriding-cmd-arguments + (unless (eq all t) + (cond ((listp last-args) + (cons (or cpa (car last-args)) (cdr last-args))) + ((stringp last-args) + last-args)))) + (series-redo-cmd (get-text-property p 'org-series-redo-cmd))) + (put 'org-agenda-tag-filter :preset-filter nil) + (put 'org-agenda-category-filter :preset-filter nil) + (put 'org-agenda-regexp-filter :preset-filter nil) + (put 'org-agenda-effort-filter :preset-filter nil) + (and cols (org-columns-quit)) + (message "Rebuilding agenda buffer...") + (if series-redo-cmd + (eval series-redo-cmd t) + (cl-progv + (mapcar #'car lprops) + (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) + (eval redo-cmd t))) + (setq org-agenda-undo-list nil + org-agenda-pending-undo-list nil + org-agenda-tag-filter tag-filter + org-agenda-category-filter cat-filter + org-agenda-regexp-filter re-filter + org-agenda-effort-filter effort-filter + org-agenda-top-headline-filter top-hl-filter) + (message "Rebuilding agenda buffer...done") + (put 'org-agenda-tag-filter :preset-filter tag-preset) + (put 'org-agenda-category-filter :preset-filter cat-preset) + (put 'org-agenda-regexp-filter :preset-filter re-preset) + (put 'org-agenda-effort-filter :preset-filter effort-preset) + (let ((tag (or tag-filter tag-preset)) + (cat (or cat-filter cat-preset)) + (effort (or effort-filter effort-preset)) + (re (or re-filter re-preset))) + (when tag (org-agenda-filter-apply tag 'tag t)) + (when cat (org-agenda-filter-apply cat 'category)) + (when effort (org-agenda-filter-apply effort 'effort)) + (when re (org-agenda-filter-apply re 'regexp))) + (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) + (and cols (called-interactively-p 'any) (org-agenda-columns)) + (org-goto-line line) + (when (called-interactively-p 'any) (recenter window-line)))) + +(defun org-agenda-redo-all (&optional exhaustive) + "Rebuild all agenda views in the current buffer. +With a prefix argument, do so in all agenda buffers." + (interactive "P") + (if exhaustive + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (derived-mode-p 'org-agenda-mode) + (org-agenda-redo t)))) + (org-agenda-redo t))) + +(defvar org-global-tags-completion-table nil) +(defvar org-agenda-filter-form nil) +(defvar org-agenda-filtered-by-category nil) + +(defsubst org-agenda-get-category () + "Return the category of the agenda line." + (org-get-at-bol 'org-category)) + +(defun org-agenda-filter-by-category (strip) + "Filter lines in the agenda buffer that have a specific category. +The category is that of the current line. +With a `\\[universal-argument]' prefix argument, exclude the lines of that category. +When there is already a category filter in place, this command removes the +filter." + (interactive "P") + (if (and org-agenda-filtered-by-category + org-agenda-category-filter) + (org-agenda-filter-show-all-cat) + (let ((cat (org-no-properties (org-get-at-eol 'org-category 1)))) + (cond + ((and cat strip) + (org-agenda-filter-apply + (push (concat "-" cat) org-agenda-category-filter) 'category)) + (cat + (org-agenda-filter-apply + (setq org-agenda-category-filter + (list (concat "+" cat))) + 'category)) + (t (error "No category at point")))))) + +(defun org-find-top-headline (&optional pos) + "Find the topmost parent headline and return it. +POS when non-nil is the marker or buffer position to start the +search from." + (save-excursion + (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) + (when pos (goto-char pos)) + ;; Skip up to the topmost parent. + (while (org-up-heading-safe)) + (ignore-errors + (replace-regexp-in-string + "^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" "" + (nth 4 (org-heading-components))))))) + +(defvar org-agenda-filtered-by-top-headline nil) +(defun org-agenda-filter-by-top-headline (strip) + "Keep only those lines that are descendants from the same top headline. +The top headline is that of the current line. With prefix arg STRIP, hide +all lines of the category at point." + (interactive "P") + (if org-agenda-filtered-by-top-headline + (progn + (setq org-agenda-filtered-by-top-headline nil + org-agenda-top-headline-filter nil) + (org-agenda-filter-show-all-top-filter)) + (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker)))) + (if toph (org-agenda-filter-top-headline-apply toph strip) + (error "No top-level headline at point"))))) + +(defvar org-agenda-regexp-filter nil) +(defun org-agenda-filter-by-regexp (strip-or-accumulate) + "Filter agenda entries by a regular expressions. +You will be prompted for the regular expression, and the agenda +view will only show entries that are matched by that expression. + +With one `\\[universal-argument]' prefix argument, hide entries matching the regexp. +When there is already a regexp filter active, this command removed the +filter. However, with two `\\[universal-argument]' prefix arguments, add a new condition to +an already existing regexp filter." + (interactive "P") + (let* ((strip (equal strip-or-accumulate '(4))) + (accumulate (equal strip-or-accumulate '(16)))) + (cond + ((and org-agenda-regexp-filter (not accumulate)) + (org-agenda-filter-show-all-re) + (message "Regexp filter removed")) + (t (let ((flt (concat (if strip "-" "+") + (read-from-minibuffer + (if strip + "Hide entries matching regexp: " + "Narrow to entries matching regexp: "))))) + (push flt org-agenda-regexp-filter) + (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)))))) + +(defvar org-agenda-effort-filter nil) +(defun org-agenda-filter-by-effort (strip-or-accumulate) + "Filter agenda entries by effort. +With no `\\[universal-argument]' prefix argument, keep entries matching the effort condition. +With one `\\[universal-argument]' prefix argument, filter out entries matching the condition. +With two `\\[universal-argument]' prefix arguments, add a second condition to the existing filter. +This last option is in practice not very useful, but it is available for +consistency with the other filter commands." + (interactive "P") + (let* ((efforts (split-string + (or (cdr (assoc-string (concat org-effort-property "_ALL") + org-global-properties + t)) + "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00"))) + ;; XXX: the following handles only up to 10 different + ;; effort values. + (allowed-keys (if (null efforts) nil + (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0 + (number-sequence 1 (length efforts))))) + (keep (equal strip-or-accumulate '(16))) + (negative (equal strip-or-accumulate '(4))) + (current org-agenda-effort-filter) + (op nil)) + (while (not (memq op '(?< ?> ?= ?_))) + (setq op (read-char-exclusive + "Effort operator? (> = or <) or press `_' again to remove filter"))) + ;; Select appropriate duration. Ignore non-digit characters. + (if (eq op ?_) + (progn + (org-agenda-filter-show-all-effort) + (message "Effort filter removed")) + (let ((prompt + (apply #'format + (concat "Effort %c " + (mapconcat (lambda (s) (concat "[%d]" s)) + efforts + " ")) + op allowed-keys)) + (eff -1)) + (while (not (memq eff allowed-keys)) + (message prompt) + (setq eff (- (read-char-exclusive) 48))) + (org-agenda-filter-show-all-effort) + (setq org-agenda-effort-filter + (append + (list (concat (if negative "-" "+") + (char-to-string op) + ;; Numbering is 1 2 3 ... 9 0, but we want + ;; 0 1 2 ... 8 9. + (nth (mod (1- eff) 10) efforts))) + (if keep current nil))) + (org-agenda-filter-apply org-agenda-effort-filter 'effort))))) + +(defun org-agenda-filter (&optional strip-or-accumulate) + "Prompt for a general filter string and apply it to the agenda. + +The string may contain filter elements like + ++category ++tag ++<effort > and = are also allowed as effort operators ++/regexp/ + +Instead of `+', `-' is allowed to strip the agenda of matching entries. +`+' is optional if it is not required to separate two string parts. +Multiple filter elements can be concatenated without spaces, for example + + +work-John<0:10-/plot/ + +selects entries with category `work' and effort estimates below 10 minutes, +and deselects entries with tag `John' or matching the regexp `plot'. + +During entry of the filter, completion for tags, categories and effort +values is offered. Since the syntax for categories and tags is identical +there should be no overlap between categories and tags. If there is, tags +get priority. + +A single `\\[universal-argument]' prefix arg STRIP-OR-ACCUMULATE will negate the +entire filter, which can be useful in connection with the prompt history. + +A double `\\[universal-argument] \\[universal-argument]' prefix arg will add the new filter elements to the +existing ones. A shortcut for this is to add an additional `+' at the +beginning of the string, like `+-John'. + +With a triple prefix argument, execute the computed filtering defined in +the variable `org-agenda-auto-exclude-function'." + (interactive "P") + (if (equal strip-or-accumulate '(64)) + ;; Execute the auto-exclude action + (if (not org-agenda-auto-exclude-function) + (user-error "`org-agenda-auto-exclude-function' is undefined") + (org-agenda-filter-show-all-tag) + (setq org-agenda-tag-filter nil) + (dolist (tag (org-agenda-get-represented-tags)) + (let ((modifier (funcall org-agenda-auto-exclude-function tag))) + (when modifier + (push modifier org-agenda-tag-filter)))) + (unless (null org-agenda-tag-filter) + (org-agenda-filter-apply org-agenda-tag-filter 'tag 'expand))) + ;; Prompt for a filter and act + (let* ((tag-list (org-agenda-get-represented-tags)) + (category-list (org-agenda-get-represented-categories)) + (negate (equal strip-or-accumulate '(4))) + (cf (mapconcat #'identity org-agenda-category-filter "")) + (tf (mapconcat #'identity org-agenda-tag-filter "")) + ;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) "")))) + (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) ""))) + (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) ""))) + (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/")))) + (f-string (completing-read + (concat + (if negate "Negative filter" "Filter") + " [+cat-tag<0:10-/regexp/]: ") + #'org-agenda-filter-completion-function + nil nil ff)) + (keep (or (if (string-match "^\\+[+-]" f-string) + (progn (setq f-string (substring f-string 1)) t)) + (equal strip-or-accumulate '(16)))) + (fc (if keep org-agenda-category-filter)) + (ft (if keep org-agenda-tag-filter)) + (fe (if keep org-agenda-effort-filter)) + (fr (if keep org-agenda-regexp-filter)) + pm s) + ;; If the filter contains a double-quoted string, replace a + ;; single hyphen by the arbitrary and temporary string "~~~" + ;; to disambiguate such hyphens from syntactic ones. + (setq f-string (replace-regexp-in-string + "\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string)) + (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string) + (setq pm (if (match-beginning 1) (match-string 1 f-string) "+")) + (when negate + (setq pm (if (equal pm "+") "-" "+"))) + (cond + ((match-beginning 3) + ;; category or tag + (setq s (replace-regexp-in-string ; Remove the temporary special string. + "~~~" "-" (match-string 3 f-string))) + (cond + ((member s tag-list) + (org-pushnew-to-end (concat pm s) ft)) + ((member s category-list) + (org-pushnew-to-end (concat pm ; Remove temporary double quotes. + (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s)) + fc)) + (t (message + "`%s%s' filter ignored because tag/category is not represented" + pm s)))) + ((match-beginning 4) + ;; effort + (org-pushnew-to-end (concat pm (match-string 4 f-string)) fe)) + ((match-beginning 5) + ;; regexp + (org-pushnew-to-end (concat pm (match-string 6 f-string)) fr))) + (setq f-string (substring f-string (match-end 0)))) + (org-agenda-filter-remove-all) + (and fc (org-agenda-filter-apply + (setq org-agenda-category-filter fc) 'category)) + (and ft (org-agenda-filter-apply + (setq org-agenda-tag-filter ft) 'tag 'expand)) + (and fe (org-agenda-filter-apply + (setq org-agenda-effort-filter fe) 'effort)) + (and fr (org-agenda-filter-apply + (setq org-agenda-regexp-filter fr) 'regexp)) + (run-hooks 'org-agenda-filter-hook)))) + +(defun org-agenda-filter-completion-function (string _predicate &optional flag) + "Complete a complex filter string. +FLAG specifies the type of completion operation to perform. This +function is passed as a collection function to `completing-read', +which see." + (let ((completion-ignore-case t) ;tags are case-sensitive + (confirm (lambda (x) (stringp x))) + (prefix "") + (operator "") + table) + (when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string) + (setq prefix (match-string 1 string) + operator (match-string 2 string) + string (match-string 3 string))) + (cond + ((member operator '("+" "-" "" nil)) + (setq table (append (org-agenda-get-represented-categories) + (org-agenda-get-represented-tags)))) + ((member operator '("<" ">" "=")) + (setq table (split-string + (or (cdr (assoc-string (concat org-effort-property "_ALL") + org-global-properties + t)) + "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00") + " +"))) + (t (setq table nil))) + (pcase flag + (`t (all-completions string table confirm)) + (`lambda (assoc string table)) ;exact match? + (`nil + (pcase (try-completion string table confirm) + ((and completion (pred stringp)) + (concat prefix completion)) + (completion completion))) + (_ nil)))) + +(defun org-agenda-filter-remove-all () + "Remove all filters from the current agenda buffer." + (interactive) + (when org-agenda-tag-filter + (org-agenda-filter-show-all-tag)) + (when org-agenda-category-filter + (org-agenda-filter-show-all-cat)) + (when org-agenda-regexp-filter + (org-agenda-filter-show-all-re)) + (when org-agenda-top-headline-filter + (org-agenda-filter-show-all-top-filter)) + (when org-agenda-effort-filter + (org-agenda-filter-show-all-effort)) + (org-agenda-finalize) + (when (called-interactively-p 'interactive) + (message "All agenda filters removed"))) + +(defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude) + "Keep only those lines in the agenda buffer that have a specific tag. + +The tag is selected with its fast selection letter, as configured. + +With a `\\[universal-argument]' prefix, apply the filter negatively, stripping all matches. + +With a `\\[universal-argument] \\[universal-argument]' prefix, add the new tag to the existing filter +instead of replacing it. + +With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \ +i.e. don't +filter on all its group members. + +A Lisp caller can specify CHAR. EXCLUDE means that the new tag +should be used to exclude the search - the interactive user can +also press `-' or `+' to switch between filtering and excluding." + (interactive "P") + (let* ((alist org-tag-alist-for-agenda) + (seen-chars nil) + (tag-chars (mapconcat + (lambda (x) (if (and (not (symbolp (car x))) + (cdr x) + (not (member (cdr x) seen-chars))) + (progn + (push (cdr x) seen-chars) + (char-to-string (cdr x))) + "")) + org-tag-alist-for-agenda "")) + (valid-char-list (append '(?\t ?\r ?\\ ?. ?\s ?q) + (string-to-list tag-chars))) + (exclude (or exclude (equal strip-or-accumulate '(4)))) + (accumulate (equal strip-or-accumulate '(16))) + (expand (not (equal strip-or-accumulate '(64)))) + (inhibit-read-only t) + (current org-agenda-tag-filter) + a tag) ;; n + (unless char + (while (not (memq char valid-char-list)) + (org-unlogged-message + "%s by tag%s: [%s ]tag-char [TAB]tag %s[\\]off [q]uit" + (if exclude "Exclude[+]" "Filter[-]") + (if expand "" " (no grouptag expand)") + tag-chars + (if org-agenda-auto-exclude-function "[RET] " "")) + (setq char (read-char-exclusive)) + ;; Excluding or filtering down + (cond ((eq char ?-) (setq exclude t)) + ((eq char ?+) (setq exclude nil))))) + (when (eq char ?\t) + (unless (local-variable-p 'org-global-tags-completion-table) + (setq-local org-global-tags-completion-table + (org-global-tags-completion-table))) + (let ((completion-ignore-case t)) + (setq tag (completing-read + "Tag: " org-global-tags-completion-table nil t)))) + (cond + ((eq char ?\r) + (org-agenda-filter-show-all-tag) + (when org-agenda-auto-exclude-function + (setq org-agenda-tag-filter nil) + (dolist (tag (org-agenda-get-represented-tags)) + (let ((modifier (funcall org-agenda-auto-exclude-function tag))) + (when modifier + (push modifier org-agenda-tag-filter)))) + (unless (null org-agenda-tag-filter) + (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))) + ((eq char ?\\) + (org-agenda-filter-show-all-tag) + (when (get 'org-agenda-tag-filter :preset-filter) + (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))) + ((eq 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 expand)) + ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...) + ((or (eq char ?\s) + (setq a (rassoc char alist)) + (and tag (setq a (cons tag nil)))) + (org-agenda-filter-show-all-tag) + (setq tag (car a)) + (setq org-agenda-tag-filter + (cons (concat (if exclude "-" "+") tag) + (if accumulate current nil))) + (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)) + (t (error "Invalid tag selection character %c" char))))) + +(defun org-agenda-get-represented-categories () + "Return a list of all categories used in this agenda buffer." + (or org-agenda-represented-categories + (when (derived-mode-p 'org-agenda-mode) + (let ((pos (point-min)) categories) + (while (and (< pos (point-max)) + (setq pos (next-single-property-change + pos 'org-category nil (point-max)))) + (push (get-text-property pos 'org-category) categories)) + (setq org-agenda-represented-categories + ;; Enclose category names with a hyphen in double + ;; quotes to process them specially in `org-agenda-filter'. + (mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s)) + (nreverse (org-uniquify (delq nil categories))))))))) + +(defvar org-tag-groups-alist-for-agenda) +(defun org-agenda-get-represented-tags () + "Return a list of all tags used in this agenda buffer. +These will be lower-case, for filtering." + (or org-agenda-represented-tags + (when (derived-mode-p 'org-agenda-mode) + (let ((pos (point-min)) tags-lists tt) + (while (and (< pos (point-max)) + (setq pos (next-single-property-change + pos 'tags nil (point-max)))) + (setq tt (get-text-property pos 'tags)) + (if tt (push tt tags-lists))) + (setq tags-lists + (nreverse (org-uniquify + (delq nil (apply #'append tags-lists))))) + (dolist (tag tags-lists) + (mapc + (lambda (group) + (when (member tag group) + (push (car group) tags-lists))) + org-tag-groups-alist-for-agenda)) + (setq org-agenda-represented-tags tags-lists))))) + +(defun org-agenda-filter-make-matcher (filter type &optional expand) + "Create the form that tests a line for agenda filter. +Optional argument EXPAND can be used for the TYPE tag and will +expand the tags in the FILTER if any of the tags in FILTER are +grouptags." + (let ((multi-pos-cats + (and (eq type 'category) + (string-match-p "\\+.*\\+" + (mapconcat (lambda (cat) (substring cat 0 1)) + filter "")))) + f f1) + (cond + ;; Tag filter + ((eq type 'tag) + (setq filter + (delete-dups + (append (get 'org-agenda-tag-filter :preset-filter) + filter))) + (dolist (x filter) + (let ((op (string-to-char x))) + (if expand (setq x (org-agenda-filter-expand-tags (list x) t)) + (setq x (list x))) + (setq f1 (org-agenda-filter-make-matcher-tag-exp x op)) + (push f1 f)))) + ;; Category filter + ((eq type 'category) + (setq filter + (delete-dups + (append (get 'org-agenda-category-filter :preset-filter) + filter))) + (dolist (x 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))) + ;; Regexp filter + ((eq type 'regexp) + (setq filter + (delete-dups + (append (get 'org-agenda-regexp-filter :preset-filter) + filter))) + (dolist (x filter) + (if (equal "-" (substring x 0 1)) + (setq f1 (list 'not (list 'string-match (substring x 1) 'txt))) + (setq f1 (list 'string-match (substring x 1) 'txt))) + (push f1 f))) + ;; Effort filter + ((eq type 'effort) + (setq filter + (delete-dups + (append (get 'org-agenda-effort-filter :preset-filter) + filter))) + (dolist (x filter) + (push (org-agenda-filter-effort-form x) f)))) + (cons (if multi-pos-cats 'or 'and) (nreverse f)))) + +(defun org-agenda-filter-make-matcher-tag-exp (tags op) + "Return a form associated to tag-expression TAGS. +Build a form testing a line for agenda filter for +tag-expressions. OP is an operator of type CHAR that allows the +function to set the right switches in the returned form." + (let (form) + ;; Any of the expressions can match if OP is +, all must match if + ;; the operator is -. + (dolist (x tags (cons (if (eq op ?-) 'and 'or) form)) + (let* ((tag (substring x 1)) + (f (cond + ((string= "" tag) 'tags) + ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag)) + ;; TAG is a regexp. + (list 'org-match-any-p (substring tag 1 -1) 'tags)) + (t (list 'member tag 'tags))))) + (push (if (eq op ?-) (list 'not f) f) form))))) + +(defun org-agenda-filter-effort-form (e) + "Return the form to compare the effort of the current line with what E says. +E looks like \"+<2:25\"." + (let (op) + (setq e (substring e 1)) + (setq op (string-to-char e) e (substring e 1)) + (setq op (cond ((equal op ?<) '<=) + ((equal op ?>) '>=) + ((equal op ??) op) + (t '=))) + (list 'org-agenda-compare-effort (list 'quote op) + (org-duration-to-minutes e)))) + +(defun org-agenda-compare-effort (op value) + "Compare the effort of the current line with VALUE, using OP. +If the line does not have an effort defined, return nil." + ;; `effort-minutes' property cannot be extracted directly from + ;; current line but is stored as a property in `txt'. + (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt)))) + (funcall op + (or effort (if org-agenda-sort-noeffort-is-high 32767 -1)) + value))) + +(defun org-agenda-filter-expand-tags (filter &optional no-operator) + "Expand group tags in FILTER for the agenda. +When NO-OPERATOR is non-nil, do not add the + operator to +returned tags." + (if org-group-tags + (let (case-fold-search rtn) + (mapc + (lambda (f) + (let (f0 dir) + (if (string-match "^\\([+-]\\)\\(.+\\)" f) + (setq dir (match-string 1 f) f0 (match-string 2 f)) + (setq dir (if no-operator "" "+") f0 f)) + (setq rtn (append (mapcar (lambda(f1) (concat dir f1)) + (org-tags-expand f0 t)) + rtn)))) + filter) + (reverse rtn)) + filter)) + +(defun org-agenda-filter-apply (filter type &optional expand) + "Set FILTER as the new agenda filter and apply it. +Optional argument EXPAND can be used for the TYPE tag and will +expand the tags in the FILTER if any of the tags in FILTER are +grouptags." + ;; Deactivate `org-agenda-entry-text-mode' when filtering + (when org-agenda-entry-text-mode (org-agenda-entry-text-mode)) + (setq org-agenda-filter-form (org-agenda-filter-make-matcher + filter type expand)) + ;; Only set `org-agenda-filtered-by-category' to t when a unique + ;; category is used as the filter: + (setq org-agenda-filtered-by-category + (and (eq type 'category) + (not (equal (substring (car filter) 0 1) "-")))) + (org-agenda-set-mode-name) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker)) + (org-dlet + ((tags (org-get-at-bol 'tags)) + (cat (org-agenda-get-category)) + (txt (or (org-get-at-bol 'txt) ""))) + (unless (eval org-agenda-filter-form t) + (org-agenda-filter-hide-line type)))) + (beginning-of-line 2))) + (when (get-char-property (point) 'invisible) + (ignore-errors (org-agenda-previous-line)))) + +(defun org-agenda-filter-top-headline-apply (hl &optional negative) + "Filter by top headline HL." + (org-agenda-set-mode-name) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let* ((pos (org-get-at-bol 'org-hd-marker)) + (tophl (and pos (org-find-top-headline pos)))) + (when (and tophl (funcall (if negative 'identity 'not) + (string= hl tophl))) + (org-agenda-filter-hide-line 'top-headline))) + (beginning-of-line 2))) + (when (get-char-property (point) 'invisible) + (org-agenda-previous-line)) + (setq org-agenda-top-headline-filter hl + org-agenda-filtered-by-top-headline t)) + +(defun org-agenda-filter-hide-line (type) + "If current line is TYPE, hide it in the agenda buffer." + (let* (buffer-invisibility-spec + (beg (max (point-min) (1- (point-at-bol)))) + (end (point-at-eol))) + (let ((inhibit-read-only t)) + (add-text-properties + beg end `(invisible org-filtered org-filter-type ,type))))) + +(defun org-agenda-remove-filter (type) + "Remove filter of type TYPE from the agenda buffer." + (interactive) + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t) pos) + (while (setq pos (text-property-any (point) (point-max) + 'org-filter-type type)) + (goto-char pos) + (remove-text-properties + (point) (next-single-property-change (point) 'org-filter-type) + `(invisible org-filtered org-filter-type ,type)))) + (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil) + (setq org-agenda-filter-form nil) + (org-agenda-set-mode-name) + (org-agenda-finalize))) + +(defun org-agenda-filter-show-all-tag nil + (org-agenda-remove-filter 'tag)) +(defun org-agenda-filter-show-all-re nil + (org-agenda-remove-filter 'regexp)) +(defun org-agenda-filter-show-all-effort nil + (org-agenda-remove-filter 'effort)) +(defun org-agenda-filter-show-all-cat nil + (org-agenda-remove-filter 'category)) +(defun org-agenda-filter-show-all-top-filter nil + (org-agenda-remove-filter 'top-headline)) + +(defun org-agenda-manipulate-query-add () + "Manipulate the query by adding a search term with positive selection. +Positive selection means the term must be matched for selection of an entry." + (interactive) + (org-agenda-manipulate-query ?\[)) +(defun org-agenda-manipulate-query-subtract () + "Manipulate the query by adding a search term with negative selection. +Negative selection means term must not be matched for selection of an entry." + (interactive) + (org-agenda-manipulate-query ?\])) +(defun org-agenda-manipulate-query-add-re () + "Manipulate the query by adding a search regexp with positive selection. +Positive selection means the regexp must match for selection of an entry." + (interactive) + (org-agenda-manipulate-query ?\{)) +(defun org-agenda-manipulate-query-subtract-re () + "Manipulate the query by adding a search regexp with negative selection. +Negative selection means regexp must not match for selection of an entry." + (interactive) + (org-agenda-manipulate-query ?\})) +(defun org-agenda-manipulate-query (char) + (cond + ((eq org-agenda-type 'agenda) + (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-redo)) + (message "Display now includes inactive timestamps as well")) + ((eq org-agenda-type 'search) + (org-add-to-string + 'org-agenda-query-string + (if org-agenda-last-search-view-search-was-boolean + (cdr (assoc char '((?\[ . " +") (?\] . " -") + (?\{ . " +{}") (?\} . " -{}")))) + " ")) + (setq org-agenda-redo-command + (list 'org-search-view + (car (get-text-property (min (1- (point-max)) (point)) + 'org-last-args)) + org-agenda-query-string + (+ (length org-agenda-query-string) + (if (member char '(?\{ ?\})) 0 1)))) + (set-register org-agenda-query-register org-agenda-query-string) + (let ((org-agenda-overriding-arguments + (cdr org-agenda-redo-command))) + (org-agenda-redo))) + (t (error "Cannot manipulate query for %s-type agenda buffers" + org-agenda-type)))) + +(defun org-add-to-string (var string) + (set var (concat (symbol-value var) string))) + +(defun org-agenda-goto-date (date) + "Jump to DATE in agenda." + (interactive + (list + (let ((org-read-date-prefer-future org-agenda-jump-prefer-future)) + (org-read-date)))) + (let* ((day (time-to-days (org-time-string-to-time date))) + (org-agenda-sticky-orig org-agenda-sticky) + (org-agenda-buffer-tmp-name (buffer-name)) + (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (0-arg (or current-prefix-arg (car args))) + (2-arg (nth 2 args)) + (with-hour-p (nth 4 org-agenda-redo-command)) + (newcmd (list 'org-agenda-list 0-arg date + (org-agenda-span-to-ndays + 2-arg (org-time-string-to-absolute date)) + with-hour-p)) + (newargs (cdr newcmd)) + (inhibit-read-only t) + org-agenda-sticky) + (if (not (org-agenda-check-type t 'agenda)) + (error "Not available in non-agenda views") + (add-text-properties (point-min) (point-max) + `(org-redo-cmd ,newcmd org-last-args ,newargs)) + (org-agenda-redo) + (goto-char (point-min)) + (while (not (or (= (or (get-text-property (point) 'day) 0) day) + (save-excursion (move-beginning-of-line 2) (eobp)))) + (move-beginning-of-line 2)) + (setq org-agenda-sticky org-agenda-sticky-orig + org-agenda-this-buffer-is-sticky org-agenda-sticky)))) + +(defun org-agenda-goto-today () + "Go to today." + (interactive) + (org-agenda-check-type t 'agenda) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (curspan (nth 2 args)) + (tdpos (text-property-any (point-min) (point-max) 'org-today t))) + (cond + (tdpos (goto-char tdpos)) + ((eq org-agenda-type 'agenda) + (let* ((sd (org-agenda-compute-starting-span + (org-today) (or curspan org-agenda-span))) + (org-agenda-overriding-arguments args)) + (setf (nth 1 org-agenda-overriding-arguments) sd) + (org-agenda-redo) + (org-agenda-find-same-or-today-or-agenda))) + (t (error "Cannot find today"))))) + +(defun org-agenda-find-same-or-today-or-agenda (&optional cnt) + (goto-char + (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) + (text-property-any (point-min) (point-max) 'org-today t) + (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) + (and (get-text-property (min (1- (point-max)) (point)) 'org-series) + (org-agenda-backward-block)) + (point-min)))) + +(defun org-agenda-backward-block () + "Move backward by one agenda block." + (interactive) + (org-agenda-forward-block 'backward)) + +(defun org-agenda-forward-block (&optional backward) + "Move forward by one agenda block. +When optional argument BACKWARD is set, go backward." + (interactive) + (cond ((not (derived-mode-p 'org-agenda-mode)) + (user-error + "Cannot execute this command outside of org-agenda-mode buffers")) + ((looking-at (if backward "\\`" "\\'")) + (message "Already at the %s block" (if backward "first" "last"))) + (t (let ((_pos (prog1 (point) + (ignore-errors (if backward (backward-char 1) + (move-end-of-line 1))))) + (f (if backward + #'previous-single-property-change + #'next-single-property-change)) + moved dest) + (while (and (setq dest (funcall + f (point) 'org-agenda-structural-header)) + (not (get-text-property + (point) 'org-agenda-structural-header))) + (setq moved t) + (goto-char dest)) + (if moved (move-beginning-of-line 1) + (goto-char (if backward (point-min) (point-max))) + (move-beginning-of-line 1) + (message "No %s block" (if backward "previous" "further"))))))) + +(defun org-agenda-later (arg) + "Go forward in time by the current span. +With prefix ARG, go forward that many times the current span." + (interactive "p") + (org-agenda-check-type t 'agenda) + (let* ((wstart (window-start)) + (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (span (or (nth 2 args) org-agenda-current-span)) + (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day)) + (greg (calendar-gregorian-from-absolute sd)) + (cnt (org-get-at-bol 'org-day-cnt)) + greg2) + (cond + ((numberp span) + (setq sd (+ (* span arg) sd))) + ((eq span 'day) + (setq sd (+ arg sd))) + ((eq span 'week) + (setq sd (+ (* 7 arg) sd))) + ((eq span 'fortnight) + (setq sd (+ (* 14 arg) sd))) + ((eq span 'month) + (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) + sd (calendar-absolute-from-gregorian greg2)) + (setcar greg2 (1+ (car greg2)))) + ((eq span 'year) + (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) + sd (calendar-absolute-from-gregorian greg2)) + (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) + (t + (setq sd (+ (* span arg) sd)))) + (let ((org-agenda-overriding-cmd + ;; `cmd' may have been set by `org-agenda-run-series' which + ;; uses `org-agenda-overriding-cmd' to decide whether + ;; overriding is allowed for `cmd' + (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) + (org-agenda-overriding-arguments + (list (car args) sd span))) + (org-agenda-redo) + (org-agenda-find-same-or-today-or-agenda cnt)) + (set-window-start nil wstart))) + +(defun org-agenda-earlier (arg) + "Go backward in time by the current span. +With prefix ARG, go backward that many times the current span." + (interactive "p") + (org-agenda-later (- arg))) + +(defun org-agenda-view-mode-dispatch () + "Call one of the view mode commands." + (interactive) + (org-unlogged-message + "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort + time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck + [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") + (pcase (read-char-exclusive) + (?\ (call-interactively 'org-agenda-reset-view)) + (?d (call-interactively 'org-agenda-day-view)) + (?w (call-interactively 'org-agenda-week-view)) + (?t (call-interactively 'org-agenda-fortnight-view)) + (?m (call-interactively 'org-agenda-month-view)) + (?y (call-interactively 'org-agenda-year-view)) + (?l (call-interactively 'org-agenda-log-mode)) + (?L (org-agenda-log-mode '(4))) + (?c (org-agenda-log-mode 'clockcheck)) + ((or ?F ?f) (call-interactively 'org-agenda-follow-mode)) + (?a (call-interactively 'org-agenda-archives-mode)) + (?A (org-agenda-archives-mode 'files)) + ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode)) + ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode)) + (?G (call-interactively 'org-agenda-toggle-time-grid)) + (?D (call-interactively 'org-agenda-toggle-diary)) + (?\! (call-interactively 'org-agenda-toggle-deadlines)) + (?\[ (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-check-type t 'agenda) + (org-agenda-redo)) + (message "Display now includes inactive timestamps as well")) + (?q (message "Abort")) + (key (user-error "Invalid key: %s" key)))) + +(defun org-agenda-reset-view () + "Switch to default view for agenda." + (interactive) + (org-agenda-change-time-span org-agenda-span)) + +(defun org-agenda-day-view (&optional day-of-month) + "Switch to daily view for agenda. +With argument DAY-OF-MONTH, switch to that day of the month." + (interactive "P") + (org-agenda-change-time-span 'day day-of-month)) + +(defun org-agenda-week-view (&optional iso-week) + "Switch to weekly view for agenda. +With argument ISO-WEEK, switch to the corresponding ISO week. +If ISO-WEEK has more then 2 digits, only the last two encode +the week. Any digits before this encode a year. So 200712 +means week 12 of year 2007. Years ranging from 70 years ago +to 30 years in the future can also be written as 2-digit years." + (interactive "P") + (org-agenda-change-time-span 'week iso-week)) + +(defun org-agenda-fortnight-view (&optional iso-week) + "Switch to fortnightly view for agenda. +With argument ISO-WEEK, switch to the corresponding ISO week. +If ISO-WEEK has more then 2 digits, only the last two encode +the week. Any digits before this encode a year. So 200712 +means week 12 of year 2007. Years ranging from 70 years ago +to 30 years in the future can also be written as 2-digit years." + (interactive "P") + (org-agenda-change-time-span 'fortnight iso-week)) + +(defun org-agenda-month-view (&optional month) + "Switch to monthly view for agenda. +With argument MONTH, switch to that month. If MONTH has more +then 2 digits, only the last two encode the month. Any digits +before this encode a year. So 200712 means December year 2007. +Years ranging from 70 years ago to 30 years in the future can +also be written as 2-digit years." + (interactive "P") + (org-agenda-change-time-span 'month month)) + +(defun org-agenda-year-view (&optional year) + "Switch to yearly view for agenda. +With argument YEAR, switch to that year. Years ranging from 70 +years ago to 30 years in the future can also be written as +2-digit years." + (interactive "P") + (when year + (setq year (org-small-year-to-year year))) + (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") + (org-agenda-change-time-span 'year year) + (error "Abort"))) + +(defun org-agenda-change-time-span (span &optional n) + "Change the agenda view to SPAN. +SPAN may be `day', `week', `fortnight', `month', `year'." + (org-agenda-check-type t 'agenda) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (curspan (nth 2 args))) + (when (and (not n) (equal curspan span)) + (error "Viewing span is already \"%s\"" span)) + (let* ((sd (or (org-get-at-bol 'day) + (nth 1 args) + org-starting-day)) + (sd (org-agenda-compute-starting-span sd span n)) + (org-agenda-overriding-cmd + (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) + (org-agenda-overriding-arguments + (list (car args) sd span))) + (org-agenda-redo) + (org-agenda-find-same-or-today-or-agenda)) + (org-agenda-set-mode-name) + (message "Switched to %s view" span))) + +(defun org-agenda-compute-starting-span (sd span &optional n) + "Compute starting date for agenda. +SPAN may be `day', `week', `fortnight', `month', `year'. The return value +is a cons cell with the starting date and the number of days, +so that the date SD will be in that range." + (let* ((greg (calendar-gregorian-from-absolute sd)) + ;; (dg (nth 1 greg)) + (mg (car greg)) + (yg (nth 2 greg))) + (cond + ((eq span 'day) + (when n + (setq sd (+ (calendar-absolute-from-gregorian + (list mg 1 yg)) + n -1)))) + ((or (eq span 'week) (eq span 'fortnight)) + (let* ((nt (calendar-day-of-week + (calendar-gregorian-from-absolute sd))) + (d (if org-agenda-start-on-weekday + (- nt org-agenda-start-on-weekday) + 0)) + y1) + (setq sd (- sd (+ (if (< d 0) 7 0) d))) + (when n + (require 'cal-iso) + (when (> n 99) + (setq y1 (org-small-year-to-year (/ n 100)) + n (mod n 100))) + (setq sd + (calendar-iso-to-absolute + (list n 1 + (or y1 (nth 2 (calendar-iso-from-absolute sd))))))))) + ((eq span 'month) + (let (y1) + (when (and n (> n 99)) + (setq y1 (org-small-year-to-year (/ n 100)) + n (mod n 100))) + (setq sd (calendar-absolute-from-gregorian + (list (or n mg) 1 (or y1 yg)))))) + ((eq span 'year) + (setq sd (calendar-absolute-from-gregorian + (list 1 1 (or n yg)))))) + sd)) + +(defun org-agenda-next-date-line (&optional arg) + "Jump to the next line indicating a date in agenda buffer." + (interactive "p") + (org-agenda-check-type t 'agenda) + (beginning-of-line 1) + ;; This does not work if user makes date format that starts with a blank + (when (looking-at-p "^\\S-") (forward-char 1)) + (unless (re-search-forward "^\\S-" nil t arg) + (backward-char 1) + (error "No next date after this line in this buffer")) + (goto-char (match-beginning 0))) + +(defun org-agenda-previous-date-line (&optional arg) + "Jump to the previous line indicating a date in agenda buffer." + (interactive "p") + (org-agenda-check-type t 'agenda) + (beginning-of-line 1) + (unless (re-search-backward "^\\S-" nil t arg) + (error "No previous date before this line in this buffer"))) + +;; Initialize the highlight +(defvar org-hl (make-overlay 1 1)) +(overlay-put org-hl 'face 'highlight) + +(defun org-highlight (begin end &optional buffer) + "Highlight a region with overlay." + (move-overlay org-hl begin end (or buffer (current-buffer)))) + +(defun org-unhighlight () + "Detach overlay INDEX." + (delete-overlay org-hl)) + +(defun org-unhighlight-once () + "Remove the highlight from its position, and this function from the hook." + (remove-hook 'pre-command-hook #'org-unhighlight-once) + (org-unhighlight)) + +(defvar org-agenda-pre-follow-window-conf nil) +(defun org-agenda-follow-mode () + "Toggle follow mode in an agenda buffer." + (interactive) + (unless org-agenda-follow-mode + (setq org-agenda-pre-follow-window-conf + (current-window-configuration))) + (setq org-agenda-follow-mode (not org-agenda-follow-mode)) + (unless org-agenda-follow-mode + (set-window-configuration org-agenda-pre-follow-window-conf)) + (org-agenda-set-mode-name) + (org-agenda-do-context-action) + (message "Follow mode is %s" + (if org-agenda-follow-mode "on" "off"))) + +(defun org-agenda-entry-text-mode (&optional arg) + "Toggle entry text mode in an agenda buffer." + (interactive "P") + (if (or org-agenda-tag-filter + org-agenda-category-filter + org-agenda-regexp-filter + org-agenda-top-headline-filter) + (user-error "Can't show entry text in filtered views") + (setq org-agenda-entry-text-mode (or (integerp arg) + (not org-agenda-entry-text-mode))) + (org-agenda-entry-text-hide) + (and org-agenda-entry-text-mode + (let ((org-agenda-entry-text-maxlines + (if (integerp arg) arg org-agenda-entry-text-maxlines))) + (org-agenda-entry-text-show))) + (org-agenda-set-mode-name) + (message "Entry text mode is %s%s" + (if org-agenda-entry-text-mode "on" "off") + (if (not org-agenda-entry-text-mode) "" + (format " (maximum number of lines is %d)" + (if (integerp arg) arg org-agenda-entry-text-maxlines)))))) + +(defun org-agenda-clockreport-mode () + "Toggle clocktable mode in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)) + (org-agenda-set-mode-name) + (org-agenda-redo) + (message "Clocktable mode is %s" + (if org-agenda-clockreport-mode "on" "off"))) + +(defun org-agenda-log-mode (&optional special) + "Toggle log mode in an agenda buffer. + +With argument SPECIAL, show all possible log items, not only the ones +configured in `org-agenda-log-mode-items'. + +With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ +log items, nothing else." + (interactive "P") + (org-agenda-check-type t 'agenda) + (setq org-agenda-show-log + (cond + ((equal special '(16)) 'only) + ((eq special 'clockcheck) + (if (eq org-agenda-show-log 'clockcheck) + nil 'clockcheck)) + (special '(closed clock state)) + (t (not org-agenda-show-log)))) + (org-agenda-set-mode-name) + (org-agenda-redo) + (message "Log mode is %s" (if org-agenda-show-log "on" "off"))) + +(defun org-agenda-archives-mode (&optional with-files) + "Toggle inclusion of items in trees marked with :ARCHIVE:. +When called with a prefix argument, include all archive files as well." + (interactive "P") + (setq org-agenda-archives-mode + (cond ((and with-files (eq org-agenda-archives-mode t)) nil) + (with-files t) + (org-agenda-archives-mode nil) + (t 'trees))) + (org-agenda-set-mode-name) + (org-agenda-redo) + (message + "%s" + (cond + ((eq org-agenda-archives-mode nil) + "No archives are included") + ((eq org-agenda-archives-mode 'trees) + (format "Trees with :%s: tag are included" org-archive-tag)) + ((eq org-agenda-archives-mode t) + (format "Trees with :%s: tag and all active archive files are included" + org-archive-tag))))) + +(defun org-agenda-toggle-diary () + "Toggle diary inclusion in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-agenda-include-diary (not org-agenda-include-diary)) + (org-agenda-redo) + (org-agenda-set-mode-name) + (message "Diary inclusion turned %s" + (if org-agenda-include-diary "on" "off"))) + +(defun org-agenda-toggle-deadlines () + "Toggle inclusion of entries with a deadline in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-agenda-include-deadlines (not org-agenda-include-deadlines)) + (org-agenda-redo) + (org-agenda-set-mode-name) + (message "Deadlines inclusion turned %s" + (if org-agenda-include-deadlines "on" "off"))) + +(defun org-agenda-toggle-time-grid () + "Toggle time grid in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) + (org-agenda-redo) + (org-agenda-set-mode-name) + (message "Time-grid turned %s" + (if org-agenda-use-time-grid "on" "off"))) + +(defun org-agenda-set-mode-name () + "Set the mode name to indicate all the small mode settings." + (setq mode-name + (list "Org-Agenda" + (if (get 'org-agenda-files 'org-restrict) " []" "") + " " + '(:eval (org-agenda-span-name org-agenda-current-span)) + (if org-agenda-follow-mode " Follow" "") + (if org-agenda-entry-text-mode " ETxt" "") + (if org-agenda-include-diary " Diary" "") + (if org-agenda-include-deadlines " Ddl" "") + (if org-agenda-use-time-grid " Grid" "") + (if (and (boundp 'org-habit-show-habits) + org-habit-show-habits) + " Habit" "") + (cond + ((consp org-agenda-show-log) " LogAll") + ((eq org-agenda-show-log 'clockcheck) " ClkCk") + (org-agenda-show-log " Log") + (t "")) + (if (org-agenda-filter-any) " " "") + (if (or org-agenda-category-filter + (get 'org-agenda-category-filter :preset-filter)) + '(:eval (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)) + '(:eval (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 (or org-agenda-effort-filter + (get 'org-agenda-effort-filter :preset-filter)) + '(:eval (propertize + (concat (mapconcat + #'identity + (append + (get 'org-agenda-effort-filter :preset-filter) + org-agenda-effort-filter) + "")) + 'face 'org-agenda-filter-effort + 'help-echo "Effort conditions used in filtering")) + "") + (if (or org-agenda-regexp-filter + (get 'org-agenda-regexp-filter :preset-filter)) + '(:eval (propertize + (concat (mapconcat + (lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/")) + (append + (get 'org-agenda-regexp-filter :preset-filter) + org-agenda-regexp-filter) + "")) + 'face 'org-agenda-filter-regexp + 'help-echo "Regexp used in filtering")) + "") + (if org-agenda-archives-mode + (if (eq org-agenda-archives-mode t) + " Archives" + (format " :%s:" org-archive-tag)) + "") + (if org-agenda-clockreport-mode " Clock" ""))) + (force-mode-line-update)) + +(defun org-agenda-update-agenda-type () + "Update the agenda type after each command." + (setq org-agenda-type + (or (get-text-property (point) 'org-agenda-type) + (get-text-property (max (point-min) (1- (point))) 'org-agenda-type)))) + +(defun org-agenda-next-line () + "Move cursor to the next line, and show if follow mode is active." + (interactive) + (call-interactively 'next-line) + (org-agenda-do-context-action)) + +(defun org-agenda-previous-line () + "Move cursor to the previous line, and show if follow-mode is active." + (interactive) + (call-interactively 'previous-line) + (org-agenda-do-context-action)) + +(defun org-agenda-next-item (n) + "Move cursor to next agenda item." + (interactive "p") + (let ((col (current-column))) + (dotimes (_ n) + (when (next-single-property-change (point-at-eol) 'org-marker) + (move-end-of-line 1) + (goto-char (next-single-property-change (point) 'org-marker)))) + (org-move-to-column col)) + (org-agenda-do-context-action)) + +(defun org-agenda-previous-item (n) + "Move cursor to next agenda item." + (interactive "p") + (dotimes (_ n) + (let ((col (current-column)) + (goto (save-excursion + (move-end-of-line 0) + (previous-single-property-change (point) 'org-marker)))) + (when goto (goto-char goto)) + (org-move-to-column col))) + (org-agenda-do-context-action)) + +(defun org-agenda-do-context-action () + "Show outline path and, maybe, follow mode window." + (let ((m (org-get-at-bol 'org-marker))) + (when (and (markerp m) (marker-buffer m)) + (and org-agenda-follow-mode + (if org-agenda-follow-indirect + (org-agenda-tree-to-indirect-buffer nil) + (org-agenda-show))) + (and org-agenda-show-outline-path + (org-with-point-at m (org-display-outline-path t)))))) + +(defun org-agenda-show-tags () + "Show the tags applicable to the current item." + (interactive) + (let* ((tags (org-get-at-bol 'tags))) + (if tags + (message "Tags are :%s:" + (org-no-properties (mapconcat #'identity tags ":"))) + (message "No tags associated with this line")))) + +(defun org-agenda-goto (&optional highlight) + "Go to the entry at point in the corresponding Org file." + (interactive) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + ;; FIXME: use `org-switch-to-buffer-other-window'? + (switch-to-buffer-other-window buffer) + (widen) + (push-mark) + (goto-char pos) + (when (derived-mode-p 'org-mode) + (org-show-context 'agenda) + (recenter (/ (window-height) 2)) + (org-back-to-heading t) + (let ((case-fold-search nil)) + (when (re-search-forward org-complex-heading-regexp nil t) + (goto-char (match-beginning 4))))) + (run-hooks 'org-agenda-after-show-hook) + (and highlight (org-highlight (point-at-bol) (point-at-eol))))) + +(defvar org-agenda-after-show-hook nil + "Normal hook run after an item has been shown from the agenda. +Point is in the buffer where the item originated.") + +;; Defined later in org-agenda.el +(defvar org-agenda-loop-over-headlines-in-active-region nil) + +(defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete) + "Between region BEG and END, call agenda command CMD. +When optional argument ARG is non-nil or FORCE-ARG is t, pass +ARG to CMD. When optional argument DELETE is non-nil, assume CMD +deletes the agenda entry and don't move to the next entry." + (save-excursion + (goto-char beg) + (let ((mend (move-marker (make-marker) end)) + (all (eq org-agenda-loop-over-headlines-in-active-region t)) + (match (and (stringp org-agenda-loop-over-headlines-in-active-region) + org-agenda-loop-over-headlines-in-active-region)) + (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level) + (org-get-at-bol 'level)))) + (while (< (point) mend) + (let ((ov (make-overlay (point) (point-at-eol)))) + (if (not (or all + (and match (looking-at-p match)) + (eq level (org-get-at-bol 'level)))) + (org-agenda-next-item 1) + (overlay-put ov 'face 'region) + (if (or arg force-arg) (funcall cmd arg) (funcall cmd)) + (when (not delete) (org-agenda-next-item 1)) + (delete-overlay ov))))))) + +;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*, +;; kill,set-property,set-effort] commands may loop over agenda +;; entries. Commands `org-agenda-set-tags' and `org-agenda-bulk-mark' +;; use their own mechanisms on active regions. +(defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body) + "Maybe loop over agenda entries and perform CMD. +Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." + (declare (debug t)) + `(if (and (called-interactively-p 'any) + org-agenda-loop-over-headlines-in-active-region + (org-region-active-p)) + (org-agenda-do-in-region + (region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete) + ,@body)) + +(defun org-agenda-kill () + "Kill the entry or subtree belonging to the current agenda entry." + (interactive) + (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) + (org-agenda-maybe-loop + #'org-agenda-kill nil nil t + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (type (org-get-at-bol 'type)) + dbeg dend (n 0)) + (org-with-remote-undo buffer + (with-current-buffer buffer + (save-excursion + (goto-char pos) + (if (and (derived-mode-p '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) + dend (min (point-max) (1+ (point-at-eol))))) + (goto-char dbeg) + (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) + (when (or (eq t org-agenda-confirm-kill) + (and (numberp org-agenda-confirm-kill) + (> n org-agenda-confirm-kill))) + (let ((win-conf (current-window-configuration))) + (unwind-protect + (and + (prog2 + (org-agenda-tree-to-indirect-buffer nil) + (not (y-or-n-p + (format "Delete entry with %d lines in buffer \"%s\"? " + n (buffer-name buffer)))) + (kill-buffer org-last-indirect-buffer)) + (error "Abort")) + (set-window-configuration win-conf)))) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda buffer dbeg dend)) + (with-current-buffer buffer (delete-region dbeg dend)) + (message "Agenda item and source killed"))))) + +(defvar org-archive-default-command) ; defined in org-archive.el +(defun org-agenda-archive-default () + "Archive the entry or subtree belonging to the current agenda entry." + (interactive) + (require 'org-archive) + (funcall-interactively + #'org-agenda-archive-with org-archive-default-command)) + +(defun org-agenda-archive-default-with-confirmation () + "Archive the entry or subtree belonging to the current agenda entry." + (interactive) + (require 'org-archive) + (funcall-interactively + #'org-agenda-archive-with org-archive-default-command 'confirm)) + +(defun org-agenda-archive () + "Archive the entry or subtree belonging to the current agenda entry." + (interactive) + (funcall-interactively + #'org-agenda-archive-with 'org-archive-subtree)) + +(defun org-agenda-archive-to-archive-sibling () + "Move the entry to the archive sibling." + (interactive) + (funcall-interactively + #'org-agenda-archive-with 'org-archive-to-archive-sibling)) + +(defvar org-archive-from-agenda) + +(defun org-agenda-archive-with (cmd &optional confirm) + "Move the entry to the archive sibling." + (interactive) + (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) + (org-agenda-maybe-loop + #'org-agenda-archive-with cmd nil t + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (org-with-remote-undo buffer + (with-current-buffer buffer + (if (derived-mode-p 'org-mode) + (if (and confirm + (not (y-or-n-p "Archive this subtree or entry? "))) + (error "Abort") + (save-window-excursion + (goto-char pos) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda)) + (org-back-to-heading t) + (let ((org-archive-from-agenda t)) + (funcall cmd)))) + (error "Archiving works only in Org files"))))))) + +(defun org-remove-subtree-entries-from-agenda (&optional buf beg end) + "Remove all lines in the agenda that correspond to a given subtree. +The subtree is the one in buffer BUF, starting at BEG and ending at END. +If this information is not given, the function uses the tree at point." + (let ((buf (or buf (current-buffer))) m p) + (save-excursion + (unless (and beg end) + (org-back-to-heading t) + (setq beg (point)) + (org-end-of-subtree t) + (setq end (point))) + (set-buffer (get-buffer org-agenda-buffer-name)) + (save-excursion + (goto-char (point-max)) + (beginning-of-line 1) + (while (not (bobp)) + (when (and (setq m (org-get-at-bol 'org-marker)) + (equal buf (marker-buffer m)) + (setq p (marker-position m)) + (>= p beg) + (< p end)) + (let ((inhibit-read-only t)) + (delete-region (point-at-bol) (1+ (point-at-eol))))) + (beginning-of-line 0)))))) + +(defun org-agenda-refile (&optional goto rfloc no-update) + "Refile the item at point. + +When called with `\\[universal-argument] \\[universal-argument]', \ +go to the location of the last +refiled item. + +When called with `\\[universal-argument] \\[universal-argument] \ +\\[universal-argument]' prefix or when GOTO is 0, clear +the refile cache. + +RFLOC can be a refile location obtained in a different way. + +When NO-UPDATE is non-nil, don't redo the agenda buffer." + (interactive "P") + (cond + ((member goto '(0 (64))) + (org-refile-cache-clear)) + ((equal goto '(16)) + (org-refile-goto-last-stored)) + (t + (let* ((buffer-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + ;; (pos (marker-position marker)) + (rfloc (or rfloc + (org-refile-get-location + (if goto "Goto" "Refile to") buffer + org-refile-allow-creating-parent-nodes)))) + (with-current-buffer buffer + (org-with-wide-buffer + (goto-char marker) + (let ((org-agenda-buffer-name buffer-orig)) + (org-remove-subtree-entries-from-agenda)) + (org-refile goto buffer rfloc)))) + (unless no-update (org-agenda-redo))))) + +(defun org-agenda-open-link (&optional arg) + "Open the link(s) in the current entry, if any. +This looks for a link in the displayed line in the agenda. +It also looks at the text of the entry itself." + (interactive "P") + (let* ((marker (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker))) + (buffer (and marker (marker-buffer marker))) + (prefix (buffer-substring (point-at-bol) (point-at-eol))) + (lkall (and buffer (org-offer-links-in-entry + buffer marker arg prefix))) + (lk0 (car lkall)) + (lk (if (stringp lk0) (list lk0) lk0)) + (lkend (cdr lkall)) + trg) + (cond + ((and buffer lk) + (mapcar (lambda(l) + (with-current-buffer buffer + (setq trg (and (string-match org-link-bracket-re l) + (match-string 1 l))) + (if (or (not trg) (string-match org-link-any-re trg)) + ;; Don't use `org-with-wide-buffer' here as + ;; opening the link may result in moving the point + (save-restriction + (widen) + (goto-char marker) + (when (search-forward l nil lkend) + (goto-char (match-beginning 0)) + (org-open-at-point))) + ;; This is an internal link, widen the buffer + ;; FIXME: use `org-switch-to-buffer-other-window'? + (switch-to-buffer-other-window buffer) + (widen) + (goto-char marker) + (when (search-forward l nil lkend) + (goto-char (match-beginning 0)) + (org-open-at-point))))) + lk)) + ((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)")) + (save-excursion + (beginning-of-line 1) + (looking-at (concat ".*?\\(" org-link-bracket-re "\\)")))) + (org-link-open-from-string (match-string 1))) + (t (message "No link to open here"))))) + +(defun org-agenda-copy-local-variable (var) + "Get a variable from a referenced buffer and install it here." + (let ((m (org-get-at-bol 'org-marker))) + (when (and m (buffer-live-p (marker-buffer m))) + (set (make-local-variable var) + (with-current-buffer (marker-buffer m) + (symbol-value var)))))) + +(defun org-agenda-switch-to (&optional delete-other-windows) + "Go to the Org mode file which contains the item at point. +When optional argument DELETE-OTHER-WINDOWS is non-nil, the +displayed Org file fills the frame." + (interactive) + (if (and org-return-follows-link + (not (org-get-at-bol 'org-marker)) + (org-in-regexp org-link-bracket-re)) + (org-link-open-from-string (match-string 0)) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (unless buffer (user-error "Trying to switch to non-existent buffer")) + (pop-to-buffer-same-window buffer) + (when delete-other-windows (delete-other-windows)) + (widen) + (goto-char pos) + (when (derived-mode-p 'org-mode) + (org-show-context 'agenda) + (run-hooks 'org-agenda-after-show-hook))))) + +(defun org-agenda-goto-mouse (ev) + "Go to the Org file which contains the item at the mouse click." + (interactive "e") + (mouse-set-point ev) + (org-agenda-goto)) + +(defun org-agenda-show (&optional full-entry) + "Display the Org file which contains the item at point. +With prefix argument FULL-ENTRY, make the entire entry visible +if it was hidden in the outline." + (interactive "P") + (let ((win (selected-window))) + (org-agenda-goto t) + (when full-entry (org-show-entry)) + (select-window win))) + +(defvar org-agenda-show-window nil) +(defun org-agenda-show-and-scroll-up (&optional arg) + "Display the Org file which contains the item at point. + +When called repeatedly, scroll the window that is displaying the buffer. + +With a `\\[universal-argument]' prefix argument, display the item, but \ +fold drawers." + (interactive "P") + (let ((win (selected-window))) + (if (and (window-live-p org-agenda-show-window) + (eq this-command last-command)) + (progn + (select-window org-agenda-show-window) + (ignore-errors (scroll-up))) + (org-agenda-goto t) + (org-show-entry) + (if arg (org-cycle-hide-drawers 'children) + (org-with-wide-buffer + (narrow-to-region (org-entry-beginning-position) + (org-entry-end-position)) + (org-show-all '(drawers)))) + (setq org-agenda-show-window (selected-window))) + (select-window win))) + +(defun org-agenda-show-scroll-down () + "Scroll down the window showing the agenda." + (interactive) + (let ((win (selected-window))) + (when (window-live-p org-agenda-show-window) + (select-window org-agenda-show-window) + (ignore-errors (scroll-down)) + (select-window win)))) + +(defun org-agenda-show-1 (&optional more) + "Display the Org file which contains the item at point. +The prefix arg selects the amount of information to display: + +0 hide the subtree +1 just show the entry according to defaults. +2 show the children view +3 show the subtree view +4 show the entire subtree and any drawers +With prefix argument FULL-ENTRY, make the entire entry visible +if it was hidden in the outline." + (interactive "p") + (let ((win (selected-window))) + (org-agenda-goto t) + (org-back-to-heading) + (set-window-start (selected-window) (point-at-bol)) + (cond + ((= more 0) + (org-flag-subtree t) + (save-excursion + (org-back-to-heading) + (run-hook-with-args 'org-cycle-hook 'folded)) + (message "Remote: FOLDED")) + ((and (called-interactively-p 'any) (= more 1)) + (message "Remote: show with default settings")) + ((= more 2) + (outline-show-entry) + (org-show-children) + (save-excursion + (org-back-to-heading) + (run-hook-with-args 'org-cycle-hook 'children)) + (message "Remote: CHILDREN")) + ((= more 3) + (outline-show-subtree) + (save-excursion + (org-back-to-heading) + (run-hook-with-args 'org-cycle-hook 'subtree)) + (message "Remote: SUBTREE")) + ((> more 3) + (outline-show-subtree) + (message "Remote: SUBTREE AND ALL DRAWERS"))) + (select-window win))) + +(defvar org-agenda-cycle-counter nil) +(defun org-agenda-cycle-show (&optional n) + "Show the current entry in another window, with default settings. + +Default settings are taken from `org-show-context-detail'. When +use repeatedly in immediate succession, the remote entry will +cycle through visibility + + children -> subtree -> folded + +When called with a numeric prefix arg, that arg will be passed through to +`org-agenda-show-1'. For the interpretation of that argument, see the +docstring of `org-agenda-show-1'." + (interactive "P") + (if (integerp n) + (setq org-agenda-cycle-counter n) + (if (not (eq last-command this-command)) + (setq org-agenda-cycle-counter 1) + (if (equal org-agenda-cycle-counter 0) + (setq org-agenda-cycle-counter 2) + (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) + (when (> org-agenda-cycle-counter 3) + (setq org-agenda-cycle-counter 0))))) + (org-agenda-show-1 org-agenda-cycle-counter)) + +(defun org-agenda-recenter (arg) + "Display the Org file which contains the item at point and recenter." + (interactive "P") + (let ((win (selected-window))) + (org-agenda-goto t) + (recenter arg) + (select-window win))) + +(defun org-agenda-show-mouse (ev) + "Display the Org file which contains the item at the mouse click." + (interactive "e") + (mouse-set-point ev) + (org-agenda-show)) + +(defun org-agenda-check-no-diary () + "Check if the entry is a diary link and abort if yes." + (when (org-get-at-bol 'org-agenda-diary-link) + (org-agenda-error))) + +(defun org-agenda-error () + "Throw an error when a command is not allowed in the agenda." + (user-error "Command not allowed in this line")) + +(defun org-agenda-tree-to-indirect-buffer (arg) + "Show the subtree corresponding to the current entry in an indirect buffer. +This calls the command `org-tree-to-indirect-buffer' from the original buffer. + +With a numerical prefix ARG, go up to this level and then take that tree. +With a negative numeric ARG, go up by this number of levels. + +With a `\\[universal-argument]' prefix, make a separate frame for this tree, \ +i.e. don't use +the dedicated frame." + (interactive "P") + (if current-prefix-arg + (org-agenda-do-tree-to-indirect-buffer arg) + (let ((agenda-buffer (buffer-name)) + (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 arg)) + (unless (or (eq org-indirect-buffer-display 'new-frame) + (eq org-indirect-buffer-display 'dedicated-frame)) + (unwind-protect + (unless (and indirect-window (window-live-p indirect-window)) + (setq indirect-window (split-window agenda-window))) + (and indirect-window (select-window indirect-window)) + (switch-to-buffer org-last-indirect-buffer :norecord) + (fit-window-to-buffer indirect-window))) + (select-window (get-buffer-window agenda-buffer)) + (setq org-agenda-last-indirect-buffer org-last-indirect-buffer)))) + +(defun org-agenda-do-tree-to-indirect-buffer (arg) + "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))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (with-current-buffer buffer + (save-excursion + (goto-char pos) + (org-tree-to-indirect-buffer arg))))) + +(defvar org-last-heading-marker (make-marker) + "Marker pointing to the headline that last changed its TODO state +by a remote command from the agenda.") + +(defun org-agenda-todo-nextset () + "Switch TODO entry to next sequence." + (interactive) + (org-agenda-todo 'nextset)) + +(defun org-agenda-todo-previousset () + "Switch TODO entry to previous sequence." + (interactive) + (org-agenda-todo 'previousset)) + +(defvar org-agenda-headline-snapshot-before-repeat) + +(defun org-agenda-todo (&optional arg) + "Cycle TODO state of line at point, also in Org file. +This changes the line at point, all other lines in the agenda referring to +the same tree node, and the headline of the tree node in the Org file." + (interactive "P") + (org-agenda-check-no-diary) + (org-agenda-maybe-loop + #'org-agenda-todo arg nil nil + (let* ((col (current-column)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (hdmarker (org-get-at-bol 'org-hd-marker)) + (todayp (org-agenda-today-p (org-get-at-bol 'day))) + (inhibit-read-only t) + org-loop-over-headlines-in-active-region + org-agenda-headline-snapshot-before-repeat newhead just-one) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (let ((current-prefix-arg arg)) + (call-interactively 'org-todo) + ;; Make sure that log is recorded in current undo. + (when (and org-log-setup + (not (eq org-log-note-how 'note))) + (org-add-log-note))) + (and (bolp) (forward-char 1)) + (setq newhead (org-get-heading)) + (when (and org-agenda-headline-snapshot-before-repeat + (not (equal org-agenda-headline-snapshot-before-repeat + newhead)) + todayp) + (setq newhead org-agenda-headline-snapshot-before-repeat + just-one t)) + (save-excursion + (org-back-to-heading) + (move-marker org-last-heading-marker (point)))) + (beginning-of-line 1) + (save-window-excursion + (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) + (when (bound-and-true-p org-clock-out-when-done) + (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda)) + newhead) + (org-agenda-unmark-clocking-task)) + (org-move-to-column col) + (org-agenda-mark-clocking-task))))) + +(defun org-agenda-add-note (&optional _arg) + "Add a time-stamped note to the entry at point." + (interactive) ;; "P" + (org-agenda-check-no-diary) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (_hdmarker (org-get-at-bol 'org-hd-marker)) + (inhibit-read-only t)) + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (org-add-note)))) + +(defun org-agenda-change-all-lines (newhead hdmarker + &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-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. +If JUST-THIS is non-nil, change just the current line, not all. +If FORCE-TAGS is non-nil, the car of it returns the new tags." + (let* ((inhibit-read-only t) + (line (org-current-line)) + (org-agenda-buffer (current-buffer)) + (thetags (with-current-buffer (marker-buffer hdmarker) + (org-get-tags hdmarker))) + props m undone-face done-face finish new dotime level cat tags) ;; pl + (save-excursion + (goto-char (point-max)) + (beginning-of-line 1) + (while (not finish) + (setq finish (bobp)) + (when (and (setq m (org-get-at-bol 'org-hd-marker)) + (or (not just-this) (= (org-current-line) line)) + (equal m hdmarker)) + (setq props (text-properties-at (point)) + dotime (org-get-at-bol 'dotime) + cat (org-agenda-get-category) + level (org-get-at-bol 'level) + tags thetags + new + (let ((org-prefix-format-compiled + (or (get-text-property (min (1- (point-max)) (point)) 'format) + org-prefix-format-compiled)) + (extra (org-get-at-bol 'extra))) + (with-current-buffer (marker-buffer hdmarker) + (org-with-wide-buffer + (org-agenda-format-item extra newhead level cat tags dotime)))) + ;; pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) + undone-face (org-get-at-bol 'undone-face) + done-face (org-get-at-bol 'done-face)) + (beginning-of-line 1) + (cond + ((equal new "") (delete-region (point) (line-beginning-position 2))) + ((looking-at ".*") + ;; When replacing the whole line, preserve bulk mark + ;; overlay, if any. + (let ((mark (catch :overlay + (dolist (o (overlays-in (point) (+ 2 (point)))) + (when (eq (overlay-get o 'type) + 'org-marked-entry-overlay) + (throw :overlay o)))))) + (replace-match new t t) + (beginning-of-line) + (when mark (move-overlay mark (point) (+ 2 (point))))) + (add-text-properties (point-at-bol) (point-at-eol) props) + (when fixface + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'face + (if org-last-todo-state-is-todo + undone-face done-face)))) + (org-agenda-highlight-todo 'line) + (beginning-of-line 1)) + (t (error "Line update did not work"))) + (save-restriction + (narrow-to-region (point-at-bol) (point-at-eol)) + (org-agenda-finalize))) + (beginning-of-line 0))))) + +(defun org-agenda-align-tags (&optional line) + "Align all tags in agenda items to `org-agenda-tags-column'. +When optional argument LINE is non-nil, align tags only on the +current line." + (let ((inhibit-read-only t) + (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column) + (- (window-text-width)) + org-agenda-tags-column)) + (end (and line (line-end-position))) + l c) + (save-excursion + (goto-char (if line (line-beginning-position) (point-min))) + (while (re-search-forward org-tag-group-re end t) + (add-text-properties + (match-beginning 1) (match-end 1) + (list 'face (delq nil (let ((prop (get-text-property + (match-beginning 1) 'face))) + (or (listp prop) (setq prop (list prop))) + (if (memq 'org-tag prop) + prop + (cons 'org-tag prop)))))) + (setq l (string-width (match-string 1)) + c (if (< org-agenda-tags-column 0) + (- (abs org-agenda-tags-column) l) + org-agenda-tags-column)) + (goto-char (match-beginning 1)) + (delete-region (save-excursion (skip-chars-backward " \t") (point)) + (point)) + (insert (org-add-props + (make-string (max 1 (- c (current-column))) ?\s) + (plist-put (copy-sequence (text-properties-at (point))) + 'face nil)))) + (goto-char (point-min)) + (org-font-lock-add-tag-faces (point-max))))) + +(defun org-agenda-priority-up () + "Increase the priority of line at point, also in Org file." + (interactive) + (org-agenda-priority 'up)) + +(defun org-agenda-priority-down () + "Decrease the priority of line at point, also in Org file." + (interactive) + (org-agenda-priority 'down)) + +(defun org-agenda-priority (&optional force-direction) + "Set the priority of line at point, also in Org file. +This changes the line at point, all other lines in the agenda +referring to the same tree node, and the headline of the tree +node in the Org file. + +Called with one universal prefix arg, show the priority instead +of setting it. + +When called programmatically, FORCE-DIRECTION can be `set', `up', +`down', or a character." + (interactive "P") + (unless org-priority-enable-commands + (user-error "Priority commands are disabled")) + (org-agenda-check-no-diary) + (let* ((col (current-column)) + (hdmarker (org-get-at-bol 'org-hd-marker)) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (org-priority force-direction) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (org-move-to-column col)))) + +;; FIXME: should fix the tags property of the agenda line. +(defun org-agenda-set-tags (&optional tag onoff) + "Set tags for the current headline." + (interactive) + (org-agenda-check-no-diary) + (if (and (org-region-active-p) (called-interactively-p 'any)) + (call-interactively 'org-change-tag-in-region) + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (if tag + (org-toggle-tag tag onoff) + (call-interactively #'org-set-tags-command)) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (beginning-of-line 1))))) + +(defun org-agenda-set-property () + "Set a property for the current headline." + (interactive) + (org-agenda-check-no-diary) + (org-agenda-maybe-loop + #'org-agenda-set-property nil nil nil + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + ) ;; newhead + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (call-interactively 'org-set-property)))))) + +(defun org-agenda-set-effort () + "Set the effort property for the current headline." + (interactive) + (org-agenda-check-no-diary) + (org-agenda-maybe-loop + #'org-agenda-set-effort nil nil nil + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (call-interactively 'org-set-effort) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker))))) + +(defun org-agenda-toggle-archive-tag () + "Toggle the archive tag for the current entry." + (interactive) + (org-agenda-check-no-diary) + (org-agenda-maybe-loop + #'org-agenda-toggle-archive-tag nil nil nil + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (call-interactively 'org-toggle-archive-tag) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (beginning-of-line 1))))) + +(defun org-agenda-do-date-later (arg) + (interactive "P") + (cond + ((or (equal arg '(16)) + (memq last-command + '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) + (setq this-command 'org-agenda-date-later-minutes) + (org-agenda-date-later-minutes 1)) + ((or (equal arg '(4)) + (memq last-command + '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) + (setq this-command 'org-agenda-date-later-hours) + (org-agenda-date-later-hours 1)) + (t + (org-agenda-date-later (prefix-numeric-value arg))))) + +(defun org-agenda-do-date-earlier (arg) + (interactive "P") + (cond + ((or (equal arg '(16)) + (memq last-command + '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) + (setq this-command 'org-agenda-date-earlier-minutes) + (org-agenda-date-earlier-minutes 1)) + ((or (equal arg '(4)) + (memq last-command + '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) + (setq this-command 'org-agenda-date-earlier-hours) + (org-agenda-date-earlier-hours 1)) + (t + (org-agenda-date-earlier (prefix-numeric-value arg))))) + +(defun org-agenda-date-later (arg &optional what) + "Change the date of this item to ARG day(s) later." + (interactive "p") + (org-agenda-check-type t 'agenda) + (org-agenda-check-no-diary) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + cdate today) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (unless (org-at-timestamp-p 'lax) (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)) + (when (> 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) + "Change the date of this item to ARG day(s) earlier." + (interactive "p") + (org-agenda-date-later (- arg) what)) + +(defun org-agenda-date-later-minutes (arg) + "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." + (interactive "p") + (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) + (org-agenda-date-later arg 'minute)) + +(defun org-agenda-date-earlier-minutes (arg) + "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." + (interactive "p") + (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) + (org-agenda-date-earlier arg 'minute)) + +(defun org-agenda-date-later-hours (arg) + "Change the time of this item, in hour steps." + (interactive "p") + (org-agenda-date-later arg 'hour)) + +(defun org-agenda-date-earlier-hours (arg) + "Change the time of this item, in hour steps." + (interactive "p") + (org-agenda-date-earlier arg 'hour)) + +(defun org-agenda-show-new-time (marker stamp &optional prefix) + "Show new date stamp via text properties." + ;; We use text properties to make this undoable + (let ((inhibit-read-only t)) + (setq stamp (concat prefix " => " stamp " ")) + (save-excursion + (goto-char (point-max)) + (while (not (bobp)) + (when (equal marker (org-get-at-bol 'org-marker)) + (remove-text-properties (line-beginning-position) + (line-end-position) + '(display nil)) + (org-move-to-column + (- (if (fboundp 'window-font-width) + (/ (window-width nil t) (window-font-width)) + ;; Fall back to pre-9.3.3 behavior on Emacs <25. + (window-width)) + (length stamp)) + t) + (add-text-properties + (1- (point)) (point-at-eol) + (list 'display (org-add-props stamp nil + 'face '(secondary-selection default)))) + (beginning-of-line 1)) + (beginning-of-line 0))))) + +(defun org-agenda-date-prompt (arg) + "Change the date of this item. Date is prompted for, with default today. +The prefix ARG is passed to the `org-time-stamp' command and can therefore +be used to request time specification in the time stamp." + (interactive "P") + (org-agenda-check-type t 'agenda) + (org-agenda-check-no-diary) + (org-agenda-maybe-loop + #'org-agenda-date-prompt arg t nil + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) + (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) + (org-agenda-show-new-time marker org-last-changed-timestamp)) + (message "Time stamp changed to %s" org-last-changed-timestamp)))) + +(defun org-agenda-schedule (arg &optional time) + "Schedule the item at point. +ARG is passed through to `org-schedule'." + (interactive "P") + (org-agenda-check-type t 'agenda 'todo 'tags 'search) + (org-agenda-check-no-diary) + (org-agenda-maybe-loop + #'org-agenda-schedule arg t nil + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + ;; (type (marker-insertion-type marker)) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + ts) + (set-marker-insertion-type marker t) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-schedule arg time))) + (org-agenda-show-new-time marker ts " S")) + (message "%s" ts)))) + +(defun org-agenda-deadline (arg &optional time) + "Schedule the item at point. +ARG is passed through to `org-deadline'." + (interactive "P") + (org-agenda-check-type t 'agenda 'todo 'tags 'search) + (org-agenda-check-no-diary) + (org-agenda-maybe-loop + #'org-agenda-deadline arg t nil + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + ts) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-deadline arg time))) + (org-agenda-show-new-time marker ts " D")) + (message "%s" ts)))) + +(defun org-agenda-clock-in (&optional arg) + "Start the clock on the currently selected item." + (interactive "P") + (org-agenda-check-no-diary) + (if (equal arg '(4)) + (org-clock-in arg) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (hdmarker (or (org-get-at-bol 'org-hd-marker) marker)) + (pos (marker-position marker)) + (col (current-column)) + newhead) + (org-with-remote-undo (marker-buffer marker) + (with-current-buffer (marker-buffer marker) + (widen) + (goto-char pos) + (org-show-context 'agenda) + (org-clock-in arg) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker)) + (org-move-to-column col)))) + +(defun org-agenda-clock-out () + "Stop the currently running clock." + (interactive) + (unless (marker-buffer org-clock-marker) + (user-error "No running clock")) + (let ((marker (make-marker)) (col (current-column)) newhead) + (org-with-remote-undo (marker-buffer org-clock-marker) + (with-current-buffer (marker-buffer org-clock-marker) + (org-with-wide-buffer + (goto-char org-clock-marker) + (org-back-to-heading t) + (move-marker marker (point)) + (org-clock-out) + (setq newhead (org-get-heading))))) + (org-agenda-change-all-lines newhead marker) + (move-marker marker nil) + (org-move-to-column col) + (org-agenda-unmark-clocking-task))) + +(defun org-agenda-clock-cancel (&optional _arg) + "Cancel the currently running clock." + (interactive) ;; "P" + (unless (marker-buffer org-clock-marker) + (user-error "No running clock")) + (org-with-remote-undo (marker-buffer org-clock-marker) + (org-clock-cancel))) + +(defun org-agenda-clock-goto () + "Jump to the currently clocked in task within the agenda. +If the currently clocked in task is not listed in the agenda +buffer, display it in another window." + (interactive) + (let (pos) + (mapc (lambda (o) + (when (eq (overlay-get o 'type) 'org-agenda-clocking) + (setq pos (overlay-start o)))) + (overlays-in (point-min) (point-max))) + (cond (pos (goto-char pos)) + ;; If the currently clocked entry is not in the agenda + ;; buffer, we visit it in another window: + ((bound-and-true-p org-clock-current-task) + (org-switch-to-buffer-other-window (org-clock-goto))) + (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) + +(defun org-agenda-diary-entry-in-org-file () + "Make a diary entry in the file `org-agenda-diary-file'." + (let (d1 d2 char (text "") dp1 dp2) + (if (equal (buffer-name) "*Calendar*") + (setq d1 (calendar-cursor-to-date t) + d2 (car calendar-mark-ring)) + (setq dp1 (get-text-property (point-at-bol) 'day)) + (unless dp1 (user-error "No date defined in current line")) + (setq d1 (calendar-gregorian-from-absolute dp1) + d2 (and (ignore-errors (mark)) + (save-excursion + (goto-char (mark)) + (setq dp2 (get-text-property (point-at-bol) 'day))) + (calendar-gregorian-from-absolute dp2)))) + (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree") + (setq char (read-char-exclusive)) + (cond + ((equal char ?d) + (setq text (read-string "Day entry: ")) + (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1) + (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) + ((equal char ?a) + (setq d1 (list (car d1) (nth 1 d1) + (read-number (format "Reference year [%d]: " (nth 2 d1)) + (nth 2 d1)))) + (setq text (read-string "Anniversary (use %d to show years): ")) + (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1) + (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) + ((equal char ?b) + (setq text (read-string "Block entry: ")) + (unless (and d1 d2 (not (equal d1 d2))) + (user-error "No block of days selected")) + (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2) + (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) + ((equal char ?j) + (org-switch-to-buffer-other-window + (find-file-noselect org-agenda-diary-file)) + (require 'org-datetree) + (org-datetree-find-date-create d1) + (org-reveal t)) + (t (user-error "Invalid selection character `%c'" char))))) + +(defcustom org-agenda-insert-diary-strategy 'date-tree + "Where in `org-agenda-diary-file' should new entries be added? +Valid values: + +date-tree in the date tree, as first child of the date +date-tree-last in the date tree, as last child of the date +top-level as top-level entries at the end of the file." + :group 'org-agenda + :type '(choice + (const :tag "first in a date tree" date-tree) + (const :tag "last in a date tree" date-tree-last) + (const :tag "as top level at end of file" top-level))) + +(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) + +(defcustom org-agenda-bulk-mark-char ">" + "A single-character string to be used as the bulk mark." + :group 'org-agenda + :version "24.1" + :type 'string) + +(defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) + "Add a diary entry with TYPE to `org-agenda-diary-file'. +If TEXT is not empty, it will become the headline of the new entry, and +the resulting entry will not be shown. When TEXT is empty, switch to +`org-agenda-diary-file' and let the user finish the entry there." + (let ((cw (current-window-configuration))) + (org-switch-to-buffer-other-window + (find-file-noselect org-agenda-diary-file)) + (widen) + (goto-char (point-min)) + (cl-case type + (anniversary + (or (re-search-forward "^\\*[ \t]+Anniversaries" nil t) + (progn + (or (org-at-heading-p t) + (progn + (outline-next-heading) + (insert "* Anniversaries\n\n") + (beginning-of-line -1))))) + (outline-next-heading) + (org-back-over-empty-lines) + (backward-char 1) + (insert "\n") + (insert (format "%%%%(org-anniversary %d %2d %2d) %s" + (nth 2 d1) (car d1) (nth 1 d1) text))) + (day + (let ((org-prefix-has-time t) + (org-agenda-time-leading-zero t) + fmt time time2) + (when org-agenda-insert-diary-extract-time + ;; 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-agenda-format-item nil text nil nil nil t) + time (get-text-property 0 'time fmt) + time2 (if (> (length time) 0) + ;; split-string removes trailing ...... if + ;; no end time given. First space + ;; separates time from date. + (concat " " (car (split-string time "\\."))) + nil) + text (get-text-property 0 'txt fmt))) + (if (eq org-agenda-insert-diary-strategy 'top-level) + (org-agenda-insert-diary-as-top-level text) + (require 'org-datetree) + (org-datetree-find-date-create d1) + (org-agenda-insert-diary-make-new-entry text)) + (org-insert-time-stamp (org-time-from-absolute + (calendar-absolute-from-gregorian d1)) + nil nil nil nil time2)) + (end-of-line 0)) + ((block) ;; Wrap this in (strictly unnecessary) parens because + ;; otherwise the indentation gets confused by the + ;; special meaning of 'block + (when (> (calendar-absolute-from-gregorian d1) + (calendar-absolute-from-gregorian d2)) + (setq d1 (prog1 d2 (setq d2 d1)))) + (if (eq org-agenda-insert-diary-strategy 'top-level) + (org-agenda-insert-diary-as-top-level text) + (require 'org-datetree) + (org-datetree-find-date-create d1) + (org-agenda-insert-diary-make-new-entry text)) + (org-insert-time-stamp (org-time-from-absolute + (calendar-absolute-from-gregorian d1))) + (insert "--") + (org-insert-time-stamp (org-time-from-absolute + (calendar-absolute-from-gregorian d2))) + (end-of-line 0))) + (if (string-match "\\S-" text) + (progn + (set-window-configuration cw) + (message "%s entry added to %s" + (capitalize (symbol-name type)) + (abbreviate-file-name org-agenda-diary-file))) + (org-reveal t) + (message "Please finish entry here")))) + +(defun org-agenda-insert-diary-as-top-level (text) + "Make new entry as a top-level entry at the end of the file. +Add TEXT as headline, and position the cursor in the second line so that +a timestamp can be added there." + (widen) + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (org-insert-heading nil t t) + (insert text) + (org-end-of-meta-data) + (unless (bolp) (insert "\n")) + (when org-adapt-indentation (indent-to-column 2))) + +(defun org-agenda-insert-diary-make-new-entry (text) + "Make a new entry with TEXT as a child of the current subtree. +Position the point in the heading's first body line so that +a timestamp can be added there." + (cond + ((eq org-agenda-insert-diary-strategy 'date-tree-last) + (end-of-line) + (org-insert-heading '(4) t) + (org-do-demote)) + (t + (outline-next-heading) + (org-back-over-empty-lines) + (unless (looking-at "[ \t]*$") (save-excursion (insert "\n"))) + (org-insert-heading nil t) + (org-do-demote))) + (let ((col (current-column))) + (insert text) + (org-end-of-meta-data) + ;; Ensure point is left on a blank line, at proper indentation. + (unless (bolp) (insert "\n")) + (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n"))) + (when org-adapt-indentation (indent-to-column col))) + (org-show-set-visibility 'lineage)) + +(defun org-agenda-diary-entry () + "Make a diary entry, like the `i' command from the calendar. +All the standard commands work: block, weekly etc. +When `org-agenda-diary-file' points to a file, +`org-agenda-diary-entry-in-org-file' is called instead to create +entries in that Org file." + (interactive) + (if (not (eq org-agenda-diary-file 'diary-file)) + (org-agenda-diary-entry-in-org-file) + (require 'diary-lib) + (let* ((char (read-char-exclusive + "Diary entry: [d]ay [w]eekly [m]onthly [y]early\ + [a]nniversary [b]lock [c]yclic")) + (cmd (cdr (assoc char + '((?d . diary-insert-entry) + (?w . diary-insert-weekly-entry) + (?m . diary-insert-monthly-entry) + (?y . diary-insert-yearly-entry) + (?a . diary-insert-anniversary-entry) + (?b . diary-insert-block-entry) + (?c . diary-insert-cyclic-entry))))) + (oldf (symbol-function 'calendar-cursor-to-date)) + ;; (buf (get-file-buffer (substitute-in-file-name diary-file))) + (point (point)) + (mark (or (mark t) (point)))) + (unless cmd + (user-error "No command associated with <%c>" char)) + (unless (and (get-text-property point 'day) + (or (not (equal ?b char)) + (get-text-property mark 'day))) + (user-error "Don't know which date to use for diary entry")) + ;; We implement this by hacking the `calendar-cursor-to-date' function + ;; and the `calendar-mark-ring' variable. Saves a lot of code. + (let ((calendar-mark-ring + (list (calendar-gregorian-from-absolute + (or (get-text-property mark 'day) + (get-text-property point 'day)))))) + (unwind-protect + (progn + (fset 'calendar-cursor-to-date + (lambda (&optional _error _dummy) + (calendar-gregorian-from-absolute + (get-text-property point 'day)))) + (call-interactively cmd)) + (fset 'calendar-cursor-to-date oldf)))))) + +(defun org-agenda-execute-calendar-command (cmd) + "Execute a calendar command from the agenda with date from cursor." + (org-agenda-check-type t 'agenda) + (require 'diary-lib) + (unless (get-text-property (min (1- (point-max)) (point)) 'day) + (user-error "Don't know which date to use for the calendar command")) + (let* ((oldf (symbol-function 'calendar-cursor-to-date)) + (point (point)) + (date (calendar-gregorian-from-absolute + (get-text-property point 'day)))) + ;; the following 2 vars are needed in the calendar + (org-dlet + ((displayed-month (car date)) + (displayed-year (nth 2 date))) + (unwind-protect + (progn + (fset 'calendar-cursor-to-date + (lambda (&optional _error _dummy) + (calendar-gregorian-from-absolute + (get-text-property point 'day)))) + (call-interactively cmd)) + (fset 'calendar-cursor-to-date oldf))))) + +(defun org-agenda-phases-of-moon () + "Display the phases of the moon for the 3 months around the cursor date." + (interactive) + (org-agenda-execute-calendar-command 'calendar-lunar-phases)) + +(defun org-agenda-holidays () + "Display the holidays for the 3 months around the cursor date." + (interactive) + (org-agenda-execute-calendar-command 'calendar-list-holidays)) + +(defvar calendar-longitude) ; defined in calendar.el +(defvar calendar-latitude) ; defined in calendar.el +(defvar calendar-location-name) ; defined in calendar.el + +(defun org-agenda-sunrise-sunset (arg) + "Display sunrise and sunset for the cursor date. +Latitude and longitude can be specified with the variables +`calendar-latitude' and `calendar-longitude'. When called with prefix +argument, latitude and longitude will be prompted for." + (interactive "P") + (require 'solar) + (let ((calendar-longitude (if arg nil calendar-longitude)) + (calendar-latitude (if arg nil calendar-latitude)) + (calendar-location-name + (if arg "the given coordinates" calendar-location-name))) + (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) + +(defun org-agenda-goto-calendar () + "Open the Emacs calendar with the date at the cursor." + (interactive) + (org-agenda-check-type t 'agenda) + (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) + (user-error "Don't know which date to open in calendar"))) + (date (calendar-gregorian-from-absolute day)) + (calendar-move-hook nil) + (calendar-view-holidays-initially-flag nil) + (calendar-view-diary-initially-flag nil)) + (calendar) + (calendar-goto-date date))) + +;;;###autoload +(defun org-calendar-goto-agenda () + "Compute the Org agenda for the calendar date displayed at the cursor. +This is a command that has to be installed in `calendar-mode-map'." + (interactive) + ;; Temporarily disable sticky agenda since user clearly wants to + ;; refresh view anyway. + (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*") + (org-agenda-sticky nil)) + (org-agenda-list nil (calendar-absolute-from-gregorian + (calendar-cursor-to-date)) + nil))) + +(defun org-agenda-convert-date () + (interactive) + (org-agenda-check-type t 'agenda) + (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) + date s) + (unless day + (user-error "Don't know which date to convert")) + (setq date (calendar-gregorian-from-absolute day)) + (setq s (concat + "Gregorian: " (calendar-date-string date) "\n" + "ISO: " (calendar-iso-date-string date) "\n" + "Day of Yr: " (calendar-day-of-year-string date) "\n" + "Julian: " (calendar-julian-date-string date) "\n" + "Astron. JD: " (calendar-astro-date-string date) + " (Julian date number at noon UTC)\n" + "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" + "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" + "French: " (calendar-french-date-string date) "\n" + "Bahá’í: " (calendar-bahai-date-string date) " (until sunset)\n" + "Mayan: " (calendar-mayan-date-string date) "\n" + "Coptic: " (calendar-coptic-date-string date) "\n" + "Ethiopic: " (calendar-ethiopic-date-string date) "\n" + "Persian: " (calendar-persian-date-string date) "\n" + "Chinese: " (calendar-chinese-date-string date) "\n")) + (with-output-to-temp-buffer "*Dates*" + (princ s)) + (org-fit-window-to-buffer (get-buffer-window "*Dates*")))) + +;;; Bulk commands + +(defun org-agenda-bulk-marked-p () + "Non-nil when current entry is marked for bulk action." + (eq (get-char-property (point-at-bol) 'type) + 'org-marked-entry-overlay)) + +(defun org-agenda-bulk-mark (&optional arg) + "Mark entries for future bulk action. + +When ARG is nil or one and region is not active then mark the +entry at point. + +When ARG is nil or one and region is active then mark the entries +in the region. + +When ARG is greater than one mark ARG lines." + (interactive "p") + (when (and (or (not arg) (= arg 1)) (use-region-p)) + (setq arg (count-lines (region-beginning) (region-end))) + (goto-char (region-beginning)) + (deactivate-mark)) + (dotimes (_ (or arg 1)) + (unless (org-get-at-bol 'org-agenda-diary-link) + (let* ((m (org-get-at-bol 'org-hd-marker)) + ov) + (unless (org-agenda-bulk-marked-p) + (unless m (user-error "Nothing to mark at point")) + (push m org-agenda-bulk-marked-entries) + (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) + (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") + (org-get-todo-face "TODO") + 'evaporate) + (overlay-put ov 'type 'org-marked-entry-overlay)) + (end-of-line 1) + (or (ignore-errors + (goto-char (next-single-property-change (point) 'org-hd-marker))) + (beginning-of-line 2)) + (while (and (get-char-property (point) 'invisible) (not (eobp))) + (beginning-of-line 2))))) + (message "%d entries marked for bulk action" + (length org-agenda-bulk-marked-entries))) + +(defun org-agenda-bulk-mark-all () + "Mark all entries for future agenda bulk action." + (interactive) + (org-agenda-bulk-mark-regexp ".")) + +(defun org-agenda-bulk-mark-regexp (regexp) + "Mark entries matching REGEXP for future agenda bulk action." + (interactive "sMark entries matching regexp: ") + (let ((entries-marked 0) txt-at-point) + (save-excursion + (goto-char (point-min)) + (goto-char (next-single-property-change (point) 'org-hd-marker)) + (while (and (re-search-forward regexp nil t) + (setq txt-at-point + (get-text-property (match-beginning 0) 'txt))) + (if (get-char-property (point) 'invisible) + (beginning-of-line 2) + (when (string-match-p regexp txt-at-point) + (setq entries-marked (1+ entries-marked)) + (call-interactively 'org-agenda-bulk-mark))))) + (unless entries-marked + (message "No entry matching this regexp.")))) + +(defun org-agenda-bulk-unmark (&optional arg) + "Unmark the entry at point for future bulk action." + (interactive "P") + (if arg + (org-agenda-bulk-unmark-all) + (cond ((org-agenda-bulk-marked-p) + (org-agenda-bulk-remove-overlays + (point-at-bol) (+ 2 (point-at-bol))) + (setq org-agenda-bulk-marked-entries + (delete (org-get-at-bol 'org-hd-marker) + org-agenda-bulk-marked-entries)) + (end-of-line 1) + (or (ignore-errors + (goto-char (next-single-property-change (point) 'txt))) + (beginning-of-line 2)) + (while (and (get-char-property (point) 'invisible) (not (eobp))) + (beginning-of-line 2)) + (message "%d entries left marked for bulk action" + (length org-agenda-bulk-marked-entries))) + (t (message "No entry to unmark here"))))) + +(defun org-agenda-bulk-toggle-all () + "Toggle all marks for bulk action." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (ignore-errors + (goto-char (next-single-property-change (point) 'org-hd-marker))) + (org-agenda-bulk-toggle)))) + +(defun org-agenda-bulk-toggle () + "Toggle the mark at point for bulk action." + (interactive) + (if (org-agenda-bulk-marked-p) + (org-agenda-bulk-unmark) + (org-agenda-bulk-mark))) + +(defun org-agenda-bulk-remove-overlays (&optional beg end) + "Remove the mark overlays between BEG and END in the agenda buffer. +BEG and END default to the buffer limits. + +This only removes the overlays, it does not remove the markers +from the list in `org-agenda-bulk-marked-entries'." + (interactive) + (mapc (lambda (ov) + (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay) + (delete-overlay ov))) + (overlays-in (or beg (point-min)) (or end (point-max))))) + +(defun org-agenda-bulk-unmark-all () + "Remove all marks in the agenda buffer. +This will remove the markers and the overlays." + (interactive) + (if (null org-agenda-bulk-marked-entries) + (message "No entry to unmark") + (setq org-agenda-bulk-marked-entries nil) + (org-agenda-bulk-remove-overlays (point-min) (point-max)))) + +(defcustom org-agenda-persistent-marks nil + "Non-nil means marked items will stay marked after a bulk action. +You can toggle this interactively by typing `p' when prompted for a +bulk action." + :group 'org-agenda + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-loop-over-headlines-in-active-region t + "Shall some commands act upon headlines in the active region? + +When set to t, some commands will be performed in all headlines +within the active region. + +When set to `start-level', some commands will be performed in all +headlines within the active region, provided that these headlines +are of the same level than the first one. + +When set to a regular expression, those commands will be +performed on the matching headlines within the active region. + +The list of commands is: `org-agenda-schedule', +`org-agenda-deadline', `org-agenda-date-prompt', +`org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'. + +See `org-loop-over-headlines-in-active-region' for the equivalent +option for Org buffers." + :type '(choice (const :tag "Don't loop" nil) + (const :tag "All headlines in active region" t) + (const :tag "In active region, headlines at the same level than the first one" start-level) + (regexp :tag "Regular expression matcher")) + :version "27.1" + :package-version '(Org . "9.4") + :group 'org-agenda) + +(defun org-agenda-bulk-action (&optional arg) + "Execute an remote-editing action on all marked entries. +The prefix arg is passed through to the command if possible." + (interactive "P") + ;; When there is no mark, act on the agenda entry at point. + (if (not org-agenda-bulk-marked-entries) + (save-excursion (org-agenda-bulk-mark))) + (dolist (m org-agenda-bulk-marked-entries) + (unless (and (markerp m) + (marker-buffer m) + (buffer-live-p (marker-buffer m)) + (marker-position m)) + (user-error "Marker %s for bulk command is invalid" m))) + + ;; Prompt for the bulk command. + (org-unlogged-message + (concat "Bulk (" (if org-agenda-persistent-marks "" "don't ") "[p]ersist marks): " + "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " + "[S]catter [f]unction " + (and org-agenda-bulk-custom-functions + (format " Custom: [%s]" + (mapconcat (lambda (f) (char-to-string (car f))) + org-agenda-bulk-custom-functions + ""))))) + (catch 'exit + (let* ((org-log-refile (if org-log-refile 'time nil)) + (entries (reverse org-agenda-bulk-marked-entries)) + (org-overriding-default-time + (and (get-text-property (point) 'org-agenda-date-header) + (org-get-cursor-date))) + redo-at-end + cmd) + (pcase (read-char-exclusive) + (?p + (let ((org-agenda-persistent-marks + (not org-agenda-persistent-marks))) + (org-agenda-bulk-action) + (throw 'exit nil))) + + (?$ + (setq cmd #'org-agenda-archive)) + + (?A + (setq cmd #'org-agenda-archive-to-archive-sibling)) + + ((or ?r ?w) + (let ((refile-location + (org-refile-get-location + "Refile to" + (marker-buffer (car entries)) + org-refile-allow-creating-parent-nodes))) + (when (nth 3 refile-location) + (setcar (nthcdr 3 refile-location) + (move-marker + (make-marker) + (nth 3 refile-location) + (or (get-file-buffer (nth 1 refile-location)) + (find-buffer-visiting (nth 1 refile-location)) + (error "This should not happen"))))) + + (setq cmd (lambda () (org-agenda-refile nil refile-location t))) + (setq redo-at-end t))) + + (?t + (let ((state (completing-read + "Todo state: " + (with-current-buffer (marker-buffer (car entries)) + (mapcar #'list org-todo-keywords-1))))) + (setq cmd (lambda () + (let ((org-inhibit-blocking t) + (org-inhibit-logging 'note)) + (org-agenda-todo state)))))) + + ((and (or ?- ?+) action) + (let ((tag (completing-read + (format "Tag to %s: " (if (eq action ?+) "add" "remove")) + (with-current-buffer (marker-buffer (car entries)) + (delq nil + (mapcar (lambda (x) (and (stringp (car x)) x)) + org-current-tag-alist)))))) + (setq cmd + (lambda () + (org-agenda-set-tags tag + (if (eq action ?+) 'on 'off)))))) + + ((and (or ?s ?d) c) + (let* ((schedule? (eq c ?s)) + (prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to")) + (time + (and (not arg) + (let ((new (org-read-date + nil nil nil prompt org-overriding-default-time))) + ;; A "double plus" answer applies to every + ;; scheduled time. Do not turn it into + ;; a fixed date yet. + (if (string-match-p "\\`[ \t]*\\+\\+" + org-read-date-final-answer) + org-read-date-final-answer + new))))) + ;; Make sure to not prompt for a note when bulk + ;; rescheduling/resetting deadline as Org cannot cope with + ;; simultaneous notes. Besides, it could be annoying + ;; depending on the number of marked items. + (setq cmd + (if schedule? + (lambda () + (let ((org-log-reschedule + (and org-log-reschedule 'time))) + (org-agenda-schedule arg time))) + (lambda () + (let ((org-log-redeadline (and org-log-redeadline 'time))) + (org-agenda-deadline arg time))))))) + + (?S + (unless (org-agenda-check-type nil 'agenda 'todo) + (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)) + (let ((days (read-number + (format "Scatter tasks across how many %sdays: " + (if arg "week" "")) + 7))) + (setq cmd + (lambda () + (let ((distance (1+ (random days)))) + (when arg + (let ((dist distance) + (day-of-week + (calendar-day-of-week + (calendar-gregorian-from-absolute (org-today))))) + (dotimes (_ (1+ dist)) + (while (member day-of-week org-agenda-weekend-days) + (cl-incf distance) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))))) + ;; Silently fail when try to replan a sexp entry. + (ignore-errors + (let* ((date (calendar-gregorian-from-absolute + (+ (org-today) distance))) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) + (nth 2 date)))) + (org-agenda-schedule nil time)))))))) + + (?f + (setq cmd + (intern + (completing-read "Function: " obarray #'fboundp t nil nil)))) + + (action + (setq cmd + (pcase (assoc action org-agenda-bulk-custom-functions) + (`(,_ ,fn) + fn) + (`(,_ ,fn ,arg-fn) + (apply #'apply-partially fn (funcall arg-fn))) + (_ + (user-error "Invalid bulk action: %c" action)))) + (setq redo-at-end t))) + ;; Sort the markers, to make sure that parents are handled + ;; before children. + (setq entries (sort entries + (lambda (a b) + (cond + ((eq (marker-buffer a) (marker-buffer b)) + (< (marker-position a) (marker-position b))) + (t + (string< (buffer-name (marker-buffer a)) + (buffer-name (marker-buffer b)))))))) + + ;; Now loop over all markers and apply CMD. + (let ((processed 0) + (skipped 0)) + (dolist (e entries) + (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e))) + (if (not pos) + (progn (message "Skipping removed entry at %s" e) + (cl-incf skipped)) + (goto-char pos) + (let (org-loop-over-headlines-in-active-region) (funcall cmd)) + ;; `post-command-hook' is not run yet. We make sure any + ;; pending log note is processed. + (when org-log-setup (org-add-log-note)) + (cl-incf processed)))) + (when redo-at-end (org-agenda-redo)) + (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all)) + (message "Acted on %d entries%s%s" + processed + (if (= skipped 0) + "" + (format ", skipped %d (disappeared before their turn)" + skipped)) + (if (not org-agenda-persistent-marks) "" " (kept marked)")))))) + +(defun org-agenda-capture (&optional with-time) + "Call `org-capture' with the date at point. +With a `C-1' prefix, use the HH:MM value at point (if any) or the +current HH:MM time." + (interactive "P") + (if (not (eq major-mode 'org-agenda-mode)) + (user-error "You cannot do this outside of agenda buffers") + (let ((org-overriding-default-time + (org-get-cursor-date (equal with-time 1)))) + (call-interactively 'org-capture)))) + +;;; Dragging agenda lines forward/backward + +(defun org-agenda-reapply-filters () + "Re-apply all agenda filters." + (mapcar + (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t))) + `((,org-agenda-tag-filter tag) + (,org-agenda-category-filter category) + (,org-agenda-regexp-filter regexp) + (,org-agenda-effort-filter effort) + (,(get 'org-agenda-tag-filter :preset-filter) tag) + (,(get 'org-agenda-category-filter :preset-filter) category) + (,(get 'org-agenda-effort-filter :preset-filter) effort) + (,(get 'org-agenda-regexp-filter :preset-filter) regexp)))) + +(defun org-agenda-drag-line-forward (arg &optional backward) + "Drag an agenda line forward by ARG lines. +When the optional argument `backward' is non-nil, move backward." + (interactive "p") + (let ((inhibit-read-only t) lst line) + (if (or (not (get-text-property (point) 'txt)) + (save-excursion + (dotimes (_ arg) + (move-beginning-of-line (if backward 0 2)) + (push (not (get-text-property (point) 'txt)) lst)) + (delq nil lst))) + (message "Cannot move line forward") + (let ((end (save-excursion (move-beginning-of-line 2) (point)))) + (move-beginning-of-line 1) + (setq line (buffer-substring (point) end)) + (delete-region (point) end) + (move-beginning-of-line (funcall (if backward '1- '1+) arg)) + (insert line) + (org-agenda-reapply-filters) + (org-agenda-mark-clocking-task) + (move-beginning-of-line 0))))) + +(defun org-agenda-drag-line-backward (arg) + "Drag an agenda line backward by ARG lines." + (interactive "p") + (org-agenda-drag-line-forward arg t)) + +;;; Flagging notes + +(defun org-agenda-show-the-flagging-note () + "Display the flagging note in the other window. +When called a second time in direct sequence, offer to remove the FLAGGING +tag and (if present) the flagging note." + (interactive) + (let ((hdmarker (org-get-at-bol 'org-hd-marker)) + (win (selected-window)) + note) ;; heading newhead + (unless hdmarker + (user-error "No linked entry at point")) + (if (and (eq this-command last-command) + (y-or-n-p "Unflag and remove any flagging note? ")) + (progn + (org-agenda-remove-flag hdmarker) + (let ((win (get-buffer-window "*Flagging Note*"))) + (and win (delete-window win))) + (message "Entry unflagged")) + (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE")) + (unless note + (user-error "No flagging note")) + (org-kill-new note) + (org-switch-to-buffer-other-window "*Flagging Note*") + (erase-buffer) + (insert note) + (goto-char (point-min)) + (while (re-search-forward "\\\\n" nil t) + (replace-match "\n" t t)) + (goto-char (point-min)) + (select-window win) + (message "%s" (substitute-command-keys "Flagging note pushed to \ +kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \ +tag and note"))))) + +(defun org-agenda-remove-flag (marker) + "Remove the FLAGGED tag and any flagging note in the entry." + (let ((newhead + (org-with-point-at marker + (org-toggle-tag "FLAGGED" 'off) + (org-entry-delete nil "THEFLAGGINGNOTE") + (org-get-heading)))) + (org-agenda-change-all-lines newhead marker) + (message "Entry unflagged"))) + +(defun org-agenda-get-any-marker (&optional pos) + (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker) + (get-text-property (or pos (point-at-bol)) 'org-marker))) + +;;; Appointment reminders + +(defvar appt-time-msg-list) ; defined in appt.el + +;;;###autoload +(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 t, interactively prompt the user for a regular +expression, and filter out entries that don't match it. + +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: + + \\='((headline \"IMPORTANT\") + (category \"Work\")) + +will only add headlines containing IMPORTANT or headlines +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* +\(i.e., deadlines and scheduled items with a hh:mm specification) +and :timestamp entries. See the docstring of `org-diary' for +details and examples. + +If an entry has a APPT_WARNTIME property, its value will be used +to override `appt-message-warning-time'." + (interactive "P") + (when refresh (setq appt-time-msg-list nil)) + (when (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 + ;; time and without date as argument, so it may pass wrong + ;; information otherwise + (today (org-date-to-gregorian + (time-to-days nil))) + (org-agenda-restrict nil) + (files (org-agenda-files 'unrestricted)) entries file + (org-agenda-buffer nil)) + ;; Get all entries which may contain an appt + (org-agenda-prepare-buffers files) + (while (setq file (pop files)) + (setq entries + (delq nil + (append entries + (apply #'org-agenda-get-day-entries + file today scope))))) + ;; Map through entries and find if we should filter them out + (mapc + (lambda (x) + (let* ((evt (org-trim + (replace-regexp-in-string + org-link-bracket-re "\\2" + (or (get-text-property 1 'txt x) "")))) + (cat (get-text-property (1- (length x)) 'org-category 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) + (let ((cat-filter (cadr (assq 'category filter))) + (evt-filter (cadr (assq 'headline filter)))) + (or (and (stringp cat-filter) + (string-match cat-filter cat)) + (and (stringp evt-filter) + (string-match evt-filter evt))))))) + (wrn (get-text-property 1 'warntime x))) + ;; FIXME: Shall we remove text-properties for the appt text? + ;; (setq evt (set-text-properties 0 (length evt) nil evt)) + (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt))) + (setq tod (concat "00" (number-to-string tod))) + (setq tod (when (string-match + "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) + (concat (match-string 1 tod) ":" + (match-string 2 tod)))) + (when (appt-add tod evt wrn) + (setq cnt (1+ cnt)))))) + entries) + (org-release-buffers org-agenda-new-buffers) + (if (eq cnt 0) + (message "No event to add") + (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) + +(defun org-agenda-today-p (date) + "Non-nil when DATE means today. +DATE is either a list of the form (month day year) or a number of +days as returned by `calendar-absolute-from-gregorian' or +`org-today'. This function considers `org-extend-today-until' +when defining today." + (eq (org-today) + (if (consp date) (calendar-absolute-from-gregorian date) date))) + +(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* ((org-use-effective-time t) + (hour (nth 2 (decode-time (org-current-time)))) + (org-extend-today-until (1+ hour))) + (org-agenda-todo arg))) + +(defun org-agenda-ctrl-c-ctrl-c () + "Set tags in agenda buffer." + (interactive) + (org-agenda-set-tags)) + +(provide 'org-agenda) + +;;; org-agenda.el ends here |