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, 0 insertions, 10892 deletions
diff --git a/elpa/org-9.5.2/org-agenda.el b/elpa/org-9.5.2/org-agenda.el deleted file mode 100644 index 59bdd5b..0000000 --- a/elpa/org-9.5.2/org-agenda.el +++ /dev/null @@ -1,10892 +0,0 @@ -;;; 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 |