dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

org-agenda.el (430633B)


      1 ;;; org-agenda.el --- Dynamic task and appointment lists for Org  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
      4 
      5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
      6 ;; Keywords: outlines, hypermedia, calendar, wp
      7 ;; Homepage: https://orgmode.org
      8 ;;
      9 ;; This file is part of GNU Emacs.
     10 ;;
     11 ;; GNU Emacs is free software: you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation, either version 3 of the License, or
     14 ;; (at your option) any later version.
     15 
     16 ;; GNU Emacs is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     24 ;;
     25 ;;; Commentary:
     26 
     27 ;; This file contains the code for creating and using the Agenda for Org.
     28 ;;
     29 ;; The functions `org-batch-agenda', `org-batch-agenda-csv', and
     30 ;; `org-batch-store-agenda-views' are implemented as macros to provide
     31 ;; a convenient way for extracting agenda information from the command
     32 ;; line.  The Lisp does not evaluate parameters of a macro call; thus
     33 ;; it is not necessary to quote the parameters passed to one of those
     34 ;; functions.  E.g. you can write:
     35 ;;
     36 ;;   emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)'
     37 ;;
     38 ;; To export an agenda spanning 7 days.  If `org-batch-agenda' would
     39 ;; have been implemented as a regular function you'd have to quote the
     40 ;; symbol org-agenda-span.  Moreover: To use a symbol as parameter
     41 ;; value you would have to double quote the symbol.
     42 ;;
     43 ;; This is a hack, but it works even when running Org byte-compiled.
     44 ;;
     45 
     46 ;;; Code:
     47 
     48 (require 'cl-lib)
     49 (require 'ol)
     50 (require 'org)
     51 (require 'org-macs)
     52 (require 'org-refile)
     53 
     54 (declare-function diary-add-to-list "diary-lib"
     55                   (date string specifier &optional marker globcolor literal))
     56 (declare-function calendar-iso-to-absolute      "cal-iso"    (date))
     57 (declare-function calendar-astro-date-string    "cal-julian" (&optional date))
     58 (declare-function calendar-bahai-date-string    "cal-bahai"  (&optional date))
     59 (declare-function calendar-chinese-date-string  "cal-china"  (&optional date))
     60 (declare-function calendar-coptic-date-string   "cal-coptic" (&optional date))
     61 (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date))
     62 (declare-function calendar-french-date-string   "cal-french" (&optional date))
     63 (declare-function calendar-goto-date            "cal-move"   (date))
     64 (declare-function calendar-hebrew-date-string   "cal-hebrew" (&optional date))
     65 (declare-function calendar-islamic-date-string  "cal-islam"  (&optional date))
     66 (declare-function calendar-iso-date-string      "cal-iso"    (&optional date))
     67 (declare-function calendar-iso-from-absolute    "cal-iso"    (date))
     68 (declare-function calendar-julian-date-string   "cal-julian" (&optional date))
     69 (declare-function calendar-mayan-date-string    "cal-mayan"  (&optional date))
     70 (declare-function calendar-persian-date-string  "cal-persia" (&optional date))
     71 (declare-function calendar-check-holidays       "holidays" (date))
     72 
     73 (declare-function org-columns-remove-overlays "org-colview" ())
     74 (declare-function org-datetree-find-date-create "org-datetree"
     75 		  (date &optional keep-restriction))
     76 (declare-function org-columns-quit              "org-colview" ())
     77 (declare-function diary-date-display-form       "diary-lib"  (&optional type))
     78 (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
     79 (declare-function org-habit-insert-consistency-graphs
     80 		  "org-habit" (&optional line))
     81 (declare-function org-is-habit-p "org-habit" (&optional pom))
     82 (declare-function org-habit-parse-todo "org-habit" (&optional pom))
     83 (declare-function org-habit-get-priority "org-habit" (habit &optional moment))
     84 (declare-function org-agenda-columns "org-colview" ())
     85 (declare-function org-add-archive-files "org-archive" (files))
     86 (declare-function org-capture "org-capture" (&optional goto keys))
     87 (declare-function org-clock-modify-effort-estimate "org-clock" (&optional value))
     88 
     89 (defvar calendar-mode-map)
     90 (defvar org-clock-current-task)
     91 (defvar org-current-tag-alist)
     92 (defvar org-mobile-force-id-on-agenda-items)
     93 (defvar org-habit-show-habits)
     94 (defvar org-habit-show-habits-only-for-today)
     95 (defvar org-habit-show-all-today)
     96 (defvar org-habit-scheduled-past-days)
     97 
     98 ;; Defined somewhere in this file, but used before definition.
     99 (defvar org-agenda-buffer-name "*Org Agenda*")
    100 (defvar org-agenda-overriding-header nil)
    101 (defvar org-agenda-title-append nil)
    102 ;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
    103 ;; (with-no-warnings (defvar date))  ;; unprefixed, from calendar.el
    104 (defvar original-date) ; dynamically scoped, calendar.el does scope this
    105 
    106 (defvar org-agenda-undo-list nil
    107   "List of undoable operations in the agenda since last refresh.")
    108 (defvar org-agenda-pending-undo-list nil
    109   "In a series of undo commands, this is the list of remaining undo items.")
    110 
    111 (defcustom org-agenda-confirm-kill 1
    112   "When set, remote killing from the agenda buffer needs confirmation.
    113 When t, a confirmation is always needed.  When a number N, confirmation is
    114 only needed when the text to be killed contains more than N non-white lines."
    115   :group 'org-agenda
    116   :type '(choice
    117 	  (const :tag "Never" nil)
    118 	  (const :tag "Always" t)
    119 	  (integer :tag "When more than N lines")))
    120 
    121 (defcustom org-agenda-compact-blocks nil
    122   "Non-nil means make the block agenda more compact.
    123 This is done globally by leaving out lines like the agenda span
    124 name and week number or the separator lines."
    125   :group 'org-agenda
    126   :type 'boolean)
    127 
    128 (defcustom org-agenda-block-separator ?=
    129   "The separator between blocks in the agenda.
    130 If this is a string, it will be used as the separator, with a newline added.
    131 If it is a character, it will be repeated to fill the window width.
    132 If nil the separator is disabled.  In `org-agenda-custom-commands' this
    133 addresses the separator between the current and the previous block."
    134   :group 'org-agenda
    135   :type '(choice
    136 	  (const :tag "Disabled" nil)
    137 	  (character)
    138 	  (string)))
    139 
    140 (defgroup org-agenda-export nil
    141   "Options concerning exporting agenda views in Org mode."
    142   :tag "Org Agenda Export"
    143   :group 'org-agenda)
    144 
    145 (defcustom org-agenda-with-colors t
    146   "Non-nil means use colors in agenda views."
    147   :group 'org-agenda-export
    148   :type 'boolean)
    149 
    150 (defcustom org-agenda-exporter-settings nil
    151   ;; FIXME: Do we really want to evaluate those settings and thus force
    152   ;; the user to use `quote' all the time?
    153   "Alist of variable/value pairs that should be active during agenda export.
    154 This is a good place to set options for ps-print and for htmlize.
    155 Note that the way this is implemented, the values will be evaluated
    156 before assigned to the variables.  So make sure to quote values you do
    157 *not* want evaluated, for example
    158 
    159    (setq org-agenda-exporter-settings
    160          \\='((ps-print-color-p \\='black-white)))"
    161   :group 'org-agenda-export
    162   :type '(repeat
    163 	  (list
    164 	   (variable)
    165 	   (sexp :tag "Value"))))
    166 
    167 (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text)
    168   "Hook run in a temporary buffer before writing the agenda to an export file.
    169 A useful function for this hook is `org-agenda-add-entry-text'."
    170   :group 'org-agenda-export
    171   :type 'hook
    172   :options '(org-agenda-add-entry-text))
    173 
    174 (defcustom org-agenda-add-entry-text-maxlines 0
    175   "Maximum number of entry text lines to be added to agenda.
    176 This is only relevant when `org-agenda-add-entry-text' is part of
    177 `org-agenda-before-write-hook', which is the default.
    178 When this is 0, nothing will happen.  When it is greater than 0, it
    179 specifies the maximum number of lines that will be added for each entry
    180 that is listed in the agenda view.
    181 
    182 Note that this variable is not used during display, only when exporting
    183 the agenda.  For agenda display, see the variables `org-agenda-entry-text-mode'
    184 and `org-agenda-entry-text-maxlines'."
    185   :group 'org-agenda
    186   :type 'integer)
    187 
    188 (defcustom org-agenda-add-entry-text-descriptive-links t
    189   "Non-nil means export org-links as descriptive links in agenda added text.
    190 This variable applies to the text added to the agenda when
    191 `org-agenda-add-entry-text-maxlines' is larger than 0.
    192 When this variable is nil, the URL will (also) be shown."
    193   :group 'org-agenda
    194   :type 'boolean)
    195 
    196 (defcustom org-agenda-export-html-style nil
    197   "The style specification for exported HTML Agenda files.
    198 If this variable contains a string, it will replace the default <style>
    199 section as produced by `htmlize'.
    200 Since there are different ways of setting style information, this variable
    201 needs to contain the full HTML structure to provide a style, including the
    202 surrounding HTML tags.  The style specifications should include definitions
    203 the fonts used by the agenda, here is an example:
    204 
    205    <style type=\"text/css\">
    206        p { font-weight: normal; color: gray; }
    207        .org-agenda-structure {
    208           font-size: 110%;
    209           color: #003399;
    210           font-weight: 600;
    211        }
    212        .org-todo {
    213           color: #cc6666;
    214           font-weight: bold;
    215        }
    216        .org-agenda-done {
    217           color: #339933;
    218        }
    219        .org-done {
    220           color: #339933;
    221        }
    222        .title { text-align: center; }
    223        .todo, .deadline { color: red; }
    224        .done { color: green; }
    225     </style>
    226 
    227 or, if you want to keep the style in a file,
    228 
    229    <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
    230 
    231 As the value of this option simply gets inserted into the HTML <head> header,
    232 you can \"misuse\" it to also add other text to the header."
    233   :group 'org-agenda-export
    234   :group 'org-export-html
    235   :type '(choice
    236 	  (const nil)
    237 	  (string)))
    238 
    239 (defcustom org-agenda-persistent-filter nil
    240   "When set, keep filters from one agenda view to the next."
    241   :group 'org-agenda
    242   :type 'boolean)
    243 
    244 (defgroup org-agenda-custom-commands nil
    245   "Options concerning agenda views in Org mode."
    246   :tag "Org Agenda Custom Commands"
    247   :group 'org-agenda)
    248 
    249 (defconst org-sorting-choice
    250   '(choice
    251     (const time-up) (const time-down)
    252     (const timestamp-up) (const timestamp-down)
    253     (const scheduled-up) (const scheduled-down)
    254     (const deadline-up)  (const deadline-down)
    255     (const ts-up) (const ts-down)
    256     (const tsia-up) (const tsia-down)
    257     (const category-keep) (const category-up) (const category-down)
    258     (const tag-down) (const tag-up)
    259     (const priority-up) (const priority-down)
    260     (const todo-state-up) (const todo-state-down)
    261     (const effort-up) (const effort-down)
    262     (const habit-up) (const habit-down)
    263     (const alpha-up) (const alpha-down)
    264     (const user-defined-up) (const user-defined-down))
    265   "Sorting choices.")
    266 
    267 ;; Keep custom values for `org-agenda-filter-preset' compatible with
    268 ;; the new variable `org-agenda-tag-filter-preset'.
    269 (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
    270 (defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
    271 
    272 (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
    273   "List of types searched for when creating the daily/weekly agenda.
    274 This variable is a list of symbols that controls the types of
    275 items that appear in the daily/weekly agenda.  Allowed symbols in this
    276 list are
    277 
    278   :timestamp   List items containing a date stamp or date range matching
    279                the selected date.  This includes sexp entries in angular
    280                brackets.
    281 
    282   :sexp        List entries resulting from plain diary-like sexps.
    283 
    284   :deadline    List deadline due on that date.  When the date is today,
    285                also list any deadlines past due, or due within
    286 	       `org-deadline-warning-days'.
    287 
    288   :deadline*   Same as above, but only include the deadline if it has an
    289                hour specification as [h]h:mm.
    290 
    291   :scheduled   List all items which are scheduled for the given date.
    292 	       The diary for *today* also contains items which were
    293 	       scheduled earlier and are not yet marked DONE.
    294 
    295   :scheduled*  Same as above, but only include the scheduled item if it
    296                has an hour specification as [h]h:mm.
    297 
    298 By default, all four non-starred types are turned on.
    299 
    300 When :scheduled* or :deadline* are included, :schedule or :deadline
    301 will be ignored.
    302 
    303 Never set this variable globally using `setq', because then it
    304 will apply to all future agenda commands.  Instead, bind it with
    305 `let' to scope it dynamically into the agenda-constructing
    306 command.  A good way to set it is through options in
    307 `org-agenda-custom-commands'.  For a more flexible (though
    308 somewhat less efficient) way of determining what is included in
    309 the daily/weekly agenda, see `org-agenda-skip-function'.")
    310 
    311 (defconst org-agenda-custom-commands-local-options
    312   `(repeat :tag "Local settings for this command.  Remember to quote values"
    313 	   (choice :tag "Setting"
    314 		   (list :tag "Heading for this block"
    315 			 (const org-agenda-overriding-header)
    316 			 (string :tag "Headline"))
    317 		   (list :tag "Files to be searched"
    318 			 (const org-agenda-files)
    319 			 (list
    320 			  (const :format "" quote)
    321 			  (repeat (file))))
    322 		   (list :tag "Sorting strategy"
    323 			 (const org-agenda-sorting-strategy)
    324 			 (list
    325 			  (const :format "" quote)
    326 			  (repeat
    327 			   ,org-sorting-choice)))
    328 		   (list :tag "Prefix format"
    329 			 (const org-agenda-prefix-format :value "  %-12:c%?-12t% s")
    330 			 (string))
    331 		   (list :tag "Number of days in agenda"
    332 			 (const org-agenda-span)
    333 			 (list
    334 			  (const :format "" quote)
    335 			  (choice (const :tag "Day" day)
    336 				  (const :tag "Week" week)
    337 				  (const :tag "Fortnight" fortnight)
    338 				  (const :tag "Month" month)
    339 				  (const :tag "Year" year)
    340 				  (integer :tag "Custom"))))
    341 		   (list :tag "Fixed starting date"
    342 			 (const org-agenda-start-day)
    343 			 (string :value "2007-11-01"))
    344 		   (list :tag "Start on day of week"
    345 			 (const org-agenda-start-on-weekday)
    346 			 (choice :value 1
    347 				 (const :tag "Today" nil)
    348 				 (integer :tag "Weekday No.")))
    349 		   (list :tag "Include data from diary"
    350 			 (const org-agenda-include-diary)
    351 			 (boolean))
    352 		   (list :tag "Deadline Warning days"
    353 			 (const org-deadline-warning-days)
    354 			 (integer :value 1))
    355 		   (list :tag "Category filter preset"
    356 			 (const org-agenda-category-filter-preset)
    357 			 (list
    358 			  (const :format "" quote)
    359 			  (repeat
    360 			   (string :tag "+category or -category"))))
    361 		   (list :tag "Tags filter preset"
    362 			 (const org-agenda-tag-filter-preset)
    363 			 (list
    364 			  (const :format "" quote)
    365 			  (repeat
    366 			   (string :tag "+tag or -tag"))))
    367 		   (list :tag "Effort filter preset"
    368 			 (const org-agenda-effort-filter-preset)
    369 			 (list
    370 			  (const :format "" quote)
    371 			  (repeat
    372 			   (string :tag "+=10 or -=10 or +<10 or ->10"))))
    373 		   (list :tag "Regexp filter preset"
    374 			 (const org-agenda-regexp-filter-preset)
    375 			 (list
    376 			  (const :format "" quote)
    377 			  (repeat
    378 			   (string :tag "+regexp or -regexp"))))
    379 		   (list :tag "Set daily/weekly entry types"
    380 			 (const org-agenda-entry-types)
    381 			 (list
    382 			  (const :format "" quote)
    383 			  (set :greedy t :value ,org-agenda-entry-types
    384 			       (const :deadline)
    385 			       (const :scheduled)
    386 			       (const :deadline*)
    387 			       (const :scheduled*)
    388 			       (const :timestamp)
    389 			       (const :sexp))))
    390 		   (list :tag "Columns format"
    391 			 (const org-overriding-columns-format)
    392 			 (string :tag "Format"))
    393 		   (list :tag "Standard skipping condition"
    394 			 :value (org-agenda-skip-function '(org-agenda-skip-entry-if))
    395 			 (const org-agenda-skip-function)
    396 			 (list
    397 			  (const :format "" quote)
    398 			  (list
    399 			   (choice
    400 			    :tag "Skipping range"
    401 			    (const :tag "Skip entry" org-agenda-skip-entry-if)
    402 			    (const :tag "Skip subtree" org-agenda-skip-subtree-if))
    403 			   (repeat :inline t :tag "Conditions for skipping"
    404 				   (choice
    405 				    :tag "Condition type"
    406 				    (list :tag "Regexp matches" :inline t
    407 					  (const :format "" regexp)
    408 					  (regexp))
    409 				    (list :tag "Regexp does not match" :inline t
    410 					  (const :format "" notregexp)
    411 					  (regexp))
    412 				    (list :tag "TODO state is" :inline t
    413 					  (const todo)
    414 					  (choice
    415 					   (const :tag "Any not-done state" todo)
    416 					   (const :tag "Any done state" done)
    417 					   (const :tag "Any state" any)
    418 					   (list :tag "Keyword list"
    419 						 (const :format "" quote)
    420 						 (repeat (string :tag "Keyword")))))
    421 				    (list :tag "TODO state is not" :inline t
    422 					  (const nottodo)
    423 					  (choice
    424 					   (const :tag "Any not-done state" todo)
    425 					   (const :tag "Any done state" done)
    426 					   (const :tag "Any state" any)
    427 					   (list :tag "Keyword list"
    428 						 (const :format "" quote)
    429 						 (repeat (string :tag "Keyword")))))
    430 				    (const :tag "scheduled" scheduled)
    431 				    (const :tag "not scheduled" notscheduled)
    432 				    (const :tag "deadline" deadline)
    433 				    (const :tag "no deadline" notdeadline)
    434 				    (const :tag "timestamp" timestamp)
    435 				    (const :tag "no timestamp" nottimestamp))))))
    436 		   (list :tag "Non-standard skipping condition"
    437 			 :value (org-agenda-skip-function)
    438 			 (const org-agenda-skip-function)
    439 			 (sexp :tag "Function or form (quoted!)"))
    440 		   (list :tag "Any variable"
    441 			 (variable :tag "Variable")
    442 			 (sexp :tag "Value (sexp)"))))
    443   "Selection of examples for agenda command settings.
    444 This will be spliced into the custom type of
    445 `org-agenda-custom-commands'.")
    446 
    447 
    448 (defcustom org-agenda-custom-commands
    449   '(("n" "Agenda and all TODOs" ((agenda "") (alltodo ""))))
    450   "Custom commands for the agenda.
    451 \\<org-mode-map>
    452 These commands will be offered on the splash screen displayed by the
    453 agenda dispatcher `\\[org-agenda]'.  Each entry is a list like this:
    454 
    455    (key desc type match settings files)
    456 
    457 key      The key (one or more characters as a string) to be associated
    458          with the command.
    459 desc     A description of the command, when omitted or nil, a default
    460          description is built using MATCH.
    461 type     The command type, any of the following symbols:
    462           agenda      The daily/weekly agenda.
    463           todo        Entries with a specific TODO keyword, in all agenda files.
    464           search      Entries containing search words entry or headline.
    465           tags        Tags/Property/TODO match in all agenda files.
    466           tags-todo   Tags/P/T match in all agenda files, TODO entries only.
    467           todo-tree   Sparse tree of specific TODO keyword in *current* file.
    468           tags-tree   Sparse tree with all tags matches in *current* file.
    469           occur-tree  Occur sparse tree for *current* file.
    470           ...         A user-defined function.
    471 match    What to search for:
    472           - a single keyword for TODO keyword searches
    473           - a tags/property/todo match expression for searches
    474           - a word search expression for text searches.
    475           - a regular expression for occur searches
    476           For all other commands, this should be the empty string.
    477 settings  A list of option settings, similar to that in a let form, so like
    478           this: ((opt1 val1) (opt2 val2) ...).   The values will be
    479           evaluated at the moment of execution, so quote them when needed.
    480 files     A list of files to write the produced agenda buffer to with
    481           the command `org-store-agenda-views'.
    482           If a file name ends in \".html\", an HTML version of the buffer
    483           is written out.  If it ends in \".ps\", a postscript version is
    484           produced.  Otherwise, only the plain text is written to the file.
    485 
    486 You can also define a set of commands, to create a composite agenda buffer.
    487 In this case, an entry looks like this:
    488 
    489   (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files)
    490 
    491 where
    492 
    493 desc   A description string to be displayed in the dispatcher menu.
    494 cmd    An agenda command, similar to the above.  However, tree commands
    495        are not allowed, but instead you can get agenda and global todo list.
    496        So valid commands for a set are:
    497        (agenda \"\" settings)
    498        (alltodo \"\" settings)
    499        (stuck \"\" settings)
    500        (todo \"match\" settings files)
    501        (search \"match\" settings files)
    502        (tags \"match\" settings files)
    503        (tags-todo \"match\" settings files)
    504 
    505 Each command can carry a list of options, and another set of options can be
    506 given for the whole set of commands.  Individual command options take
    507 precedence over the general options.
    508 
    509 When using several characters as key to a command, the first characters
    510 are prefix commands.  For the dispatcher to display useful information, you
    511 should provide a description for the prefix, like
    512 
    513  (setq org-agenda-custom-commands
    514    \\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
    515      (\"hl\" tags \"+HOME+Lisa\")
    516      (\"hp\" tags \"+HOME+Peter\")
    517      (\"hk\" tags \"+HOME+Kim\")))"
    518   :group 'org-agenda-custom-commands
    519   :type `(repeat
    520 	  (choice :value ("x" "Describe command here" tags "" nil)
    521 		  (list :tag "Single command"
    522 			(string :tag "Access Key(s) ")
    523 			(option (string :tag "Description"))
    524 			(choice
    525 			 (const :tag "Agenda" agenda)
    526 			 (const :tag "TODO list" alltodo)
    527 			 (const :tag "Search words" search)
    528 			 (const :tag "Stuck projects" stuck)
    529 			 (const :tag "Tags/Property match (all agenda files)" tags)
    530 			 (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
    531 			 (const :tag "TODO keyword search (all agenda files)" todo)
    532 			 (const :tag "Tags sparse tree (current buffer)" tags-tree)
    533 			 (const :tag "TODO keyword tree (current buffer)" todo-tree)
    534 			 (const :tag "Occur tree (current buffer)" occur-tree)
    535 			 (sexp :tag "Other, user-defined function"))
    536 			(string :tag "Match (only for some commands)")
    537 			,org-agenda-custom-commands-local-options
    538 			(option (repeat :tag "Export" (file :tag "Export to"))))
    539 		  (list :tag "Command series, all agenda files"
    540 			(string :tag "Access Key(s)")
    541 			(string :tag "Description  ")
    542 			(repeat :tag "Component"
    543 				(choice
    544 				 (list :tag "Agenda"
    545 				       (const :format "" agenda)
    546 				       (const :tag "" :format "" "")
    547 				       ,org-agenda-custom-commands-local-options)
    548 				 (list :tag "TODO list (all keywords)"
    549 				       (const :format "" alltodo)
    550 				       (const :tag "" :format "" "")
    551 				       ,org-agenda-custom-commands-local-options)
    552 				 (list :tag "Search words"
    553 				       (const :format "" search)
    554 				       (string :tag "Match")
    555 				       ,org-agenda-custom-commands-local-options)
    556 				 (list :tag "Stuck projects"
    557 				       (const :format "" stuck)
    558 				       (const :tag "" :format "" "")
    559 				       ,org-agenda-custom-commands-local-options)
    560 				 (list :tag "Tags/Property match (all agenda files)"
    561 				       (const :format "" tags)
    562 				       (string :tag "Match")
    563 				       ,org-agenda-custom-commands-local-options)
    564 				 (list :tag "Tags/Property match of TODO entries (all agenda files)"
    565 				       (const :format "" tags-todo)
    566 				       (string :tag "Match")
    567 				       ,org-agenda-custom-commands-local-options)
    568 				 (list :tag "TODO keyword search"
    569 				       (const :format "" todo)
    570 				       (string :tag "Match")
    571 				       ,org-agenda-custom-commands-local-options)
    572 				 (list :tag "Other, user-defined function"
    573 				       (symbol :tag "function")
    574 				       (string :tag "Match")
    575 				       ,org-agenda-custom-commands-local-options)))
    576 
    577 			(repeat :tag "Settings for entire command set"
    578 				(list (variable :tag "Any variable")
    579 				      (sexp :tag "Value")))
    580 			(option (repeat :tag "Export" (file :tag "Export to"))))
    581 		  (cons :tag "Prefix key documentation"
    582 			(string :tag "Access Key(s)")
    583 			(string :tag "Description  ")))))
    584 
    585 (defcustom org-agenda-query-register ?o
    586   "The register holding the current query string.
    587 The purpose of this is that if you construct a query string interactively,
    588 you can then use it to define a custom command."
    589   :group 'org-agenda-custom-commands
    590   :type 'character)
    591 
    592 (defcustom org-stuck-projects
    593   '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
    594   "How to identify stuck projects.
    595 This is a list of four items:
    596 1. A tags/todo/property matcher string that is used to identify a project.
    597    See the manual for a description of tag and property searches.
    598    The entire tree below a headline matched by this is considered one project.
    599 2. A list of TODO keywords identifying non-stuck projects.
    600    If the project subtree contains any headline with one of these todo
    601    keywords, the project is considered to be not stuck.  If you specify
    602    \"*\" as a keyword, any TODO keyword will mark the project unstuck.
    603 3. A list of tags identifying non-stuck projects.
    604    If the project subtree contains any headline with one of these tags,
    605    the project is considered to be not stuck.  If you specify \"*\" as
    606    a tag, any tag will mark the project unstuck.  Note that this is about
    607    the explicit presence of a tag somewhere in the subtree, inherited
    608    tags do not count here.  If inherited tags make a project not stuck,
    609    use \"-TAG\" in the tags part of the matcher under (1.) above.
    610 4. An arbitrary regular expression matching non-stuck projects.
    611 
    612 If the project turns out to be not stuck, search continues also in the
    613 subtree to see if any of the subtasks have project status.
    614 
    615 See also the variable `org-tags-match-list-sublevels' which applies
    616 to projects matched by this search as well.
    617 
    618 After defining this variable, you may use `org-agenda-list-stuck-projects'
    619 \(bound to `\\[org-agenda] #') to produce the list."
    620   :group 'org-agenda-custom-commands
    621   :type '(list
    622 	  (string :tag "Tags/TODO match to identify a project")
    623 	  (repeat :tag "Projects are *not* stuck if they have an entry with \
    624 TODO keyword any of" (string))
    625 	  (repeat :tag "Projects are *not* stuck if they have an entry with \
    626 TAG being any of" (string))
    627 	  (regexp :tag "Projects are *not* stuck if this regexp matches inside \
    628 the subtree")))
    629 
    630 (defgroup org-agenda-skip nil
    631   "Options concerning skipping parts of agenda files."
    632   :tag "Org Agenda Skip"
    633   :group 'org-agenda)
    634 
    635 (defcustom org-agenda-skip-function-global nil
    636   "Function to be called at each match during agenda construction.
    637 If this function returns nil, the current match should not be skipped.
    638 If the function decided to skip an agenda match, is must return the
    639 buffer position from which the search should be continued.
    640 This may also be a Lisp form, which will be evaluated.
    641 
    642 This variable will be applied to every agenda match, including
    643 tags/property searches and TODO lists.  So try to make the test function
    644 do its checking as efficiently as possible.  To implement a skipping
    645 condition just for specific agenda commands, use the variable
    646 `org-agenda-skip-function' which can be set in the options section
    647 of custom agenda commands."
    648   :group 'org-agenda-skip
    649   :type 'sexp)
    650 
    651 (defgroup org-agenda-daily/weekly nil
    652   "Options concerning the daily/weekly agenda."
    653   :tag "Org Agenda Daily/Weekly"
    654   :group 'org-agenda)
    655 (defgroup org-agenda-todo-list nil
    656   "Options concerning the global todo list agenda view."
    657   :tag "Org Agenda Todo List"
    658   :group 'org-agenda)
    659 (defgroup org-agenda-match-view nil
    660   "Options concerning the general tags/property/todo match agenda view."
    661   :tag "Org Agenda Match View"
    662   :group 'org-agenda)
    663 (defgroup org-agenda-search-view nil
    664   "Options concerning the search agenda view."
    665   :tag "Org Agenda Search View"
    666   :group 'org-agenda)
    667 
    668 (defvar org-agenda-archives-mode nil
    669   "Non-nil means the agenda will include archived items.
    670 If this is the symbol `trees', trees in the selected agenda scope
    671 that are marked with the ARCHIVE tag will be included anyway.  When this is
    672 t, also all archive files associated with the current selection of agenda
    673 files will be included.")
    674 
    675 (defcustom org-agenda-restriction-lock-highlight-subtree t
    676   "Non-nil means highlight the whole subtree when restriction is active.
    677 Otherwise only highlight the headline.  Highlighting the whole subtree is
    678 useful to ensure no edits happen beyond the restricted region."
    679   :group 'org-agenda
    680   :type 'boolean)
    681 
    682 (defcustom org-agenda-skip-comment-trees t
    683   "Non-nil means skip trees that start with the COMMENT keyword.
    684 When nil, these trees are also scanned by agenda commands."
    685   :group 'org-agenda-skip
    686   :type 'boolean)
    687 
    688 (defcustom org-agenda-todo-list-sublevels t
    689   "Non-nil means check also the sublevels of a TODO entry for TODO entries.
    690 When nil, the sublevels of a TODO entry are not checked, resulting in
    691 potentially much shorter TODO lists."
    692   :group 'org-agenda-skip
    693   :group 'org-agenda-todo-list
    694   :type 'boolean)
    695 
    696 (defcustom org-agenda-todo-ignore-with-date nil
    697   "Non-nil means don't show entries with a date in the global todo list.
    698 You can use this if you prefer to mark mere appointments with a TODO keyword,
    699 but don't want them to show up in the TODO list.
    700 When this is set, it also covers deadlines and scheduled items, the settings
    701 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
    702 will be ignored.
    703 See also the variable `org-agenda-tags-todo-honor-ignore-options'."
    704   :group 'org-agenda-skip
    705   :group 'org-agenda-todo-list
    706   :type 'boolean)
    707 
    708 (defcustom org-agenda-todo-ignore-timestamp nil
    709   "Non-nil means don't show entries with a timestamp.
    710 This applies when creating the global todo list.
    711 Valid values are:
    712 
    713 past     Don't show entries for today or in the past.
    714 
    715 future   Don't show entries with a timestamp in the future.
    716          The idea behind this is that if it has a future
    717          timestamp, you don't want to think about it until the
    718          date.
    719 
    720 all      Don't show any entries with a timestamp in the global todo list.
    721          The idea behind this is that by setting a timestamp, you
    722          have already \"taken care\" of this item.
    723 
    724 This variable can also have an integer as a value.  If positive (N),
    725 todos with a timestamp N or more days in the future will be ignored.  If
    726 negative (-N), todos with a timestamp N or more days in the past will be
    727 ignored.  If 0, todos with a timestamp either today or in the future will
    728 be ignored.  For example, a value of -1 will exclude todos with a
    729 timestamp in the past (yesterday or earlier), while a value of 7 will
    730 exclude todos with a timestamp a week or more in the future.
    731 
    732 See also `org-agenda-todo-ignore-with-date'.
    733 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
    734 to make his option also apply to the tags-todo list."
    735   :group 'org-agenda-skip
    736   :group 'org-agenda-todo-list
    737   :version "24.1"
    738   :type '(choice
    739 	  (const :tag "Ignore future timestamp todos" future)
    740 	  (const :tag "Ignore past or present timestamp todos" past)
    741 	  (const :tag "Ignore all timestamp todos" all)
    742 	  (const :tag "Show timestamp todos" nil)
    743 	  (integer :tag "Ignore if N or more days in past(-) or future(+).")))
    744 
    745 (defcustom org-agenda-todo-ignore-scheduled nil
    746   "Non-nil means, ignore some scheduled TODO items when making TODO list.
    747 This applies when creating the global todo list.
    748 Valid values are:
    749 
    750 past     Don't show entries scheduled today or in the past.
    751 
    752 future   Don't show entries scheduled in the future.
    753          The idea behind this is that by scheduling it, you don't want to
    754          think about it until the scheduled date.
    755 
    756 all      Don't show any scheduled entries in the global todo list.
    757          The idea behind this is that by scheduling it, you have already
    758          \"taken care\" of this item.
    759 
    760 t        Same as `all', for backward compatibility.
    761 
    762 This variable can also have an integer as a value.  See
    763 `org-agenda-todo-ignore-timestamp' for more details.
    764 
    765 See also `org-agenda-todo-ignore-with-date'.
    766 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
    767 to make his option also apply to the tags-todo list."
    768   :group 'org-agenda-skip
    769   :group 'org-agenda-todo-list
    770   :type '(choice
    771 	  (const :tag "Ignore future-scheduled todos" future)
    772 	  (const :tag "Ignore past- or present-scheduled todos" past)
    773 	  (const :tag "Ignore all scheduled todos" all)
    774 	  (const :tag "Ignore all scheduled todos (compatibility)" t)
    775 	  (const :tag "Show scheduled todos" nil)
    776 	  (integer :tag "Ignore if N or more days in past(-) or future(+).")))
    777 
    778 (defcustom org-agenda-todo-ignore-deadlines nil
    779   "Non-nil means ignore some deadline TODO items when making TODO list.
    780 
    781 There are different motivations for using different values, please think
    782 carefully when configuring this variable.
    783 
    784 This applies when creating the global TODO list.
    785 
    786 Valid values are:
    787 
    788 near    Don't show near deadline entries.  A deadline is near when it is
    789         closer than `org-deadline-warning-days' days.  The idea behind this
    790         is that such items will appear in the agenda anyway.
    791 
    792 far     Don't show TODO entries where a deadline has been defined, but
    793         is not going to happen anytime soon.  This is useful if you want to use
    794         the TODO list to figure out what to do now.
    795 
    796 past    Don't show entries with a deadline timestamp for today or in the past.
    797 
    798 future  Don't show entries with a deadline timestamp in the future, not even
    799         when they become `near' ones.  Use it with caution.
    800 
    801 all     Ignore all TODO entries that do have a deadline.
    802 
    803 t       Same as `near', for backward compatibility.
    804 
    805 This variable can also have an integer as a value.  See
    806 `org-agenda-todo-ignore-timestamp' for more details.
    807 
    808 See also `org-agenda-todo-ignore-with-date'.
    809 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
    810 to make his option also apply to the tags-todo list."
    811   :group 'org-agenda-skip
    812   :group 'org-agenda-todo-list
    813   :type '(choice
    814 	  (const :tag "Ignore near deadlines" near)
    815 	  (const :tag "Ignore near deadlines (compatibility)" t)
    816 	  (const :tag "Ignore far deadlines" far)
    817 	  (const :tag "Ignore all TODOs with a deadlines" all)
    818 	  (const :tag "Show all TODOs, even if they have a deadline" nil)
    819 	  (integer :tag "Ignore if N or more days in past(-) or future(+).")))
    820 
    821 (defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil
    822   "Time unit to use when possibly ignoring an agenda item.
    823 
    824 See the docstring of various `org-agenda-todo-ignore-*' options.
    825 The default is to compare time stamps using days.  An item is thus
    826 considered to be in the future if it is at least one day after today.
    827 Non-nil means to compare time stamps using seconds.  An item is then
    828 considered future if it has a time value later than current time."
    829   :group 'org-agenda-skip
    830   :group 'org-agenda-todo-list
    831   :version "24.4"
    832   :package-version '(Org . "8.0")
    833   :type '(choice
    834 	  (const :tag "Compare time with days" nil)
    835 	  (const :tag "Compare time with seconds" t)))
    836 
    837 (defcustom org-agenda-tags-todo-honor-ignore-options nil
    838   "Non-nil means honor todo-list ignores options also in tags-todo search.
    839 The variables
    840    `org-agenda-todo-ignore-with-date',
    841    `org-agenda-todo-ignore-timestamp',
    842    `org-agenda-todo-ignore-scheduled',
    843    `org-agenda-todo-ignore-deadlines'
    844 make the global TODO list skip entries that have time stamps of certain
    845 kinds.  If this option is set, the same options will also apply for the
    846 tags-todo search, which is the general tags/property matcher
    847 restricted to unfinished TODO entries only."
    848   :group 'org-agenda-skip
    849   :group 'org-agenda-todo-list
    850   :group 'org-agenda-match-view
    851   :type 'boolean)
    852 
    853 (defcustom org-agenda-skip-scheduled-if-done nil
    854   "Non-nil means don't show scheduled items in agenda when they are done.
    855 This is relevant for the daily/weekly agenda, not for the TODO list.  It
    856 applies only to the actual date of the scheduling.  Warnings about an item
    857 with a past scheduling dates are always turned off when the item is DONE."
    858   :group 'org-agenda-skip
    859   :group 'org-agenda-daily/weekly
    860   :type 'boolean)
    861 
    862 (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil
    863   "Non-nil means skip scheduling line if same entry shows because of deadline.
    864 
    865 In the agenda of today, an entry can show up multiple times
    866 because it is both scheduled and has a nearby deadline, and maybe
    867 a plain time stamp as well.
    868 
    869 When this variable is nil, the entry will be shown several times.
    870 
    871 When set to t, then only the deadline is shown and the fact that
    872 the entry is scheduled today or was scheduled previously is not
    873 shown.
    874 
    875 When set to the symbol `not-today', skip scheduled previously,
    876 but not scheduled today.
    877 
    878 When set to the symbol `repeated-after-deadline', skip scheduled
    879 items if they are repeated beyond the current deadline."
    880   :group 'org-agenda-skip
    881   :group 'org-agenda-daily/weekly
    882   :type '(choice
    883 	  (const :tag "Never" nil)
    884 	  (const :tag "Always" t)
    885 	  (const :tag "Not when scheduled today" not-today)
    886 	  (const :tag "When repeated past deadline" repeated-after-deadline)))
    887 
    888 (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
    889   "Non-nil means skip timestamp line if same entry shows because of deadline.
    890 In the agenda of today, an entry can show up multiple times
    891 because it has both a plain timestamp and has a nearby deadline.
    892 When this variable is t, then only the deadline is shown and the
    893 fact that the entry has a timestamp for or including today is not
    894 shown.  When this variable is nil, the entry will be shown
    895 several times."
    896   :group 'org-agenda-skip
    897   :group 'org-agenda-daily/weekly
    898   :version "24.1"
    899   :type '(choice
    900 	  (const :tag "Never" nil)
    901 	  (const :tag "Always" t)))
    902 
    903 (defcustom org-agenda-skip-deadline-if-done nil
    904   "Non-nil means don't show deadlines when the corresponding item is done.
    905 When nil, the deadline is still shown and should give you a happy feeling.
    906 This is relevant for the daily/weekly agenda.  It applies only to the
    907 actual date of the deadline.  Warnings about approaching and past-due
    908 deadlines are always turned off when the item is DONE."
    909   :group 'org-agenda-skip
    910   :group 'org-agenda-daily/weekly
    911   :type 'boolean)
    912 
    913 (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil
    914   "Non-nil means skip deadline prewarning when entry is also scheduled.
    915 This will apply on all days where a prewarning for the deadline would
    916 be shown, but not at the day when the entry is actually due.  On that day,
    917 the deadline will be shown anyway.
    918 This variable may be set to nil, t, the symbol `pre-scheduled',
    919 or a number which will then give the number of days before the actual
    920 deadline when the prewarnings should resume.  The symbol `pre-scheduled'
    921 eliminates the deadline prewarning only prior to the scheduled date.
    922 This can be used in a workflow where the first showing of the deadline will
    923 trigger you to schedule it, and then you don't want to be reminded of it
    924 because you will take care of it on the day when scheduled."
    925   :group 'org-agenda-skip
    926   :group 'org-agenda-daily/weekly
    927   :version "24.1"
    928   :type '(choice
    929 	  (const :tag "Always show prewarning" nil)
    930 	  (const :tag "Remove prewarning prior to scheduled date" pre-scheduled)
    931 	  (const :tag "Remove prewarning if entry is scheduled" t)
    932 	  (integer :tag "Restart prewarning N days before deadline")))
    933 
    934 (defcustom org-agenda-skip-scheduled-delay-if-deadline nil
    935   "Non-nil means skip scheduled delay when entry also has a deadline.
    936 This variable may be set to nil, t, the symbol `post-deadline',
    937 or a number which will then give the number of days after the actual
    938 scheduled date when the delay should expire.  The symbol `post-deadline'
    939 eliminates the schedule delay when the date is posterior to the deadline."
    940   :group 'org-agenda-skip
    941   :group 'org-agenda-daily/weekly
    942   :version "24.4"
    943   :package-version '(Org . "8.0")
    944   :type '(choice
    945 	  (const :tag "Always honor delay" nil)
    946 	  (const :tag "Ignore delay if posterior to the deadline" post-deadline)
    947 	  (const :tag "Ignore delay if entry has a deadline" t)
    948 	  (integer :tag "Honor delay up until N days after the scheduled date")))
    949 
    950 (defcustom org-agenda-skip-additional-timestamps-same-entry nil
    951   "When nil, multiple same-day timestamps in entry make multiple agenda lines.
    952 When non-nil, after the search for timestamps has matched once in an
    953 entry, the rest of the entry will not be searched."
    954   :group 'org-agenda-skip
    955   :type 'boolean)
    956 
    957 (defcustom org-agenda-skip-timestamp-if-done nil
    958   "Non-nil means don't select item by timestamp or -range if it is DONE."
    959   :group 'org-agenda-skip
    960   :group 'org-agenda-daily/weekly
    961   :type 'boolean)
    962 
    963 (defcustom org-agenda-dim-blocked-tasks t
    964   "Non-nil means dim blocked tasks in the agenda display.
    965 This causes some overhead during agenda construction, but if you
    966 have turned on `org-enforce-todo-dependencies',
    967 `org-enforce-todo-checkbox-dependencies', or any other blocking
    968 mechanism, this will create useful feedback in the agenda.
    969 
    970 Instead of t, this variable can also have the value `invisible'.
    971 Then blocked tasks will be invisible and only become visible when
    972 they become unblocked.  An exemption to this behavior is when a task is
    973 blocked because of unchecked checkboxes below it.  Since checkboxes do
    974 not show up in the agenda views, making this task invisible you remove any
    975 trace from agenda views that there is something to do.  Therefore, a task
    976 that is blocked because of checkboxes will never be made invisible, it
    977 will only be dimmed."
    978   :group 'org-agenda-daily/weekly
    979   :group 'org-agenda-todo-list
    980   :version "24.3"
    981   :type '(choice
    982 	  (const :tag "Do not dim" nil)
    983 	  (const :tag "Dim to a gray face" t)
    984 	  (const :tag "Make invisible" invisible)))
    985 
    986 (defgroup org-agenda-startup nil
    987   "Options concerning initial settings in the Agenda in Org Mode."
    988   :tag "Org Agenda Startup"
    989   :group 'org-agenda)
    990 
    991 (defcustom org-agenda-menu-show-matcher t
    992   "Non-nil means show the match string in the agenda dispatcher menu.
    993 When nil, the matcher string is not shown, but is put into the help-echo
    994 property so than moving the mouse over the command shows it.
    995 Setting it to nil is good if matcher strings are very long and/or if
    996 you want to use two-columns display (see `org-agenda-menu-two-columns')."
    997   :group 'org-agenda
    998   :version "24.1"
    999   :type 'boolean)
   1000 
   1001 (defcustom org-agenda-menu-two-columns nil
   1002   "Non-nil means, use two columns to show custom commands in the dispatcher.
   1003 If you use this, you probably want to set `org-agenda-menu-show-matcher'
   1004 to nil."
   1005   :group 'org-agenda
   1006   :version "24.1"
   1007   :type 'boolean)
   1008 
   1009 (defcustom org-agenda-finalize-hook nil
   1010   "Hook run just before displaying an agenda buffer.
   1011 The buffer is still writable when the hook is called.
   1012 
   1013 You can modify some of the buffer substrings but you should be
   1014 extra careful not to modify the text properties of the agenda
   1015 headlines as the agenda display heavily relies on them."
   1016   :group 'org-agenda-startup
   1017   :type 'hook)
   1018 
   1019 (defcustom org-agenda-filter-hook nil
   1020   "Hook run just after filtering with `org-agenda-filter'."
   1021   :group 'org-agenda-startup
   1022   :package-version '(Org . "9.4")
   1023   :type 'hook)
   1024 
   1025 (defcustom org-agenda-mouse-1-follows-link nil
   1026   "Non-nil means mouse-1 on a link will follow the link in the agenda.
   1027 A longer mouse click will still set point.  Needs to be set
   1028 before org.el is loaded."
   1029   :group 'org-agenda-startup
   1030   :type 'boolean)
   1031 
   1032 (defcustom org-agenda-start-with-follow-mode nil
   1033   "The initial value of follow mode in a newly created agenda window."
   1034   :group 'org-agenda-startup
   1035   :type 'boolean)
   1036 
   1037 (defcustom org-agenda-follow-indirect nil
   1038   "Non-nil means `org-agenda-follow-mode' displays only the
   1039 current item's tree, in an indirect buffer."
   1040   :group 'org-agenda
   1041   :version "24.1"
   1042   :type 'boolean)
   1043 
   1044 (defcustom org-agenda-show-outline-path t
   1045   "Non-nil means show outline path in echo area after line motion."
   1046   :group 'org-agenda-startup
   1047   :type 'boolean)
   1048 
   1049 (defcustom org-agenda-start-with-entry-text-mode nil
   1050   "The initial value of entry-text-mode in a newly created agenda window."
   1051   :group 'org-agenda-startup
   1052   :type 'boolean)
   1053 
   1054 (defcustom org-agenda-entry-text-maxlines 5
   1055   "Number of text lines to be added when `E' is pressed in the agenda.
   1056 
   1057 Note that this variable only used during agenda display.  To add entry text
   1058 when exporting the agenda, configure the variable
   1059 `org-agenda-add-entry-text-maxlines'."
   1060   :group 'org-agenda
   1061   :type 'integer)
   1062 
   1063 (defcustom org-agenda-entry-text-exclude-regexps nil
   1064   "List of regular expressions to clean up entry text.
   1065 The complete matches of all regular expressions in this list will be
   1066 removed from entry text before it is shown in the agenda."
   1067   :group 'org-agenda
   1068   :type '(repeat (regexp)))
   1069 
   1070 (defcustom org-agenda-entry-text-leaders "    > "
   1071   "Text prepended to the entry text in agenda buffers."
   1072   :version "24.4"
   1073   :package-version '(Org . "8.0")
   1074   :group 'org-agenda
   1075   :type 'string)
   1076 
   1077 (defvar org-agenda-entry-text-cleanup-hook nil
   1078   "Hook that is run after basic cleanup of entry text to be shown in agenda.
   1079 This cleanup is done in a temporary buffer, so the function may inspect and
   1080 change the entire buffer.
   1081 Some default stuff like drawers and scheduling/deadline dates will already
   1082 have been removed when this is called, as will any matches for regular
   1083 expressions listed in `org-agenda-entry-text-exclude-regexps'.")
   1084 
   1085 (defvar org-agenda-include-inactive-timestamps nil
   1086   "Non-nil means include inactive time stamps in agenda.
   1087 Dynamically scoped.")
   1088 
   1089 (defgroup org-agenda-windows nil
   1090   "Options concerning the windows used by the Agenda in Org Mode."
   1091   :tag "Org Agenda Windows"
   1092   :group 'org-agenda)
   1093 
   1094 (defcustom org-agenda-window-setup 'reorganize-frame
   1095   "How the agenda buffer should be displayed.
   1096 Possible values for this option are:
   1097 
   1098 current-window    Show agenda in the current window, keeping all other windows.
   1099 other-window      Use `switch-to-buffer-other-window' to display agenda.
   1100 only-window       Show agenda, deleting all other windows.
   1101 reorganize-frame  Show only two windows on the current frame, the current
   1102                   window and the agenda.
   1103 other-frame       Use `switch-to-buffer-other-frame' to display agenda.
   1104                   Also, when exiting the agenda, kill that frame.
   1105 other-tab         Use `switch-to-buffer-other-tab' to display the
   1106                   agenda, making use of the `tab-bar-mode' introduced
   1107                   in Emacs version 27.1.  Also, kill that tab when
   1108                   exiting the agenda view.
   1109 
   1110 See also the variable `org-agenda-restore-windows-after-quit'."
   1111   :group 'org-agenda-windows
   1112   :type '(choice
   1113 	  (const current-window)
   1114 	  (const other-frame)
   1115 	  (const other-tab)
   1116 	  (const other-window)
   1117 	  (const only-window)
   1118 	  (const reorganize-frame))
   1119   :package-version '(Org . "9.4"))
   1120 
   1121 (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
   1122   "The min and max height of the agenda window as a fraction of frame height.
   1123 The value of the variable is a cons cell with two numbers between 0 and 1.
   1124 It only matters if `org-agenda-window-setup' is `reorganize-frame'."
   1125   :group 'org-agenda-windows
   1126   :type '(cons (number :tag "Minimum") (number :tag "Maximum")))
   1127 
   1128 (defcustom org-agenda-restore-windows-after-quit nil
   1129   "Non-nil means restore window configuration upon exiting agenda.
   1130 Before the window configuration is changed for displaying the
   1131 agenda, the current status is recorded.  When the agenda is
   1132 exited with `q' or `x' and this option is set, the old state is
   1133 restored.  If `org-agenda-window-setup' is `other-frame' or
   1134 `other-tab', the value of this option will be ignored."
   1135   :group 'org-agenda-windows
   1136   :type 'boolean)
   1137 
   1138 (defcustom org-agenda-span 'week
   1139   "Number of days to include in overview display.
   1140 Can be day, week, month, year, or any number of days.
   1141 Custom commands can set this variable in the options section."
   1142   :group 'org-agenda-daily/weekly
   1143   :type '(choice (const :tag "Day" day)
   1144 		 (const :tag "Week" week)
   1145 		 (const :tag "Fortnight" fortnight)
   1146 		 (const :tag "Month" month)
   1147 		 (const :tag "Year" year)
   1148 		 (integer :tag "Custom")))
   1149 
   1150 (defcustom org-agenda-start-on-weekday 1
   1151   "Non-nil means start the overview always on the specified weekday.
   1152 0 denotes Sunday, 1 denotes Monday, etc.
   1153 When nil, always start on the current day.
   1154 Custom commands can set this variable in the options section."
   1155   :group 'org-agenda-daily/weekly
   1156   :type '(choice (const :tag "Today" nil)
   1157 		 (integer :tag "Weekday No.")))
   1158 
   1159 (defcustom org-agenda-show-all-dates t
   1160   "Non-nil means `org-agenda' shows every day in the selected range.
   1161 When nil, only the days which actually have entries are shown."
   1162   :group 'org-agenda-daily/weekly
   1163   :type 'boolean)
   1164 
   1165 (defcustom org-agenda-format-date 'org-agenda-format-date-aligned
   1166   "Format string for displaying dates in the agenda.
   1167 Used by the daily/weekly agenda.  This should be a format string
   1168 understood by `format-time-string', or a function returning the
   1169 formatted date as a string.  The function must take a single
   1170 argument, a calendar-style date list like (month day year)."
   1171   :group 'org-agenda-daily/weekly
   1172   :type '(choice
   1173 	  (string :tag "Format string")
   1174 	  (function :tag "Function")))
   1175 
   1176 (defun org-agenda-end-of-line ()
   1177   "Go to the end of visible line."
   1178   (interactive)
   1179   (goto-char (line-end-position)))
   1180 
   1181 (defun org-agenda-format-date-aligned (date)
   1182   "Format a DATE string for display in the daily/weekly agenda.
   1183 This function makes sure that dates are aligned for easy reading."
   1184   (require 'cal-iso)
   1185   (let* ((dayname (calendar-day-name date))
   1186 	 (day (cadr date))
   1187 	 (day-of-week (calendar-day-of-week date))
   1188 	 (month (car date))
   1189 	 (monthname (calendar-month-name month))
   1190 	 (year (nth 2 date))
   1191 	 (iso-week (org-days-to-iso-week
   1192 		    (calendar-absolute-from-gregorian date)))
   1193 	 ;; (weekyear (cond ((and (= month 1) (>= iso-week 52))
   1194 	 ;;        	  (1- year))
   1195 	 ;;        	 ((and (= month 12) (<= iso-week 1))
   1196 	 ;;        	  (1+ year))
   1197 	 ;;        	 (t year)))
   1198 	 (weekstring (if (= day-of-week 1)
   1199 			 (format " W%02d" iso-week)
   1200 		       "")))
   1201     (format "%-10s %2d %s %4d%s"
   1202 	    dayname day monthname year weekstring)))
   1203 
   1204 (defcustom org-agenda-time-leading-zero nil
   1205   "Non-nil means use leading zero for military times in agenda.
   1206 For example, 9:30am would become 09:30 rather than  9:30."
   1207   :group 'org-agenda-daily/weekly
   1208   :version "24.1"
   1209   :type 'boolean)
   1210 
   1211 (defcustom org-agenda-timegrid-use-ampm nil
   1212   "When set, show AM/PM style timestamps on the timegrid."
   1213   :group 'org-agenda
   1214   :version "24.1"
   1215   :type 'boolean)
   1216 
   1217 (defun org-agenda-time-of-day-to-ampm (time)
   1218   "Convert TIME of a string like \"13:45\" to an AM/PM style time string."
   1219   (let* ((hour-number (string-to-number (substring time 0 -3)))
   1220          (minute (substring time -2))
   1221          (ampm "am"))
   1222     (cond
   1223      ((equal hour-number 12)
   1224       (setq ampm "pm"))
   1225      ((> hour-number 12)
   1226       (setq ampm "pm")
   1227       (setq hour-number (- hour-number 12))))
   1228     (concat
   1229      (if org-agenda-time-leading-zero
   1230 	 (format "%02d" hour-number)
   1231        (format "%02s" (number-to-string hour-number)))
   1232      ":" minute ampm)))
   1233 
   1234 (defun org-agenda-time-of-day-to-ampm-maybe (time)
   1235   "Conditionally convert TIME to AM/PM format.
   1236 This is based on `org-agenda-timegrid-use-ampm'."
   1237   (if org-agenda-timegrid-use-ampm
   1238       (org-agenda-time-of-day-to-ampm time)
   1239     time))
   1240 
   1241 (defcustom org-agenda-weekend-days '(6 0)
   1242   "Which days are weekend?
   1243 These days get the special face `org-agenda-date-weekend' in the agenda."
   1244   :group 'org-agenda-daily/weekly
   1245   :type '(set :greedy t
   1246 	      (const :tag "Monday" 1)
   1247 	      (const :tag "Tuesday" 2)
   1248 	      (const :tag "Wednesday" 3)
   1249 	      (const :tag "Thursday" 4)
   1250 	      (const :tag "Friday" 5)
   1251 	      (const :tag "Saturday" 6)
   1252 	      (const :tag "Sunday" 0)))
   1253 
   1254 (defcustom org-agenda-move-date-from-past-immediately-to-today t
   1255   "Non-nil means jump to today when moving a past date forward in time.
   1256 When using S-right in the agenda to move a date forward, and the date
   1257 stamp currently points to the past, the first key press will move it
   1258 to today.  When nil, just move one day forward even if the date stays
   1259 in the past."
   1260   :group 'org-agenda-daily/weekly
   1261   :version "24.1"
   1262   :type 'boolean)
   1263 
   1264 (defcustom org-agenda-diary-file 'diary-file
   1265   "File to which to add new entries with the `i' key in agenda and calendar.
   1266 When this is the symbol `diary-file', the functionality in the Emacs
   1267 calendar will be used to add entries to the `diary-file'.  But when this
   1268 points to a file, `org-agenda-diary-entry' will be used instead."
   1269   :group 'org-agenda
   1270   :type '(choice
   1271 	  (const :tag "The standard Emacs diary file" diary-file)
   1272 	  (file :tag "Special Org file diary entries")))
   1273 
   1274 (defcustom org-agenda-include-diary nil
   1275   "If non-nil, include in the agenda entries from the Emacs Calendar's diary.
   1276 Custom commands can set this variable in the options section."
   1277   :group 'org-agenda-daily/weekly
   1278   :type 'boolean)
   1279 
   1280 (defcustom org-agenda-include-deadlines t
   1281   "If non-nil, include entries within their deadline warning period.
   1282 Custom commands can set this variable in the options section."
   1283   :group 'org-agenda-daily/weekly
   1284   :version "24.1"
   1285   :type 'boolean)
   1286 
   1287 (defcustom org-agenda-show-future-repeats t
   1288   "Non-nil shows repeated entries in the future part of the agenda.
   1289 When set to the symbol `next' only the first future repeat is shown."
   1290   :group 'org-agenda-daily/weekly
   1291   :type '(choice
   1292 	  (const :tag "Show all repeated entries" t)
   1293 	  (const :tag "Show next repeated entry" next)
   1294 	  (const :tag "Do not show repeated entries" nil))
   1295   :version "26.1"
   1296   :package-version '(Org . "9.1")
   1297   :safe #'symbolp)
   1298 
   1299 (defcustom org-agenda-prefer-last-repeat nil
   1300   "Non-nil sets date for repeated entries to their last repeat.
   1301 
   1302 When nil, display SCHEDULED and DEADLINE dates at their base
   1303 date, and in today's agenda, as a reminder.  Display plain
   1304 time-stamps, on the other hand, at every repeat date in the past
   1305 in addition to the base date.
   1306 
   1307 When non-nil, show a repeated entry at its latest repeat date,
   1308 possibly being today even if it wasn't marked as done.  This
   1309 setting is useful if you do not always mark repeated entries as
   1310 done and, yet, consider that reaching repeat date starts the task
   1311 anew.
   1312 
   1313 When set to a list of strings, prefer last repeats only for
   1314 entries with these TODO keywords."
   1315   :group 'org-agenda-daily/weekly
   1316   :type '(choice
   1317 	  (const :tag "Prefer last repeat" t)
   1318 	  (const :tag "Prefer base date" nil)
   1319 	  (repeat :tag "Prefer last repeat for entries with these TODO keywords"
   1320 		  (string :tag "TODO keyword")))
   1321   :version "26.1"
   1322   :package-version '(Org . "9.1")
   1323   :safe (lambda (x) (or (booleanp x) (consp x))))
   1324 
   1325 (defcustom org-scheduled-past-days 10000
   1326   "Number of days to continue listing scheduled items not marked DONE.
   1327 When an item is scheduled on a date, it shows up in the agenda on
   1328 this day and will be listed until it is marked done or for the
   1329 number of days given here."
   1330   :group 'org-agenda-daily/weekly
   1331   :type 'integer
   1332   :safe 'integerp)
   1333 
   1334 (defcustom org-deadline-past-days 10000
   1335   "Number of days to warn about missed deadlines.
   1336 When an item has deadline on a date, it shows up in the agenda on
   1337 this day and will appear as a reminder until it is marked DONE or
   1338 for the number of days given here."
   1339   :group 'org-agenda-daily/weekly
   1340   :type 'integer
   1341   :version "26.1"
   1342   :package-version '(Org . "9.1")
   1343   :safe 'integerp)
   1344 
   1345 (defcustom org-agenda-log-mode-items '(closed clock)
   1346   "List of items that should be shown in agenda log mode.
   1347 \\<org-agenda-mode-map>\
   1348 This list may contain the following symbols:
   1349 
   1350   closed    Show entries that have been closed on that day.
   1351   clock     Show entries that have received clocked time on that day.
   1352   state     Show all logged state changes.
   1353 Note that instead of changing this variable, you can also press \
   1354 `\\[universal-argument] \\[org-agenda-log-mode]' in
   1355 the agenda to display all available LOG items temporarily."
   1356   :group 'org-agenda-daily/weekly
   1357   :type '(set :greedy t (const closed) (const clock) (const state)))
   1358 
   1359 (defcustom org-agenda-clock-consistency-checks
   1360   '(:max-duration "10:00" :min-duration 0 :max-gap "0:05"
   1361 		  :gap-ok-around ("4:00")
   1362 		  :default-face ((:background "DarkRed") (:foreground "white"))
   1363 		  :overlap-face nil :gap-face nil :no-end-time-face nil
   1364 		  :long-face nil :short-face nil)
   1365   "This is a property list, with the following keys:
   1366 
   1367 :max-duration    Mark clocking chunks that are longer than this time.
   1368                  This is a time string like \"HH:MM\", or the number
   1369                  of minutes as an integer.
   1370 
   1371 :min-duration    Mark clocking chunks that are shorter that this.
   1372                  This is a time string like \"HH:MM\", or the number
   1373                  of minutes as an integer.
   1374 
   1375 :max-gap         Mark gaps between clocking chunks that are longer than
   1376                  this duration.  A number of minutes, or a string
   1377                  like \"HH:MM\".
   1378 
   1379 :gap-ok-around   List of times during the day which are usually not working
   1380                  times.  When a gap is detected, but the gap contains any
   1381                  of these times, the gap is *not* reported.  For example,
   1382                  if this is (\"4:00\" \"13:00\") then gaps that contain
   1383                  4:00 in the morning (i.e. the night) and 13:00
   1384                  (i.e. a typical lunch time) do not cause a warning.
   1385                  You should have at least one time during the night in this
   1386                  list, or otherwise the first task each morning will trigger
   1387                  a warning because it follows a long gap.
   1388 
   1389 Furthermore, the following properties can be used to define faces for
   1390 issue display.
   1391 
   1392 :default-face         the default face, if the specific face is undefined
   1393 :overlap-face         face for overlapping clocks
   1394 :gap-face             face for gaps between clocks
   1395 :no-end-time-face     face for incomplete clocks
   1396 :long-face            face for clock intervals that are too long
   1397 :short-face           face for clock intervals that are too short"
   1398   :group 'org-agenda-daily/weekly
   1399   :group 'org-clock
   1400   :version "24.1"
   1401   :type 'plist)
   1402 
   1403 (defcustom org-agenda-log-mode-add-notes t
   1404   "Non-nil means add first line of notes to log entries in agenda views.
   1405 If a log item like a state change or a clock entry is associated with
   1406 notes, the first line of these notes will be added to the entry in the
   1407 agenda display."
   1408   :group 'org-agenda-daily/weekly
   1409   :type 'boolean)
   1410 
   1411 (defcustom org-agenda-start-with-log-mode nil
   1412   "The initial value of log-mode in a newly created agenda window.
   1413 See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further
   1414 explanations on the possible values."
   1415   :group 'org-agenda-startup
   1416   :group 'org-agenda-daily/weekly
   1417   :type '(choice (const :tag "Don't show log items" nil)
   1418 		 (const :tag "Show only log items" only)
   1419 		 (const :tag "Show all possible log items" clockcheck)
   1420 		 (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
   1421 			 (choice (const :tag "Show closed log items" closed)
   1422 				 (const :tag "Show clocked log items" clock)
   1423 				 (const :tag "Show all logged state changes" state)))))
   1424 
   1425 (defcustom org-agenda-start-with-clockreport-mode nil
   1426   "The initial value of clockreport-mode in a newly created agenda window."
   1427   :group 'org-agenda-startup
   1428   :group 'org-agenda-daily/weekly
   1429   :type 'boolean)
   1430 
   1431 (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2)
   1432   "Property list with parameters for the clocktable in clockreport mode.
   1433 This is the display mode that shows a clock table in the daily/weekly
   1434 agenda, the properties for this dynamic block can be set here.
   1435 The usual clocktable parameters are allowed here, but you cannot set
   1436 the properties :name, :tstart, :tend, :block, and :scope - these will
   1437 be overwritten to make sure the content accurately reflects the
   1438 current display in the agenda."
   1439   :group 'org-agenda-daily/weekly
   1440   :type 'plist)
   1441 
   1442 (defvaralias 'org-agenda-search-view-search-words-only
   1443   'org-agenda-search-view-always-boolean)
   1444 
   1445 (defcustom org-agenda-search-view-always-boolean nil
   1446   "Non-nil means the search string is interpreted as individual parts.
   1447 
   1448 The search string for search view can either be interpreted as a phrase,
   1449 or as a list of snippets that define a boolean search for a number of
   1450 strings.
   1451 
   1452 When this is non-nil, the string will be split on whitespace, and each
   1453 snippet will be searched individually, and all must match in order to
   1454 select an entry.  A snippet is then a single string of non-white
   1455 characters, or a string in double quotes, or a regexp in {} braces.
   1456 If a snippet is preceded by \"-\", the snippet must *not* match.
   1457 \"+\" is syntactic sugar for positive selection.  Each snippet may
   1458 be found as a full word or a partial word, but see the variable
   1459 `org-agenda-search-view-force-full-words'.
   1460 
   1461 When this is nil, search will look for the entire search phrase as one,
   1462 with each space character matching any amount of whitespace, including
   1463 line breaks.
   1464 
   1465 Even when this is nil, you can still switch to Boolean search dynamically
   1466 by preceding the first snippet with \"+\" or \"-\".  If the first snippet
   1467 is a regexp marked with braces like \"{abc}\", this will also switch to
   1468 boolean search."
   1469   :group 'org-agenda-search-view
   1470   :version "24.1"
   1471   :type 'boolean)
   1472 
   1473 (defcustom org-agenda-search-view-force-full-words nil
   1474   "Non-nil means, search words must be matches as complete words.
   1475 When nil, they may also match part of a word."
   1476   :group 'org-agenda-search-view
   1477   :version "24.1"
   1478   :type 'boolean)
   1479 
   1480 (defcustom org-agenda-search-view-max-outline-level 0
   1481   "Maximum outline level to display in search view.
   1482 E.g. when this is set to 1, the search view will only
   1483 show headlines of level 1.  When set to 0, the default
   1484 value, don't limit agenda view by outline level."
   1485   :group 'org-agenda-search-view
   1486   :version "26.1"
   1487   :package-version '(Org . "8.3")
   1488   :type 'integer)
   1489 
   1490 (defgroup org-agenda-time-grid nil
   1491   "Options concerning the time grid in the Org Agenda."
   1492   :tag "Org Agenda Time Grid"
   1493   :group 'org-agenda)
   1494 
   1495 (defcustom org-agenda-search-headline-for-time t
   1496   "Non-nil means search headline for a time-of-day.
   1497 If the headline contains a time-of-day in one format or another, it will
   1498 be used to sort the entry into the time sequence of items for a day.
   1499 Some people have time stamps in the headline that refer to the creation
   1500 time or so, and then this produces an unwanted side effect.  If this is
   1501 the case for your, use this variable to turn off searching the headline
   1502 for a time."
   1503   :group 'org-agenda-time-grid
   1504   :type 'boolean)
   1505 
   1506 (defcustom org-agenda-use-time-grid t
   1507   "Non-nil means show a time grid in the agenda schedule.
   1508 A time grid is a set of lines for specific times (like every two hours between
   1509 8:00 and 20:00).  The items scheduled for a day at specific times are
   1510 sorted in between these lines.
   1511 For details about when the grid will be shown, and what it will look like, see
   1512 the variable `org-agenda-time-grid'."
   1513   :group 'org-agenda-time-grid
   1514   :type 'boolean)
   1515 
   1516 (defcustom org-agenda-time-grid
   1517   '((daily today require-timed)
   1518     (800 1000 1200 1400 1600 1800 2000)
   1519     "......"
   1520     "----------------")
   1521 
   1522   "The settings for time grid for agenda display.
   1523 This is a list of four items.  The first item is again a list.  It contains
   1524 symbols specifying conditions when the grid should be displayed:
   1525 
   1526  daily         if the agenda shows a single day
   1527  weekly        if the agenda shows an entire week
   1528  today         show grid on current date, independent of daily/weekly display
   1529  require-timed show grid only if at least one item has a time specification
   1530  remove-match  skip grid times already present in an entry
   1531 
   1532 The second item is a list of integers, indicating the times that
   1533 should have a grid line.
   1534 
   1535 The third item is a string which will be placed right after the
   1536 times that have a grid line.
   1537 
   1538 The fourth item is a string placed after the grid times.  This
   1539 will align with agenda items."
   1540   :group 'org-agenda-time-grid
   1541   :type
   1542   '(list
   1543     (set :greedy t :tag "Grid Display Options"
   1544 	 (const :tag "Show grid in single day agenda display" daily)
   1545 	 (const :tag "Show grid in weekly agenda display" weekly)
   1546 	 (const :tag "Always show grid for today" today)
   1547 	 (const :tag "Show grid only if any timed entries are present"
   1548 		require-timed)
   1549 	 (const :tag "Skip grid times already present in an entry"
   1550 		remove-match))
   1551     (repeat :tag "Grid Times" (integer :tag "Time"))
   1552     (string :tag "Grid String (after agenda times)")
   1553     (string :tag "Grid String (aligns with agenda items)")))
   1554 
   1555 (defcustom org-agenda-show-current-time-in-grid t
   1556   "Non-nil means show the current time in the time grid."
   1557   :group 'org-agenda-time-grid
   1558   :version "24.1"
   1559   :type 'boolean)
   1560 
   1561 (defcustom org-agenda-current-time-string
   1562   "now - - - - - - - - - - - - - - - - - - - - - - - - -"
   1563   "The string for the current time marker in the agenda."
   1564   :group 'org-agenda-time-grid
   1565   :version "24.1"
   1566   :type 'string)
   1567 
   1568 (defgroup org-agenda-sorting nil
   1569   "Options concerning sorting in the Org Agenda."
   1570   :tag "Org Agenda Sorting"
   1571   :group 'org-agenda)
   1572 
   1573 (defcustom org-agenda-sorting-strategy
   1574   '((agenda habit-down time-up priority-down category-keep)
   1575     (todo   priority-down category-keep)
   1576     (tags   priority-down category-keep)
   1577     (search category-keep))
   1578   "Sorting structure for the agenda items of a single day.
   1579 This is a list of symbols which will be used in sequence to determine
   1580 if an entry should be listed before another entry.  The following
   1581 symbols are recognized:
   1582 
   1583 time-up            Put entries with time-of-day indications first, early first.
   1584 time-down          Put entries with time-of-day indications first, late first.
   1585 timestamp-up       Sort by any timestamp, early first.
   1586 timestamp-down     Sort by any timestamp, late first.
   1587 scheduled-up       Sort by scheduled timestamp, early first.
   1588 scheduled-down     Sort by scheduled timestamp, late first.
   1589 deadline-up        Sort by deadline timestamp, early first.
   1590 deadline-down      Sort by deadline timestamp, late first.
   1591 ts-up              Sort by active timestamp, early first.
   1592 ts-down            Sort by active timestamp, late first.
   1593 tsia-up            Sort by inactive timestamp, early first.
   1594 tsia-down          Sort by inactive timestamp, late first.
   1595 category-keep      Keep the default order of categories, corresponding to the
   1596 		   sequence in `org-agenda-files'.
   1597 category-up        Sort alphabetically by category, A-Z.
   1598 category-down      Sort alphabetically by category, Z-A.
   1599 tag-up             Sort alphabetically by last tag, A-Z.
   1600 tag-down           Sort alphabetically by last tag, Z-A.
   1601 priority-up        Sort numerically by priority, high priority last.
   1602 priority-down      Sort numerically by priority, high priority first.
   1603 todo-state-up      Sort by todo state, tasks that are done last.
   1604 todo-state-down    Sort by todo state, tasks that are done first.
   1605 effort-up          Sort numerically by estimated effort, high effort last.
   1606 effort-down        Sort numerically by estimated effort, high effort first.
   1607 user-defined-up    Sort according to `org-agenda-cmp-user-defined', high last.
   1608 user-defined-down  Sort according to `org-agenda-cmp-user-defined', high first.
   1609 habit-up           Put entries that are habits first.
   1610 habit-down         Put entries that are habits last.
   1611 alpha-up           Sort headlines alphabetically.
   1612 alpha-down         Sort headlines alphabetically, reversed.
   1613 
   1614 The different possibilities will be tried in sequence, and testing stops
   1615 if one comparison returns a \"not-equal\".  For example, the default
   1616     '(time-up category-keep priority-down)
   1617 means: Pull out all entries having a specified time of day and sort them,
   1618 in order to make a time schedule for the current day the first thing in the
   1619 agenda listing for the day.  Of the entries without a time indication, keep
   1620 the grouped in categories, don't sort the categories, but keep them in
   1621 the sequence given in `org-agenda-files'.  Within each category sort by
   1622 priority.
   1623 
   1624 Leaving out `category-keep' would mean that items will be sorted across
   1625 categories by priority.
   1626 
   1627 Instead of a single list, this can also be a set of list for specific
   1628 contents, with a context symbol in the car of the list, any of
   1629 `agenda', `todo', `tags', `search' for the corresponding agenda views.
   1630 
   1631 Custom commands can bind this variable in the options section."
   1632   :group 'org-agenda-sorting
   1633   :type `(choice
   1634 	  (repeat :tag "General" ,org-sorting-choice)
   1635 	  (list :tag "Individually"
   1636 		(cons (const :tag "Strategy for Weekly/Daily agenda" agenda)
   1637 		      (repeat ,org-sorting-choice))
   1638 		(cons (const :tag "Strategy for TODO lists" todo)
   1639 		      (repeat ,org-sorting-choice))
   1640 		(cons (const :tag "Strategy for Tags matches" tags)
   1641 		      (repeat ,org-sorting-choice))
   1642 		(cons (const :tag "Strategy for search matches" search)
   1643 		      (repeat ,org-sorting-choice)))))
   1644 
   1645 (defcustom org-agenda-cmp-user-defined nil
   1646   "A function to define the comparison `user-defined'.
   1647 This function must receive two arguments, agenda entry a and b.
   1648 If a>b, return +1.  If a<b, return -1.  If they are equal as seen by
   1649 the user comparison, return nil.
   1650 When this is defined, you can make `user-defined-up' and `user-defined-down'
   1651 part of an agenda sorting strategy."
   1652   :group 'org-agenda-sorting
   1653   :type 'symbol)
   1654 
   1655 (defcustom org-agenda-sort-notime-is-late t
   1656   "Non-nil means items without time are considered late.
   1657 This is only relevant for sorting.  When t, items which have no explicit
   1658 time like 15:30 will be considered as 99:01, i.e. later than any items which
   1659 do have a time.  When nil, the default time is before 0:00.  You can use this
   1660 option to decide if the schedule for today should come before or after timeless
   1661 agenda entries."
   1662   :group 'org-agenda-sorting
   1663   :type 'boolean)
   1664 
   1665 (defcustom org-agenda-sort-noeffort-is-high t
   1666   "Non-nil means items without effort estimate are sorted as high effort.
   1667 This also applies when filtering an agenda view with respect to the
   1668 < or > effort operator.  Then, tasks with no effort defined will be treated
   1669 as tasks with high effort.
   1670 When nil, such items are sorted as 0 minutes effort."
   1671   :group 'org-agenda-sorting
   1672   :type 'boolean)
   1673 
   1674 (defgroup org-agenda-line-format nil
   1675   "Options concerning the entry prefix in the Org agenda display."
   1676   :tag "Org Agenda Line Format"
   1677   :group 'org-agenda)
   1678 
   1679 (defcustom org-agenda-prefix-format
   1680   '((agenda  . " %i %-12:c%?-12t% s")
   1681     (todo  . " %i %-12:c")
   1682     (tags  . " %i %-12:c")
   1683     (search . " %i %-12:c"))
   1684   "Format specifications for the prefix of items in the agenda views.
   1685 
   1686 An alist with one entry per agenda type.  The keys of the
   1687 sublists are `agenda', `todo', `search' and `tags'.  The values
   1688 are format strings.
   1689 
   1690 This format works similar to a printf format, with the following meaning:
   1691 
   1692   %c   the category of the item, \"Diary\" for entries from the diary,
   1693        or as given by the CATEGORY keyword or derived from the file name
   1694   %e   the effort required by the item
   1695   %l   the level of the item (insert X space(s) if item is of level X)
   1696   %i   the icon category of the item, see `org-agenda-category-icon-alist'
   1697   %T   the last tag of the item (ignore inherited tags, which come first)
   1698   %t   the HH:MM time-of-day specification if one applies to the entry
   1699   %s   Scheduling/Deadline information, a short string
   1700   %b   show breadcrumbs, i.e., the names of the higher levels
   1701   %(expression) Eval EXPRESSION and replace the control string
   1702                 by the result
   1703 
   1704 All specifiers work basically like the standard `%s' of printf, but may
   1705 contain two additional characters: a question mark just after the `%'
   1706 and a whitespace/punctuation character just before the final letter.
   1707 
   1708 If the first character after `%' is a question mark, the entire field
   1709 will only be included if the corresponding value applies to the current
   1710 entry.  This is useful for fields which should have fixed width when
   1711 present, but zero width when absent.  For example, \"%?-12t\" will
   1712 result in a 12 character time field if a time of the day is specified,
   1713 but will completely disappear in entries which do not contain a time.
   1714 
   1715 If there is punctuation or whitespace character just before the
   1716 final format letter, this character will be appended to the field
   1717 value if the value is not empty.  For example, the format
   1718 \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\".  If
   1719 the category is empty, no additional colon is inserted.
   1720 
   1721 The default value for the agenda sublist is \"  %-12:c%?-12t% s\",
   1722 which means:
   1723 
   1724 - Indent the line with two space characters
   1725 - Give the category a 12 chars wide field, padded with whitespace on
   1726   the right (because of `-').  Append a colon if there is a category
   1727   (because of `:').
   1728 - If there is a time-of-day, put it into a 12 chars wide field.  If no
   1729   time, don't put in an empty field, just skip it (because of '?').
   1730 - Finally, put the scheduling information.
   1731 
   1732 See also the variables `org-agenda-remove-times-when-in-prefix' and
   1733 `org-agenda-remove-tags'.
   1734 
   1735 Custom commands can set this variable in the options section."
   1736   :type '(choice
   1737 	  (string :tag "General format")
   1738 	  (list :greedy t :tag "View dependent"
   1739 		(cons  (const agenda) (string :tag "Format"))
   1740 		(cons  (const todo) (string :tag "Format"))
   1741 		(cons  (const tags) (string :tag "Format"))
   1742 		(cons  (const search) (string :tag "Format"))))
   1743   :group 'org-agenda-line-format
   1744   :version "26.1"
   1745   :package-version '(Org . "9.1"))
   1746 
   1747 (defcustom org-agenda-breadcrumbs-separator "->"
   1748   "The separator of breadcrumbs in agenda lines."
   1749   :group 'org-agenda-line-format
   1750   :package-version '(Org . "9.3")
   1751   :type 'string
   1752   :safe #'stringp)
   1753 
   1754 (defvar org-prefix-format-compiled nil
   1755   "The compiled prefix format and associated variables.
   1756 This is a list where first element is a list of variable bindings, and second
   1757 element is the compiled format expression.  See the variable
   1758 `org-agenda-prefix-format'.")
   1759 
   1760 (defcustom org-agenda-todo-keyword-format "%-1s"
   1761   "Format for the TODO keyword in agenda lines.
   1762 Set this to something like \"%-12s\" if you want all TODO keywords
   1763 to occupy a fixed space in the agenda display."
   1764   :group 'org-agenda-line-format
   1765   :type 'string)
   1766 
   1767 (defcustom org-agenda-diary-sexp-prefix nil
   1768   "A regexp that matches part of a diary sexp entry
   1769 which should be treated as scheduling/deadline information in
   1770 `org-agenda'.
   1771 
   1772 For example, you can use this to extract the `diary-remind-message' from
   1773 `diary-remind' entries."
   1774   :group 'org-agenda-line-format
   1775   :type '(choice (const :tag "None" nil) (regexp :tag "Regexp")))
   1776 
   1777 (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ")
   1778   "Text preceding timerange entries in the agenda view.
   1779 This is a list with two strings.  The first applies when the range
   1780 is entirely on one day.  The second applies if the range spans several days.
   1781 The strings may have two \"%d\" format specifiers which will be filled
   1782 with the sequence number of the days, and the total number of days in the
   1783 range, respectively."
   1784   :group 'org-agenda-line-format
   1785   :type '(list
   1786 	  (string :tag "Deadline today   ")
   1787 	  (choice :tag "Deadline relative"
   1788 		  (string :tag "Format string")
   1789 		  (function))))
   1790 
   1791 (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
   1792   "Text preceding scheduled items in the agenda view.
   1793 This is a list with two strings.  The first applies when the item is
   1794 scheduled on the current day.  The second applies when it has been scheduled
   1795 previously, it may contain a %d indicating that this is the nth time that
   1796 this item is scheduled, due to automatic rescheduling of unfinished items
   1797 for the following day.  So this number is one larger than the number of days
   1798 that passed since this item was scheduled first."
   1799   :group 'org-agenda-line-format
   1800   :version "24.4"
   1801   :package-version '(Org . "8.0")
   1802   :type '(list
   1803 	  (string :tag "Scheduled today     ")
   1804 	  (string :tag "Scheduled previously")))
   1805 
   1806 (defcustom org-agenda-inactive-leader "["
   1807   "Text preceding item pulled into the agenda by inactive time stamps.
   1808 These entries are added to the agenda when pressing \"[\"."
   1809   :group 'org-agenda-line-format
   1810   :version "24.1"
   1811   :type 'string)
   1812 
   1813 (defcustom org-agenda-deadline-leaders '("Deadline:  " "In %3d d.: " "%2d d. ago: ")
   1814   "Text preceding deadline items in the agenda view.
   1815 This is a list with three strings.  The first applies when the item has its
   1816 deadline on the current day.  The second applies when the deadline is in the
   1817 future, the third one when it is in the past.  The strings may contain %d
   1818 to capture the number of days."
   1819   :group 'org-agenda-line-format
   1820   :version "24.4"
   1821   :package-version '(Org . "8.0")
   1822   :type '(list
   1823 	  (string :tag "Deadline today          ")
   1824 	  (string :tag "Deadline in the future  ")
   1825 	  (string :tag "Deadline in the past    ")))
   1826 
   1827 (defcustom org-agenda-remove-times-when-in-prefix t
   1828   "Non-nil means remove duplicate time specifications in agenda items.
   1829 When the format `org-agenda-prefix-format' contains a `%t' specifier, a
   1830 time-of-day specification in a headline or diary entry is extracted and
   1831 placed into the prefix.  If this option is non-nil, the original specification
   1832 \(a timestamp or -range, or just a plain time(range) specification like
   1833 11:30-4pm) will be removed for agenda display.  This makes the agenda less
   1834 cluttered.
   1835 The option can be t or nil.  It may also be the symbol `beg', indicating
   1836 that the time should only be removed when it is located at the beginning of
   1837 the headline/diary entry."
   1838   :group 'org-agenda-line-format
   1839   :type '(choice
   1840 	  (const :tag "Always" t)
   1841 	  (const :tag "Never" nil)
   1842 	  (const :tag "When at beginning of entry" beg)))
   1843 
   1844 (defcustom org-agenda-remove-timeranges-from-blocks nil
   1845   "Non-nil means remove time ranges specifications in agenda
   1846 items that span on several days."
   1847   :group 'org-agenda-line-format
   1848   :version "24.1"
   1849   :type 'boolean)
   1850 
   1851 (defcustom org-agenda-default-appointment-duration nil
   1852   "Default duration for appointments that only have a starting time.
   1853 When nil, no duration is specified in such cases.
   1854 When non-nil, this must be the number of minutes, e.g. 60 for one hour."
   1855   :group 'org-agenda-line-format
   1856   :type '(choice
   1857 	  (integer :tag "Minutes")
   1858 	  (const :tag "No default duration")))
   1859 
   1860 (defcustom org-agenda-show-inherited-tags t
   1861   "Non-nil means show inherited tags in each agenda line.
   1862 
   1863 When this option is set to `always', it takes precedence over
   1864 `org-agenda-use-tag-inheritance' and inherited tags are shown
   1865 in every agenda.
   1866 
   1867 When this option is set to t (the default), inherited tags are
   1868 shown when they are available, i.e. when the value of
   1869 `org-agenda-use-tag-inheritance' enables tag inheritance for the
   1870 given agenda type.
   1871 
   1872 This can be set to a list of agenda types in which the agenda
   1873 must display the inherited tags.  Available types are `todo',
   1874 `agenda' and `search'.
   1875 
   1876 When set to nil, never show inherited tags in agenda lines."
   1877   :group 'org-agenda-line-format
   1878   :group 'org-agenda
   1879   :version "24.3"
   1880   :type '(choice
   1881 	  (const :tag "Show inherited tags when available" t)
   1882 	  (const :tag "Always show inherited tags" always)
   1883 	  (repeat :tag "Show inherited tags only in selected agenda types"
   1884 		  (symbol :tag "Agenda type"))))
   1885 
   1886 (defcustom org-agenda-use-tag-inheritance '(todo search agenda)
   1887   "List of agenda view types where to use tag inheritance.
   1888 
   1889 In tags/tags-todo/tags-tree agenda views, tag inheritance is
   1890 controlled by `org-use-tag-inheritance'.  In other agenda types,
   1891 `org-use-tag-inheritance' is not used for the selection of the
   1892 agenda entries.  Still, you may want the agenda to be aware of
   1893 the inherited tags anyway, e.g. for later tag filtering.
   1894 
   1895 Allowed value are `todo', `search' and `agenda'.
   1896 
   1897 This variable has no effect if `org-agenda-show-inherited-tags'
   1898 is set to `always'.  In that case, the agenda is aware of those
   1899 tags.
   1900 
   1901 The default value sets tags in every agenda type.  Setting this
   1902 option to nil will speed up non-tags agenda view a lot."
   1903   :group 'org-agenda
   1904   :version "26.1"
   1905   :package-version '(Org . "9.1")
   1906   :type '(choice
   1907 	  (const :tag "Use tag inheritance in all agenda types" t)
   1908 	  (repeat :tag "Use tag inheritance in selected agenda types"
   1909 		  (symbol :tag "Agenda type"))))
   1910 
   1911 (defcustom org-agenda-hide-tags-regexp nil
   1912   "Regular expression used to filter away specific tags in agenda views.
   1913 This means that these tags will be present, but not be shown in the agenda
   1914 line.  Secondary filtering will still work on the hidden tags.
   1915 Nil means don't hide any tags."
   1916   :group 'org-agenda-line-format
   1917   :type '(choice
   1918 	  (const  :tag "Hide none" nil)
   1919 	  (regexp :tag "Regexp   ")))
   1920 
   1921 (defvaralias 'org-agenda-remove-tags-when-in-prefix
   1922   'org-agenda-remove-tags)
   1923 
   1924 (defcustom org-agenda-remove-tags nil
   1925   "Non-nil means remove the tags from the headline copy in the agenda.
   1926 When this is the symbol `prefix', only remove tags when
   1927 `org-agenda-prefix-format' contains a `%T' specifier."
   1928   :group 'org-agenda-line-format
   1929   :type '(choice
   1930 	  (const :tag "Always" t)
   1931 	  (const :tag "Never" nil)
   1932 	  (const :tag "When prefix format contains %T" prefix)))
   1933 
   1934 (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
   1935 
   1936 (defcustom org-agenda-tags-column 'auto
   1937   "Shift tags in agenda items to this column.
   1938 If set to `auto', tags will be automatically aligned to the right
   1939 edge of the window.
   1940 
   1941 If set to a positive number, tags will be left-aligned to that
   1942 column.  If set to a negative number, tags will be right-aligned
   1943 to that column.  For example, -80 works well for a normal 80
   1944 character screen."
   1945   :group 'org-agenda-line-format
   1946   :type '(choice
   1947 	  (const :tag "Automatically align to right edge of window" auto)
   1948 	  (integer :tag "Specific column" -80))
   1949   :package-version '(Org . "9.1")
   1950   :version "26.1")
   1951 
   1952 (defcustom org-agenda-fontify-priorities 'cookies
   1953   "Non-nil means highlight low and high priorities in agenda.
   1954 When t, the highest priority entries are bold, lowest priority italic.
   1955 However, settings in `org-priority-faces' will overrule these faces.
   1956 When this variable is the symbol `cookies', only fontify the
   1957 cookies, not the entire task.
   1958 This may also be an association list of priority faces, whose
   1959 keys are the character values of `org-priority-highest',
   1960 `org-priority-default', and `org-priority-lowest' (the default values
   1961 are ?A, ?B, and ?C, respectively).  The face may be a named face, a
   1962 color as a string, or a list like `(:background \"Red\")'.
   1963 If it is a color, the variable `org-faces-easy-properties'
   1964 determines if it is a foreground or a background color."
   1965   :group 'org-agenda-line-format
   1966   :type '(choice
   1967 	  (const :tag "Never" nil)
   1968 	  (const :tag "Defaults" t)
   1969 	  (const :tag "Cookies only" cookies)
   1970 	  (repeat :tag "Specify"
   1971 		  (list (character :tag "Priority" :value ?A)
   1972 			(choice    :tag "Face    "
   1973 				   (string :tag "Color")
   1974 				   (sexp :tag "Face"))))))
   1975 
   1976 (defcustom org-agenda-day-face-function nil
   1977   "Function called to determine what face should be used to display a day.
   1978 The only argument passed to that function is the day.  It should
   1979 returns a face, or nil if does not want to specify a face and let
   1980 the normal rules apply."
   1981   :group 'org-agenda-line-format
   1982   :version "24.1"
   1983   :type '(choice (const nil) (function)))
   1984 
   1985 (defcustom org-agenda-category-icon-alist nil
   1986   "Alist of category icon to be displayed in agenda views.
   1987 
   1988 Each entry should have the following format:
   1989 
   1990   (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS)
   1991 
   1992 Where CATEGORY-REGEXP is a regexp matching the categories where
   1993 the icon should be displayed.
   1994 FILE-OR-DATA either a file path or a string containing image data.
   1995 
   1996 The other fields can be omitted safely if not needed:
   1997 TYPE indicates the image type.
   1998 DATA-P is a boolean indicating whether the FILE-OR-DATA string is
   1999 image data.
   2000 PROPS are additional image attributes to assign to the image,
   2001 like, e.g. `:ascent center'.
   2002 
   2003    (\"Org\" \"/path/to/icon.png\" nil nil :ascent center)
   2004 
   2005 If you want to set the display properties yourself, just put a
   2006 list as second element:
   2007 
   2008   (CATEGORY-REGEXP (MY PROPERTY LIST))
   2009 
   2010 For example, to display a 16px horizontal space for Emacs
   2011 category, you can use:
   2012 
   2013   (\"Emacs\" \\='(space . (:width (16))))"
   2014   :group 'org-agenda-line-format
   2015   :version "24.1"
   2016   :type '(alist :key-type (regexp :tag "Regexp matching category")
   2017 		:value-type (choice (list :tag "Icon"
   2018 					  (string :tag "File or data")
   2019 					  (symbol :tag "Type")
   2020 					  (boolean :tag "Data?")
   2021 					  (repeat :tag "Extra image properties" :inline t sexp))
   2022 				    (list :tag "Display properties" sexp))))
   2023 
   2024 (defgroup org-agenda-column-view nil
   2025   "Options concerning column view in the agenda."
   2026   :tag "Org Agenda Column View"
   2027   :group 'org-agenda)
   2028 
   2029 (defcustom org-agenda-view-columns-initially nil
   2030   "When non-nil, switch to columns view right after creating the agenda."
   2031   :group 'org-agenda-column-view
   2032   :type 'boolean
   2033   :version "26.1"
   2034   :package-version '(Org . "9.0")
   2035   :safe #'booleanp)
   2036 
   2037 (defcustom org-agenda-columns-show-summaries t
   2038   "Non-nil means show summaries for columns displayed in the agenda view."
   2039   :group 'org-agenda-column-view
   2040   :type 'boolean)
   2041 
   2042 (defcustom org-agenda-columns-compute-summary-properties t
   2043   "Non-nil means recompute all summary properties before column view.
   2044 When column view in the agenda is listing properties that have a summary
   2045 operator, it can go to all relevant buffers and recompute the summaries
   2046 there.  This can mean overhead for the agenda column view, but is necessary
   2047 to have thing up to date.
   2048 As a special case, a CLOCKSUM property also makes sure that the clock
   2049 computations are current."
   2050   :group 'org-agenda-column-view
   2051   :type 'boolean)
   2052 
   2053 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil
   2054   "Non-nil means the duration of an appointment will add to day effort.
   2055 The property to which appointment durations will be added is the one given
   2056 in the option `org-effort-property'.  If an appointment does not have
   2057 an end time, `org-agenda-default-appointment-duration' will be used.  If that
   2058 is not set, an appointment without end time will not contribute to the time
   2059 estimate."
   2060   :group 'org-agenda-column-view
   2061   :type 'boolean)
   2062 
   2063 (defcustom org-agenda-auto-exclude-function nil
   2064   "A function called with a tag to decide if it is filtered on \
   2065 \\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] RET'.
   2066 The sole argument to the function, which is called once for each
   2067 possible tag, is a string giving the name of the tag.  The
   2068 function should return either nil if the tag should be included
   2069 as normal, \"-<TAG>\" to exclude the tag, or \"+<TAG>\" to exclude
   2070 lines not carrying this tag.
   2071 Note that for the purpose of tag filtering, only the lower-case version of
   2072 all tags will be considered, so that this function will only ever see
   2073 the lower-case version of all tags."
   2074   :group 'org-agenda
   2075   :type '(choice (const nil) (function)))
   2076 
   2077 (defcustom org-agenda-bulk-custom-functions nil
   2078   "Alist of characters and custom functions for bulk actions.
   2079 For example, this value makes those two functions available:
   2080 
   2081   \\='((?R set-category)
   2082     (?C bulk-cut))
   2083 
   2084 With selected entries in an agenda buffer, `B R' will call
   2085 the custom function `set-category' on the selected entries.
   2086 Note that functions in this alist don't need to be quoted.
   2087 
   2088 You can also specify a function which collects arguments to be
   2089 used for each call to your bulk custom function.  The argument
   2090 collecting function will be run once and should return a list of
   2091 arguments to pass to the bulk function.  For example:
   2092 
   2093   \\='((?R set-category get-category))
   2094 
   2095 Now, `B R' will call the custom `get-category' which would prompt
   2096 the user once for a category.  That category is then passed as an
   2097 argument to `set-category' for each entry it's called against."
   2098   :type
   2099   '(alist :key-type character
   2100 	  :value-type
   2101           (group (function :tag "Bulk Custom Function")
   2102 		 (choice (function :tag "Bulk Custom Argument Function")
   2103 		         (const :tag "No Bulk Custom Argument Function" nil))))
   2104   :package-version '(Org . "9.5")
   2105   :group 'org-agenda)
   2106 
   2107 (defmacro org-agenda-with-point-at-orig-entry (string &rest body)
   2108   "Execute BODY with point at location given by `org-hd-marker' property.
   2109 If STRING is non-nil, the text property will be fetched from position 0
   2110 in that string.  If STRING is nil, it will be fetched from the beginning
   2111 of the current line."
   2112   (declare (debug t))
   2113   (org-with-gensyms (marker)
   2114     `(let ((,marker (get-text-property (if ,string 0 (point-at-bol))
   2115 				       'org-hd-marker ,string)))
   2116        (with-current-buffer (marker-buffer ,marker)
   2117 	 (save-excursion
   2118 	   (goto-char ,marker)
   2119 	   ,@body)))))
   2120 
   2121 (defun org-add-agenda-custom-command (entry)
   2122   "Replace or add a command in `org-agenda-custom-commands'.
   2123 This is mostly for hacking and trying a new command - once the command
   2124 works you probably want to add it to `org-agenda-custom-commands' for good."
   2125   (let ((ass (assoc (car entry) org-agenda-custom-commands)))
   2126     (if ass
   2127 	(setcdr ass (cdr entry))
   2128       (push entry org-agenda-custom-commands))))
   2129 
   2130 (defmacro org-agenda--insert-overriding-header (default)
   2131   "Insert header into agenda view.
   2132 The inserted header depends on `org-agenda-overriding-header'.
   2133 If the empty string, don't insert a header.  If any other string,
   2134 insert it as a header.  If nil, insert DEFAULT, which should
   2135 evaluate to a string.  If a function, call it and insert the
   2136 string that it returns."
   2137   (declare (debug (form)) (indent defun))
   2138   `(cond
   2139     ((not org-agenda-overriding-header) (insert ,default))
   2140     ((equal org-agenda-overriding-header "") nil)
   2141     ((stringp org-agenda-overriding-header)
   2142      (insert (propertize org-agenda-overriding-header
   2143 			 'face 'org-agenda-structure)
   2144 	     "\n"))
   2145     ((functionp org-agenda-overriding-header)
   2146      (insert (funcall org-agenda-overriding-header)))
   2147     (t (user-error "Invalid value for `org-agenda-overriding-header': %S"
   2148 		   org-agenda-overriding-header))))
   2149 
   2150 ;;; Define the org-agenda-mode
   2151 
   2152 (defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
   2153 (defvar org-agenda-mode-map (make-sparse-keymap)
   2154   "Keymap for `org-agenda-mode'.")
   2155 
   2156 (org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line)
   2157 
   2158 (defvar org-agenda-menu) ; defined later in this file.
   2159 (defvar org-agenda-restrict nil) ; defined later in this file.
   2160 (defvar org-agenda-follow-mode nil)
   2161 (defvar org-agenda-entry-text-mode nil)
   2162 (defvar org-agenda-clockreport-mode nil)
   2163 (defvar org-agenda-show-log nil
   2164   "When non-nil, show the log in the agenda.
   2165 Do not set this directly; instead use
   2166 `org-agenda-start-with-log-mode', which see.")
   2167 (defvar org-agenda-redo-command nil)
   2168 (defvar org-agenda-query-string nil)
   2169 (defvar org-agenda-mode-hook nil
   2170   "Hook run after `org-agenda-mode' is turned on.
   2171 The buffer is still writable when this hook is called.")
   2172 (defvar org-agenda-type nil)
   2173 (defvar org-agenda-force-single-file nil)
   2174 (defvar org-agenda-bulk-marked-entries nil
   2175   "List of markers that refer to marked entries in the agenda.")
   2176 (defvar org-agenda-current-date nil
   2177   "Active date when building the agenda.")
   2178 
   2179 ;;; Multiple agenda buffers support
   2180 
   2181 (defcustom org-agenda-sticky nil
   2182   "Non-nil means agenda q key will bury agenda buffers.
   2183 Agenda commands will then show existing buffer instead of generating new ones.
   2184 When nil, `q' will kill the single agenda buffer."
   2185   :group 'org-agenda
   2186   :version "24.3"
   2187   :type 'boolean)
   2188 
   2189 
   2190 ;;;###autoload
   2191 (defun org-toggle-sticky-agenda (&optional arg)
   2192   "Toggle `org-agenda-sticky'."
   2193   (interactive "P")
   2194   (let ((new-value (if arg
   2195 		       (> (prefix-numeric-value arg) 0)
   2196 		     (not org-agenda-sticky))))
   2197     (if (equal new-value org-agenda-sticky)
   2198 	(and (called-interactively-p 'interactive)
   2199 	     (message "Sticky agenda was already %s"
   2200 		      (if org-agenda-sticky "enabled" "disabled")))
   2201       (setq org-agenda-sticky new-value)
   2202       (org-agenda-kill-all-agenda-buffers)
   2203       (and (called-interactively-p 'interactive)
   2204 	   (message "Sticky agenda %s"
   2205 		    (if org-agenda-sticky "enabled" "disabled"))))))
   2206 
   2207 (defvar org-agenda-buffer nil
   2208   "Agenda buffer currently being generated.")
   2209 
   2210 (defvar org-agenda-last-prefix-arg nil)
   2211 (defvar org-agenda-this-buffer-name nil)
   2212 (defvar org-agenda-doing-sticky-redo nil)
   2213 (defvar org-agenda-this-buffer-is-sticky nil)
   2214 (defvar org-agenda-last-indirect-buffer nil
   2215   "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.")
   2216 
   2217 (defconst org-agenda-local-vars
   2218   '(org-agenda-this-buffer-name
   2219     org-agenda-undo-list
   2220     org-agenda-pending-undo-list
   2221     org-agenda-follow-mode
   2222     org-agenda-entry-text-mode
   2223     org-agenda-clockreport-mode
   2224     org-agenda-show-log
   2225     org-agenda-redo-command
   2226     org-agenda-query-string
   2227     org-agenda-type
   2228     org-agenda-bulk-marked-entries
   2229     org-agenda-undo-has-started-in
   2230     org-agenda-info
   2231     org-agenda-pre-window-conf
   2232     org-agenda-columns-active
   2233     org-agenda-tag-filter
   2234     org-agenda-category-filter
   2235     org-agenda-top-headline-filter
   2236     org-agenda-regexp-filter
   2237     org-agenda-effort-filter
   2238     org-agenda-markers
   2239     org-agenda-last-search-view-search-was-boolean
   2240     org-agenda-last-indirect-buffer
   2241     org-agenda-filtered-by-category
   2242     org-agenda-filter-form
   2243     org-agenda-cycle-counter
   2244     org-agenda-last-prefix-arg)
   2245   "Variables that must be local in agenda buffers to allow multiple buffers.")
   2246 
   2247 (defun org-agenda-mode ()
   2248   "Mode for time-sorted view on action items in Org files.
   2249 
   2250 The following commands are available:
   2251 
   2252 \\{org-agenda-mode-map}"
   2253   (interactive)
   2254   (ignore-errors (require 'face-remap))
   2255   (let ((agenda-local-vars-to-keep
   2256 	 '(text-scale-mode-amount
   2257 	   text-scale-mode
   2258 	   text-scale-mode-lighter
   2259 	   face-remapping-alist))
   2260 	(save (buffer-local-variables)))
   2261     (kill-all-local-variables)
   2262     (cl-flet ((reset-saved (var-set)
   2263 		"Reset variables in VAR-SET to possibly stored value in SAVE."
   2264 		(dolist (elem save)
   2265 		  (pcase elem
   2266 		    (`(,var . ,val)		;ignore unbound variables
   2267 		     (when (and val (memq var var-set))
   2268 		       (set var val)))))))
   2269       (cond (org-agenda-doing-sticky-redo
   2270 	      ;; Refreshing sticky agenda-buffer
   2271 	      ;;
   2272 	      ;; Preserve the value of `org-agenda-local-vars' variables.
   2273 	      (mapc #'make-local-variable org-agenda-local-vars)
   2274 	      (reset-saved org-agenda-local-vars)
   2275 	      (setq-local org-agenda-this-buffer-is-sticky t))
   2276 	    (org-agenda-sticky
   2277 	      ;; Creating a sticky Agenda buffer for the first time
   2278 	      (mapc #'make-local-variable org-agenda-local-vars)
   2279 	      (setq-local org-agenda-this-buffer-is-sticky t))
   2280 	    (t
   2281 	      ;; Creating a non-sticky agenda buffer
   2282 	      (setq-local org-agenda-this-buffer-is-sticky nil)))
   2283       (mapc #'make-local-variable agenda-local-vars-to-keep)
   2284       (reset-saved agenda-local-vars-to-keep)))
   2285   (setq org-agenda-undo-list nil
   2286 	org-agenda-pending-undo-list nil
   2287 	org-agenda-bulk-marked-entries nil)
   2288   (setq major-mode 'org-agenda-mode)
   2289   ;; Keep global-font-lock-mode from turning on font-lock-mode
   2290   (setq-local font-lock-global-modes (list 'not major-mode))
   2291   (setq mode-name "Org-Agenda")
   2292   (setq indent-tabs-mode nil)
   2293   (use-local-map org-agenda-mode-map)
   2294   (when org-startup-truncated (setq truncate-lines t))
   2295   (setq-local line-move-visual nil)
   2296   (add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local)
   2297   (add-hook 'pre-command-hook #'org-unhighlight nil 'local)
   2298   ;; Make sure properties are removed when copying text
   2299   (if (boundp 'filter-buffer-substring-functions)
   2300       (add-hook 'filter-buffer-substring-functions
   2301 		(lambda (fun start end delete)
   2302                   (substring-no-properties (funcall fun start end delete)))
   2303 		nil t)
   2304     ;; Emacs >= 24.4.
   2305     (add-function :filter-return (local 'filter-buffer-substring-function)
   2306                   #'substring-no-properties))
   2307   (unless org-agenda-keep-modes
   2308     (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
   2309 	  org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
   2310 	  org-agenda-show-log org-agenda-start-with-log-mode
   2311 	  org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode))
   2312   (add-to-invisibility-spec '(org-filtered))
   2313   (add-to-invisibility-spec '(org-link))
   2314   (easy-menu-change
   2315    '("Agenda") "Agenda Files"
   2316    (append
   2317     (list
   2318      (vector
   2319       (if (get 'org-agenda-files 'org-restrict)
   2320 	  "Restricted to single file"
   2321 	"Edit File List")
   2322       '(org-edit-agenda-file-list)
   2323       (not (get 'org-agenda-files 'org-restrict)))
   2324      "--")
   2325     (mapcar #'org-file-menu-entry (org-agenda-files))))
   2326   (org-agenda-set-mode-name)
   2327   (run-mode-hooks 'org-agenda-mode-hook))
   2328 
   2329 (substitute-key-definition #'undo #'org-agenda-undo
   2330 			   org-agenda-mode-map global-map)
   2331 (org-defkey org-agenda-mode-map "\C-i" #'org-agenda-goto)
   2332 (org-defkey org-agenda-mode-map [(tab)] #'org-agenda-goto)
   2333 (org-defkey org-agenda-mode-map "\C-m" #'org-agenda-switch-to)
   2334 (org-defkey org-agenda-mode-map "\C-k" #'org-agenda-kill)
   2335 (org-defkey org-agenda-mode-map "\C-c\C-w" #'org-agenda-refile)
   2336 (org-defkey org-agenda-mode-map [(meta down)] #'org-agenda-drag-line-forward)
   2337 (org-defkey org-agenda-mode-map [(meta up)] #'org-agenda-drag-line-backward)
   2338 (org-defkey org-agenda-mode-map "m" #'org-agenda-bulk-mark)
   2339 (org-defkey org-agenda-mode-map "\M-m" #'org-agenda-bulk-toggle)
   2340 (org-defkey org-agenda-mode-map "*" #'org-agenda-bulk-mark-all)
   2341 (org-defkey org-agenda-mode-map "\M-*" #'org-agenda-bulk-toggle-all)
   2342 (org-defkey org-agenda-mode-map "#" #'org-agenda-dim-blocked-tasks)
   2343 (org-defkey org-agenda-mode-map "%" #'org-agenda-bulk-mark-regexp)
   2344 (org-defkey org-agenda-mode-map "u" #'org-agenda-bulk-unmark)
   2345 (org-defkey org-agenda-mode-map "U" #'org-agenda-bulk-unmark-all)
   2346 (org-defkey org-agenda-mode-map "B" #'org-agenda-bulk-action)
   2347 (org-defkey org-agenda-mode-map "k" #'org-agenda-capture)
   2348 (org-defkey org-agenda-mode-map "A" #'org-agenda-append-agenda)
   2349 (org-defkey org-agenda-mode-map "\C-c\C-x!" #'org-reload)
   2350 (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" #'org-agenda-archive-default)
   2351 (org-defkey org-agenda-mode-map "\C-c\C-xa" #'org-agenda-toggle-archive-tag)
   2352 (org-defkey org-agenda-mode-map "\C-c\C-xA" #'org-agenda-archive-to-archive-sibling)
   2353 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" #'org-agenda-archive)
   2354 (org-defkey org-agenda-mode-map "\C-c$" #'org-agenda-archive)
   2355 (org-defkey org-agenda-mode-map "$" #'org-agenda-archive)
   2356 (org-defkey org-agenda-mode-map "\C-c\C-o" #'org-agenda-open-link)
   2357 (org-defkey org-agenda-mode-map " " #'org-agenda-show-and-scroll-up)
   2358 (org-defkey org-agenda-mode-map [backspace] #'org-agenda-show-scroll-down)
   2359 (org-defkey org-agenda-mode-map "\d" #'org-agenda-show-scroll-down)
   2360 (org-defkey org-agenda-mode-map [(control shift right)] #'org-agenda-todo-nextset)
   2361 (org-defkey org-agenda-mode-map [(control shift left)] #'org-agenda-todo-previousset)
   2362 (org-defkey org-agenda-mode-map "\C-c\C-xb" #'org-agenda-tree-to-indirect-buffer)
   2363 (org-defkey org-agenda-mode-map "o" #'delete-other-windows)
   2364 (org-defkey org-agenda-mode-map "L" #'org-agenda-recenter)
   2365 (org-defkey org-agenda-mode-map "\C-c\C-t" #'org-agenda-todo)
   2366 (org-defkey org-agenda-mode-map "t" #'org-agenda-todo)
   2367 (org-defkey org-agenda-mode-map "a" #'org-agenda-archive-default-with-confirmation)
   2368 (org-defkey org-agenda-mode-map ":" #'org-agenda-set-tags)
   2369 (org-defkey org-agenda-mode-map "\C-c\C-q" #'org-agenda-set-tags)
   2370 (org-defkey org-agenda-mode-map "." #'org-agenda-goto-today)
   2371 (org-defkey org-agenda-mode-map "j" #'org-agenda-goto-date)
   2372 (org-defkey org-agenda-mode-map "d" #'org-agenda-day-view)
   2373 (org-defkey org-agenda-mode-map "w" #'org-agenda-week-view)
   2374 (org-defkey org-agenda-mode-map "y" #'org-agenda-year-view)
   2375 (org-defkey org-agenda-mode-map "\C-c\C-z" #'org-agenda-add-note)
   2376 (org-defkey org-agenda-mode-map "z" #'org-agenda-add-note)
   2377 (org-defkey org-agenda-mode-map [(shift right)] #'org-agenda-do-date-later)
   2378 (org-defkey org-agenda-mode-map [(shift left)] #'org-agenda-do-date-earlier)
   2379 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] #'org-agenda-do-date-later)
   2380 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] #'org-agenda-do-date-earlier)
   2381 (org-defkey org-agenda-mode-map ">" #'org-agenda-date-prompt)
   2382 (org-defkey org-agenda-mode-map "\C-c\C-s" #'org-agenda-schedule)
   2383 (org-defkey org-agenda-mode-map "\C-c\C-d" #'org-agenda-deadline)
   2384 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
   2385   (while l (org-defkey org-agenda-mode-map
   2386 		       (number-to-string (pop l)) #'digit-argument)))
   2387 (org-defkey org-agenda-mode-map "F" #'org-agenda-follow-mode)
   2388 (org-defkey org-agenda-mode-map "R" #'org-agenda-clockreport-mode)
   2389 (org-defkey org-agenda-mode-map "E" #'org-agenda-entry-text-mode)
   2390 (org-defkey org-agenda-mode-map "l" #'org-agenda-log-mode)
   2391 (org-defkey org-agenda-mode-map "v" #'org-agenda-view-mode-dispatch)
   2392 (org-defkey org-agenda-mode-map "D" #'org-agenda-toggle-diary)
   2393 (org-defkey org-agenda-mode-map "!" #'org-agenda-toggle-deadlines)
   2394 (org-defkey org-agenda-mode-map "G" #'org-agenda-toggle-time-grid)
   2395 (org-defkey org-agenda-mode-map "r" #'org-agenda-redo)
   2396 (org-defkey org-agenda-mode-map "g" #'org-agenda-redo-all)
   2397 (org-defkey org-agenda-mode-map "e" #'org-agenda-set-effort)
   2398 (org-defkey org-agenda-mode-map "\C-c\C-xe" #'org-agenda-set-effort)
   2399 (org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
   2400 	    #'org-clock-modify-effort-estimate)
   2401 (org-defkey org-agenda-mode-map "\C-c\C-xp" #'org-agenda-set-property)
   2402 (org-defkey org-agenda-mode-map "q" #'org-agenda-quit)
   2403 (org-defkey org-agenda-mode-map "Q" #'org-agenda-Quit)
   2404 (org-defkey org-agenda-mode-map "x" #'org-agenda-exit)
   2405 (org-defkey org-agenda-mode-map "\C-x\C-w" #'org-agenda-write)
   2406 (org-defkey org-agenda-mode-map "\C-x\C-s" #'org-save-all-org-buffers)
   2407 (org-defkey org-agenda-mode-map "s" #'org-save-all-org-buffers)
   2408 (org-defkey org-agenda-mode-map "T" #'org-agenda-show-tags)
   2409 (org-defkey org-agenda-mode-map "n" #'org-agenda-next-line)
   2410 (org-defkey org-agenda-mode-map "p" #'org-agenda-previous-line)
   2411 (org-defkey org-agenda-mode-map "N" #'org-agenda-next-item)
   2412 (org-defkey org-agenda-mode-map "P" #'org-agenda-previous-item)
   2413 (substitute-key-definition #'next-line #'org-agenda-next-line
   2414 			   org-agenda-mode-map global-map)
   2415 (substitute-key-definition #'previous-line #'org-agenda-previous-line
   2416 			   org-agenda-mode-map global-map)
   2417 (org-defkey org-agenda-mode-map "\C-c\C-a" #'org-attach)
   2418 (org-defkey org-agenda-mode-map "\C-c\C-n" #'org-agenda-next-date-line)
   2419 (org-defkey org-agenda-mode-map "\C-c\C-p" #'org-agenda-previous-date-line)
   2420 (org-defkey org-agenda-mode-map "\C-c," #'org-agenda-priority)
   2421 (org-defkey org-agenda-mode-map "," #'org-agenda-priority)
   2422 (org-defkey org-agenda-mode-map "i" #'org-agenda-diary-entry)
   2423 (org-defkey org-agenda-mode-map "c" #'org-agenda-goto-calendar)
   2424 (org-defkey org-agenda-mode-map "C" #'org-agenda-convert-date)
   2425 (org-defkey org-agenda-mode-map "M" #'org-agenda-phases-of-moon)
   2426 (org-defkey org-agenda-mode-map "S" #'org-agenda-sunrise-sunset)
   2427 (org-defkey org-agenda-mode-map "h" #'org-agenda-holidays)
   2428 (org-defkey org-agenda-mode-map "H" #'org-agenda-holidays)
   2429 (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" #'org-agenda-clock-in)
   2430 (org-defkey org-agenda-mode-map "I" #'org-agenda-clock-in)
   2431 (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" #'org-agenda-clock-out)
   2432 (org-defkey org-agenda-mode-map "O" #'org-agenda-clock-out)
   2433 (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" #'org-agenda-clock-cancel)
   2434 (org-defkey org-agenda-mode-map "X" #'org-agenda-clock-cancel)
   2435 (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" #'org-clock-goto)
   2436 (org-defkey org-agenda-mode-map "J" #'org-agenda-clock-goto)
   2437 (org-defkey org-agenda-mode-map "+" #'org-agenda-priority-up)
   2438 (org-defkey org-agenda-mode-map "-" #'org-agenda-priority-down)
   2439 (org-defkey org-agenda-mode-map [(shift up)] #'org-agenda-priority-up)
   2440 (org-defkey org-agenda-mode-map [(shift down)] #'org-agenda-priority-down)
   2441 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] #'org-agenda-priority-up)
   2442 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] #'org-agenda-priority-down)
   2443 (org-defkey org-agenda-mode-map "f" #'org-agenda-later)
   2444 (org-defkey org-agenda-mode-map "b" #'org-agenda-earlier)
   2445 (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" #'org-agenda-columns)
   2446 (org-defkey org-agenda-mode-map "\C-c\C-x>" #'org-agenda-remove-restriction-lock)
   2447 (org-defkey org-agenda-mode-map "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda)
   2448 (org-defkey org-agenda-mode-map "[" #'org-agenda-manipulate-query-add)
   2449 (org-defkey org-agenda-mode-map "]" #'org-agenda-manipulate-query-subtract)
   2450 (org-defkey org-agenda-mode-map "{" #'org-agenda-manipulate-query-add-re)
   2451 (org-defkey org-agenda-mode-map "}" #'org-agenda-manipulate-query-subtract-re)
   2452 (org-defkey org-agenda-mode-map "\\" #'org-agenda-filter-by-tag)
   2453 (org-defkey org-agenda-mode-map "_" #'org-agenda-filter-by-effort)
   2454 (org-defkey org-agenda-mode-map "=" #'org-agenda-filter-by-regexp)
   2455 (org-defkey org-agenda-mode-map "/" #'org-agenda-filter)
   2456 (org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all)
   2457 (org-defkey org-agenda-mode-map "~" #'org-agenda-limit-interactively)
   2458 (org-defkey org-agenda-mode-map "<" #'org-agenda-filter-by-category)
   2459 (org-defkey org-agenda-mode-map "^" #'org-agenda-filter-by-top-headline)
   2460 (org-defkey org-agenda-mode-map ";" #'org-timer-set-timer)
   2461 (org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop)
   2462 (org-defkey org-agenda-mode-map "?" #'org-agenda-show-the-flagging-note)
   2463 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" #'org-mobile-pull)
   2464 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" #'org-mobile-push)
   2465 (org-defkey org-agenda-mode-map "\C-c\C-xI" #'org-info-find-node)
   2466 (org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse)
   2467 (org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse)
   2468 (org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block)
   2469 (org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block)
   2470 (org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c)
   2471 
   2472 (when org-agenda-mouse-1-follows-link
   2473   (org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
   2474 
   2475 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu."
   2476   '("Agenda"
   2477     ("Agenda Files")
   2478     "--"
   2479     ("Agenda Dates"
   2480      ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)]
   2481      ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
   2482      ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
   2483      ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
   2484     "--"
   2485     ("View"
   2486      ["Day View" org-agenda-day-view
   2487       :active (org-agenda-check-type nil 'agenda)
   2488       :style radio :selected (eq org-agenda-current-span 'day)
   2489       :keys "v d  (or just d)"]
   2490      ["Week View" org-agenda-week-view
   2491       :active (org-agenda-check-type nil 'agenda)
   2492       :style radio :selected (eq org-agenda-current-span 'week)
   2493       :keys "v w"]
   2494      ["Fortnight View" org-agenda-fortnight-view
   2495       :active (org-agenda-check-type nil 'agenda)
   2496       :style radio :selected (eq org-agenda-current-span 'fortnight)
   2497       :keys "v t"]
   2498      ["Month View" org-agenda-month-view
   2499       :active (org-agenda-check-type nil 'agenda)
   2500       :style radio :selected (eq org-agenda-current-span 'month)
   2501       :keys "v m"]
   2502      ["Year View" org-agenda-year-view
   2503       :active (org-agenda-check-type nil 'agenda)
   2504       :style radio :selected (eq org-agenda-current-span 'year)
   2505       :keys "v y"]
   2506      "--"
   2507      ["Include Diary" org-agenda-toggle-diary
   2508       :style toggle :selected org-agenda-include-diary
   2509       :active (org-agenda-check-type nil 'agenda)]
   2510      ["Include Deadlines" org-agenda-toggle-deadlines
   2511       :style toggle :selected org-agenda-include-deadlines
   2512       :active (org-agenda-check-type nil 'agenda)]
   2513      ["Use Time Grid" org-agenda-toggle-time-grid
   2514       :style toggle :selected org-agenda-use-time-grid
   2515       :active (org-agenda-check-type nil 'agenda)]
   2516      "--"
   2517      ["Show clock report" org-agenda-clockreport-mode
   2518       :style toggle :selected org-agenda-clockreport-mode
   2519       :active (org-agenda-check-type nil 'agenda)]
   2520      ["Show some entry text" org-agenda-entry-text-mode
   2521       :style toggle :selected org-agenda-entry-text-mode
   2522       :active t]
   2523      "--"
   2524      ["Show Logbook entries" org-agenda-log-mode
   2525       :style toggle :selected org-agenda-show-log
   2526       :active (org-agenda-check-type nil 'agenda)
   2527       :keys "v l (or just l)"]
   2528      ["Include archived trees" org-agenda-archives-mode
   2529       :style toggle :selected org-agenda-archives-mode :active t
   2530       :keys "v a"]
   2531      ["Include archive files" (org-agenda-archives-mode t)
   2532       :style toggle :selected (eq org-agenda-archives-mode t) :active t
   2533       :keys "v A"]
   2534      "--"
   2535      ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
   2536     ("Filter current view"
   2537      ["with generic interface" org-agenda-filter t]
   2538      "--"
   2539      ["by category at cursor" org-agenda-filter-by-category t]
   2540      ["by tag" org-agenda-filter-by-tag t]
   2541      ["by effort" org-agenda-filter-by-effort t]
   2542      ["by regexp" org-agenda-filter-by-regexp t]
   2543      ["by top-level headline" org-agenda-filter-by-top-headline t]
   2544      "--"
   2545      ["Remove all filtering" org-agenda-filter-remove-all t]
   2546      "--"
   2547      ["limit" org-agenda-limit-interactively t])
   2548     ["Rebuild buffer" org-agenda-redo t]
   2549     ["Write view to file" org-agenda-write t]
   2550     ["Save all Org buffers" org-save-all-org-buffers t]
   2551     "--"
   2552     ["Show original entry" org-agenda-show t]
   2553     ["Go To (other window)" org-agenda-goto t]
   2554     ["Go To (this window)" org-agenda-switch-to t]
   2555     ["Capture with cursor date" org-agenda-capture t]
   2556     ["Follow Mode" org-agenda-follow-mode
   2557      :style toggle :selected org-agenda-follow-mode :active t]
   2558     ;;    ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
   2559     "--"
   2560     ("TODO"
   2561      ["Cycle TODO" org-agenda-todo t]
   2562      ["Next TODO set" org-agenda-todo-nextset t]
   2563      ["Previous TODO set" org-agenda-todo-previousset t]
   2564      ["Add note" org-agenda-add-note t])
   2565     ("Archive/Refile/Delete"
   2566      ["Archive default" org-agenda-archive-default t]
   2567      ["Archive default" org-agenda-archive-default-with-confirmation t]
   2568      ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
   2569      ["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
   2570      ["Archive subtree" org-agenda-archive t]
   2571      "--"
   2572      ["Refile" org-agenda-refile t]
   2573      "--"
   2574      ["Delete subtree" org-agenda-kill t])
   2575     ("Bulk action"
   2576      ["Mark entry" org-agenda-bulk-mark t]
   2577      ["Mark all" org-agenda-bulk-mark-all t]
   2578      ["Unmark entry" org-agenda-bulk-unmark t]
   2579      ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"]
   2580      ["Toggle mark" org-agenda-bulk-toggle t]
   2581      ["Toggle all" org-agenda-bulk-toggle-all t]
   2582      ["Mark regexp" org-agenda-bulk-mark-regexp t])
   2583     ["Act on all marked" org-agenda-bulk-action t]
   2584     "--"
   2585     ("Tags and Properties"
   2586      ["Show all Tags" org-agenda-show-tags t]
   2587      ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))]
   2588      ["Change tag in region" org-agenda-set-tags (org-region-active-p)]
   2589      "--"
   2590      ["Column View" org-columns t])
   2591     ("Deadline/Schedule"
   2592      ["Schedule" org-agenda-schedule t]
   2593      ["Set Deadline" org-agenda-deadline t]
   2594      "--"
   2595      ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)]
   2596      ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)]
   2597      ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"]
   2598      ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"]
   2599      ["Change Time +  min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"]
   2600      ["Change Time -  min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"]
   2601      ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)])
   2602     ("Clock and Effort"
   2603      ["Clock in" org-agenda-clock-in t]
   2604      ["Clock out" org-agenda-clock-out t]
   2605      ["Clock cancel" org-agenda-clock-cancel t]
   2606      ["Goto running clock" org-clock-goto t]
   2607      "--"
   2608      ["Set Effort" org-agenda-set-effort t]
   2609      ["Change clocked effort" org-clock-modify-effort-estimate
   2610       (org-clock-is-active)])
   2611     ("Priority"
   2612      ["Set Priority" org-agenda-priority t]
   2613      ["Increase Priority" org-agenda-priority-up t]
   2614      ["Decrease Priority" org-agenda-priority-down t]
   2615      ["Show Priority" org-priority-show t])
   2616     ("Calendar/Diary"
   2617      ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)]
   2618      ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)]
   2619      ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)]
   2620      ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)]
   2621      ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)]
   2622      ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)]
   2623      "--"
   2624      ["Create iCalendar File" org-icalendar-combine-agenda-files t])
   2625     "--"
   2626     ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
   2627     "--"
   2628     ("MobileOrg"
   2629      ["Push Files and Views" org-mobile-push t]
   2630      ["Get Captured and Flagged" org-mobile-pull t]
   2631      ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"]
   2632      ["Show note / unflag" org-agenda-show-the-flagging-note t]
   2633      "--"
   2634      ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
   2635     "--"
   2636     ["Quit" org-agenda-quit t]
   2637     ["Exit and Release Buffers" org-agenda-exit t]
   2638     ))
   2639 
   2640 ;;; Agenda undo
   2641 
   2642 (defvar org-agenda-allow-remote-undo t
   2643   "Non-nil means allow remote undo from the agenda buffer.")
   2644 (defvar org-agenda-undo-has-started-in nil
   2645   "Buffers that have already seen `undo-start' in the current undo sequence.")
   2646 
   2647 (defun org-agenda-undo ()
   2648   "Undo a remote editing step in the agenda.
   2649 This undoes changes both in the agenda buffer and in the remote buffer
   2650 that have been changed along."
   2651   (interactive)
   2652   (or org-agenda-allow-remote-undo
   2653       (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
   2654   (when (not (eq this-command last-command))
   2655     (setq org-agenda-undo-has-started-in nil
   2656 	  org-agenda-pending-undo-list org-agenda-undo-list))
   2657   (when (not org-agenda-pending-undo-list)
   2658     (user-error "No further undo information"))
   2659   (let* ((entry (pop org-agenda-pending-undo-list))
   2660 	 buf line cmd rembuf)
   2661     (setq cmd (pop entry) line (pop entry))
   2662     (setq rembuf (nth 2 entry))
   2663     (org-with-remote-undo rembuf
   2664       (while (bufferp (setq buf (pop entry)))
   2665 	(when (pop entry)
   2666 	  (with-current-buffer buf
   2667 	    (let (;; (last-undo-buffer buf)
   2668                   (inhibit-read-only t))
   2669 	      (unless (memq buf org-agenda-undo-has-started-in)
   2670 		(push buf org-agenda-undo-has-started-in)
   2671 		(make-local-variable 'pending-undo-list)
   2672 		(undo-start))
   2673 	      (while (and pending-undo-list
   2674 			  (listp pending-undo-list)
   2675 			  (not (car pending-undo-list)))
   2676 		(pop pending-undo-list))
   2677 	      (undo-more 1))))))
   2678     (org-goto-line line)
   2679     (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf))))
   2680 
   2681 (defun org-verify-change-for-undo (l1 l2)
   2682   "Verify that a real change occurred between the undo lists L1 and L2."
   2683   (while (and l1 (listp l1) (null (car l1))) (pop l1))
   2684   (while (and l2 (listp l2) (null (car l2))) (pop l2))
   2685   (not (eq l1 l2)))
   2686 
   2687 ;;; Agenda dispatch
   2688 
   2689 (defvar org-agenda-restrict-begin (make-marker))
   2690 (defvar org-agenda-restrict-end (make-marker))
   2691 (defvar org-agenda-last-dispatch-buffer nil)
   2692 (defvar org-agenda-overriding-restriction nil)
   2693 
   2694 (defcustom org-agenda-custom-commands-contexts nil
   2695   "Alist of custom agenda keys and contextual rules.
   2696 
   2697 For example, if you have a custom agenda command \"p\" and you
   2698 want this command to be accessible only from plain text files,
   2699 use this:
   2700 
   2701    \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\"))))
   2702 
   2703 Here are the available contexts definitions:
   2704 
   2705       in-file: command displayed only in matching files
   2706       in-mode: command displayed only in matching modes
   2707   not-in-file: command not displayed in matching files
   2708   not-in-mode: command not displayed in matching modes
   2709     in-buffer: command displayed only in matching buffers
   2710 not-in-buffer: command not displayed in matching buffers
   2711    [function]: a custom function taking no argument
   2712 
   2713 If you define several checks, the agenda command will be
   2714 accessible if there is at least one valid check.
   2715 
   2716 You can also bind a key to another agenda custom command
   2717 depending on contextual rules.
   2718 
   2719     \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\"))))
   2720 
   2721 Here it means: in .txt files, use \"p\" as the key for the
   2722 agenda command otherwise associated with \"q\".  (The command
   2723 originally associated with \"q\" is not displayed to avoid
   2724 duplicates.)"
   2725   :version "24.3"
   2726   :group 'org-agenda-custom-commands
   2727   :type '(repeat (list :tag "Rule"
   2728 		       (string :tag "        Agenda key")
   2729 		       (string :tag "Replace by command")
   2730 		       (repeat :tag "Available when"
   2731 			       (choice
   2732 				(cons :tag "Condition"
   2733 				      (choice
   2734 				       (const :tag "In file" in-file)
   2735 				       (const :tag "Not in file" not-in-file)
   2736 				       (const :tag "In buffer" in-buffer)
   2737 				       (const :tag "Not in buffer" not-in-buffer)
   2738 				       (const :tag "In mode" in-mode)
   2739 				       (const :tag "Not in mode" not-in-mode))
   2740 				      (regexp))
   2741 				(function :tag "Custom function"))))))
   2742 
   2743 (defcustom org-agenda-max-entries nil
   2744   "Maximum number of entries to display in an agenda.
   2745 This can be nil (no limit) or an integer or an alist of agenda
   2746 types with an associated number of entries to display in this
   2747 type."
   2748   :version "24.4"
   2749   :package-version '(Org . "8.0")
   2750   :group 'org-agenda-custom-commands
   2751   :type '(choice (symbol :tag "No limit" nil)
   2752 		 (integer :tag "Max number of entries")
   2753 		 (repeat
   2754 		  (cons (choice :tag "Agenda type"
   2755 				(const agenda)
   2756 				(const todo)
   2757 				(const tags)
   2758 				(const search))
   2759 			(integer :tag "Max number of entries")))))
   2760 
   2761 (defcustom org-agenda-max-todos nil
   2762   "Maximum number of TODOs to display in an agenda.
   2763 This can be nil (no limit) or an integer or an alist of agenda
   2764 types with an associated number of entries to display in this
   2765 type."
   2766   :version "24.4"
   2767   :package-version '(Org . "8.0")
   2768   :group 'org-agenda-custom-commands
   2769   :type '(choice (symbol :tag "No limit" nil)
   2770 		 (integer :tag "Max number of TODOs")
   2771 		 (repeat
   2772 		  (cons (choice :tag "Agenda type"
   2773 				(const agenda)
   2774 				(const todo)
   2775 				(const tags)
   2776 				(const search))
   2777 			(integer :tag "Max number of TODOs")))))
   2778 
   2779 (defcustom org-agenda-max-tags nil
   2780   "Maximum number of tagged entries to display in an agenda.
   2781 This can be nil (no limit) or an integer or an alist of agenda
   2782 types with an associated number of entries to display in this
   2783 type."
   2784   :version "24.4"
   2785   :package-version '(Org . "8.0")
   2786   :group 'org-agenda-custom-commands
   2787   :type '(choice (symbol :tag "No limit" nil)
   2788 		 (integer :tag "Max number of tagged entries")
   2789 		 (repeat
   2790 		  (cons (choice :tag "Agenda type"
   2791 				(const agenda)
   2792 				(const todo)
   2793 				(const tags)
   2794 				(const search))
   2795 			(integer :tag "Max number of tagged entries")))))
   2796 
   2797 (defcustom org-agenda-max-effort nil
   2798   "Maximum cumulated effort duration for the agenda.
   2799 This can be nil (no limit) or a number of minutes (as an integer)
   2800 or an alist of agenda types with an associated number of minutes
   2801 to limit entries to in this type."
   2802   :version "24.4"
   2803   :package-version '(Org . "8.0")
   2804   :group 'org-agenda-custom-commands
   2805   :type '(choice (symbol :tag "No limit" nil)
   2806 		 (integer :tag "Max number of minutes")
   2807 		 (repeat
   2808 		  (cons (choice :tag "Agenda type"
   2809 				(const agenda)
   2810 				(const todo)
   2811 				(const tags)
   2812 				(const search))
   2813 			(integer :tag "Max number of minutes")))))
   2814 
   2815 (defvar org-agenda-keep-restricted-file-list nil)
   2816 (defvar org-keys nil)
   2817 (defvar org-match nil)
   2818 ;;;###autoload
   2819 (defun org-agenda (&optional arg keys restriction)
   2820   "Dispatch agenda commands to collect entries to the agenda buffer.
   2821 Prompts for a command to execute.  Any prefix arg will be passed
   2822 on to the selected command.  The default selections are:
   2823 
   2824 a     Call `org-agenda-list' to display the agenda for current day or week.
   2825 t     Call `org-todo-list' to display the global todo list.
   2826 T     Call `org-todo-list' to display the global todo list, select only
   2827       entries with a specific TODO keyword (the user gets a prompt).
   2828 m     Call `org-tags-view' to display headlines with tags matching
   2829       a condition  (the user is prompted for the condition).
   2830 M     Like `m', but select only TODO entries, no ordinary headlines.
   2831 e     Export views to associated files.
   2832 s     Search entries for keywords.
   2833 S     Search entries for keywords, only with TODO keywords.
   2834 /     Multi occur across all agenda files and also files listed
   2835       in `org-agenda-text-search-extra-files'.
   2836 <     Restrict agenda commands to buffer, subtree, or region.
   2837       Press several times to get the desired effect.
   2838 >     Remove a previous restriction.
   2839 #     List \"stuck\" projects.
   2840 !     Configure what \"stuck\" means.
   2841 C     Configure custom agenda commands.
   2842 
   2843 More commands can be added by configuring the variable
   2844 `org-agenda-custom-commands'.  In particular, specific tags and TODO keyword
   2845 searches can be pre-defined in this way.
   2846 
   2847 If the current buffer is in Org mode and visiting a file, you can also
   2848 first press `<' once to indicate that the agenda should be temporarily
   2849 \(until the next use of `\\[org-agenda]') restricted to the current file.
   2850 Pressing `<' twice means to restrict to the current subtree or region
   2851 \(if active)."
   2852   (interactive "P")
   2853   (catch 'exit
   2854     (let* ((org-keys keys)
   2855 	   (prefix-descriptions nil)
   2856 	   (org-agenda-buffer-name org-agenda-buffer-name)
   2857 	   (org-agenda-window-setup (if (equal (buffer-name)
   2858 					       org-agenda-buffer-name)
   2859 					'current-window
   2860 				      org-agenda-window-setup))
   2861 	   (org-agenda-custom-commands-orig org-agenda-custom-commands)
   2862 	   (org-agenda-custom-commands
   2863 	    ;; normalize different versions
   2864 	    (delq nil
   2865 		  (mapcar
   2866 		   (lambda (x)
   2867 		     (cond ((stringp (cdr x))
   2868 			    (push x prefix-descriptions)
   2869 			    nil)
   2870 			   ((stringp (nth 1 x)) x)
   2871 			   ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
   2872 			   (t (cons (car x) (cons "" (cdr x))))))
   2873 		   org-agenda-custom-commands)))
   2874 	   (org-agenda-custom-commands
   2875 	    (org-contextualize-keys
   2876 	     org-agenda-custom-commands org-agenda-custom-commands-contexts))
   2877 	   ;; (buf (current-buffer))
   2878 	   (bfn (buffer-file-name (buffer-base-buffer)))
   2879 	   entry type org-match lprops ans) ;; key
   2880       ;; Turn off restriction unless there is an overriding one,
   2881       (unless org-agenda-overriding-restriction
   2882 	(unless org-agenda-keep-restricted-file-list
   2883 	  ;; There is a request to keep the file list in place
   2884 	  (put 'org-agenda-files 'org-restrict nil))
   2885 	(setq org-agenda-restrict nil)
   2886 	(move-marker org-agenda-restrict-begin nil)
   2887 	(move-marker org-agenda-restrict-end nil))
   2888       ;; Delete old local properties
   2889       (put 'org-agenda-redo-command 'org-lprops nil)
   2890       ;; Delete previously set last-arguments
   2891       (put 'org-agenda-redo-command 'last-args nil)
   2892       ;; Remember where this call originated
   2893       (setq org-agenda-last-dispatch-buffer (current-buffer))
   2894       (unless org-keys
   2895 	(setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
   2896 	      org-keys (car ans)
   2897 	      restriction (cdr ans)))
   2898       ;; If we have sticky agenda buffers, set a name for the buffer,
   2899       ;; depending on the invoking keys.  The user may still set this
   2900       ;; as a command option, which will overwrite what we do here.
   2901       (when org-agenda-sticky
   2902 	(setq org-agenda-buffer-name
   2903 	      (format "*Org Agenda(%s)*" org-keys)))
   2904       ;; Establish the restriction, if any
   2905       (when (and (not org-agenda-overriding-restriction) restriction)
   2906 	(put 'org-agenda-files 'org-restrict (list bfn))
   2907 	(cond
   2908 	 ((eq restriction 'region)
   2909 	  (setq org-agenda-restrict (current-buffer))
   2910 	  (move-marker org-agenda-restrict-begin (region-beginning))
   2911 	  (move-marker org-agenda-restrict-end (region-end)))
   2912 	 ((eq restriction 'subtree)
   2913 	  (save-excursion
   2914 	    (setq org-agenda-restrict (current-buffer))
   2915 	    (org-back-to-heading t)
   2916 	    (move-marker org-agenda-restrict-begin (point))
   2917 	    (move-marker org-agenda-restrict-end
   2918 			 (progn (org-end-of-subtree t)))))
   2919 	 ((and (eq restriction 'buffer)
   2920 	       (or (< 1 (point-min))
   2921 		   (< (point-max) (1+ (buffer-size)))))
   2922 	  (setq org-agenda-restrict (current-buffer))
   2923 	  (move-marker org-agenda-restrict-begin (point-min))
   2924 	  (move-marker org-agenda-restrict-end (point-max)))))
   2925 
   2926       ;; For example the todo list should not need it (but does...)
   2927       (cond
   2928        ((setq entry (assoc org-keys org-agenda-custom-commands))
   2929 	(if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
   2930 	    (progn
   2931 	      ;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars)
   2932               ;; to some of the local variables?  There's no doc about
   2933               ;; that for `org-agenda-custom-commands'.
   2934 	      (setq type (nth 2 entry) org-match (eval (nth 3 entry) t)
   2935 		    lprops (nth 4 entry))
   2936 	      (when org-agenda-sticky
   2937 		(setq org-agenda-buffer-name
   2938 		      (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
   2939 			  (format "*Org Agenda(%s)*" org-keys))))
   2940 	      (put 'org-agenda-redo-command 'org-lprops lprops)
   2941 	      (cl-progv
   2942 	          (mapcar #'car lprops)
   2943 	          (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
   2944 	        (pcase type
   2945 	          (`agenda
   2946 	           (org-agenda-list current-prefix-arg))
   2947 	          (`agenda*
   2948 	           (org-agenda-list current-prefix-arg nil nil t))
   2949 	          (`alltodo
   2950 	           (org-todo-list current-prefix-arg))
   2951 	          (`search
   2952 	           (org-search-view current-prefix-arg org-match nil))
   2953 	          (`stuck
   2954 	           (org-agenda-list-stuck-projects current-prefix-arg))
   2955 	          (`tags
   2956 	           (org-tags-view current-prefix-arg org-match))
   2957 	          (`tags-todo
   2958 	           (org-tags-view '(4) org-match))
   2959 	          (`todo
   2960 		   (org-todo-list org-match))
   2961 		  (`tags-tree
   2962 		   (org-check-for-org-mode)
   2963 		   (org-match-sparse-tree current-prefix-arg org-match))
   2964 		  (`todo-tree
   2965 		   (org-check-for-org-mode)
   2966 		   (org-occur (concat "^" org-outline-regexp "[ \t]*"
   2967 				      (regexp-quote org-match) "\\>")))
   2968 		  (`occur-tree
   2969 		   (org-check-for-org-mode)
   2970 		   (org-occur org-match))
   2971 		  ((pred functionp)
   2972 		   (funcall type org-match))
   2973 		  ;; FIXME: Will signal an error since it's not `functionp'!
   2974 		  ((pred fboundp) (funcall type org-match))
   2975 		  (_ (user-error "Invalid custom agenda command type %s" type)))))
   2976 	  (org-agenda-run-series (nth 1 entry) (cddr entry))))
   2977        ((equal org-keys "C")
   2978 	(setq org-agenda-custom-commands org-agenda-custom-commands-orig)
   2979 	(customize-variable 'org-agenda-custom-commands))
   2980        ((equal org-keys "a") (call-interactively 'org-agenda-list))
   2981        ((equal org-keys "s") (call-interactively 'org-search-view))
   2982        ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4))))
   2983        ((equal org-keys "t") (call-interactively 'org-todo-list))
   2984        ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
   2985        ((equal org-keys "m") (call-interactively 'org-tags-view))
   2986        ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
   2987        ((equal org-keys "e") (call-interactively 'org-store-agenda-views))
   2988        ((equal org-keys "?") (org-tags-view nil "+FLAGGED")
   2989 	(add-hook
   2990 	 'post-command-hook
   2991 	 (lambda ()
   2992 	   (unless (current-message)
   2993 	     (let* ((m (org-agenda-get-any-marker))
   2994 		    (note (and m (org-entry-get m "THEFLAGGINGNOTE"))))
   2995 	       (when note
   2996 		 (message "FLAGGING-NOTE ([?] for more info): %s"
   2997 			  (org-add-props
   2998 			      (replace-regexp-in-string
   2999 			       "\\\\n" "//"
   3000 			       (copy-sequence note))
   3001 			      nil 'face 'org-warning))))))
   3002 	 t t))
   3003        ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
   3004        ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
   3005        ((equal org-keys "!") (customize-variable 'org-stuck-projects))
   3006        (t (user-error "Invalid agenda key"))))))
   3007 
   3008 (defvar org-agenda-multi)
   3009 
   3010 (defun org-agenda-append-agenda ()
   3011   "Append another agenda view to the current one.
   3012 This function allows interactive building of block agendas.
   3013 Agenda views are separated by `org-agenda-block-separator'."
   3014   (interactive)
   3015   (unless (derived-mode-p 'org-agenda-mode)
   3016     (user-error "Can only append from within agenda buffer"))
   3017   (let ((org-agenda-multi t))
   3018     (org-agenda)
   3019     (widen)
   3020     (org-agenda-finalize)
   3021     (setq buffer-read-only t)
   3022     (org-agenda-fit-window-to-buffer)))
   3023 
   3024 (defun org-agenda-normalize-custom-commands (cmds)
   3025   "Normalize custom commands CMDS."
   3026   (delq nil
   3027 	(mapcar
   3028 	 (lambda (x)
   3029 	   (cond ((stringp (cdr x)) nil)
   3030 		 ((stringp (nth 1 x)) x)
   3031 		 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
   3032 		 (t (cons (car x) (cons "" (cdr x))))))
   3033 	 cmds)))
   3034 
   3035 (defun org-agenda-get-restriction-and-command (prefix-descriptions)
   3036   "The user interface for selecting an agenda command."
   3037   (catch 'exit
   3038     (let* ((bfn (buffer-file-name (buffer-base-buffer)))
   3039 	   (restrict-ok (and bfn (derived-mode-p 'org-mode)))
   3040 	   (region-p (org-region-active-p))
   3041 	   (custom org-agenda-custom-commands)
   3042 	   (selstring "")
   3043 	   restriction second-time
   3044 	   c entry key type match prefixes rmheader header-end custom1 desc
   3045 	   line lines left right n n1)
   3046       (save-window-excursion
   3047 	(delete-other-windows)
   3048 	(org-switch-to-buffer-other-window " *Agenda Commands*")
   3049 	(erase-buffer)
   3050 	(insert (eval-when-compile
   3051 		  (let ((header
   3052 			 (copy-sequence
   3053 			  "Press key for an agenda command:
   3054 --------------------------------        <   Buffer, subtree/region restriction
   3055 a   Agenda for current week or day      >   Remove restriction
   3056 t   List of all TODO entries            e   Export agenda views
   3057 m   Match a TAGS/PROP/TODO query        T   Entries with special TODO kwd
   3058 s   Search for keywords                 M   Like m, but only TODO entries
   3059 /   Multi-occur                         S   Like s, but only TODO entries
   3060 ?   Find :FLAGGED: entries              C   Configure custom agenda commands
   3061 *   Toggle sticky agenda views          #   List stuck projects (!=configure)
   3062 "))
   3063 			(start 0))
   3064 		    (while (string-match
   3065 			    "\\(^\\|   \\|(\\)\\(\\S-\\)\\( \\|=\\)"
   3066 			    header start)
   3067 		      (setq start (match-end 0))
   3068 		      (add-text-properties (match-beginning 2) (match-end 2)
   3069 					   '(face bold) header))
   3070 		    header)))
   3071 	(setq header-end (point-marker))
   3072 	(while t
   3073 	  (setq custom1 custom)
   3074 	  (when (eq rmheader t)
   3075 	    (org-goto-line 1)
   3076 	    (re-search-forward ":" nil t)
   3077 	    (delete-region (match-end 0) (point-at-eol))
   3078 	    (forward-char 1)
   3079 	    (looking-at "-+")
   3080 	    (delete-region (match-end 0) (point-at-eol))
   3081 	    (move-marker header-end (match-end 0)))
   3082 	  (goto-char header-end)
   3083 	  (delete-region (point) (point-max))
   3084 
   3085 	  ;; Produce all the lines that describe custom commands and prefixes
   3086 	  (setq lines nil)
   3087 	  (while (setq entry (pop custom1))
   3088 	    (setq key (car entry) desc (nth 1 entry)
   3089 		  type (nth 2 entry)
   3090 		  match (nth 3 entry))
   3091 	    (if (> (length key) 1)
   3092 		(cl-pushnew (string-to-char key) prefixes :test #'equal)
   3093 	      (setq line
   3094 		    (format
   3095 		     "%-4s%-14s"
   3096 		     (org-add-props (copy-sequence key)
   3097 			 '(face bold))
   3098 		     (cond
   3099 		      ((string-match "\\S-" desc) desc)
   3100 		      ((eq type 'agenda) "Agenda for current week or day")
   3101 		      ((eq type 'agenda*) "Appointments for current week or day")
   3102 		      ((eq type 'alltodo) "List of all TODO entries")
   3103 		      ((eq type 'search) "Word search")
   3104 		      ((eq type 'stuck) "List of stuck projects")
   3105 		      ((eq type 'todo) "TODO keyword")
   3106 		      ((eq type 'tags) "Tags query")
   3107 		      ((eq type 'tags-todo) "Tags (TODO)")
   3108 		      ((eq type 'tags-tree) "Tags tree")
   3109 		      ((eq type 'todo-tree) "TODO kwd tree")
   3110 		      ((eq type 'occur-tree) "Occur tree")
   3111 		      ((functionp type) (if (symbolp type)
   3112 					    (symbol-name type)
   3113 					  "Lambda expression"))
   3114 		      (t "???"))))
   3115 	      (cond
   3116 	       ((not (org-string-nw-p match)) nil)
   3117 	       (org-agenda-menu-show-matcher
   3118 		(setq line
   3119 		      (concat line ": "
   3120 			      (cond
   3121 			       ((stringp match)
   3122 				(propertize match 'face 'org-warning))
   3123 			       ((listp type)
   3124 				(format "set of %d commands" (length type)))))))
   3125 	       (t
   3126 		(org-add-props line nil 'help-echo (concat "Matcher: " match))))
   3127 	      (push line lines)))
   3128 	  (setq lines (nreverse lines))
   3129 	  (when prefixes
   3130 	    (mapc (lambda (x)
   3131 		    (push
   3132 		     (format "%s   %s"
   3133 			     (org-add-props (char-to-string x)
   3134 				 nil 'face 'bold)
   3135 			     (or (cdr (assoc (concat selstring
   3136 						     (char-to-string x))
   3137 					     prefix-descriptions))
   3138 				 "Prefix key"))
   3139 		     lines))
   3140 		  prefixes))
   3141 
   3142 	  ;; Check if we should display in two columns
   3143 	  (if org-agenda-menu-two-columns
   3144 	      (progn
   3145 		(setq n (length lines)
   3146 		      n1 (+ (/ n 2) (mod n 2))
   3147 		      right (nthcdr n1 lines)
   3148 		      left (copy-sequence lines))
   3149 		(setcdr (nthcdr (1- n1) left) nil))
   3150 	    (setq left lines right nil))
   3151 	  (while left
   3152 	    (insert "\n" (pop left))
   3153 	    (when right
   3154 	      (if (< (current-column) 40)
   3155 		  (move-to-column 40 t)
   3156 		(insert "   "))
   3157 	      (insert (pop right))))
   3158 
   3159 	  ;; Make the window the right size
   3160 	  (goto-char (point-min))
   3161 	  (if second-time
   3162 	      (when (not (pos-visible-in-window-p (point-max)))
   3163 		(org-fit-window-to-buffer))
   3164 	    (setq second-time t)
   3165 	    (org-fit-window-to-buffer))
   3166 
   3167 	  ;; Hint to navigation if window too small for all information
   3168 	  (setq header-line-format
   3169 		(when (not (pos-visible-in-window-p (point-max)))
   3170 		  "Use C-v, M-v, C-n or C-p to navigate."))
   3171 
   3172 	  ;; Ask for selection
   3173 	  (cl-loop
   3174 	   do (progn
   3175 		(message "Press key for agenda command%s:"
   3176 			 (if (or restrict-ok org-agenda-overriding-restriction)
   3177 			     (if org-agenda-overriding-restriction
   3178 				 " (restriction lock active)"
   3179 			       (if restriction
   3180 				   (format " (restricted to %s)" restriction)
   3181 				 " (unrestricted)"))
   3182 			   ""))
   3183 		(setq c (read-char-exclusive)))
   3184 	   until (not (memq c '(14 16 22 134217846)))
   3185 	   do (org-scroll c))
   3186 
   3187 	  (message "")
   3188 	  (cond
   3189 	   ((assoc (char-to-string c) custom)
   3190 	    (setq selstring (concat selstring (char-to-string c)))
   3191 	    (throw 'exit (cons selstring restriction)))
   3192 	   ((memq c prefixes)
   3193 	    (setq selstring (concat selstring (char-to-string c))
   3194 		  prefixes nil
   3195 		  rmheader (or rmheader t)
   3196 		  custom (delq nil (mapcar
   3197 				    (lambda (x)
   3198 				      (if (or (= (length (car x)) 1)
   3199 					      (/= (string-to-char (car x)) c))
   3200 					  nil
   3201 					(cons (substring (car x) 1) (cdr x))))
   3202 				    custom))))
   3203 	   ((eq c ?*)
   3204 	    (call-interactively 'org-toggle-sticky-agenda)
   3205 	    (sit-for 2))
   3206 	   ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
   3207 	    (message "Restriction is only possible in Org buffers")
   3208 	    (ding) (sit-for 1))
   3209 	   ((eq c ?1)
   3210 	    (org-agenda-remove-restriction-lock 'noupdate)
   3211 	    (setq restriction 'buffer))
   3212 	   ((eq c ?0)
   3213 	    (org-agenda-remove-restriction-lock 'noupdate)
   3214 	    (setq restriction (if region-p 'region 'subtree)))
   3215 	   ((eq c ?<)
   3216 	    (org-agenda-remove-restriction-lock 'noupdate)
   3217 	    (setq restriction
   3218 		  (cond
   3219 		   ((eq restriction 'buffer)
   3220 		    (if region-p 'region 'subtree))
   3221 		   ((memq restriction '(subtree region))
   3222 		    nil)
   3223 		   (t 'buffer))))
   3224 	   ((eq c ?>)
   3225 	    (org-agenda-remove-restriction-lock 'noupdate)
   3226 	    (setq restriction nil))
   3227 	   ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
   3228 	    (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
   3229            ((and (> (length selstring) 0) (eq c ?\d))
   3230             (delete-window)
   3231             (org-agenda-get-restriction-and-command prefix-descriptions))
   3232 
   3233 	   ((equal c ?q) (user-error "Abort"))
   3234 	   (t (user-error "Invalid key %c" c))))))))
   3235 
   3236 (defun org-agenda-fit-window-to-buffer ()
   3237   "Fit the window to the buffer size."
   3238   (and (memq org-agenda-window-setup '(reorganize-frame))
   3239        (fboundp 'fit-window-to-buffer)
   3240        (if (and (= (cdr org-agenda-window-frame-fractions) 1.0)
   3241 		(= (car org-agenda-window-frame-fractions) 1.0))
   3242 	   (delete-other-windows)
   3243 	 (org-fit-window-to-buffer
   3244 	  nil
   3245 	  (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
   3246 	  (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))))
   3247 
   3248 (defvar org-cmd nil)
   3249 (defvar org-agenda-overriding-cmd nil)
   3250 (defvar org-agenda-overriding-arguments nil)
   3251 (defvar org-agenda-overriding-cmd-arguments nil)
   3252 
   3253 (defun org-let (list &rest body) ;FIXME: So many kittens are suffering here.
   3254   (declare (indent 1) (obsolete cl-progv "2021"))
   3255   (eval (cons 'let (cons list body))))
   3256 
   3257 (defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go?
   3258   (declare (indent 2) (obsolete cl-progv "2021"))
   3259   (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
   3260 
   3261 (defun org-agenda-run-series (name series)
   3262   "Run agenda NAME as a SERIES of agenda commands."
   3263   (let* ((gprops (nth 1 series))
   3264          (gvars (mapcar #'car gprops))
   3265          (gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops)))
   3266     (cl-progv gvars gvals (org-agenda-prepare name))
   3267     ;; We need to reset agenda markers here, because when constructing a
   3268     ;; block agenda, the individual blocks do not do that.
   3269     (org-agenda-reset-markers)
   3270     (with-no-warnings
   3271       (defvar match))          ;Used via the `eval' below.
   3272     (let* ((org-agenda-multi t)
   3273 	   ;; FIXME: Redo should contain lists of (FUNS . ARGS) rather
   3274            ;; than expressions, so you don't need to `quote' the args
   3275            ;; and you just need to `apply' instead of `eval' when using it.
   3276 	   (redo (list 'org-agenda-run-series name (list 'quote series)))
   3277 	   (cmds (car series))
   3278 	   match
   3279 	   org-cmd type lprops)
   3280       (while (setq org-cmd (pop cmds))
   3281         (setq type (car org-cmd))
   3282         (setq match (eval (nth 1 org-cmd) t))
   3283         (setq lprops (nth 2 org-cmd))
   3284         (let ((org-agenda-overriding-arguments
   3285 	       (if (eq org-agenda-overriding-cmd org-cmd)
   3286 		   (or org-agenda-overriding-arguments
   3287 		       org-agenda-overriding-cmd-arguments)))
   3288               (lvars (mapcar #'car lprops))
   3289               (lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)))
   3290           (cl-progv (append gvars lvars) (append gvals lvals)
   3291 	    (pcase type
   3292 	      (`agenda
   3293 	       (call-interactively 'org-agenda-list))
   3294 	      (`agenda*
   3295 	       (funcall 'org-agenda-list nil nil t))
   3296 	      (`alltodo
   3297 	       (call-interactively 'org-todo-list))
   3298 	      (`search
   3299 	       (org-search-view current-prefix-arg match nil))
   3300 	      (`stuck
   3301 	       (call-interactively 'org-agenda-list-stuck-projects))
   3302 	      (`tags
   3303 	       (org-tags-view current-prefix-arg match))
   3304 	      (`tags-todo
   3305 	       (org-tags-view '(4) match))
   3306 	      (`todo
   3307 	       (org-todo-list match))
   3308 	      ((pred fboundp)
   3309 	       (funcall type match))
   3310 	      (_ (error "Invalid type in command series"))))))
   3311       (widen)
   3312       (let ((inhibit-read-only t))
   3313 	(add-text-properties (point-min) (point-max)
   3314 			     `(org-series t org-series-redo-cmd ,redo)))
   3315       (setq org-agenda-redo-command redo)
   3316       (goto-char (point-min)))
   3317     (org-agenda-fit-window-to-buffer)
   3318     (cl-progv gvars gvals (org-agenda-finalize))))
   3319 
   3320 (defun org-agenda--split-plist (plist)
   3321   ;; We could/should arguably use `map-keys' and `map-values'.
   3322   (let (keys vals)
   3323     (while plist
   3324       (push (pop plist) keys)
   3325       (push (pop plist) vals))
   3326     (cons (nreverse keys) (nreverse vals))))
   3327 
   3328 ;;;###autoload
   3329 (defmacro org-batch-agenda (cmd-key &rest parameters)
   3330   "Run an agenda command in batch mode and send the result to STDOUT.
   3331 If CMD-KEY is a string of length 1, it is used as a key in
   3332 `org-agenda-custom-commands' and triggers this command.  If it is a
   3333 longer string it is used as a tags/todo match string.
   3334 Parameters are alternating variable names and values that will be bound
   3335 before running the agenda command."
   3336   (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
   3337     `(org--batch-agenda ,cmd-key ',vars (list ,@exps))))
   3338 
   3339 (defun org--batch-agenda (cmd-key vars vals)
   3340   ;; `org-batch-agenda' is a macro because every other "parameter" is
   3341   ;; a variable name rather than an expression to evaluate.  Yuck!
   3342   (cl-progv vars vals
   3343     (let (org-agenda-sticky)
   3344       (if (> (length cmd-key) 1)
   3345 	  (org-tags-view nil cmd-key)
   3346 	(org-agenda nil cmd-key))))
   3347   (set-buffer org-agenda-buffer-name)
   3348   (princ (buffer-string)))
   3349 
   3350 (defvar org-agenda-info nil)
   3351 
   3352 ;;;###autoload
   3353 (defmacro org-batch-agenda-csv (cmd-key &rest parameters)
   3354   "Run an agenda command in batch mode and send the result to STDOUT.
   3355 If CMD-KEY is a string of length 1, it is used as a key in
   3356 `org-agenda-custom-commands' and triggers this command.  If it is a
   3357 longer string it is used as a tags/todo match string.
   3358 Parameters are alternating variable names and values that will be bound
   3359 before running the agenda command.
   3360 
   3361 The output gives a line for each selected agenda item.  Each
   3362 item is a list of comma-separated values, like this:
   3363 
   3364 category,head,type,todo,tags,date,time,extra,priority-l,priority-n
   3365 
   3366 category     The category of the item
   3367 head         The headline, without TODO kwd, TAGS and PRIORITY
   3368 type         The type of the agenda entry, can be
   3369                 todo               selected in TODO match
   3370                 tagsmatch          selected in tags match
   3371                 diary              imported from diary
   3372                 deadline           a deadline on given date
   3373                 scheduled          scheduled on given date
   3374                 timestamp          entry has timestamp on given date
   3375                 closed             entry was closed on given date
   3376                 upcoming-deadline  warning about deadline
   3377                 past-scheduled     forwarded scheduled item
   3378                 block              entry has date block including g. date
   3379 todo         The todo keyword, if any
   3380 tags         All tags including inherited ones, separated by colons
   3381 date         The relevant date, like 2007-2-14
   3382 time         The time, like 15:00-16:50
   3383 extra        String with extra planning info
   3384 priority-l   The priority letter if any was given
   3385 priority-n   The computed numerical priority
   3386 agenda-day   The day in the agenda where this is listed"
   3387   (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
   3388     `(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps))))
   3389 
   3390 (defun org--batch-agenda-csv (cmd-key vars vals)
   3391   ;; `org-batch-agenda-csv' is a macro because every other "parameter" is
   3392   ;; a variable name rather than an expression to evaluate.  Yuck!
   3393   (let ((org-agenda-remove-tags t))
   3394     (cl-progv vars vals
   3395       ;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)?
   3396       (if (> (length cmd-key) 2)
   3397 	  (org-tags-view nil cmd-key)
   3398 	(org-agenda nil cmd-key))))
   3399   (set-buffer org-agenda-buffer-name)
   3400   (let ((lines (org-split-string (buffer-string) "\n")))
   3401     (dolist (line lines)
   3402       (when (get-text-property 0 'org-category line)
   3403 	(setq org-agenda-info
   3404 	      (org-fix-agenda-info (text-properties-at 0 line)))
   3405 	(princ
   3406 	 (mapconcat #'org-agenda-export-csv-mapper
   3407 		    '(org-category txt type todo tags date time extra
   3408 		                   priority-letter priority agenda-day)
   3409 		    ","))
   3410 	(princ "\n")))))
   3411 
   3412 (defun org-fix-agenda-info (props)
   3413   "Make sure all properties on an agenda item have a canonical form.
   3414 This ensures the export commands can easily use it."
   3415   (let (tmp re)
   3416     (when (setq tmp (plist-get props 'tags))
   3417       (setq props (plist-put props 'tags (mapconcat #'identity tmp ":"))))
   3418     (when (setq tmp (plist-get props 'date))
   3419       (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
   3420       (let ((calendar-date-display-form '(year "-" month "-" day)))
   3421 	'((format "%4d, %9s %2s, %4s" dayname monthname day year))
   3422 
   3423 	(setq tmp (calendar-date-string tmp)))
   3424       (setq props (plist-put props 'date tmp)))
   3425     (when (setq tmp (plist-get props 'day))
   3426       (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
   3427       (let ((calendar-date-display-form '(year "-" month "-" day)))
   3428 	(setq tmp (calendar-date-string tmp)))
   3429       (setq props (plist-put props 'day tmp))
   3430       (setq props (plist-put props 'agenda-day tmp)))
   3431     (when (setq tmp (plist-get props 'txt))
   3432       (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp)
   3433 	(plist-put props 'priority-letter (match-string 1 tmp))
   3434 	(setq tmp (replace-match "" t t tmp)))
   3435       (when (and (setq re (plist-get props 'org-todo-regexp))
   3436 		 (setq re (concat "\\`\\.*" re " ?"))
   3437 		 (let ((case-fold-search nil)) (string-match re tmp)))
   3438 	(plist-put props 'todo (match-string 1 tmp))
   3439 	(setq tmp (replace-match "" t t tmp)))
   3440       (plist-put props 'txt tmp)))
   3441   props)
   3442 
   3443 (defun org-agenda-export-csv-mapper (prop)
   3444   (let ((res (plist-get org-agenda-info prop)))
   3445     (setq res
   3446 	  (cond
   3447 	   ((not res) "")
   3448 	   ((stringp res) res)
   3449 	   (t (prin1-to-string res))))
   3450     (org-trim (replace-regexp-in-string "," ";" res nil t))))
   3451 
   3452 ;;;###autoload
   3453 (defun org-store-agenda-views (&rest _parameters)
   3454   "Store agenda views."
   3455   (interactive)
   3456   (org--batch-store-agenda-views nil nil))
   3457 
   3458 ;;;###autoload
   3459 (defmacro org-batch-store-agenda-views (&rest parameters)
   3460   "Run all custom agenda commands that have a file argument."
   3461   (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
   3462     `(org--batch-store-agenda-views ',vars (list ,@exps))))
   3463 
   3464 (defun org--batch-store-agenda-views (vars vals)
   3465   (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
   3466         (pop-up-frames nil)
   3467         (dir default-directory)
   3468         cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
   3469     (save-window-excursion
   3470       (while cmds
   3471 	(setq cmd (pop cmds)
   3472 	      thiscmdkey (car cmd)
   3473 	      thiscmdcmd (cdr cmd)
   3474 	      match (nth 2 thiscmdcmd)
   3475 	      bufname (if org-agenda-sticky
   3476 			  (or (and (stringp match)
   3477 				   (format "*Org Agenda(%s:%s)*" thiscmdkey match))
   3478 			      (format "*Org Agenda(%s)*" thiscmdkey))
   3479 			org-agenda-buffer-name)
   3480 	      cmd-or-set (nth 2 cmd)
   3481 	      opts (nth (if (listp cmd-or-set) 3 4) cmd)
   3482 	      files (nth (if (listp cmd-or-set) 4 5) cmd))
   3483 	(if (stringp files) (setq files (list files)))
   3484 	(when files
   3485 	  (let* ((opts (append org-agenda-exporter-settings opts))
   3486 	         (vars (append (mapcar #'car opts) vars))
   3487 	         (vals (append (mapcar (lambda (binding) (eval (cadr binding) t))
   3488 	                               opts)
   3489 	                       vals)))
   3490 	    (cl-progv vars vals
   3491 	      (org-agenda nil thiscmdkey))
   3492 	    (set-buffer bufname)
   3493 	    (while files
   3494 	      (cl-progv vars vals
   3495 	        (org-agenda-write (expand-file-name (pop files) dir)
   3496 	                          nil t bufname))))
   3497 	  (and (get-buffer bufname)
   3498 	       (kill-buffer bufname)))))))
   3499 
   3500 (defvar org-agenda-current-span nil
   3501   "The current span used in the agenda view.") ; local variable in the agenda buffer
   3502 (defun org-agenda-mark-header-line (pos)
   3503   "Mark the line at POS as an agenda structure header."
   3504   (save-excursion
   3505     (goto-char pos)
   3506     (put-text-property (point-at-bol) (point-at-eol)
   3507 		       'org-agenda-structural-header t)
   3508     (when org-agenda-title-append
   3509       (put-text-property (point-at-bol) (point-at-eol)
   3510 			 'org-agenda-title-append org-agenda-title-append))))
   3511 
   3512 (defvar org-mobile-creating-agendas) ; defined in org-mobile.el
   3513 (defvar org-agenda-write-buffer-name "Agenda View")
   3514 (defun org-agenda-write (file &optional open nosettings agenda-bufname)
   3515   "Write the current buffer (an agenda view) as a file.
   3516 
   3517 Depending on the extension of the file name, plain text (.txt),
   3518 HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
   3519 If the extension is .ics, translate visible agenda into iCalendar
   3520 format.  If the extension is .org, collect all subtrees
   3521 corresponding to the agenda entries and add them in an .org file.
   3522 
   3523 With prefix argument OPEN, open the new file immediately.  If
   3524 NOSETTINGS is given, do not scope the settings of
   3525 `org-agenda-exporter-settings' into the export commands.  This is
   3526 used when the settings have already been scoped and we do not
   3527 wish to overrule other, higher priority settings.  If
   3528 AGENDA-BUFFER-NAME is provided, use this as the buffer name for
   3529 the agenda to write."
   3530   (interactive "FWrite agenda to file: \nP")
   3531   (if (or (not (file-writable-p file))
   3532 	  (and (file-exists-p file)
   3533 	       (if (called-interactively-p 'any)
   3534 		   (not (y-or-n-p (format "Overwrite existing file %s? " file))))))
   3535       (user-error "Cannot write agenda to file %s" file))
   3536   (cl-progv
   3537       (if nosettings nil (mapcar #'car org-agenda-exporter-settings))
   3538       (if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t))
   3539                                  org-agenda-exporter-settings))
   3540     (save-excursion
   3541       (save-window-excursion
   3542 	(let ((bs (copy-sequence (buffer-string)))
   3543 	      (extension (file-name-extension file))
   3544 	      (default-directory (file-name-directory file))
   3545 	      ) ;; beg content
   3546 	  (with-temp-buffer
   3547 	    (rename-buffer org-agenda-write-buffer-name t)
   3548 	    (set-buffer-modified-p nil)
   3549 	    (insert bs)
   3550 	    (org-agenda-remove-marked-text 'invisible 'org-filtered)
   3551 	    (run-hooks 'org-agenda-before-write-hook)
   3552 	    (cond
   3553 	     ((bound-and-true-p org-mobile-creating-agendas)
   3554 	      (org-mobile-write-agenda-for-mobile file))
   3555 	     ((string= "org" extension)
   3556 	      (let (content p m message-log-max)
   3557 		(goto-char (point-min))
   3558 		(while (setq p (next-single-property-change (point) 'org-hd-marker nil))
   3559 		  (goto-char p)
   3560 		  (setq m (get-text-property (point) 'org-hd-marker))
   3561 		  (when m
   3562 		    (push (with-current-buffer (marker-buffer m)
   3563 			    (goto-char m)
   3564 			    (org-copy-subtree 1 nil t t)
   3565 			    org-subtree-clip)
   3566 			  content)))
   3567 		(find-file file)
   3568 		(erase-buffer)
   3569 		(dolist (s content) (org-paste-subtree 1 s))
   3570 		(write-file file)
   3571 		(kill-buffer (current-buffer))
   3572 		(message "Org file written to %s" file)))
   3573 	     ((member extension '("html" "htm"))
   3574 	      (or (require 'htmlize nil t)
   3575 		  (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
   3576 	      (declare-function htmlize-buffer "htmlize" (&optional buffer))
   3577 	      (set-buffer (htmlize-buffer (current-buffer)))
   3578 	      (when org-agenda-export-html-style
   3579 		;; replace <style> section with org-agenda-export-html-style
   3580 		(goto-char (point-min))
   3581 		(kill-region (- (search-forward "<style") 6)
   3582 			     (search-forward "</style>"))
   3583 		(insert org-agenda-export-html-style))
   3584 	      (write-file file)
   3585 	      (kill-buffer (current-buffer))
   3586 	      (message "HTML written to %s" file))
   3587 	     ((string= "ps" extension)
   3588 	      (require 'ps-print)
   3589 	      (ps-print-buffer-with-faces file)
   3590 	      (message "Postscript written to %s" file))
   3591 	     ((string= "pdf" extension)
   3592 	      (require 'ps-print)
   3593 	      (ps-print-buffer-with-faces
   3594 	       (concat (file-name-sans-extension file) ".ps"))
   3595 	      (call-process "ps2pdf" nil nil nil
   3596 			    (expand-file-name
   3597 			     (concat (file-name-sans-extension file) ".ps"))
   3598 			    (expand-file-name file))
   3599 	      (delete-file (concat (file-name-sans-extension file) ".ps"))
   3600 	      (message "PDF written to %s" file))
   3601 	     ((string= "ics" extension)
   3602 	      (require 'ox-icalendar)
   3603 	      (declare-function org-icalendar-export-current-agenda
   3604 	                        "ox-icalendar" (file))
   3605 	      (org-icalendar-export-current-agenda (expand-file-name file)))
   3606 	     (t
   3607 	      (let ((bs (buffer-string)))
   3608 		(find-file file)
   3609 		(erase-buffer)
   3610 		(insert bs)
   3611 		(save-buffer 0)
   3612 		(kill-buffer (current-buffer))
   3613 		(message "Plain text written to %s" file))))))))
   3614     (set-buffer (or agenda-bufname
   3615 		    ;; FIXME: I'm pretty sure called-interactively-p
   3616                     ;; doesn't do what we want here!
   3617 		    (and (called-interactively-p 'any) (buffer-name))
   3618 		    org-agenda-buffer-name)))
   3619   (when open (org-open-file file)))
   3620 
   3621 (defun org-agenda-remove-marked-text (property &optional value)
   3622   "Delete all text marked with VALUE of PROPERTY.
   3623 VALUE defaults to t."
   3624   (let (beg)
   3625     (setq value (or value t))
   3626     (while (setq beg (text-property-any (point-min) (point-max)
   3627 					property value))
   3628       (delete-region
   3629        beg (or (next-single-property-change beg property)
   3630 	       (point-max))))))
   3631 
   3632 (defun org-agenda-add-entry-text ()
   3633   "Add entry text to agenda lines.
   3634 This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
   3635 entry text following headings shown in the agenda.
   3636 Drawers will be excluded, also the line with scheduling/deadline info."
   3637   (when (and (> org-agenda-add-entry-text-maxlines 0)
   3638 	     (not (bound-and-true-p org-mobile-creating-agendas)))
   3639     (let (m txt)
   3640       (goto-char (point-min))
   3641       (while (not (eobp))
   3642 	(if (not (setq m (org-get-at-bol 'org-hd-marker)))
   3643 	    (beginning-of-line 2)
   3644 	  (setq txt (org-agenda-get-some-entry-text
   3645 		     m org-agenda-add-entry-text-maxlines "    > "))
   3646 	  (end-of-line 1)
   3647 	  (if (string-match "\\S-" txt)
   3648 	      (insert "\n" txt)
   3649 	    (or (eobp) (forward-char 1))))))))
   3650 
   3651 (defun org-agenda-get-some-entry-text (marker n-lines &optional indent
   3652 					      &rest keep)
   3653   "Extract entry text from MARKER, at most N-LINES lines.
   3654 This will ignore drawers etc, just get the text.
   3655 If INDENT is given, prefix every line with this string.  If KEEP is
   3656 given, it is a list of symbols, defining stuff that should not be
   3657 removed from the entry content.  Currently only `planning' is allowed here."
   3658   (let (txt drawer-re kwd-time-re ind)
   3659     (save-excursion
   3660       (with-current-buffer (marker-buffer marker)
   3661 	(if (not (derived-mode-p 'org-mode))
   3662 	    (setq txt "")
   3663 	  (org-with-wide-buffer
   3664 	   (goto-char marker)
   3665 	   (end-of-line 1)
   3666 	   (setq txt (buffer-substring
   3667 		      (min (1+ (point)) (point-max))
   3668 		      (progn (outline-next-heading) (point)))
   3669 		 drawer-re org-drawer-regexp
   3670 		 kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
   3671 				     ".*\n?"))
   3672 	   (with-temp-buffer
   3673 	     (insert txt)
   3674 	     (when org-agenda-add-entry-text-descriptive-links
   3675 	       (goto-char (point-min))
   3676 	       (while (org-activate-links (point-max))
   3677 		 (goto-char (match-end 0))))
   3678 	     (goto-char (point-min))
   3679 	     (while (re-search-forward org-link-bracket-re (point-max) t)
   3680 	       (set-text-properties (match-beginning 0) (match-end 0)
   3681 				    nil))
   3682 	     (goto-char (point-min))
   3683 	     (while (re-search-forward drawer-re nil t)
   3684 	       (delete-region
   3685 		(match-beginning 0)
   3686 		(progn (re-search-forward
   3687 			"^[ \t]*:END:.*\n?" nil 'move)
   3688 		       (point))))
   3689 	     (unless (member 'planning keep)
   3690 	       (goto-char (point-min))
   3691 	       (while (re-search-forward kwd-time-re nil t)
   3692 		 (replace-match "")))
   3693 	     (goto-char (point-min))
   3694 	     (when org-agenda-entry-text-exclude-regexps
   3695 	       (let ((re-list org-agenda-entry-text-exclude-regexps)	re)
   3696 		 (while (setq re (pop re-list))
   3697 		   (goto-char (point-min))
   3698 		   (while (re-search-forward re nil t)
   3699 		     (replace-match "")))))
   3700 	     (goto-char (point-max))
   3701 	     (skip-chars-backward " \t\n")
   3702 	     (when (looking-at "[ \t\n]+\\'") (replace-match ""))
   3703 
   3704 	     ;; find and remove min common indentation
   3705 	     (goto-char (point-min))
   3706 	     (untabify (point-min) (point-max))
   3707 	     (setq ind (current-indentation))
   3708 	     (while (not (eobp))
   3709 	       (unless (looking-at "[ \t]*$")
   3710 		 (setq ind (min ind (current-indentation))))
   3711 	       (beginning-of-line 2))
   3712 	     (goto-char (point-min))
   3713 	     (while (not (eobp))
   3714 	       (unless (looking-at "[ \t]*$")
   3715 		 (move-to-column ind)
   3716 		 (delete-region (point-at-bol) (point)))
   3717 	       (beginning-of-line 2))
   3718 
   3719 	     (run-hooks 'org-agenda-entry-text-cleanup-hook)
   3720 
   3721 	     (goto-char (point-min))
   3722 	     (when indent
   3723 	       (while (and (not (eobp)) (re-search-forward "^" nil t))
   3724 		 (replace-match indent t t)))
   3725 	     (goto-char (point-min))
   3726 	     (while (looking-at "[ \t]*\n") (replace-match ""))
   3727 	     (goto-char (point-max))
   3728 	     (when (> (org-current-line)
   3729 		      n-lines)
   3730 	       (org-goto-line (1+ n-lines))
   3731 	       (backward-char 1))
   3732 	     (setq txt (buffer-substring (point-min) (point))))))))
   3733     txt))
   3734 
   3735 (defun org-check-for-org-mode ()
   3736   "Make sure current buffer is in Org mode.  Error if not."
   3737   (or (derived-mode-p 'org-mode)
   3738       (error "Cannot execute Org agenda command on buffer in %s"
   3739 	     major-mode)))
   3740 
   3741 ;;; Agenda prepare and finalize
   3742 
   3743 (defvar org-agenda-multi nil)  ; dynamically scoped
   3744 (defvar org-agenda-pre-window-conf nil)
   3745 (defvar org-agenda-columns-active nil)
   3746 (defvar org-agenda-name nil)
   3747 (defvar org-agenda-tag-filter nil)
   3748 (defvar org-agenda-category-filter nil)
   3749 (defvar org-agenda-regexp-filter nil)
   3750 (defvar org-agenda-effort-filter nil)
   3751 (defvar org-agenda-top-headline-filter nil)
   3752 
   3753 (defvar org-agenda-represented-categories nil
   3754   "Cache for the list of all categories in the agenda.")
   3755 (defvar org-agenda-represented-tags nil
   3756   "Cache for the list of all categories in the agenda.")
   3757 (defvar org-agenda-tag-filter-preset nil
   3758   "A preset of the tags filter used for secondary agenda filtering.
   3759 This must be a list of strings, each string must be a single tag preceded
   3760 by \"+\" or \"-\".
   3761 This variable should not be set directly, but agenda custom commands can
   3762 bind it in the options section.  The preset filter is a global property of
   3763 the entire agenda view.  In a block agenda, it will not work reliably to
   3764 define a filter for one of the individual blocks.  You need to set it in
   3765 the global options and expect it to be applied to the entire view.")
   3766 
   3767 (defconst org-agenda-filter-variables
   3768   '((category . org-agenda-category-filter)
   3769     (tag . org-agenda-tag-filter)
   3770     (effort . org-agenda-effort-filter)
   3771     (regexp . org-agenda-regexp-filter))
   3772   "Alist of filter types and associated variables.")
   3773 (defun org-agenda-filter-any ()
   3774   "Is any filter active?"
   3775   (cl-some (lambda (x)
   3776 	     (or (symbol-value (cdr x))
   3777 		 (get :preset-filter x)))
   3778 	   org-agenda-filter-variables))
   3779 
   3780 (defvar org-agenda-category-filter-preset nil
   3781   "A preset of the category filter used for secondary agenda filtering.
   3782 This must be a list of strings, each string must be a single category
   3783 preceded by \"+\" or \"-\".
   3784 This variable should not be set directly, but agenda custom commands can
   3785 bind it in the options section.  The preset filter is a global property of
   3786 the entire agenda view.  In a block agenda, it will not work reliably to
   3787 define a filter for one of the individual blocks.  You need to set it in
   3788 the global options and expect it to be applied to the entire view.")
   3789 
   3790 (defvar org-agenda-regexp-filter-preset nil
   3791   "A preset of the regexp filter used for secondary agenda filtering.
   3792 This must be a list of strings, each string must be a single regexp
   3793 preceded by \"+\" or \"-\".
   3794 This variable should not be set directly, but agenda custom commands can
   3795 bind it in the options section.  The preset filter is a global property of
   3796 the entire agenda view.  In a block agenda, it will not work reliably to
   3797 define a filter for one of the individual blocks.  You need to set it in
   3798 the global options and expect it to be applied to the entire view.")
   3799 
   3800 (defvar org-agenda-effort-filter-preset nil
   3801   "A preset of the effort condition used for secondary agenda filtering.
   3802 This must be a list of strings, each string must be a single regexp
   3803 preceded by \"+\" or \"-\".
   3804 This variable should not be set directly, but agenda custom commands can
   3805 bind it in the options section.  The preset filter is a global property of
   3806 the entire agenda view.  In a block agenda, it will not work reliably to
   3807 define a filter for one of the individual blocks.  You need to set it in
   3808 the global options and expect it to be applied to the entire view.")
   3809 
   3810 (defun org-agenda-use-sticky-p ()
   3811   "Return non-nil if an agenda buffer named
   3812 `org-agenda-buffer-name' exists and should be shown instead of
   3813 generating a new one."
   3814   (and
   3815    ;; turned off by user
   3816    org-agenda-sticky
   3817    ;; For multi-agenda buffer already exists
   3818    (not org-agenda-multi)
   3819    ;; buffer found
   3820    (get-buffer org-agenda-buffer-name)
   3821    ;; C-u parameter is same as last call
   3822    (with-current-buffer (get-buffer org-agenda-buffer-name)
   3823      (and
   3824       (equal current-prefix-arg
   3825 	     org-agenda-last-prefix-arg)
   3826       ;; In case user turned stickiness on, while having existing
   3827       ;; Agenda buffer active, don't reuse that buffer, because it
   3828       ;; does not have org variables local
   3829       org-agenda-this-buffer-is-sticky))))
   3830 
   3831 (defvar org-agenda-buffer-tmp-name nil)
   3832 
   3833 (defun org-agenda--get-buffer-name (sticky-name)
   3834   (or org-agenda-buffer-tmp-name
   3835       (and org-agenda-doing-sticky-redo org-agenda-buffer-name)
   3836       sticky-name
   3837       "*Org Agenda*"))
   3838 
   3839 (defun org-agenda-prepare-window (abuf filter-alist)
   3840   "Setup agenda buffer in the window.
   3841 ABUF is the buffer for the agenda window.
   3842 FILTER-ALIST is an alist of filters we need to apply when
   3843 `org-agenda-persistent-filter' is non-nil."
   3844   (let* ((awin (get-buffer-window abuf)) wconf)
   3845     (cond
   3846      ((equal (current-buffer) abuf) nil)
   3847      (awin (select-window awin))
   3848      ((not (setq wconf (current-window-configuration))))
   3849      ((eq org-agenda-window-setup 'current-window)
   3850       (pop-to-buffer-same-window abuf))
   3851      ((eq org-agenda-window-setup 'other-window)
   3852       (org-switch-to-buffer-other-window abuf))
   3853      ((eq org-agenda-window-setup 'other-frame)
   3854       (switch-to-buffer-other-frame abuf))
   3855      ((eq org-agenda-window-setup 'other-tab)
   3856       (if (fboundp 'switch-to-buffer-other-tab)
   3857 	  (switch-to-buffer-other-tab abuf)
   3858 	(user-error "Your version of Emacs does not have tab bar support")))
   3859      ((eq org-agenda-window-setup 'only-window)
   3860       (delete-other-windows)
   3861       (pop-to-buffer-same-window abuf))
   3862      ((eq org-agenda-window-setup 'reorganize-frame)
   3863       (delete-other-windows)
   3864       (org-switch-to-buffer-other-window abuf)))
   3865     (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist)))
   3866     (setq org-agenda-category-filter (cdr (assq 'cat filter-alist)))
   3867     (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist)))
   3868     (setq org-agenda-regexp-filter (cdr (assq 're filter-alist)))
   3869     ;; Additional test in case agenda is invoked from within agenda
   3870     ;; buffer via elisp link.
   3871     (unless (equal (current-buffer) abuf)
   3872       (pop-to-buffer-same-window abuf))
   3873     (setq org-agenda-pre-window-conf
   3874 	  (or wconf org-agenda-pre-window-conf))))
   3875 
   3876 (defun org-agenda-prepare (&optional name)
   3877   (let ((filter-alist (when org-agenda-persistent-filter
   3878 			(with-current-buffer
   3879 			    (get-buffer-create org-agenda-buffer-name)
   3880 			  `((tag . ,org-agenda-tag-filter)
   3881 			    (re . ,org-agenda-regexp-filter)
   3882 			    (effort . ,org-agenda-effort-filter)
   3883 			    (cat . ,org-agenda-category-filter))))))
   3884     (if (org-agenda-use-sticky-p)
   3885 	(progn
   3886 	  (put 'org-agenda-tag-filter :preset-filter nil)
   3887 	  (put 'org-agenda-category-filter :preset-filter nil)
   3888 	  (put 'org-agenda-regexp-filter :preset-filter nil)
   3889 	  (put 'org-agenda-effort-filter :preset-filter nil)
   3890 	  ;; Popup existing buffer
   3891 	  (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
   3892 				     filter-alist)
   3893 	  (message "Sticky Agenda buffer, use `r' to refresh")
   3894 	  (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   3895 	  (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
   3896       (setq org-todo-keywords-for-agenda nil)
   3897       (put 'org-agenda-tag-filter :preset-filter
   3898 	   org-agenda-tag-filter-preset)
   3899       (put 'org-agenda-category-filter :preset-filter
   3900 	   org-agenda-category-filter-preset)
   3901       (put 'org-agenda-regexp-filter :preset-filter
   3902 	   org-agenda-regexp-filter-preset)
   3903       (put 'org-agenda-effort-filter :preset-filter
   3904 	   org-agenda-effort-filter-preset)
   3905       (if org-agenda-multi
   3906 	  (progn
   3907 	    (setq buffer-read-only nil)
   3908 	    (goto-char (point-max))
   3909 	    (unless (or (bobp) org-agenda-compact-blocks
   3910 			(not org-agenda-block-separator))
   3911 	      (insert "\n"
   3912 		      (if (stringp org-agenda-block-separator)
   3913 			  org-agenda-block-separator
   3914 			(make-string (window-width) org-agenda-block-separator))
   3915 		      "\n"))
   3916 	    (narrow-to-region (point) (point-max)))
   3917 	(setq org-done-keywords-for-agenda nil)
   3918 	;; Setting any org variables that are in org-agenda-local-vars
   3919 	;; list need to be done after the prepare call
   3920 	(org-agenda-prepare-window
   3921 	 (get-buffer-create org-agenda-buffer-name) filter-alist)
   3922 	(setq buffer-read-only nil)
   3923 	(org-agenda-reset-markers)
   3924 	(let ((inhibit-read-only t)) (erase-buffer))
   3925 	(org-agenda-mode)
   3926 	(setq org-agenda-buffer (current-buffer))
   3927 	(setq org-agenda-contributing-files nil)
   3928 	(setq org-agenda-columns-active nil)
   3929 	(org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
   3930 	(setq org-todo-keywords-for-agenda
   3931 	      (org-uniquify org-todo-keywords-for-agenda))
   3932 	(setq org-done-keywords-for-agenda
   3933 	      (org-uniquify org-done-keywords-for-agenda))
   3934 	(setq org-agenda-last-prefix-arg current-prefix-arg)
   3935 	(setq org-agenda-this-buffer-name org-agenda-buffer-name)
   3936 	(and name (not org-agenda-name)
   3937 	     (setq-local org-agenda-name name)))
   3938       (setq buffer-read-only nil))))
   3939 
   3940 (defvar org-overriding-columns-format)
   3941 (defvar org-local-columns-format)
   3942 (defun org-agenda-finalize ()
   3943   "Finishing touch for the agenda buffer.
   3944 This function is called just before displaying the agenda.  If
   3945 you want to add your own functions to the finalization of the
   3946 agenda display, configure `org-agenda-finalize-hook'."
   3947   (unless org-agenda-multi
   3948     (let ((inhibit-read-only t))
   3949       (save-excursion
   3950 	(goto-char (point-min))
   3951 	(save-excursion
   3952 	  (while (org-activate-links (point-max))
   3953 	    (goto-char (match-end 0))))
   3954 	(unless (eq org-agenda-remove-tags t)
   3955 	  (org-agenda-align-tags))
   3956 	(unless org-agenda-with-colors
   3957 	  (remove-text-properties (point-min) (point-max) '(face nil)))
   3958 	(when (bound-and-true-p org-overriding-columns-format)
   3959 	  (setq-local org-local-columns-format
   3960 		      org-overriding-columns-format))
   3961 	(when org-agenda-view-columns-initially
   3962 	  (org-agenda-columns))
   3963 	(when org-agenda-fontify-priorities
   3964 	  (org-agenda-fontify-priorities))
   3965 	(when (and org-agenda-dim-blocked-tasks org-blocker-hook)
   3966 	  (org-agenda-dim-blocked-tasks))
   3967 	(org-agenda-mark-clocking-task)
   3968 	(when org-agenda-entry-text-mode
   3969 	  (org-agenda-entry-text-hide)
   3970 	  (org-agenda-entry-text-show))
   3971 	(when (and (featurep 'org-habit)
   3972 		   (save-excursion (next-single-property-change (point-min) 'org-habit-p)))
   3973 	  (org-habit-insert-consistency-graphs))
   3974 	(setq org-agenda-type (org-get-at-bol 'org-agenda-type))
   3975 	(unless (or (eq org-agenda-show-inherited-tags 'always)
   3976 		    (and (listp org-agenda-show-inherited-tags)
   3977 			 (memq org-agenda-type org-agenda-show-inherited-tags))
   3978 		    (and (eq org-agenda-show-inherited-tags t)
   3979 			 (or (eq org-agenda-use-tag-inheritance t)
   3980 			     (and (listp org-agenda-use-tag-inheritance)
   3981 				  (not (memq org-agenda-type
   3982 					     org-agenda-use-tag-inheritance))))))
   3983 	  (let (mrk)
   3984 	    (save-excursion
   3985 	      (goto-char (point-min))
   3986 	      (while (equal (forward-line) 0)
   3987 		(when (setq mrk (get-text-property (point) 'org-hd-marker))
   3988 		  (put-text-property (point-at-bol) (point-at-eol)
   3989 				     'tags
   3990 				     (org-with-point-at mrk
   3991 				       (org-get-tags))))))))
   3992 	(setq org-agenda-represented-tags nil
   3993 	      org-agenda-represented-categories nil)
   3994 	(when org-agenda-top-headline-filter
   3995 	  (org-agenda-filter-top-headline-apply
   3996 	   org-agenda-top-headline-filter))
   3997 	(when org-agenda-tag-filter
   3998 	  (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
   3999 	(when (get 'org-agenda-tag-filter :preset-filter)
   4000 	  (org-agenda-filter-apply
   4001 	   (get 'org-agenda-tag-filter :preset-filter) 'tag t))
   4002 	(when org-agenda-category-filter
   4003 	  (org-agenda-filter-apply org-agenda-category-filter 'category))
   4004 	(when (get 'org-agenda-category-filter :preset-filter)
   4005 	  (org-agenda-filter-apply
   4006 	   (get 'org-agenda-category-filter :preset-filter) 'category))
   4007 	(when org-agenda-regexp-filter
   4008 	  (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
   4009 	(when (get 'org-agenda-regexp-filter :preset-filter)
   4010 	  (org-agenda-filter-apply
   4011 	   (get 'org-agenda-regexp-filter :preset-filter) 'regexp))
   4012 	(when org-agenda-effort-filter
   4013 	  (org-agenda-filter-apply org-agenda-effort-filter 'effort))
   4014 	(when (get 'org-agenda-effort-filter :preset-filter)
   4015 	  (org-agenda-filter-apply
   4016 	   (get 'org-agenda-effort-filter :preset-filter) 'effort))
   4017 	(add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local))
   4018       (run-hooks 'org-agenda-finalize-hook))))
   4019 
   4020 (defun org-agenda-mark-clocking-task ()
   4021   "Mark the current clock entry in the agenda if it is present."
   4022   ;; We need to widen when `org-agenda-finalize' is called from
   4023   ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in').
   4024   (when (bound-and-true-p org-clock-current-task)
   4025     (save-restriction
   4026       (widen)
   4027       (org-agenda-unmark-clocking-task)
   4028       (when (marker-buffer org-clock-hd-marker)
   4029 	(save-excursion
   4030 	  (goto-char (point-min))
   4031 	  (let (s ov)
   4032 	    (while (setq s (next-single-property-change (point) 'org-hd-marker))
   4033 	      (goto-char s)
   4034 	      (when (equal (org-get-at-bol 'org-hd-marker)
   4035 			   org-clock-hd-marker)
   4036 		(setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
   4037 		(overlay-put ov 'type 'org-agenda-clocking)
   4038 		(overlay-put ov 'face 'org-agenda-clocking)
   4039 		(overlay-put ov 'help-echo
   4040 			     "The clock is running in this item")))))))))
   4041 
   4042 (defun org-agenda-unmark-clocking-task ()
   4043   "Unmark the current clocking task."
   4044   (mapc (lambda (o)
   4045 	  (when (eq (overlay-get o 'type) 'org-agenda-clocking)
   4046 	    (delete-overlay o)))
   4047 	(overlays-in (point-min) (point-max))))
   4048 
   4049 (defun org-agenda-fontify-priorities ()
   4050   "Make highest priority lines bold, and lowest italic."
   4051   (interactive)
   4052   (mapc (lambda (o) (when (eq (overlay-get o 'org-type) 'org-priority)
   4053 		      (delete-overlay o)))
   4054 	(overlays-in (point-min) (point-max)))
   4055   (save-excursion
   4056     (let (b e p ov h l)
   4057       (goto-char (point-min))
   4058       (while (re-search-forward org-priority-regexp nil t)
   4059 	(setq h (or (get-char-property (point) 'org-priority-highest)
   4060 		    org-priority-highest)
   4061 	      l (or (get-char-property (point) 'org-priority-lowest)
   4062 		    org-priority-lowest)
   4063 	      p (string-to-char (match-string 2))
   4064 	      b (match-beginning 1)
   4065 	      e (if (eq org-agenda-fontify-priorities 'cookies)
   4066 		    (1+ (match-end 2))
   4067 		  (point-at-eol))
   4068 	      ov (make-overlay b e))
   4069 	(overlay-put
   4070 	 ov 'face
   4071 	 (let ((special-face
   4072 		(cond ((org-face-from-face-or-color
   4073 			'priority 'org-priority
   4074 			(cdr (assoc p org-priority-faces))))
   4075 		      ((and (listp org-agenda-fontify-priorities)
   4076 			    (org-face-from-face-or-color
   4077 			     'priority 'org-priority
   4078 			     (cdr (assoc p org-agenda-fontify-priorities)))))
   4079 		      ((equal p l) 'italic)
   4080 		      ((equal p h) 'bold))))
   4081 	   (if special-face (list special-face 'org-priority) 'org-priority)))
   4082 	(overlay-put ov 'org-type 'org-priority)))))
   4083 
   4084 (defvar org-depend-tag-blocked)
   4085 
   4086 (defun org-agenda-dim-blocked-tasks (&optional _invisible)
   4087   "Dim currently blocked TODOs in the agenda display.
   4088 When INVISIBLE is non-nil, hide currently blocked TODO instead of
   4089 dimming them."                   ;FIXME: The arg isn't used, actually!
   4090   (interactive "P")
   4091   (when (called-interactively-p 'interactive)
   4092     (message "Dim or hide blocked tasks..."))
   4093   (dolist (o (overlays-in (point-min) (point-max)))
   4094     (when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face)
   4095       (delete-overlay o)))
   4096   (save-excursion
   4097     (let ((inhibit-read-only t))
   4098       (goto-char (point-min))
   4099       (while (let ((pos (text-property-not-all
   4100 			 (point) (point-max) 'org-todo-blocked nil)))
   4101 	       (when pos (goto-char pos)))
   4102 	(let* ((invisible
   4103 		(eq (org-get-at-bol 'org-todo-blocked) 'invisible))
   4104 	       (todo-blocked
   4105 		(eq (org-get-at-bol 'org-filter-type) 'todo-blocked))
   4106 	       (ov (make-overlay (if invisible
   4107 				     (line-end-position 0)
   4108 				   (line-beginning-position))
   4109 				 (line-end-position))))
   4110 	  (when todo-blocked
   4111 	    (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
   4112 	  (when invisible
   4113 	    (org-agenda-filter-hide-line 'todo-blocked)))
   4114         (if (= (point-max) (line-end-position))
   4115             (goto-char (point-max))
   4116 	  (move-beginning-of-line 2)))))
   4117   (when (called-interactively-p 'interactive)
   4118     (message "Dim or hide blocked tasks...done")))
   4119 
   4120 (defun org-agenda--mark-blocked-entry (entry)
   4121   "If ENTRY is blocked, mark it for fontification or invisibility.
   4122 
   4123 If the header at `org-hd-marker' is blocked according to
   4124 `org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is
   4125 'invisible and the header is not blocked by checkboxes, set the
   4126 text property `org-todo-blocked' to `invisible', otherwise set it
   4127 to t."
   4128   (when (get-text-property 0 'todo-state entry)
   4129     (let ((entry-marker (get-text-property 0 'org-hd-marker entry))
   4130           (org-blocked-by-checkboxes nil)
   4131 	  ;; Necessary so that `org-entry-blocked-p' does not change
   4132 	  ;; the buffer.
   4133           (org-depend-tag-blocked nil))
   4134       (when entry-marker
   4135 	(let ((blocked
   4136 	       (with-current-buffer (marker-buffer entry-marker)
   4137 		 (save-excursion
   4138 		   (goto-char entry-marker)
   4139 		   (org-entry-blocked-p)))))
   4140 	  (when blocked
   4141 	    (let ((really-invisible
   4142 		   (and (not org-blocked-by-checkboxes)
   4143 			(eq org-agenda-dim-blocked-tasks 'invisible))))
   4144 	      (put-text-property
   4145 	       0 (length entry) 'org-todo-blocked
   4146 	       (if really-invisible 'invisible t)
   4147 	       entry)
   4148 	      (put-text-property
   4149 	       0 (length entry) 'org-filter-type 'todo-blocked entry)))))))
   4150   entry)
   4151 
   4152 (defvar org-agenda-skip-function nil
   4153   "Function to be called at each match during agenda construction.
   4154 If this function returns nil, the current match should not be skipped.
   4155 Otherwise, the function must return a position from where the search
   4156 should be continued.
   4157 This may also be a Lisp form, it will be evaluated.
   4158 Never set this variable using `setq' or so, because then it will apply
   4159 to all future agenda commands.  If you do want a global skipping condition,
   4160 use the option `org-agenda-skip-function-global' instead.
   4161 The correct usage for `org-agenda-skip-function' is to bind it with
   4162 `let' to scope it dynamically into the agenda-constructing command.
   4163 A good way to set it is through options in `org-agenda-custom-commands'.")
   4164 
   4165 (defun org-agenda-skip ()
   4166   "Throw to `:skip' in places that should be skipped.
   4167 Also moves point to the end of the skipped region, so that search can
   4168 continue from there."
   4169   (let ((p (point-at-bol)) to)
   4170     (when (or
   4171 	   (save-excursion (goto-char p) (looking-at comment-start-skip))
   4172 	   (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
   4173 		(or (and (get-text-property p :org-archived)
   4174 			 (org-end-of-subtree t))
   4175 		    (and (member org-archive-tag org-file-tags)
   4176 			 (goto-char (point-max)))))
   4177 	   (and org-agenda-skip-comment-trees
   4178 		(get-text-property p :org-comment)
   4179 		(org-end-of-subtree t))
   4180 	   (and (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global)
   4181 			     (org-agenda-skip-eval org-agenda-skip-function)))
   4182 		(goto-char to))
   4183 	   (org-in-src-block-p t))
   4184       (throw :skip t))))
   4185 
   4186 (defun org-agenda-skip-eval (form)
   4187   "If FORM is a function or a list, call (or eval) it and return the result.
   4188 `save-excursion' and `save-match-data' are wrapped around the call, so point
   4189 and match data are returned to the previous state no matter what these
   4190 functions do."
   4191   (let (fp)
   4192     (and form
   4193 	 (or (setq fp (functionp form))
   4194 	     (consp form))
   4195 	 (save-excursion
   4196 	   (save-match-data
   4197 	     (if fp
   4198 		 (funcall form)
   4199 	       (eval form t)))))))
   4200 
   4201 (defvar org-agenda-markers nil
   4202   "List of all currently active markers created by `org-agenda'.")
   4203 (defvar org-agenda-last-marker-time (float-time)
   4204   "Creation time of the last agenda marker.")
   4205 
   4206 (defun org-agenda-new-marker (&optional pos)
   4207   "Return a new agenda marker.
   4208 Marker is at point, or at POS if non-nil.  Org mode keeps a list
   4209 of these markers and resets them when they are no longer in use."
   4210   (let ((m (copy-marker (or pos (point)) t)))
   4211     (setq org-agenda-last-marker-time (float-time))
   4212     (if org-agenda-buffer
   4213 	(with-current-buffer org-agenda-buffer
   4214 	  (push m org-agenda-markers))
   4215       (push m org-agenda-markers))
   4216     m))
   4217 
   4218 (defun org-agenda-reset-markers ()
   4219   "Reset markers created by `org-agenda'."
   4220   (while org-agenda-markers
   4221     (move-marker (pop org-agenda-markers) nil)))
   4222 
   4223 (defun org-agenda-save-markers-for-cut-and-paste (beg end)
   4224   "Save relative positions of markers in region.
   4225 This check for agenda markers in all agenda buffers currently active."
   4226   (dolist (buf (buffer-list))
   4227     (with-current-buffer buf
   4228       (when (eq major-mode 'org-agenda-mode)
   4229 	(mapc (lambda (m) (org-check-and-save-marker m beg end))
   4230 	      org-agenda-markers)))))
   4231 
   4232 ;;; Entry text mode
   4233 
   4234 (defun org-agenda-entry-text-show-here ()
   4235   "Add some text from the entry as context to the current line."
   4236   (let (m txt o)
   4237     (setq m (org-get-at-bol 'org-hd-marker))
   4238     (unless (marker-buffer m)
   4239       (error "No marker points to an entry here"))
   4240     (setq txt (concat "\n" (org-no-properties
   4241 			    (org-agenda-get-some-entry-text
   4242 			     m org-agenda-entry-text-maxlines
   4243 			     org-agenda-entry-text-leaders))))
   4244     (when (string-match "\\S-" txt)
   4245       (setq o (make-overlay (point-at-bol) (point-at-eol)))
   4246       (overlay-put o 'evaporate t)
   4247       (overlay-put o 'org-overlay-type 'agenda-entry-content)
   4248       (overlay-put o 'after-string txt))))
   4249 
   4250 (defun org-agenda-entry-text-show ()
   4251   "Add entry context for all agenda lines."
   4252   (interactive)
   4253   (save-excursion
   4254     (goto-char (point-max))
   4255     (beginning-of-line 1)
   4256     (while (not (bobp))
   4257       (when (org-get-at-bol 'org-hd-marker)
   4258 	(org-agenda-entry-text-show-here))
   4259       (beginning-of-line 0))))
   4260 
   4261 (defun org-agenda-entry-text-hide ()
   4262   "Remove any shown entry context."
   4263   (mapc (lambda (o)
   4264 	  (when (eq (overlay-get o 'org-overlay-type)
   4265 		    'agenda-entry-content)
   4266 	    (delete-overlay o)))
   4267 	(overlays-in (point-min) (point-max))))
   4268 
   4269 (defun org-agenda-get-day-face (date)
   4270   "Return the face DATE should be displayed with."
   4271   (cond ((and (functionp org-agenda-day-face-function)
   4272 	      (funcall org-agenda-day-face-function date)))
   4273 	((and (org-agenda-today-p date)
   4274               (memq (calendar-day-of-week date) org-agenda-weekend-days))
   4275          'org-agenda-date-weekend-today)
   4276 	((org-agenda-today-p date) 'org-agenda-date-today)
   4277 	((memq (calendar-day-of-week date) org-agenda-weekend-days)
   4278 	 'org-agenda-date-weekend)
   4279 	(t 'org-agenda-date)))
   4280 
   4281 (defvar org-agenda-show-log-scoped)
   4282 
   4283 ;;; Agenda Daily/Weekly
   4284 
   4285 (defvar org-agenda-start-day nil  ; dynamically scoped parameter
   4286   "Start day for the agenda view.
   4287 Custom commands can set this variable in the options section.
   4288 This is usually a string like \"2007-11-01\", \"+2d\" or any other
   4289 input allowed when reading a date through the Org calendar.
   4290 See the docstring of `org-read-date' for details.")
   4291 (defvar org-starting-day nil) ; local variable in the agenda buffer
   4292 (defvar org-arg-loc nil) ; local variable
   4293 
   4294 ;;;###autoload
   4295 (defun org-agenda-list (&optional arg start-day span with-hour)
   4296   "Produce a daily/weekly view from all files in variable `org-agenda-files'.
   4297 The view will be for the current day or week, but from the overview buffer
   4298 you will be able to go to other days/weeks.
   4299 
   4300 With a numeric prefix argument in an interactive call, the agenda will
   4301 span ARG days.  Lisp programs should instead specify SPAN to change
   4302 the number of days.  SPAN defaults to `org-agenda-span'.
   4303 
   4304 START-DAY defaults to TODAY, or to the most recent match for the weekday
   4305 given in `org-agenda-start-on-weekday'.
   4306 
   4307 When WITH-HOUR is non-nil, only include scheduled and deadline
   4308 items if they have an hour specification like [h]h:mm."
   4309   (interactive "P")
   4310   (when org-agenda-overriding-arguments
   4311     (setq arg (car org-agenda-overriding-arguments)
   4312 	  start-day (nth 1 org-agenda-overriding-arguments)
   4313 	  span (nth 2 org-agenda-overriding-arguments)))
   4314   (when (and (integerp arg) (> arg 0))
   4315     (setq span arg arg nil))
   4316   (when (numberp span)
   4317     (unless (< 0 span)
   4318       (user-error "Agenda creation impossible for this span(=%d days)" span)))
   4319   (catch 'exit
   4320     (setq org-agenda-buffer-name
   4321 	  (org-agenda--get-buffer-name
   4322 	   (and org-agenda-sticky
   4323 		(cond ((and org-keys (stringp org-match))
   4324 		       (format "*Org Agenda(%s:%s)*" org-keys org-match))
   4325 		      (org-keys
   4326 		       (format "*Org Agenda(%s)*" org-keys))
   4327 		      (t "*Org Agenda(a)*")))))
   4328     (org-agenda-prepare "Day/Week")
   4329     (setq start-day (or start-day org-agenda-start-day))
   4330     (when (stringp start-day)
   4331       ;; Convert to an absolute day number
   4332       (setq start-day (time-to-days (org-read-date nil t start-day))))
   4333     (org-compile-prefix-format 'agenda)
   4334     (org-set-sorting-strategy 'agenda)
   4335     (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span)))
   4336 	   (today (org-today))
   4337 	   (sd (or start-day today))
   4338 	   (ndays (org-agenda-span-to-ndays span sd))
   4339 	   (org-agenda-start-on-weekday
   4340 	    (and (or (eq ndays 7) (eq ndays 14))
   4341 		 org-agenda-start-on-weekday))
   4342 	   (thefiles (org-agenda-files nil 'ifmode))
   4343 	   (files thefiles)
   4344 	   (start (if (or (null org-agenda-start-on-weekday)
   4345 			  (< ndays 7))
   4346 		      sd
   4347 		    (let* ((nt (calendar-day-of-week
   4348 				(calendar-gregorian-from-absolute sd)))
   4349 			   (n1 org-agenda-start-on-weekday)
   4350 			   (d (- nt n1)))
   4351 		      (- sd (+ (if (< d 0) 7 0) d)))))
   4352 	   (day-numbers (list start))
   4353 	   (day-cnt 0)
   4354 	   (inhibit-redisplay (not debug-on-error))
   4355 	   (org-agenda-show-log-scoped org-agenda-show-log)
   4356 	   s rtn rtnall file date d start-pos end-pos todayp ;; e
   4357 	   clocktable-start clocktable-end) ;; filter
   4358       (setq org-agenda-redo-command
   4359 	    (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
   4360       (dotimes (_ (1- ndays))
   4361 	(push (1+ (car day-numbers)) day-numbers))
   4362       (setq day-numbers (nreverse day-numbers))
   4363       (setq clocktable-start (car day-numbers)
   4364 	    clocktable-end (1+ (or (org-last day-numbers) 0)))
   4365       (setq-local org-starting-day (car day-numbers))
   4366       (setq-local org-arg-loc arg)
   4367       (setq-local org-agenda-current-span (org-agenda-ndays-to-span span))
   4368       (unless org-agenda-compact-blocks
   4369 	(let* ((d1 (car day-numbers))
   4370 	       (d2 (org-last day-numbers))
   4371 	       (w1 (org-days-to-iso-week d1))
   4372 	       (w2 (org-days-to-iso-week d2)))
   4373 	  (setq s (point))
   4374 	  (org-agenda--insert-overriding-header
   4375 	    (concat (org-agenda-span-name span)
   4376 		    "-agenda"
   4377 		    (cond ((<= 350 (- d2 d1)) "")
   4378                           ((= w1 w2) (format " (W%02d)" w1))
   4379                           (t (format " (W%02d-W%02d)" w1 w2)))
   4380 		    ":\n")))
   4381 	;; Add properties if we actually inserted a header.
   4382 	(when (> (point) s)
   4383 	  (add-text-properties s (1- (point))
   4384 			       (list 'face 'org-agenda-structure
   4385 				     'org-date-line t))
   4386 	  (org-agenda-mark-header-line s)))
   4387       (while (setq d (pop day-numbers))
   4388 	(setq date (calendar-gregorian-from-absolute d)
   4389 	      s (point))
   4390 	(if (or (setq todayp (= d today))
   4391 		(and (not start-pos) (= d sd)))
   4392 	    (setq start-pos (point))
   4393 	  (when (and start-pos (not end-pos))
   4394 	    (setq end-pos (point))))
   4395 	(setq files thefiles
   4396 	      rtnall nil)
   4397 	(while (setq file (pop files))
   4398 	  (catch 'nextfile
   4399 	    (org-check-agenda-file file)
   4400 	    (let ((org-agenda-entry-types org-agenda-entry-types))
   4401 	      ;; Starred types override non-starred equivalents
   4402 	      (when (member :deadline* org-agenda-entry-types)
   4403 		(setq org-agenda-entry-types
   4404 		      (delq :deadline org-agenda-entry-types)))
   4405 	      (when (member :scheduled* org-agenda-entry-types)
   4406 		(setq org-agenda-entry-types
   4407 		      (delq :scheduled org-agenda-entry-types)))
   4408 	      ;; Honor with-hour
   4409 	      (when with-hour
   4410 		(when (member :deadline org-agenda-entry-types)
   4411 		  (setq org-agenda-entry-types
   4412 			(delq :deadline org-agenda-entry-types))
   4413 		  (push :deadline* org-agenda-entry-types))
   4414 		(when (member :scheduled org-agenda-entry-types)
   4415 		  (setq org-agenda-entry-types
   4416 			(delq :scheduled org-agenda-entry-types))
   4417 		  (push :scheduled* org-agenda-entry-types)))
   4418 	      (unless org-agenda-include-deadlines
   4419 		(setq org-agenda-entry-types
   4420 		      (delq :deadline* (delq :deadline org-agenda-entry-types))))
   4421 	      (cond
   4422 	       ((memq org-agenda-show-log-scoped '(only clockcheck))
   4423 		(setq rtn (org-agenda-get-day-entries
   4424 			   file date :closed)))
   4425 	       (org-agenda-show-log-scoped
   4426 		(setq rtn (apply #'org-agenda-get-day-entries
   4427 				 file date
   4428 				 (append '(:closed) org-agenda-entry-types))))
   4429 	       (t
   4430 		(setq rtn (apply #'org-agenda-get-day-entries
   4431 				 file date
   4432 				 org-agenda-entry-types)))))
   4433 	    (setq rtnall (append rtnall rtn)))) ;; all entries
   4434 	(when org-agenda-include-diary
   4435 	  (let ((org-agenda-search-headline-for-time t))
   4436 	    (require 'diary-lib)
   4437 	    (setq rtn (org-get-entries-from-diary date))
   4438 	    (setq rtnall (append rtnall rtn))))
   4439 	(when (or rtnall org-agenda-show-all-dates)
   4440 	  (setq day-cnt (1+ day-cnt))
   4441 	  (insert
   4442 	   (if (stringp org-agenda-format-date)
   4443 	       (format-time-string org-agenda-format-date
   4444 				   (org-time-from-absolute date))
   4445 	     (funcall org-agenda-format-date date))
   4446 	   "\n")
   4447 	  (put-text-property s (1- (point)) 'face
   4448 			     (org-agenda-get-day-face date))
   4449 	  (put-text-property s (1- (point)) 'org-date-line t)
   4450 	  (put-text-property s (1- (point)) 'org-agenda-date-header t)
   4451 	  (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
   4452 	  (when todayp
   4453 	    (put-text-property s (1- (point)) 'org-today t))
   4454 	  (setq rtnall
   4455 		(org-agenda-add-time-grid-maybe rtnall ndays todayp))
   4456 	  (when rtnall (insert ;; all entries
   4457 			(org-agenda-finalize-entries rtnall 'agenda)
   4458 			"\n"))
   4459 	  (put-text-property s (1- (point)) 'day d)
   4460 	  (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))
   4461       (when (and org-agenda-clockreport-mode clocktable-start)
   4462 	(let ((org-agenda-files (org-agenda-files nil 'ifmode))
   4463 	      ;; the above line is to ensure the restricted range!
   4464 	      (p (copy-sequence org-agenda-clockreport-parameter-plist))
   4465 	      tbl)
   4466 	  (setq p (org-plist-delete p :block))
   4467 	  (setq p (plist-put p :tstart clocktable-start))
   4468 	  (setq p (plist-put p :tend clocktable-end))
   4469 	  (setq p (plist-put p :scope 'agenda))
   4470 	  (setq tbl (apply #'org-clock-get-clocktable p))
   4471 	  (insert tbl)))
   4472       (goto-char (point-min))
   4473       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   4474       (unless (or (not (get-buffer-window org-agenda-buffer-name))
   4475 		  (and (pos-visible-in-window-p (point-min))
   4476 		       (pos-visible-in-window-p (point-max))))
   4477 	(goto-char (1- (point-max)))
   4478 	(recenter -1)
   4479 	(when (not (pos-visible-in-window-p (or start-pos 1)))
   4480 	  (goto-char (or start-pos 1))
   4481 	  (recenter 1)))
   4482       (goto-char (or start-pos 1))
   4483       (add-text-properties (point-min) (point-max)
   4484 			   `(org-agenda-type agenda
   4485 					     org-last-args (,arg ,start-day ,span)
   4486 					     org-redo-cmd ,org-agenda-redo-command
   4487 					     org-series-cmd ,org-cmd))
   4488       (when (eq org-agenda-show-log-scoped 'clockcheck)
   4489 	(org-agenda-show-clocking-issues))
   4490       (org-agenda-finalize)
   4491       (setq buffer-read-only t)
   4492       (message ""))))
   4493 
   4494 (defun org-agenda-ndays-to-span (n)
   4495   "Return a span symbol for a span of N days, or N if none matches."
   4496   (cond ((symbolp n) n)
   4497 	((= n 1) 'day)
   4498 	((= n 7) 'week)
   4499 	((= n 14) 'fortnight)
   4500 	(t n)))
   4501 
   4502 (defun org-agenda-span-to-ndays (span &optional start-day)
   4503   "Return ndays from SPAN, possibly starting at START-DAY.
   4504 START-DAY is an absolute time value."
   4505   (cond ((numberp span) span)
   4506 	((eq span 'day) 1)
   4507 	((eq span 'week) 7)
   4508 	((eq span 'fortnight) 14)
   4509 	((eq span 'month)
   4510 	 (let ((date (calendar-gregorian-from-absolute start-day)))
   4511 	   (calendar-last-day-of-month (car date) (cl-caddr date))))
   4512 	((eq span 'year)
   4513 	 (let ((date (calendar-gregorian-from-absolute start-day)))
   4514 	   (if (calendar-leap-year-p (cl-caddr date)) 366 365)))))
   4515 
   4516 (defun org-agenda-span-name (span)
   4517   "Return a SPAN name."
   4518   (if (null span)
   4519       ""
   4520     (if (symbolp span)
   4521 	(capitalize (symbol-name span))
   4522       (format "%d days" span))))
   4523 
   4524 ;;; Agenda word search
   4525 
   4526 (defvar org-agenda-search-history nil)
   4527 
   4528 (defvar org-search-syntax-table nil
   4529   "Special syntax table for Org search.
   4530 In this table, we have single quotes not as word constituents, to
   4531 that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
   4532 
   4533 (defvar org-mode-syntax-table) ; From org.el
   4534 (defun org-search-syntax-table ()
   4535   (unless org-search-syntax-table
   4536     (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table))
   4537     (modify-syntax-entry ?' "." org-search-syntax-table)
   4538     (modify-syntax-entry ?` "." org-search-syntax-table))
   4539   org-search-syntax-table)
   4540 
   4541 (defvar org-agenda-last-search-view-search-was-boolean nil)
   4542 
   4543 ;;;###autoload
   4544 (defun org-search-view (&optional todo-only string edit-at)
   4545   "Show all entries that contain a phrase or words or regular expressions.
   4546 
   4547 With optional prefix argument TODO-ONLY, only consider entries that are
   4548 TODO entries.  The argument STRING can be used to pass a default search
   4549 string into this function.  If EDIT-AT is non-nil, it means that the
   4550 user should get a chance to edit this string, with cursor at position
   4551 EDIT-AT.
   4552 
   4553 The search string can be viewed either as a phrase that should be found as
   4554 is, or it can be broken into a number of snippets, each of which must match
   4555 in a Boolean way to select an entry.  The default depends on the variable
   4556 `org-agenda-search-view-always-boolean'.
   4557 Even if this is turned off (the default) you can always switch to
   4558 Boolean search dynamically by preceding the first word with  \"+\" or \"-\".
   4559 
   4560 The default is a direct search of the whole phrase, where each space in
   4561 the search string can expand to an arbitrary amount of whitespace,
   4562 including newlines.
   4563 
   4564 If using a Boolean search, the search string is split on whitespace and
   4565 each snippet is searched separately, with logical AND to select an entry.
   4566 Words prefixed with a minus must *not* occur in the entry.  Words without
   4567 a prefix or prefixed with a plus must occur in the entry.  Matching is
   4568 case-insensitive.  Words are enclosed by word delimiters (i.e. they must
   4569 match whole words, not parts of a word) if
   4570 `org-agenda-search-view-force-full-words' is set (default is nil).
   4571 
   4572 Boolean search snippets enclosed by curly braces are interpreted as
   4573 regular expressions that must or (when preceded with \"-\") must not
   4574 match in the entry.  Snippets enclosed into double quotes will be taken
   4575 as a whole, to include whitespace.
   4576 
   4577 - If the search string starts with an asterisk, search only in headlines.
   4578 - If (possibly after the leading star) the search string starts with an
   4579   exclamation mark, this also means to look at TODO entries only, an effect
   4580   that can also be achieved with a prefix argument.
   4581 - If (possibly after star and exclamation mark) the search string starts
   4582   with a colon, this will mean that the (non-regexp) snippets of the
   4583   Boolean search must match as full words.
   4584 
   4585 This command searches the agenda files, and in addition the files
   4586 listed in `org-agenda-text-search-extra-files' unless a restriction lock
   4587 is active."
   4588   (interactive "P")
   4589   (when org-agenda-overriding-arguments
   4590     (setq todo-only (car org-agenda-overriding-arguments)
   4591 	  string (nth 1 org-agenda-overriding-arguments)
   4592 	  edit-at (nth 2 org-agenda-overriding-arguments)))
   4593   (let* ((props (list 'face nil
   4594 		      'done-face 'org-agenda-done
   4595 		      'org-not-done-regexp org-not-done-regexp
   4596 		      'org-todo-regexp org-todo-regexp
   4597 		      'org-complex-heading-regexp org-complex-heading-regexp
   4598 		      'mouse-face 'highlight
   4599 		      'help-echo "mouse-2 or RET jump to location"))
   4600 	 (full-words org-agenda-search-view-force-full-words)
   4601 	 (org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
   4602 	 regexp rtn rtnall files file pos inherited-tags
   4603 	 marker category level tags c neg re boolean
   4604 	 ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
   4605     (unless (and (not edit-at)
   4606 		 (stringp string)
   4607 		 (string-match "\\S-" string))
   4608       (setq string (read-string
   4609 		    (if org-agenda-search-view-always-boolean
   4610 			"[+-]Word/{Regexp} ...: "
   4611 		      "Phrase or [+-]Word/{Regexp} ...: ")
   4612 		    (cond
   4613 		     ((integerp edit-at) (cons string edit-at))
   4614 		     (edit-at string))
   4615 		    'org-agenda-search-history)))
   4616     (catch 'exit
   4617       (setq org-agenda-buffer-name
   4618 	    (org-agenda--get-buffer-name
   4619 	     (and org-agenda-sticky
   4620 		  (if (stringp string)
   4621 		      (format "*Org Agenda(%s:%s)*"
   4622 			      (or org-keys (or (and todo-only "S") "s"))
   4623 			      string)
   4624 		    (format "*Org Agenda(%s)*"
   4625 			    (or (and todo-only "S") "s"))))))
   4626       (org-agenda-prepare "SEARCH")
   4627       (org-compile-prefix-format 'search)
   4628       (org-set-sorting-strategy 'search)
   4629       (setq org-agenda-redo-command
   4630 	    (list 'org-search-view (if todo-only t nil)
   4631 		  (list 'if 'current-prefix-arg nil string)))
   4632       (setq org-agenda-query-string string)
   4633       (if (equal (string-to-char string) ?*)
   4634 	  (setq hdl-only t
   4635 		words (substring string 1))
   4636 	(setq words string))
   4637       (when (equal (string-to-char words) ?!)
   4638 	(setq todo-only t
   4639 	      words (substring words 1)))
   4640       (when (equal (string-to-char words) ?:)
   4641 	(setq full-words t
   4642 	      words (substring words 1)))
   4643       (when (or org-agenda-search-view-always-boolean
   4644 		(member (string-to-char words) '(?- ?+ ?\{)))
   4645 	(setq boolean t))
   4646       (setq words (split-string words))
   4647       (let (www w)
   4648 	(while (setq w (pop words))
   4649 	  (while (and (string-match "\\\\\\'" w) words)
   4650 	    (setq w (concat (substring w 0 -1) " " (pop words))))
   4651 	  (push w www))
   4652 	(setq words (nreverse www) www nil)
   4653 	(while (setq w (pop words))
   4654 	  (when (and (string-match "\\`[-+]?{" w)
   4655 		     (not (string-match "}\\'" w)))
   4656 	    (while (and words (not (string-match "}\\'" (car words))))
   4657 	      (setq w (concat w " " (pop words))))
   4658 	    (setq w (concat w " " (pop words))))
   4659 	  (push w www))
   4660 	(setq words (nreverse www)))
   4661       (setq org-agenda-last-search-view-search-was-boolean boolean)
   4662       (when boolean
   4663 	(let (wds w)
   4664 	  (while (setq w (pop words))
   4665 	    (when (or (equal (substring w 0 1) "\"")
   4666 		      (and (> (length w) 1)
   4667 			   (member (substring w 0 1) '("+" "-"))
   4668 			   (equal (substring w 1 2) "\"")))
   4669 	      (while (and words (not (equal (substring w -1) "\"")))
   4670 		(setq w (concat w " " (pop words)))))
   4671 	    (and (string-match "\\`\\([-+]?\\)\"" w)
   4672 		 (setq w (replace-match "\\1" nil nil w)))
   4673 	    (and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
   4674 	    (push w wds))
   4675 	  (setq words (nreverse wds))))
   4676       (if boolean
   4677 	  (mapc (lambda (w)
   4678 		  (setq c (string-to-char w))
   4679 		  (if (equal c ?-)
   4680 		      (setq neg t w (substring w 1))
   4681 		    (if (equal c ?+)
   4682 			(setq neg nil w (substring w 1))
   4683 		      (setq neg nil)))
   4684 		  (if (string-match "\\`{.*}\\'" w)
   4685 		      (setq re (substring w 1 -1))
   4686 		    (if full-words
   4687 			(setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
   4688 		      (setq re (regexp-quote (downcase w)))))
   4689 		  (if neg (push re regexps-) (push re regexps+)))
   4690 		words)
   4691 	(push (mapconcat #'regexp-quote words "\\s-+")
   4692 	      regexps+))
   4693       (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
   4694       (if (not regexps+)
   4695 	  (setq regexp org-outline-regexp-bol)
   4696 	(setq regexp (pop regexps+))
   4697 	(when hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
   4698 					    regexp))))
   4699       (setq files (org-agenda-files nil 'ifmode))
   4700       ;; Add `org-agenda-text-search-extra-files' unless there is some
   4701       ;; restriction.
   4702       (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
   4703 	(pop org-agenda-text-search-extra-files)
   4704 	(unless (get 'org-agenda-files 'org-restrict)
   4705 	  (setq files (org-add-archive-files files))))
   4706       ;; Uniquify files.  However, let `org-check-agenda-file' handle
   4707       ;; non-existent ones.
   4708       (setq files (cl-remove-duplicates
   4709 		   (append files org-agenda-text-search-extra-files)
   4710 		   :test (lambda (a b)
   4711 			   (and (file-exists-p a)
   4712 				(file-exists-p b)
   4713 				(file-equal-p a b))))
   4714 	    rtnall nil)
   4715       (while (setq file (pop files))
   4716 	(setq ee nil)
   4717 	(catch 'nextfile
   4718 	  (org-check-agenda-file file)
   4719 	  (setq buffer (if (file-exists-p file)
   4720 			   (org-get-agenda-file-buffer file)
   4721 			 (error "No such file %s" file)))
   4722 	  (unless buffer
   4723 	    ;; If file does not exist, make sure an error message is sent
   4724 	    (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
   4725 				    file))))
   4726 	  (with-current-buffer buffer
   4727 	    (with-syntax-table (org-search-syntax-table)
   4728 	      (unless (derived-mode-p 'org-mode)
   4729 		(error "Agenda file %s is not in Org mode" file))
   4730 	      (let ((case-fold-search t))
   4731 		(save-excursion
   4732 		  (save-restriction
   4733 		    (if (eq buffer org-agenda-restrict)
   4734 			(narrow-to-region org-agenda-restrict-begin
   4735 					  org-agenda-restrict-end)
   4736 		      (widen))
   4737 		    (goto-char (point-min))
   4738 		    (unless (or (org-at-heading-p)
   4739 				(outline-next-heading))
   4740 		      (throw 'nextfile t))
   4741 		    (goto-char (max (point-min) (1- (point))))
   4742 		    (while (re-search-forward regexp nil t)
   4743 		      (org-back-to-heading t)
   4744 		      (while (and (not (zerop org-agenda-search-view-max-outline-level))
   4745 				  (> (org-reduced-level (org-outline-level))
   4746 				     org-agenda-search-view-max-outline-level)
   4747 				  (forward-line -1)
   4748 				  (org-back-to-heading t)))
   4749 		      (skip-chars-forward "* ")
   4750 		      (setq beg (point-at-bol)
   4751 			    beg1 (point)
   4752 			    end (progn
   4753 				  (outline-next-heading)
   4754 				  (while (and (not (zerop org-agenda-search-view-max-outline-level))
   4755 					      (> (org-reduced-level (org-outline-level))
   4756 						 org-agenda-search-view-max-outline-level)
   4757 					      (forward-line 1)
   4758 					      (outline-next-heading)))
   4759 				  (point)))
   4760 
   4761 		      (catch :skip
   4762 			(goto-char beg)
   4763 			(org-agenda-skip)
   4764 			(setq str (buffer-substring-no-properties
   4765 				   (point-at-bol)
   4766 				   (if hdl-only (point-at-eol) end)))
   4767 			(mapc (lambda (wr) (when (string-match wr str)
   4768 					     (goto-char (1- end))
   4769 					     (throw :skip t)))
   4770 			      regexps-)
   4771 			(mapc (lambda (wr) (unless (string-match wr str)
   4772 					     (goto-char (1- end))
   4773 					     (throw :skip t)))
   4774 			      (if todo-only
   4775 				  (cons (concat "^\\*+[ \t]+"
   4776                                                 org-not-done-regexp)
   4777 					regexps+)
   4778 				regexps+))
   4779 			(goto-char beg)
   4780 			(setq marker (org-agenda-new-marker (point))
   4781 			      category (org-get-category)
   4782 			      level (make-string (org-reduced-level (org-outline-level)) ? )
   4783 			      inherited-tags
   4784 			      (or (eq org-agenda-show-inherited-tags 'always)
   4785 				  (and (listp org-agenda-show-inherited-tags)
   4786 				       (memq 'todo org-agenda-show-inherited-tags))
   4787 				  (and (eq org-agenda-show-inherited-tags t)
   4788 				       (or (eq org-agenda-use-tag-inheritance t)
   4789 					   (memq 'todo org-agenda-use-tag-inheritance))))
   4790 			      tags (org-get-tags nil (not inherited-tags))
   4791 			      txt (org-agenda-format-item
   4792 				   ""
   4793 				   (buffer-substring-no-properties
   4794 				    beg1 (point-at-eol))
   4795 				   level category tags t))
   4796 			(org-add-props txt props
   4797 			  'org-marker marker 'org-hd-marker marker
   4798 			  'org-todo-regexp org-todo-regexp
   4799 			  'level level
   4800 			  'org-complex-heading-regexp org-complex-heading-regexp
   4801 			  'priority 1000
   4802 			  'type "search")
   4803 			(push txt ee)
   4804 			(goto-char (1- end))))))))))
   4805 	(setq rtn (nreverse ee))
   4806 	(setq rtnall (append rtnall rtn)))
   4807       (org-agenda--insert-overriding-header
   4808 	(with-temp-buffer
   4809 	  (insert "Search words: ")
   4810 	  (add-text-properties (point-min) (1- (point))
   4811 			       (list 'face 'org-agenda-structure))
   4812 	  (setq pos (point))
   4813 	  (insert string "\n")
   4814 	  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter))
   4815 	  (setq pos (point))
   4816 	  (unless org-agenda-multi
   4817 	    (insert (substitute-command-keys "\\<org-agenda-mode-map>\
   4818 Press `\\[org-agenda-manipulate-query-add]', \
   4819 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
   4820 `\\[org-agenda-manipulate-query-add-re]', \
   4821 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
   4822 `\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n"))
   4823 	    (add-text-properties pos (1- (point))
   4824 				 (list 'face 'org-agenda-structure-secondary)))
   4825 	  (buffer-string)))
   4826       (org-agenda-mark-header-line (point-min))
   4827       (when rtnall
   4828 	(insert (org-agenda-finalize-entries rtnall 'search) "\n"))
   4829       (goto-char (point-min))
   4830       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   4831       (add-text-properties (point-min) (point-max)
   4832 			   `(org-agenda-type search
   4833 					     org-last-args (,todo-only ,string ,edit-at)
   4834 					     org-redo-cmd ,org-agenda-redo-command
   4835 					     org-series-cmd ,org-cmd))
   4836       (org-agenda-finalize)
   4837       (setq buffer-read-only t))))
   4838 
   4839 ;;; Agenda TODO list
   4840 
   4841 (defun org-agenda-propertize-selected-todo-keywords (keywords)
   4842   "Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
   4843   (concat
   4844    (if (or (equal keywords "ALL") (not keywords))
   4845        (propertize "ALL" 'face 'org-agenda-structure-filter)
   4846      (mapconcat
   4847       (lambda (kw)
   4848         (propertize kw 'face (list (org-get-todo-face kw) 'org-agenda-structure)))
   4849       (org-split-string keywords "|")
   4850       "|"))
   4851    "\n"))
   4852 
   4853 (defvar org-select-this-todo-keyword nil)
   4854 (defvar org-last-arg nil)
   4855 
   4856 (defvar crm-separator)
   4857 
   4858 ;;;###autoload
   4859 (defun org-todo-list (&optional arg)
   4860   "Show all (not done) TODO entries from all agenda file in a single list.
   4861 The prefix arg can be used to select a specific TODO keyword and limit
   4862 the list to these.  When using `\\[universal-argument]', you will be prompted
   4863 for a keyword.  A numeric prefix directly selects the Nth keyword in
   4864 `org-todo-keywords-1'."
   4865   (interactive "P")
   4866   (when org-agenda-overriding-arguments
   4867     (setq arg org-agenda-overriding-arguments))
   4868   (when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
   4869   (let* ((today (org-today))
   4870 	 (date (calendar-gregorian-from-absolute today))
   4871 	 (completion-ignore-case t)
   4872          kwds org-select-this-todo-keyword rtn rtnall files file pos)
   4873     (catch 'exit
   4874       (setq org-agenda-buffer-name
   4875 	    (org-agenda--get-buffer-name
   4876 	     (and org-agenda-sticky
   4877 		  (if (stringp org-select-this-todo-keyword)
   4878 		      (format "*Org Agenda(%s:%s)*" (or org-keys "t")
   4879 			      org-select-this-todo-keyword)
   4880 		    (format "*Org Agenda(%s)*" (or org-keys "t"))))))
   4881       (org-agenda-prepare "TODO")
   4882       (setq kwds org-todo-keywords-for-agenda
   4883             org-select-this-todo-keyword (if (stringp arg) arg
   4884                                            (and (integerp arg)
   4885 						(> arg 0)
   4886                                                 (nth (1- arg) kwds))))
   4887       (when (equal arg '(4))
   4888         (setq org-select-this-todo-keyword
   4889               (mapconcat #'identity
   4890                          (let ((crm-separator "|"))
   4891                            (completing-read-multiple
   4892                             "Keyword (or KWD1|KWD2|...): "
   4893                             (mapcar #'list kwds) nil nil))
   4894                          "|")))
   4895       (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
   4896       (org-compile-prefix-format 'todo)
   4897       (org-set-sorting-strategy 'todo)
   4898       (setq org-agenda-redo-command
   4899 	    `(org-todo-list (or (and (numberp current-prefix-arg)
   4900 				     current-prefix-arg)
   4901 				,org-select-this-todo-keyword
   4902 				current-prefix-arg ,arg)))
   4903       (setq files (org-agenda-files nil 'ifmode)
   4904 	    rtnall nil)
   4905       (while (setq file (pop files))
   4906 	(catch 'nextfile
   4907 	  (org-check-agenda-file file)
   4908 	  (setq rtn (org-agenda-get-day-entries file date :todo))
   4909 	  (setq rtnall (append rtnall rtn))))
   4910       (org-agenda--insert-overriding-header
   4911         (with-temp-buffer
   4912 	  (insert "Global list of TODO items of type: ")
   4913 	  (add-text-properties (point-min) (1- (point))
   4914 			       (list 'face 'org-agenda-structure
   4915 				     'short-heading
   4916 				     (concat "ToDo: "
   4917 					     (or org-select-this-todo-keyword "ALL"))))
   4918 	  (org-agenda-mark-header-line (point-min))
   4919 	  (insert (org-agenda-propertize-selected-todo-keywords
   4920 		   org-select-this-todo-keyword))
   4921 	  (setq pos (point))
   4922 	  (unless org-agenda-multi
   4923 	    (insert (substitute-command-keys "Press \
   4924 \\<org-agenda-mode-map>`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \
   4925 to search again: (0)[ALL]"))
   4926 	    (let ((n 0))
   4927               (dolist (k kwds)
   4928                 (let ((s (format "(%d)%s" (cl-incf n) k)))
   4929                   (when (> (+ (current-column) (string-width s) 1) (window-width))
   4930                     (insert "\n                     "))
   4931                   (insert " " s))))
   4932 	    (insert "\n"))
   4933 	  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary))
   4934 	  (buffer-string)))
   4935       (org-agenda-mark-header-line (point-min))
   4936       (when rtnall
   4937 	(insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
   4938       (goto-char (point-min))
   4939       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   4940       (add-text-properties (point-min) (point-max)
   4941 			   `(org-agenda-type todo
   4942 					     org-last-args ,arg
   4943 					     org-redo-cmd ,org-agenda-redo-command
   4944 					     org-series-cmd ,org-cmd))
   4945       (org-agenda-finalize)
   4946       (setq buffer-read-only t))))
   4947 
   4948 ;;; Agenda tags match
   4949 
   4950 ;;;###autoload
   4951 (defun org-tags-view (&optional todo-only match)
   4952   "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
   4953 The prefix arg TODO-ONLY limits the search to TODO entries."
   4954   (interactive "P")
   4955   (when org-agenda-overriding-arguments
   4956     (setq todo-only (car org-agenda-overriding-arguments)
   4957 	  match (nth 1 org-agenda-overriding-arguments)))
   4958   (let* ((org-tags-match-list-sublevels
   4959 	  org-tags-match-list-sublevels)
   4960 	 (completion-ignore-case t)
   4961 	 (org--matcher-tags-todo-only todo-only)
   4962 	 rtn rtnall files file pos matcher
   4963 	 buffer)
   4964     (when (and (stringp match) (not (string-match "\\S-" match)))
   4965       (setq match nil))
   4966     (catch 'exit
   4967       (setq org-agenda-buffer-name
   4968 	    (org-agenda--get-buffer-name
   4969 	     (and org-agenda-sticky
   4970 		  (if (stringp match)
   4971 		      (format "*Org Agenda(%s:%s)*"
   4972 			      (or org-keys (or (and todo-only "M") "m"))
   4973 			      match)
   4974 		    (format "*Org Agenda(%s)*"
   4975 			    (or (and todo-only "M") "m"))))))
   4976       (setq matcher (org-make-tags-matcher match))
   4977       ;; Prepare agendas (and `org-tag-alist-for-agenda') before
   4978       ;; expanding tags within `org-make-tags-matcher'
   4979       (org-agenda-prepare (concat "TAGS " match))
   4980       (setq match (car matcher)
   4981 	    matcher (cdr matcher))
   4982       (org-compile-prefix-format 'tags)
   4983       (org-set-sorting-strategy 'tags)
   4984       (setq org-agenda-query-string match)
   4985       (setq org-agenda-redo-command
   4986 	    (list 'org-tags-view
   4987 		  `(quote ,org--matcher-tags-todo-only)
   4988 		  `(if current-prefix-arg nil ,org-agenda-query-string)))
   4989       (setq files (org-agenda-files nil 'ifmode)
   4990 	    rtnall nil)
   4991       (while (setq file (pop files))
   4992 	(catch 'nextfile
   4993 	  (org-check-agenda-file file)
   4994 	  (setq buffer (if (file-exists-p file)
   4995 			   (org-get-agenda-file-buffer file)
   4996 			 (error "No such file %s" file)))
   4997 	  (if (not buffer)
   4998 	      ;; If file does not exist, error message to agenda
   4999 	      (setq rtn (list
   5000 			 (format "ORG-AGENDA-ERROR: No such org-file %s" file))
   5001 		    rtnall (append rtnall rtn))
   5002 	    (with-current-buffer buffer
   5003 	      (unless (derived-mode-p 'org-mode)
   5004 		(error "Agenda file %s is not in Org mode" file))
   5005 	      (save-excursion
   5006 		(save-restriction
   5007 		  (if (eq buffer org-agenda-restrict)
   5008 		      (narrow-to-region org-agenda-restrict-begin
   5009 					org-agenda-restrict-end)
   5010 		    (widen))
   5011 		  (setq rtn (org-scan-tags 'agenda
   5012 					   matcher
   5013 					   org--matcher-tags-todo-only))
   5014 		  (setq rtnall (append rtnall rtn))))))))
   5015       (org-agenda--insert-overriding-header
   5016         (with-temp-buffer
   5017 	  (insert "Headlines with TAGS match: ")
   5018 	  (add-text-properties (point-min) (1- (point))
   5019 			       (list 'face 'org-agenda-structure
   5020 				     'short-heading
   5021 				     (concat "Match: " match)))
   5022 	  (setq pos (point))
   5023 	  (insert match "\n")
   5024 	  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter))
   5025 	  (setq pos (point))
   5026 	  (unless org-agenda-multi
   5027 	    (insert (substitute-command-keys
   5028 		     "Press \
   5029 \\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \
   5030 to search again\n")))
   5031 	  (add-text-properties pos (1- (point))
   5032 			       (list 'face 'org-agenda-structure-secondary))
   5033 	  (buffer-string)))
   5034       (org-agenda-mark-header-line (point-min))
   5035       (when rtnall
   5036 	(insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
   5037       (goto-char (point-min))
   5038       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   5039       (add-text-properties
   5040        (point-min) (point-max)
   5041        `(org-agenda-type tags
   5042 			 org-last-args (,org--matcher-tags-todo-only ,match)
   5043 			 org-redo-cmd ,org-agenda-redo-command
   5044 			 org-series-cmd ,org-cmd))
   5045       (org-agenda-finalize)
   5046       (setq buffer-read-only t))))
   5047 
   5048 ;;; Agenda Finding stuck projects
   5049 
   5050 (defvar org-agenda-skip-regexp nil
   5051   "Regular expression used in skipping subtrees for the agenda.
   5052 This is basically a temporary global variable that can be set and then
   5053 used by user-defined selections using `org-agenda-skip-function'.")
   5054 
   5055 (defvar org-agenda-overriding-header nil
   5056   "When set during agenda, todo and tags searches it replaces the header.
   5057 If an empty string, no header will be inserted.  If any other
   5058 string, it will be inserted as a header.  If a function, insert
   5059 the string returned by the function as a header.  If nil, a
   5060 header will be generated automatically according to the command.
   5061 This variable should not be set directly, but custom commands can
   5062 bind it in the options section.")
   5063 
   5064 (defun org-agenda-skip-entry-if (&rest conditions)
   5065   "Skip entry if any of CONDITIONS is true.
   5066 See `org-agenda-skip-if' for details."
   5067   (org-agenda-skip-if nil conditions))
   5068 
   5069 (defun org-agenda-skip-subtree-if (&rest conditions)
   5070   "Skip subtree if any of CONDITIONS is true.
   5071 See `org-agenda-skip-if' for details."
   5072   (org-agenda-skip-if t conditions))
   5073 
   5074 (defun org-agenda-skip-if (subtree conditions)
   5075   "Check current entity for CONDITIONS.
   5076 If SUBTREE is non-nil, the entire subtree is checked.  Otherwise, only
   5077 the entry (i.e. the text before the next heading) is checked.
   5078 
   5079 CONDITIONS is a list of symbols, boolean OR is used to combine the results
   5080 from different tests.  Valid conditions are:
   5081 
   5082 scheduled     Check if there is a scheduled cookie
   5083 notscheduled  Check if there is no scheduled cookie
   5084 deadline      Check if there is a deadline
   5085 notdeadline   Check if there is no deadline
   5086 timestamp     Check if there is a timestamp (also deadline or scheduled)
   5087 nottimestamp  Check if there is no timestamp (also deadline or scheduled)
   5088 regexp        Check if regexp matches
   5089 notregexp     Check if regexp does not match.
   5090 todo          Check if TODO keyword matches
   5091 nottodo       Check if TODO keyword does not match
   5092 
   5093 The regexp is taken from the conditions list, it must come right after
   5094 the `regexp' or `notregexp' element.
   5095 
   5096 `todo' and `nottodo' accept as an argument a list of todo
   5097 keywords, which may include \"*\" to match any todo keyword.
   5098 
   5099     (org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\"))
   5100 
   5101 would skip all entries with \"TODO\" or \"WAITING\" keywords.
   5102 
   5103 Instead of a list, a keyword class may be given.  For example:
   5104 
   5105     (org-agenda-skip-entry-if \\='nottodo \\='done)
   5106 
   5107 would skip entries that haven't been marked with any of \"DONE\"
   5108 keywords.  Possible classes are: `todo', `done', `any'.
   5109 
   5110 If any of these conditions is met, this function returns the end point of
   5111 the entity, causing the search to continue from there.  This is a function
   5112 that can be put into `org-agenda-skip-function' for the duration of a command."
   5113   (org-back-to-heading t)
   5114   (let* (;; (beg (point))
   5115 	 (end (if subtree (save-excursion (org-end-of-subtree t) (point))
   5116 		(org-entry-end-position)))
   5117 	 (planning-end (if subtree end (line-end-position 2)))
   5118 	 m)
   5119     (and
   5120      (or (and (memq 'scheduled conditions)
   5121 	      (re-search-forward org-scheduled-time-regexp planning-end t))
   5122 	 (and (memq 'notscheduled conditions)
   5123 	      (not
   5124 	       (save-excursion
   5125 		 (re-search-forward org-scheduled-time-regexp planning-end t))))
   5126 	 (and (memq 'deadline conditions)
   5127 	      (re-search-forward org-deadline-time-regexp planning-end t))
   5128 	 (and (memq 'notdeadline conditions)
   5129 	      (not
   5130 	       (save-excursion
   5131 		 (re-search-forward org-deadline-time-regexp planning-end t))))
   5132 	 (and (memq 'timestamp conditions)
   5133 	      (re-search-forward org-ts-regexp end t))
   5134 	 (and (memq 'nottimestamp conditions)
   5135 	      (not (save-excursion (re-search-forward org-ts-regexp end t))))
   5136 	 (and (setq m (memq 'regexp conditions))
   5137 	      (stringp (nth 1 m))
   5138 	      (re-search-forward (nth 1 m) end t))
   5139 	 (and (setq m (memq 'notregexp conditions))
   5140 	      (stringp (nth 1 m))
   5141 	      (not (save-excursion (re-search-forward (nth 1 m) end t))))
   5142 	 (and (or
   5143 	       (setq m (memq 'nottodo conditions))
   5144 	       (setq m (memq 'todo-unblocked conditions))
   5145 	       (setq m (memq 'nottodo-unblocked conditions))
   5146 	       (setq m (memq 'todo conditions)))
   5147 	      (org-agenda-skip-if-todo m end)))
   5148      end)))
   5149 
   5150 (defun org-agenda-skip-if-todo (args end)
   5151   "Helper function for `org-agenda-skip-if', do not use it directly.
   5152 ARGS is a list with first element either `todo', `nottodo',
   5153 `todo-unblocked' or `nottodo-unblocked'.  The remainder is either
   5154 a list of TODO keywords, or a state symbol `todo' or `done' or
   5155 `any'."
   5156   (let ((todo-re
   5157 	 (concat "^\\*+[ \t]+"
   5158 		 (regexp-opt
   5159 		  (pcase args
   5160 		    (`(,_ todo)
   5161 		     (org-delete-all org-done-keywords
   5162 				     (copy-sequence org-todo-keywords-1)))
   5163 		    (`(,_ done) org-done-keywords)
   5164 		    (`(,_ any) org-todo-keywords-1)
   5165 		    (`(,_ ,(pred atom))
   5166 		     (error "Invalid TODO class or type: %S" args))
   5167 		    (`(,_ ,(pred (member "*"))) org-todo-keywords-1)
   5168 		    (`(,_ ,todo-list) todo-list))
   5169 		  'words))))
   5170     (pcase args
   5171       (`(todo . ,_)
   5172        (let (case-fold-search) (re-search-forward todo-re end t)))
   5173       (`(nottodo . ,_)
   5174        (not (let (case-fold-search) (re-search-forward todo-re end t))))
   5175       (`(todo-unblocked . ,_)
   5176        (catch :unblocked
   5177 	 (while (let (case-fold-search) (re-search-forward todo-re end t))
   5178 	   (when (org-entry-blocked-p) (throw :unblocked t)))
   5179 	 nil))
   5180       (`(nottodo-unblocked . ,_)
   5181        (catch :unblocked
   5182 	 (while (let (case-fold-search) (re-search-forward todo-re end t))
   5183 	   (when (org-entry-blocked-p) (throw :unblocked nil)))
   5184 	 t))
   5185       (`(,type . ,_) (error "Unknown TODO skip type: %S" type)))))
   5186 
   5187 ;;;###autoload
   5188 (defun org-agenda-list-stuck-projects (&rest _ignore)
   5189   "Create agenda view for projects that are stuck.
   5190 Stuck projects are project that have no next actions.  For the definitions
   5191 of what a project is and how to check if it stuck, customize the variable
   5192 `org-stuck-projects'."
   5193   (interactive)
   5194   (let* ((org-agenda-overriding-header
   5195 	  (or org-agenda-overriding-header "List of stuck projects: "))
   5196 	 (matcher (nth 0 org-stuck-projects))
   5197 	 (todo (nth 1 org-stuck-projects))
   5198 	 (tags (nth 2 org-stuck-projects))
   5199 	 (gen-re (org-string-nw-p (nth 3 org-stuck-projects)))
   5200 	 (todo-wds
   5201 	  (if (not (member "*" todo)) todo
   5202 	    (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
   5203 	    (org-delete-all org-done-keywords-for-agenda
   5204 			    (copy-sequence org-todo-keywords-for-agenda))))
   5205 	 (todo-re (and todo
   5206 		       (format "^\\*+[ \t]+\\(%s\\)\\>"
   5207 			       (mapconcat #'identity todo-wds "\\|"))))
   5208 	 (tags-re (cond ((null tags) nil)
   5209 			((member "*" tags) org-tag-line-re)
   5210 			(tags
   5211 			 (let ((other-tags (format "\\(?:%s:\\)*" org-tag-re)))
   5212 			   (concat org-outline-regexp-bol
   5213 				   ".*?[ \t]:"
   5214 				   other-tags
   5215 				   (regexp-opt tags t)
   5216 				   ":" other-tags "[ \t]*$")))
   5217 			(t nil)))
   5218 	 (re-list (delq nil (list todo-re tags-re gen-re)))
   5219 	 (skip-re
   5220 	  (if (null re-list)
   5221 	      (error "Missing information to identify unstuck projects")
   5222 	    (mapconcat #'identity re-list "\\|")))
   5223 	 (org-agenda-skip-function
   5224 	  ;; Skip entry if `org-agenda-skip-regexp' matches anywhere
   5225 	  ;; in the subtree.
   5226 	  (lambda ()
   5227 	    (and (save-excursion
   5228 		   (let ((case-fold-search nil))
   5229 		     (re-search-forward
   5230 		      skip-re (save-excursion (org-end-of-subtree t)) t)))
   5231 		 (progn (outline-next-heading) (point))))))
   5232     (org-tags-view nil matcher)
   5233     (setq org-agenda-buffer-name (buffer-name))
   5234     (with-current-buffer org-agenda-buffer-name
   5235       (setq org-agenda-redo-command
   5236 	    `(org-agenda-list-stuck-projects ,current-prefix-arg))
   5237       (let ((inhibit-read-only t))
   5238         (add-text-properties
   5239          (point-min) (point-max)
   5240          `(org-redo-cmd ,org-agenda-redo-command))))))
   5241 
   5242 ;;; Diary integration
   5243 
   5244 (defvar org-disable-agenda-to-diary nil)          ;Dynamically-scoped param.
   5245 (defvar diary-list-entries-hook)
   5246 (defvar diary-time-regexp)
   5247 (defvar diary-modify-entry-list-string-function)
   5248 (defvar diary-file-name-prefix)
   5249 (defvar diary-display-function)
   5250 
   5251 (defun org-get-entries-from-diary (date)
   5252   "Get the (Emacs Calendar) diary entries for DATE."
   5253   (require 'diary-lib)
   5254   (declare-function diary-fancy-display "diary-lib" ())
   5255   (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
   5256 	 (diary-display-function #'diary-fancy-display)
   5257 	 (pop-up-frames nil)
   5258 	 (diary-list-entries-hook
   5259 	  (cons 'org-diary-default-entry diary-list-entries-hook))
   5260 	 (diary-file-name-prefix nil) ; turn this feature off
   5261 	 (diary-modify-entry-list-string-function
   5262 	  #'org-modify-diary-entry-string)
   5263 	 (diary-time-regexp (concat "^" diary-time-regexp))
   5264 	 entries
   5265 	 (org-disable-agenda-to-diary t))
   5266     (save-excursion
   5267       (save-window-excursion
   5268         (diary-list-entries date 1)))
   5269     (if (not (get-buffer diary-fancy-buffer))
   5270 	(setq entries nil)
   5271       (with-current-buffer diary-fancy-buffer
   5272 	(setq buffer-read-only nil)
   5273 	(if (zerop (buffer-size))
   5274 	    ;; No entries
   5275 	    (setq entries nil)
   5276 	  ;; Omit the date and other unnecessary stuff
   5277 	  (org-agenda-cleanup-fancy-diary)
   5278 	  ;; Add prefix to each line and extend the text properties
   5279 	  (if (zerop (buffer-size))
   5280 	      (setq entries nil)
   5281 	    (setq entries (buffer-substring (point-min) (- (point-max) 1)))
   5282 	    (setq entries
   5283 		  (with-temp-buffer
   5284 		    (insert entries) (goto-char (point-min))
   5285 		    (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t)
   5286 		      (unless (save-match-data (string-match diary-time-regexp (match-string 1)))
   5287 			(replace-match (concat "; " (match-string 1)))))
   5288 		    (buffer-string)))))
   5289 	(set-buffer-modified-p nil)
   5290 	(kill-buffer diary-fancy-buffer)))
   5291     (when entries
   5292       (setq entries (org-split-string entries "\n"))
   5293       (setq entries
   5294 	    (mapcar
   5295 	     (lambda (x)
   5296 	       (setq x (org-agenda-format-item "" x nil "Diary" nil 'time))
   5297 	       ;; Extend the text properties to the beginning of the line
   5298 	       (org-add-props x (text-properties-at (1- (length x)) x)
   5299 		 'type "diary" 'date date 'face 'org-agenda-diary))
   5300 	     entries)))))
   5301 
   5302 (defvar org-agenda-cleanup-fancy-diary-hook nil
   5303   "Hook run when the fancy diary buffer is cleaned up.")
   5304 
   5305 (defun org-agenda-cleanup-fancy-diary ()
   5306   "Remove unwanted stuff in buffer created by `fancy-diary-display'.
   5307 This gets rid of the date, the underline under the date, and the
   5308 dummy entry installed by Org mode to ensure non-empty diary for
   5309 each date.  It also removes lines that contain only whitespace."
   5310   (goto-char (point-min))
   5311   (if (looking-at ".*?:[ \t]*")
   5312       (progn
   5313 	(replace-match "")
   5314 	(re-search-forward "\n=+$" nil t)
   5315 	(replace-match "")
   5316 	(while (re-search-backward "^ +\n?" nil t) (replace-match "")))
   5317     (re-search-forward "\n=+$" nil t)
   5318     (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
   5319   (goto-char (point-min))
   5320   (while (re-search-forward "^ +\n" nil t)
   5321     (replace-match ""))
   5322   (goto-char (point-min))
   5323   (when (re-search-forward "^Org mode dummy\n?" nil t)
   5324     (replace-match ""))
   5325   (run-hooks 'org-agenda-cleanup-fancy-diary-hook))
   5326 
   5327 (defun org-modify-diary-entry-string (string)
   5328   "Add text properties to string, allowing Org to act on it."
   5329   (org-add-props string nil
   5330     'mouse-face 'highlight
   5331     'help-echo (if buffer-file-name
   5332 		   (format "mouse-2 or RET jump to diary file %s"
   5333 			   (abbreviate-file-name buffer-file-name))
   5334 		 "")
   5335     'org-agenda-diary-link t
   5336     'org-marker (org-agenda-new-marker (point-at-bol))))
   5337 
   5338 (defun org-diary-default-entry ()
   5339   "Add a dummy entry to the diary.
   5340 Needed to avoid empty dates which mess up holiday display."
   5341   ;; Catch the error if dealing with the new add-to-diary-alist
   5342   (when org-disable-agenda-to-diary
   5343     (diary-add-to-list original-date "Org mode dummy" "")))
   5344 
   5345 (defvar org-diary-last-run-time nil)
   5346 
   5347 ;;;###autoload
   5348 (defun org-diary (&rest args)
   5349   "Return diary information from org files.
   5350 This function can be used in a \"sexp\" diary entry in the Emacs calendar.
   5351 It accesses org files and extracts information from those files to be
   5352 listed in the diary.  The function accepts arguments specifying what
   5353 items should be listed.  For a list of arguments allowed here, see the
   5354 variable `org-agenda-entry-types'.
   5355 
   5356 The call in the diary file should look like this:
   5357 
   5358    &%%(org-diary) ~/path/to/some/orgfile.org
   5359 
   5360 Use a separate line for each org file to check.  Or, if you omit the file name,
   5361 all files listed in `org-agenda-files' will be checked automatically:
   5362 
   5363    &%%(org-diary)
   5364 
   5365 If you don't give any arguments (as in the example above), the default value
   5366 of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
   5367 So the example above may also be written as
   5368 
   5369    &%%(org-diary :deadline :timestamp :sexp :scheduled)
   5370 
   5371 The function expects the lisp variables `entry' and `date' to be provided
   5372 by the caller, because this is how the calendar works.  Don't use this
   5373 function from a program - use `org-agenda-get-day-entries' instead."
   5374   (with-no-warnings (defvar date) (defvar entry))
   5375   (when (> (- (float-time)
   5376 	      org-agenda-last-marker-time)
   5377 	   5)
   5378     ;; I am not sure if this works with sticky agendas, because the marker
   5379     ;; list is then no longer a global variable.
   5380     (org-agenda-reset-markers))
   5381   (org-compile-prefix-format 'agenda)
   5382   (org-set-sorting-strategy 'agenda)
   5383   (setq args (or args org-agenda-entry-types))
   5384   (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
   5385 		    (list entry)
   5386 		  (org-agenda-files t)))
   5387 	 (time (float-time))
   5388 	 file rtn results)
   5389     (when (or (not org-diary-last-run-time)
   5390 	      (> (- time
   5391 		    org-diary-last-run-time)
   5392 		 3))
   5393       (org-agenda-prepare-buffers files))
   5394     (setq org-diary-last-run-time time)
   5395     ;; If this is called during org-agenda, don't return any entries to
   5396     ;; the calendar.  Org Agenda will list these entries itself.
   5397     (when org-disable-agenda-to-diary (setq files nil))
   5398     (while (setq file (pop files))
   5399       (setq rtn (apply #'org-agenda-get-day-entries file date args))
   5400       (setq results (append results rtn)))
   5401     (when results
   5402       (setq results
   5403 	    (mapcar (lambda (i) (replace-regexp-in-string
   5404 				 org-link-bracket-re "\\2" i))
   5405 		    results))
   5406       (concat (org-agenda-finalize-entries results) "\n"))))
   5407 
   5408 ;;; Agenda entry finders
   5409 
   5410 (defun org-agenda--timestamp-to-absolute (&rest args)
   5411   "Call `org-time-string-to-absolute' with ARGS.
   5412 However, throw `:skip' whenever an error is raised."
   5413   (condition-case e
   5414       (apply #'org-time-string-to-absolute args)
   5415     (org-diary-sexp-no-match (throw :skip nil))
   5416     (error
   5417      (message "%s; Skipping entry" (error-message-string e))
   5418      (throw :skip nil))))
   5419 
   5420 (defun org-agenda-get-day-entries (file date &rest args)
   5421   "Does the work for `org-diary' and `org-agenda'.
   5422 FILE is the path to a file to be checked for entries.  DATE is date like
   5423 the one returned by `calendar-current-date'.  ARGS are symbols indicating
   5424 which kind of entries should be extracted.  For details about these, see
   5425 the documentation of `org-diary'."
   5426   (let* ((org-startup-folded nil)
   5427 	 (org-startup-align-all-tables nil)
   5428 	 (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file)
   5429 		   (error "No such file %s" file))))
   5430     (if (not buffer)
   5431 	;; If file does not exist, signal it in diary nonetheless.
   5432 	(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
   5433       (with-current-buffer buffer
   5434 	(unless (derived-mode-p 'org-mode)
   5435 	  (error "Agenda file %s is not in Org mode" file))
   5436 	(setq org-agenda-buffer (or org-agenda-buffer buffer))
   5437 	(setf org-agenda-current-date date)
   5438 	(save-excursion
   5439 	  (save-restriction
   5440 	    (if (eq buffer org-agenda-restrict)
   5441 		(narrow-to-region org-agenda-restrict-begin
   5442 				  org-agenda-restrict-end)
   5443 	      (widen))
   5444 	    ;; Rationalize ARGS.  Also make sure `:deadline' comes
   5445 	    ;; first in order to populate DEADLINES before passing it.
   5446 	    ;;
   5447 	    ;; We use `delq' since `org-uniquify' duplicates ARGS,
   5448 	    ;; guarding us from modifying `org-agenda-entry-types'.
   5449 	    (setf args (org-uniquify (or args org-agenda-entry-types)))
   5450 	    (when (and (memq :scheduled args) (memq :scheduled* args))
   5451 	      (setf args (delq :scheduled* args)))
   5452 	    (cond
   5453 	     ((memq :deadline args)
   5454 	      (setf args (cons :deadline
   5455 			       (delq :deadline (delq :deadline* args)))))
   5456 	     ((memq :deadline* args)
   5457 	      (setf args (cons :deadline* (delq :deadline* args)))))
   5458 	    ;; Collect list of headlines.  Return them flattened.
   5459 	    (let ((case-fold-search nil) results deadlines)
   5460               (org-dlet
   5461                   ((date date))
   5462 	        (dolist (arg args (apply #'nconc (nreverse results)))
   5463 		  (pcase arg
   5464 		    ((and :todo (guard (org-agenda-today-p date)))
   5465 		     (push (org-agenda-get-todos) results))
   5466 		    (:timestamp
   5467 		     (push (org-agenda-get-blocks) results)
   5468 		     (push (org-agenda-get-timestamps deadlines) results))
   5469 		    (:sexp
   5470 		     (push (org-agenda-get-sexps) results))
   5471 		    (:scheduled
   5472 		     (push (org-agenda-get-scheduled deadlines) results))
   5473 		    (:scheduled*
   5474 		     (push (org-agenda-get-scheduled deadlines t) results))
   5475 		    (:closed
   5476 		     (push (org-agenda-get-progress) results))
   5477 		    (:deadline
   5478 		     (setf deadlines (org-agenda-get-deadlines))
   5479 		     (push deadlines results))
   5480 		    (:deadline*
   5481 		     (setf deadlines (org-agenda-get-deadlines t))
   5482 		     (push deadlines results))))))))))))
   5483 
   5484 (defsubst org-em (x y list)
   5485   "Is X or Y a member of LIST?"
   5486   (or (memq x list) (memq y list)))
   5487 
   5488 (defvar org-heading-keyword-regexp-format) ; defined in org.el
   5489 (defvar org-agenda-sorting-strategy-selected nil)
   5490 
   5491 (defun org-agenda-entry-get-agenda-timestamp (pom)
   5492   "Retrieve timestamp information for sorting agenda views.
   5493 Given a point or marker POM, returns a cons cell of the timestamp
   5494 and the timestamp type relevant for the sorting strategy in
   5495 `org-agenda-sorting-strategy-selected'."
   5496   (let (ts ts-date-type)
   5497     (save-match-data
   5498       (cond ((org-em 'scheduled-up 'scheduled-down
   5499 		     org-agenda-sorting-strategy-selected)
   5500 	     (setq ts (org-entry-get pom "SCHEDULED")
   5501 		   ts-date-type " scheduled"))
   5502 	    ((org-em 'deadline-up 'deadline-down
   5503 		     org-agenda-sorting-strategy-selected)
   5504 	     (setq ts (org-entry-get pom "DEADLINE")
   5505 		   ts-date-type " deadline"))
   5506 	    ((org-em 'ts-up 'ts-down
   5507 		     org-agenda-sorting-strategy-selected)
   5508 	     (setq ts (org-entry-get pom "TIMESTAMP")
   5509 		   ts-date-type " timestamp"))
   5510 	    ((org-em 'tsia-up 'tsia-down
   5511 		     org-agenda-sorting-strategy-selected)
   5512 	     (setq ts (org-entry-get pom "TIMESTAMP_IA")
   5513 		   ts-date-type " timestamp_ia"))
   5514 	    ((org-em 'timestamp-up 'timestamp-down
   5515 		     org-agenda-sorting-strategy-selected)
   5516 	     (setq ts (or (org-entry-get pom "SCHEDULED")
   5517 			  (org-entry-get pom "DEADLINE")
   5518 			  (org-entry-get pom "TIMESTAMP")
   5519 			  (org-entry-get pom "TIMESTAMP_IA"))
   5520 		   ts-date-type ""))
   5521 	    (t (setq ts-date-type "")))
   5522       (cons (when ts (ignore-errors (org-time-string-to-absolute ts)))
   5523 	    ts-date-type))))
   5524 
   5525 (defun org-agenda-get-todos ()
   5526   "Return the TODO information for agenda display."
   5527   (let* ((props (list 'face nil
   5528 		      'done-face 'org-agenda-done
   5529 		      'org-not-done-regexp org-not-done-regexp
   5530 		      'org-todo-regexp org-todo-regexp
   5531 		      'org-complex-heading-regexp org-complex-heading-regexp
   5532 		      'mouse-face 'highlight
   5533 		      'help-echo
   5534 		      (format "mouse-2 or RET jump to org file %s"
   5535 			      (abbreviate-file-name buffer-file-name))))
   5536 	 (case-fold-search nil)
   5537 	 (regexp (format org-heading-keyword-regexp-format
   5538 			 (cond
   5539 			  ((and org-select-this-todo-keyword
   5540 				(equal org-select-this-todo-keyword "*"))
   5541 			   org-todo-regexp)
   5542 			  (org-select-this-todo-keyword
   5543 			   (concat "\\("
   5544 				   (mapconcat #'identity
   5545 					      (org-split-string
   5546 					       org-select-this-todo-keyword
   5547 					       "|")
   5548 					      "\\|")
   5549 				   "\\)"))
   5550 			  (t org-not-done-regexp))))
   5551 	 marker priority category level tags todo-state
   5552 	 ts-date ts-date-type ts-date-pair
   5553 	 ee txt beg end inherited-tags todo-state-end-pos)
   5554     (goto-char (point-min))
   5555     (while (re-search-forward regexp nil t)
   5556       (catch :skip
   5557 	(save-match-data
   5558 	  (beginning-of-line)
   5559 	  (org-agenda-skip)
   5560 	  (setq beg (point) end (save-excursion (outline-next-heading) (point)))
   5561 	  (unless (and (setq todo-state (org-get-todo-state))
   5562 		       (setq todo-state-end-pos (match-end 2)))
   5563 	    (goto-char end)
   5564 	    (throw :skip nil))
   5565 	  (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
   5566 	    (goto-char (1+ beg))
   5567 	    (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
   5568 	    (throw :skip nil)))
   5569 	(goto-char (match-beginning 2))
   5570 	(setq marker (org-agenda-new-marker (match-beginning 0))
   5571 	      category (org-get-category)
   5572 	      ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
   5573 	      ts-date (car ts-date-pair)
   5574 	      ts-date-type (cdr ts-date-pair)
   5575 	      txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
   5576 	      inherited-tags
   5577 	      (or (eq org-agenda-show-inherited-tags 'always)
   5578 		  (and (listp org-agenda-show-inherited-tags)
   5579 		       (memq 'todo org-agenda-show-inherited-tags))
   5580 		  (and (eq org-agenda-show-inherited-tags t)
   5581 		       (or (eq org-agenda-use-tag-inheritance t)
   5582 			   (memq 'todo org-agenda-use-tag-inheritance))))
   5583 	      tags (org-get-tags nil (not inherited-tags))
   5584 	      level (make-string (org-reduced-level (org-outline-level)) ? )
   5585 	      txt (org-agenda-format-item "" txt level category tags t)
   5586 	      priority (1+ (org-get-priority txt)))
   5587 	(org-add-props txt props
   5588 	  'org-marker marker 'org-hd-marker marker
   5589 	  'priority priority
   5590 	  'level level
   5591 	  'ts-date ts-date
   5592 	  'type (concat "todo" ts-date-type) 'todo-state todo-state)
   5593 	(push txt ee)
   5594 	(if org-agenda-todo-list-sublevels
   5595 	    (goto-char todo-state-end-pos)
   5596 	  (org-end-of-subtree 'invisible))))
   5597     (nreverse ee)))
   5598 
   5599 (defun org-agenda-todo-custom-ignore-p (time n)
   5600   "Check whether timestamp is farther away than n number of days.
   5601 This function is invoked if `org-agenda-todo-ignore-deadlines',
   5602 `org-agenda-todo-ignore-scheduled' or
   5603 `org-agenda-todo-ignore-timestamp' is set to an integer."
   5604   (let ((days (org-time-stamp-to-now
   5605 	       time org-agenda-todo-ignore-time-comparison-use-seconds)))
   5606     (if (>= n 0)
   5607 	(>= days n)
   5608       (<= days n))))
   5609 
   5610 ;;;###autoload
   5611 (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
   5612     (&optional end)
   5613   "Do we have a reason to ignore this TODO entry because it has a time stamp?"
   5614   (when (or org-agenda-todo-ignore-with-date
   5615 	    org-agenda-todo-ignore-scheduled
   5616 	    org-agenda-todo-ignore-deadlines
   5617 	    org-agenda-todo-ignore-timestamp)
   5618     (setq end (or end (save-excursion (outline-next-heading) (point))))
   5619     (save-excursion
   5620       (or (and org-agenda-todo-ignore-with-date
   5621 	       (re-search-forward org-ts-regexp end t))
   5622 	  (and org-agenda-todo-ignore-scheduled
   5623 	       (re-search-forward org-scheduled-time-regexp end t)
   5624 	       (cond
   5625 		((eq org-agenda-todo-ignore-scheduled 'future)
   5626 		 (> (org-time-stamp-to-now
   5627 		     (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5628 		    0))
   5629 		((eq org-agenda-todo-ignore-scheduled 'past)
   5630 		 (<= (org-time-stamp-to-now
   5631 		      (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5632 		     0))
   5633 		((numberp org-agenda-todo-ignore-scheduled)
   5634 		 (org-agenda-todo-custom-ignore-p
   5635 		  (match-string 1) org-agenda-todo-ignore-scheduled))
   5636 		(t)))
   5637 	  (and org-agenda-todo-ignore-deadlines
   5638 	       (re-search-forward org-deadline-time-regexp end t)
   5639 	       (cond
   5640 		((eq org-agenda-todo-ignore-deadlines 'all) t)
   5641 		((eq org-agenda-todo-ignore-deadlines 'far)
   5642 		 (not (org-deadline-close-p (match-string 1))))
   5643 		((eq org-agenda-todo-ignore-deadlines 'future)
   5644 		 (> (org-time-stamp-to-now
   5645 		     (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5646 		    0))
   5647 		((eq org-agenda-todo-ignore-deadlines 'past)
   5648 		 (<= (org-time-stamp-to-now
   5649 		      (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5650 		     0))
   5651 		((numberp org-agenda-todo-ignore-deadlines)
   5652 		 (org-agenda-todo-custom-ignore-p
   5653 		  (match-string 1) org-agenda-todo-ignore-deadlines))
   5654 		(t (org-deadline-close-p (match-string 1)))))
   5655 	  (and org-agenda-todo-ignore-timestamp
   5656 	       (let ((buffer (current-buffer))
   5657 		     (regexp
   5658 		      (concat
   5659 		       org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
   5660 		     (start (point)))
   5661 		 ;; Copy current buffer into a temporary one
   5662 		 (with-temp-buffer
   5663 		   (insert-buffer-substring buffer start end)
   5664 		   (goto-char (point-min))
   5665 		   ;; Delete SCHEDULED and DEADLINE items
   5666 		   (while (re-search-forward regexp end t)
   5667 		     (delete-region (match-beginning 0) (match-end 0)))
   5668 		   (goto-char (point-min))
   5669 		   ;; No search for timestamp left
   5670 		   (when (re-search-forward org-ts-regexp nil t)
   5671 		     (cond
   5672 		      ((eq org-agenda-todo-ignore-timestamp 'future)
   5673 		       (> (org-time-stamp-to-now
   5674 			   (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5675 			  0))
   5676 		      ((eq org-agenda-todo-ignore-timestamp 'past)
   5677 		       (<= (org-time-stamp-to-now
   5678 			    (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5679 			   0))
   5680 		      ((numberp org-agenda-todo-ignore-timestamp)
   5681 		       (org-agenda-todo-custom-ignore-p
   5682 			(match-string 1) org-agenda-todo-ignore-timestamp))
   5683 		      (t))))))))))
   5684 
   5685 (defun org-agenda-get-timestamps (&optional deadlines)
   5686   "Return the date stamp information for agenda display.
   5687 Optional argument DEADLINES is a list of deadline items to be
   5688 displayed in agenda view."
   5689   (with-no-warnings (defvar date))
   5690   (let* ((props (list 'face 'org-agenda-calendar-event
   5691 		      'org-not-done-regexp org-not-done-regexp
   5692 		      'org-todo-regexp org-todo-regexp
   5693 		      'org-complex-heading-regexp org-complex-heading-regexp
   5694 		      'mouse-face 'highlight
   5695 		      'help-echo
   5696 		      (format "mouse-2 or RET jump to Org file %s"
   5697 			      (abbreviate-file-name buffer-file-name))))
   5698 	 (current (calendar-absolute-from-gregorian date))
   5699 	 (today (org-today))
   5700 	 (deadline-position-alist
   5701 	  (mapcar (lambda (d)
   5702 		    (let ((m (get-text-property 0 'org-hd-marker d)))
   5703 		      (and m (marker-position m))))
   5704 		  deadlines))
   5705 	 ;; Match time-stamps set to current date, time-stamps with
   5706 	 ;; a repeater, and S-exp time-stamps.
   5707 	 (regexp
   5708 	  (concat
   5709 	   (if org-agenda-include-inactive-timestamps "[[<]" "<")
   5710 	   (regexp-quote
   5711 	    (substring
   5712 	     (format-time-string
   5713 	      (car org-time-stamp-formats)
   5714 	      (encode-time	; DATE bound by calendar
   5715 	       0 0 0 (nth 1 date) (car date) (nth 2 date)))
   5716 	     1 11))
   5717 	   "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
   5718 	   "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
   5719 	 timestamp-items)
   5720     (goto-char (point-min))
   5721     (while (re-search-forward regexp nil t)
   5722       ;; Skip date ranges, scheduled and deadlines, which are handled
   5723       ;; specially.  Also skip time-stamps before first headline as
   5724       ;; there would be no entry to add to the agenda.  Eventually,
   5725       ;; ignore clock entries.
   5726       (catch :skip
   5727 	(save-match-data
   5728 	  (when (or (org-at-date-range-p)
   5729 		    (org-at-planning-p)
   5730 		    (org-before-first-heading-p)
   5731 		    (and org-agenda-include-inactive-timestamps
   5732 			 (org-at-clock-log-p)))
   5733 	    (throw :skip nil))
   5734 	  (org-agenda-skip))
   5735 	(let* ((pos (match-beginning 0))
   5736 	       (repeat (match-string 1))
   5737 	       (sexp-entry (match-string 3))
   5738 	       (time-stamp (if (or repeat sexp-entry) (match-string 0)
   5739 			     (save-excursion
   5740 			       (goto-char pos)
   5741 			       (looking-at org-ts-regexp-both)
   5742 			       (match-string 0))))
   5743 	       (todo-state (org-get-todo-state))
   5744 	       (warntime (get-text-property (point) 'org-appt-warntime))
   5745 	       (done? (member todo-state org-done-keywords)))
   5746 	  ;; Possibly skip done tasks.
   5747 	  (when (and done? org-agenda-skip-timestamp-if-done)
   5748 	    (throw :skip t))
   5749 	  ;; S-exp entry doesn't match current day: skip it.
   5750 	  (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
   5751 	    (throw :skip nil))
   5752 	  (when repeat
   5753 	    (let* ((past
   5754 		    ;; A repeating time stamp is shown at its base
   5755 		    ;; date and every repeated date up to TODAY.  If
   5756 		    ;; `org-agenda-prefer-last-repeat' is non-nil,
   5757 		    ;; however, only the last repeat before today
   5758 		    ;; (inclusive) is shown.
   5759 		    (org-agenda--timestamp-to-absolute
   5760 		     repeat
   5761 		     (if (or (> current today)
   5762 			     (eq org-agenda-prefer-last-repeat t)
   5763 			     (member todo-state org-agenda-prefer-last-repeat))
   5764 			 today
   5765 		       current)
   5766 		     'past (current-buffer) pos))
   5767 		   (future
   5768 		    ;;  Display every repeated date past TODAY
   5769 		    ;;  (exclusive) unless
   5770 		    ;;  `org-agenda-show-future-repeats' is nil.  If
   5771 		    ;;  this variable is set to `next', only display
   5772 		    ;;  the first repeated date after TODAY
   5773 		    ;;  (exclusive).
   5774 		    (cond
   5775 		     ((<= current today) past)
   5776 		     ((not org-agenda-show-future-repeats) past)
   5777 		     (t
   5778 		      (let ((base (if (eq org-agenda-show-future-repeats 'next)
   5779 				      (1+ today)
   5780 				    current)))
   5781 			(org-agenda--timestamp-to-absolute
   5782 			 repeat base 'future (current-buffer) pos))))))
   5783 	      (when (and (/= current past) (/= current future))
   5784 		(throw :skip nil))))
   5785 	  (save-excursion
   5786 	    (re-search-backward org-outline-regexp-bol nil t)
   5787 	    ;; Possibly skip time-stamp when a deadline is set.
   5788 	    (when (and org-agenda-skip-timestamp-if-deadline-is-shown
   5789 		       (assq (point) deadline-position-alist))
   5790 	      (throw :skip nil))
   5791 	    (let* ((category (org-get-category pos))
   5792 		   (inherited-tags
   5793 		    (or (eq org-agenda-show-inherited-tags 'always)
   5794 			(and (consp org-agenda-show-inherited-tags)
   5795 			     (memq 'agenda org-agenda-show-inherited-tags))
   5796 			(and (eq org-agenda-show-inherited-tags t)
   5797 			     (or (eq org-agenda-use-tag-inheritance t)
   5798 				 (memq 'agenda
   5799 				       org-agenda-use-tag-inheritance)))))
   5800 		   (tags (org-get-tags nil (not inherited-tags)))
   5801 		   (level (make-string (org-reduced-level (org-outline-level))
   5802 				       ?\s))
   5803 		   (head (and (looking-at "\\*+[ \t]+\\(.*\\)")
   5804 			      (match-string 1)))
   5805 		   (inactive? (= (char-after pos) ?\[))
   5806 		   (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
   5807 		   (item
   5808 		    (org-agenda-format-item
   5809 		     (and inactive? org-agenda-inactive-leader)
   5810 		     head level category tags time-stamp org-ts-regexp habit?)))
   5811 	      (org-add-props item props
   5812 		'priority (if habit?
   5813 			      (org-habit-get-priority (org-habit-parse-todo))
   5814 			    (org-get-priority item))
   5815 		'org-marker (org-agenda-new-marker pos)
   5816 		'org-hd-marker (org-agenda-new-marker)
   5817 		'date date
   5818 		'level level
   5819 		'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat)
   5820 			   current)
   5821 		'todo-state todo-state
   5822 		'warntime warntime
   5823 		'type "timestamp")
   5824 	      (push item timestamp-items))))
   5825 	(when org-agenda-skip-additional-timestamps-same-entry
   5826 	  (outline-next-heading))))
   5827     (nreverse timestamp-items)))
   5828 
   5829 (defun org-agenda-get-sexps ()
   5830   "Return the sexp information for agenda display."
   5831   (require 'diary-lib)
   5832   (with-no-warnings (defvar date) (defvar entry))
   5833   (let* ((props (list 'face 'org-agenda-calendar-sexp
   5834 		      'mouse-face 'highlight
   5835 		      'help-echo
   5836 		      (format "mouse-2 or RET jump to org file %s"
   5837 			      (abbreviate-file-name buffer-file-name))))
   5838 	 (regexp "^&?%%(")
   5839 	 ;; FIXME: Is this `entry' binding intended to be dynamic,
   5840          ;; so as to "hide" any current binding for it?
   5841 	 marker category extra level ee txt tags entry
   5842 	 result beg b sexp sexp-entry todo-state warntime inherited-tags)
   5843     (goto-char (point-min))
   5844     (while (re-search-forward regexp nil t)
   5845       (catch :skip
   5846 	(org-agenda-skip)
   5847 	(setq beg (match-beginning 0))
   5848 	(goto-char (1- (match-end 0)))
   5849 	(setq b (point))
   5850 	(forward-sexp 1)
   5851 	(setq sexp (buffer-substring b (point)))
   5852 	(setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
   5853 			     (org-trim (match-string 1))
   5854 			   ""))
   5855 	(setq result (org-diary-sexp-entry sexp sexp-entry date))
   5856 	(when result
   5857 	  (setq marker (org-agenda-new-marker beg)
   5858 		level (make-string (org-reduced-level (org-outline-level)) ? )
   5859 		category (org-get-category beg)
   5860 		inherited-tags
   5861 		(or (eq org-agenda-show-inherited-tags 'always)
   5862 		    (and (listp org-agenda-show-inherited-tags)
   5863 			 (memq 'agenda org-agenda-show-inherited-tags))
   5864 		    (and (eq org-agenda-show-inherited-tags t)
   5865 			 (or (eq org-agenda-use-tag-inheritance t)
   5866 			     (memq 'agenda org-agenda-use-tag-inheritance))))
   5867 		tags (org-get-tags nil (not inherited-tags))
   5868 		todo-state (org-get-todo-state)
   5869 		warntime (get-text-property (point) 'org-appt-warntime)
   5870 		extra nil)
   5871 
   5872 	  (dolist (r (if (stringp result)
   5873 			 (list result)
   5874 		       result)) ;; we expect a list here
   5875 	    (when (and org-agenda-diary-sexp-prefix
   5876 		       (string-match org-agenda-diary-sexp-prefix r))
   5877 	      (setq extra (match-string 0 r)
   5878 		    r (replace-match "" nil nil r)))
   5879 	    (if (string-match "\\S-" r)
   5880 		(setq txt r)
   5881 	      (setq txt "SEXP entry returned empty string"))
   5882 	    (setq txt (org-agenda-format-item extra txt level category tags 'time))
   5883 	    (org-add-props txt props 'org-marker marker
   5884 			   'date date 'todo-state todo-state
   5885 			   'level level 'type "sexp" 'warntime warntime)
   5886 	    (push txt ee)))))
   5887     (nreverse ee)))
   5888 
   5889 ;; Calendar sanity: define some functions that are independent of
   5890 ;; `calendar-date-style'.
   5891 (defun org-anniversary (year month day &optional mark)
   5892   "Like `diary-anniversary', but with fixed (ISO) order of arguments."
   5893   (with-no-warnings
   5894     (let ((calendar-date-style 'iso))
   5895       (diary-anniversary year month day mark))))
   5896 (defun org-cyclic (N year month day &optional mark)
   5897   "Like `diary-cyclic', but with fixed (ISO) order of arguments."
   5898   (with-no-warnings
   5899     (let ((calendar-date-style 'iso))
   5900       (diary-cyclic N year month day mark))))
   5901 (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
   5902   "Like `diary-block', but with fixed (ISO) order of arguments."
   5903   (with-no-warnings
   5904     (let ((calendar-date-style 'iso))
   5905       (diary-block Y1 M1 D1 Y2 M2 D2 mark))))
   5906 (defun org-date (year month day &optional mark)
   5907   "Like `diary-date', but with fixed (ISO) order of arguments."
   5908   (with-no-warnings
   5909     (let ((calendar-date-style 'iso))
   5910       (diary-date year month day mark))))
   5911 
   5912 ;; Define the `org-class' function
   5913 (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
   5914   "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
   5915 DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
   5916 SKIP-WEEKS is any number of ISO weeks in the block period for which the
   5917 item should be skipped.  If any of the SKIP-WEEKS arguments is the symbol
   5918 `holidays', then any date that is known by the Emacs calendar to be a
   5919 holiday will also be skipped.  If SKIP-WEEKS arguments are holiday strings,
   5920 then those holidays will be skipped."
   5921   (with-no-warnings (defvar date) (defvar entry))
   5922   (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
   5923 	 (date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
   5924 	 (d (calendar-absolute-from-gregorian date))
   5925 	 (h (when skip-weeks (calendar-check-holidays date))))
   5926     (and
   5927      (<= date1 d)
   5928      (<= d date2)
   5929      (= (calendar-day-of-week date) dayname)
   5930      (or (not skip-weeks)
   5931 	 (progn
   5932 	   (require 'cal-iso)
   5933 	   (not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
   5934      (not (or (and h (memq 'holidays skip-weeks))
   5935 	      (delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
   5936      entry)))
   5937 
   5938 (defalias 'org-get-closed #'org-agenda-get-progress)
   5939 (defun org-agenda-get-progress ()
   5940   "Return the logged TODO entries for agenda display."
   5941   (with-no-warnings (defvar date))
   5942   (let* ((props (list 'mouse-face 'highlight
   5943 		      'org-not-done-regexp org-not-done-regexp
   5944 		      'org-todo-regexp org-todo-regexp
   5945 		      'org-complex-heading-regexp org-complex-heading-regexp
   5946 		      'help-echo
   5947 		      (format "mouse-2 or RET jump to org file %s"
   5948 			      (abbreviate-file-name buffer-file-name))))
   5949 	 (items (if (consp org-agenda-show-log-scoped)
   5950 		    org-agenda-show-log-scoped
   5951 		  (if (eq org-agenda-show-log-scoped 'clockcheck)
   5952 		      '(clock)
   5953 		    org-agenda-log-mode-items)))
   5954 	 (parts
   5955 	  (delq nil
   5956 		(list
   5957 		 (when (memq 'closed items) (concat "\\<" org-closed-string))
   5958 		 (when (memq 'clock items) (concat "\\<" org-clock-string))
   5959 		 (when (memq 'state items)
   5960 		   (format "- +State \"%s\".*?" org-todo-regexp)))))
   5961 	 (parts-re (if parts (mapconcat #'identity parts "\\|")
   5962 		     (error "`org-agenda-log-mode-items' is empty")))
   5963 	 (regexp (concat
   5964 		  "\\(" parts-re "\\)"
   5965 		  " *\\["
   5966 		  (regexp-quote
   5967 		   (substring
   5968 		    (format-time-string
   5969 		     (car org-time-stamp-formats)
   5970 		     (encode-time  ; DATE bound by calendar
   5971 		      0 0 0 (nth 1 date) (car date) (nth 2 date)))
   5972 		    1 11))))
   5973 	 (org-agenda-search-headline-for-time nil)
   5974 	 marker hdmarker priority category level tags closedp type
   5975 	 statep clockp state ee txt extra timestr rest clocked inherited-tags)
   5976     (goto-char (point-min))
   5977     (while (re-search-forward regexp nil t)
   5978       (catch :skip
   5979 	(org-agenda-skip)
   5980 	(setq marker (org-agenda-new-marker (match-beginning 0))
   5981 	      closedp (equal (match-string 1) org-closed-string)
   5982 	      statep (equal (string-to-char (match-string 1)) ?-)
   5983 	      clockp (not (or closedp statep))
   5984 	      state (and statep (match-string 2))
   5985 	      category (org-get-category (match-beginning 0))
   5986 	      timestr (buffer-substring (match-beginning 0) (point-at-eol)))
   5987 	(when (string-match "\\]" timestr)
   5988 	  ;; substring should only run to end of time stamp
   5989 	  (setq rest (substring timestr (match-end 0))
   5990 		timestr (substring timestr 0 (match-end 0)))
   5991 	  (if (and (not closedp) (not statep)
   5992 		   (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
   5993 				 rest))
   5994 	      (progn (setq timestr (concat (substring timestr 0 -1)
   5995 					   "-" (match-string 1 rest) "]"))
   5996 		     (setq clocked (match-string 2 rest)))
   5997 	    (setq clocked "-")))
   5998 	(save-excursion
   5999 	  (setq extra
   6000 		(cond
   6001 		 ((not org-agenda-log-mode-add-notes) nil)
   6002 		 (statep
   6003 		  (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
   6004 		       (match-string 1)))
   6005 		 (clockp
   6006 		  (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
   6007 		       (match-string 1)))))
   6008 	  (if (not (re-search-backward org-outline-regexp-bol nil t))
   6009 	      (throw :skip nil)
   6010 	    (goto-char (match-beginning 0))
   6011 	    (setq hdmarker (org-agenda-new-marker)
   6012 		  inherited-tags
   6013 		  (or (eq org-agenda-show-inherited-tags 'always)
   6014 		      (and (listp org-agenda-show-inherited-tags)
   6015 			   (memq 'todo org-agenda-show-inherited-tags))
   6016 		      (and (eq org-agenda-show-inherited-tags t)
   6017 			   (or (eq org-agenda-use-tag-inheritance t)
   6018 			       (memq 'todo org-agenda-use-tag-inheritance))))
   6019 		  tags (org-get-tags nil (not inherited-tags))
   6020 		  level (make-string (org-reduced-level (org-outline-level)) ? ))
   6021 	    (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
   6022 	    (setq txt (match-string 1))
   6023 	    (when extra
   6024 	      (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
   6025 		  (setq txt (concat (substring txt 0 (match-beginning 1))
   6026 				    " - " extra " " (match-string 2 txt)))
   6027 		(setq txt (concat txt " - " extra))))
   6028 	    (setq txt (org-agenda-format-item
   6029 		       (cond
   6030 			(closedp "Closed:    ")
   6031 			(statep (concat "State:     (" state ")"))
   6032 			(t (concat "Clocked:   (" clocked  ")")))
   6033 		       txt level category tags timestr)))
   6034 	  (setq type (cond (closedp "closed")
   6035 			   (statep "state")
   6036 			   (t "clock")))
   6037 	  (setq priority 100000)
   6038 	  (org-add-props txt props
   6039 	    'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
   6040 	    'priority priority 'level level
   6041 	    'type type 'date date
   6042 	    'undone-face 'org-warning 'done-face 'org-agenda-done)
   6043 	  (push txt ee))
   6044 	(goto-char (point-at-eol))))
   6045     (nreverse ee)))
   6046 
   6047 (defun org-agenda-show-clocking-issues ()
   6048   "Add overlays, showing issues with clocking.
   6049 See also the user option `org-agenda-clock-consistency-checks'."
   6050   (interactive)
   6051   (let* ((pl org-agenda-clock-consistency-checks)
   6052 	 (re (concat "^[ \t]*"
   6053 		     org-clock-string
   6054 		     "[ \t]+"
   6055 		     "\\(\\[.*?\\]\\)"	; group 1 is first stamp
   6056 		     "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
   6057 	 (tlstart 0.)
   6058 	 (tlend 0.)
   6059 	 (maxtime (org-duration-to-minutes
   6060 		   (or (plist-get pl :max-duration) "24:00")))
   6061 	 (mintime (org-duration-to-minutes
   6062 		   (or (plist-get pl :min-duration) 0)))
   6063 	 (maxgap  (org-duration-to-minutes
   6064 		   ;; default 30:00 means never complain
   6065 		   (or (plist-get pl :max-gap) "30:00")))
   6066 	 (gapok (mapcar #'org-duration-to-minutes
   6067 			(plist-get pl :gap-ok-around)))
   6068 	 (def-face (or (plist-get pl :default-face)
   6069 		       '((:background "DarkRed") (:foreground "white"))))
   6070 	 issue face m te ts dt ov)
   6071     (goto-char (point-min))
   6072     (while (re-search-forward " Clocked: +(\\(?:-\\|\\([0-9]+:[0-9]+\\)\\))" nil t)
   6073       (setq issue nil face def-face)
   6074       (catch 'next
   6075 	(setq m (org-get-at-bol 'org-marker)
   6076 	      te nil ts nil)
   6077 	(unless (and m (markerp m))
   6078 	  (setq issue "No valid clock line") (throw 'next t))
   6079 	(org-with-point-at m
   6080 	  (save-excursion
   6081 	    (goto-char (point-at-bol))
   6082 	    (unless (looking-at re)
   6083 	      (error "No valid Clock line")
   6084 	      (throw 'next t))
   6085 	    (unless (match-end 3)
   6086 	      (setq issue
   6087 		    (format
   6088 		     "No end time: (%s)"
   6089 		     (org-duration-from-minutes
   6090 		      (floor
   6091 		       (- (float-time (org-current-time))
   6092 			  (float-time (org-time-string-to-time (match-string 1))))
   6093 		       60)))
   6094 		    face (or (plist-get pl :no-end-time-face) face))
   6095 	      (throw 'next t))
   6096 	    (setq ts (match-string 1)
   6097 		  te (match-string 3)
   6098 		  ts (float-time (org-time-string-to-time ts))
   6099 		  te (float-time (org-time-string-to-time te))
   6100 		  dt (- te ts))))
   6101 	(cond
   6102 	 ((> dt (* 60 maxtime))
   6103 	  ;; a very long clocking chunk
   6104 	  (setq issue (format "Clocking interval is very long: %s"
   6105 			      (org-duration-from-minutes (floor dt 60)))
   6106 		face (or (plist-get pl :long-face) face)))
   6107 	 ((< dt (* 60 mintime))
   6108 	  ;; a very short clocking chunk
   6109 	  (setq issue (format "Clocking interval is very short: %s"
   6110 			      (org-duration-from-minutes (floor dt 60)))
   6111 		face (or (plist-get pl :short-face) face)))
   6112 	 ((and (> tlend 0) (< ts tlend))
   6113 	  ;; Two clock entries are overlapping
   6114 	  (setq issue (format "Clocking overlap: %d minutes"
   6115 			      (/ (- tlend ts) 60))
   6116 		face (or (plist-get pl :overlap-face) face)))
   6117 	 ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap))))
   6118 	  ;; There is a gap, lets see if we need to report it
   6119 	  (unless (org-agenda-check-clock-gap tlend ts gapok)
   6120 	    (setq issue (format "Clocking gap: %d minutes"
   6121 				(/ (- ts tlend) 60))
   6122 		  face (or (plist-get pl :gap-face) face))))
   6123 	 (t nil)))
   6124       (setq tlend (or te tlend) tlstart (or ts tlstart))
   6125       (when issue
   6126 	;; OK, there was some issue, add an overlay to show the issue
   6127 	(setq ov (make-overlay (point-at-bol) (point-at-eol)))
   6128 	(overlay-put ov 'before-string
   6129 		     (concat
   6130 		      (org-add-props
   6131 			  (format "%-43s" (concat " " issue))
   6132 			  nil
   6133 			'face face)
   6134 		      "\n"))
   6135 	(overlay-put ov 'evaporate t)))))
   6136 
   6137 (defun org-agenda-check-clock-gap (t1 t2 ok-list)
   6138   "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values."
   6139   (catch 'exit
   6140     (unless ok-list
   6141       ;; there are no OK times for gaps...
   6142       (throw 'exit nil))
   6143     (when (> (- (/ t2 36000) (/ t1 36000)) 24)
   6144       ;; This is more than 24 hours, so it is OK.
   6145       ;; because we have at least one OK time, that must be in the
   6146       ;; 24 hour interval.
   6147       (throw 'exit t))
   6148     ;; We have a shorter gap.
   6149     ;; Now we have to get the minute of the day when these times are
   6150     (let* ((t1dec (org-decode-time t1))
   6151 	   (t2dec (org-decode-time t2))
   6152 	   ;; compute the minute on the day
   6153 	   (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec))))
   6154 	   (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec)))))
   6155       (when (< min2 min1)
   6156 	;; if min2 is smaller than min1, this means it is on the next day.
   6157 	;; Wrap it to after midnight.
   6158 	(setq min2 (+ min2 1440)))
   6159       ;; Now check if any of the OK times is in the gap
   6160       (mapc (lambda (x)
   6161 	      ;; Wrap the time to after midnight if necessary
   6162 	      (when (< x min1) (setq x (+ x 1440)))
   6163 	      ;; Check if in interval
   6164 	      (and (<= min1 x) (>= min2 x) (throw 'exit t)))
   6165 	    ok-list)
   6166       ;; Nope, this gap is not OK
   6167       nil)))
   6168 
   6169 (defun org-agenda-get-deadlines (&optional with-hour)
   6170   "Return the deadline information for agenda display.
   6171 When WITH-HOUR is non-nil, only return deadlines with an hour
   6172 specification like [h]h:mm."
   6173   (with-no-warnings (defvar date))
   6174   (let* ((props (list 'mouse-face 'highlight
   6175 		      'org-not-done-regexp org-not-done-regexp
   6176 		      'org-todo-regexp org-todo-regexp
   6177 		      'org-complex-heading-regexp org-complex-heading-regexp
   6178 		      'help-echo
   6179 		      (format "mouse-2 or RET jump to org file %s"
   6180 			      (abbreviate-file-name buffer-file-name))))
   6181 	 (regexp (if with-hour
   6182 		     org-deadline-time-hour-regexp
   6183 		   org-deadline-time-regexp))
   6184 	 (today (org-today))
   6185 	 (today? (org-agenda-today-p date)) ; DATE bound by calendar.
   6186 	 (current (calendar-absolute-from-gregorian date))
   6187 	 deadline-items)
   6188     (goto-char (point-min))
   6189     (while (re-search-forward regexp nil t)
   6190       (catch :skip
   6191 	(unless (save-match-data (org-at-planning-p)) (throw :skip nil))
   6192 	(org-agenda-skip)
   6193 	(let* ((s (match-string 1))
   6194 	       (pos (1- (match-beginning 1)))
   6195 	       (todo-state (save-match-data (org-get-todo-state)))
   6196 	       (done? (member todo-state org-done-keywords))
   6197                (sexp? (string-prefix-p "%%" s))
   6198 	       ;; DEADLINE is the deadline date for the entry.  It is
   6199 	       ;; either the base date or the last repeat, according
   6200 	       ;; to `org-agenda-prefer-last-repeat'.
   6201 	       (deadline
   6202 		(cond
   6203 		 (sexp? (org-agenda--timestamp-to-absolute s current))
   6204 		 ((or (eq org-agenda-prefer-last-repeat t)
   6205 		      (member todo-state org-agenda-prefer-last-repeat))
   6206 		  (org-agenda--timestamp-to-absolute
   6207 		   s today 'past (current-buffer) pos))
   6208 		 (t (org-agenda--timestamp-to-absolute s))))
   6209 	       ;; REPEAT is the future repeat closest from CURRENT,
   6210 	       ;; according to `org-agenda-show-future-repeats'. If
   6211 	       ;; the latter is nil, or if the time stamp has no
   6212 	       ;; repeat part, default to DEADLINE.
   6213 	       (repeat
   6214 		(cond
   6215 		 (sexp? deadline)
   6216 		 ((<= current today) deadline)
   6217 		 ((not org-agenda-show-future-repeats) deadline)
   6218 		 (t
   6219 		  (let ((base (if (eq org-agenda-show-future-repeats 'next)
   6220 				  (1+ today)
   6221 				current)))
   6222 		    (org-agenda--timestamp-to-absolute
   6223 		     s base 'future (current-buffer) pos)))))
   6224 	       (diff (- deadline current))
   6225 	       (suppress-prewarning
   6226 		(let ((scheduled
   6227 		       (and org-agenda-skip-deadline-prewarning-if-scheduled
   6228 			    (org-entry-get nil "SCHEDULED"))))
   6229 		  (cond
   6230 		   ((not scheduled) nil)
   6231 		   ;; The current item has a scheduled date, so
   6232 		   ;; evaluate its prewarning lead time.
   6233 		   ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
   6234 		    ;; Use global prewarning-restart lead time.
   6235 		    org-agenda-skip-deadline-prewarning-if-scheduled)
   6236 		   ((eq org-agenda-skip-deadline-prewarning-if-scheduled
   6237 			'pre-scheduled)
   6238 		    ;; Set pre-warning to no earlier than SCHEDULED.
   6239 		    (min (- deadline
   6240 			    (org-agenda--timestamp-to-absolute scheduled))
   6241 			 org-deadline-warning-days))
   6242 		   ;; Set pre-warning to deadline.
   6243 		   (t 0))))
   6244 	       (wdays (or suppress-prewarning (org-get-wdays s))))
   6245 	  (cond
   6246 	   ;; Only display deadlines at their base date, at future
   6247 	   ;; repeat occurrences or in today agenda.
   6248 	   ((= current deadline) nil)
   6249 	   ((= current repeat) nil)
   6250 	   ((not today?) (throw :skip nil))
   6251 	   ;; Upcoming deadline: display within warning period WDAYS.
   6252 	   ((> deadline current) (when (> diff wdays) (throw :skip nil)))
   6253 	   ;; Overdue deadline: warn about it for
   6254 	   ;; `org-deadline-past-days' duration.
   6255 	   (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
   6256 	  ;; Possibly skip done tasks.
   6257 	  (when (and done?
   6258 		     (or org-agenda-skip-deadline-if-done
   6259 			 (/= deadline current)))
   6260 	    (throw :skip nil))
   6261 	  (save-excursion
   6262 	    (re-search-backward "^\\*+[ \t]+" nil t)
   6263 	    (goto-char (match-end 0))
   6264 	    (let* ((category (org-get-category))
   6265 		   (level (make-string (org-reduced-level (org-outline-level))
   6266 				       ?\s))
   6267 		   (head (buffer-substring (point) (line-end-position)))
   6268 		   (inherited-tags
   6269 		    (or (eq org-agenda-show-inherited-tags 'always)
   6270 			(and (listp org-agenda-show-inherited-tags)
   6271 			     (memq 'agenda org-agenda-show-inherited-tags))
   6272 			(and (eq org-agenda-show-inherited-tags t)
   6273 			     (or (eq org-agenda-use-tag-inheritance t)
   6274 				 (memq 'agenda
   6275 				       org-agenda-use-tag-inheritance)))))
   6276 		   (tags (org-get-tags nil (not inherited-tags)))
   6277 		   (time
   6278 		    (cond
   6279 		     ;; No time of day designation if it is only
   6280 		     ;; a reminder.
   6281 		     ((and (/= current deadline) (/= current repeat)) nil)
   6282 		     ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
   6283 		      (concat (substring s (match-beginning 1)) " "))
   6284 		     (t 'time)))
   6285 		   (item
   6286 		    (org-agenda-format-item
   6287 		     ;; Insert appropriate suffixes before deadlines.
   6288 		     ;; Those only apply to today agenda.
   6289 		     (pcase-let ((`(,now ,future ,past)
   6290 				  org-agenda-deadline-leaders))
   6291 		       (cond
   6292 			((and today? (< deadline today)) (format past (- diff)))
   6293 			((and today? (> deadline today)) (format future diff))
   6294 			(t now)))
   6295 		     head level category tags time))
   6296 		   (face (org-agenda-deadline-face
   6297 			  (- 1 (/ (float diff) (max wdays 1)))))
   6298 		   (upcoming? (and today? (> deadline today)))
   6299 		   (warntime (get-text-property (point) 'org-appt-warntime)))
   6300 	      (org-add-props item props
   6301 		'org-marker (org-agenda-new-marker pos)
   6302 		'org-hd-marker (org-agenda-new-marker (line-beginning-position))
   6303 		'warntime warntime
   6304 		'level level
   6305 		'ts-date deadline
   6306 		'priority
   6307 		;; Adjust priority to today reminders about deadlines.
   6308 		;; Overdue deadlines get the highest priority
   6309 		;; increase, then imminent deadlines and eventually
   6310 		;; more distant deadlines.
   6311 		(let ((adjust (if today? (- diff) 0)))
   6312 		  (+ adjust (org-get-priority item)))
   6313 		'todo-state todo-state
   6314 		'type (if upcoming? "upcoming-deadline" "deadline")
   6315 		'date (if upcoming? date deadline)
   6316 		'face (if done? 'org-agenda-done face)
   6317 		'undone-face face
   6318 		'done-face 'org-agenda-done)
   6319 	      (push item deadline-items))))))
   6320     (nreverse deadline-items)))
   6321 
   6322 (defun org-agenda-deadline-face (fraction)
   6323   "Return the face to displaying a deadline item.
   6324 FRACTION is what fraction of the head-warning time has passed."
   6325   (assoc-default fraction org-agenda-deadline-faces #'<=))
   6326 
   6327 (defun org-agenda-get-scheduled (&optional deadlines with-hour)
   6328   "Return the scheduled information for agenda display.
   6329 Optional argument DEADLINES is a list of deadline items to be
   6330 displayed in agenda view.  When WITH-HOUR is non-nil, only return
   6331 scheduled items with an hour specification like [h]h:mm."
   6332   (with-no-warnings (defvar date))
   6333   (let* ((props (list 'org-not-done-regexp org-not-done-regexp
   6334 		      'org-todo-regexp org-todo-regexp
   6335 		      'org-complex-heading-regexp org-complex-heading-regexp
   6336 		      'done-face 'org-agenda-done
   6337 		      'mouse-face 'highlight
   6338 		      'help-echo
   6339 		      (format "mouse-2 or RET jump to Org file %s"
   6340 			      (abbreviate-file-name buffer-file-name))))
   6341 	 (regexp (if with-hour
   6342 		     org-scheduled-time-hour-regexp
   6343 		   org-scheduled-time-regexp))
   6344 	 (today (org-today))
   6345 	 (todayp (org-agenda-today-p date)) ; DATE bound by calendar.
   6346 	 (current (calendar-absolute-from-gregorian date))
   6347 	 (deadline-pos
   6348 	  (mapcar (lambda (d)
   6349 		    (let ((m (get-text-property 0 'org-hd-marker d)))
   6350 		      (and m (marker-position m))))
   6351 		  deadlines))
   6352 	 scheduled-items)
   6353     (goto-char (point-min))
   6354     (while (re-search-forward regexp nil t)
   6355       (catch :skip
   6356 	(unless (save-match-data (org-at-planning-p)) (throw :skip nil))
   6357 	(org-agenda-skip)
   6358 	(let* ((s (match-string 1))
   6359 	       (pos (1- (match-beginning 1)))
   6360 	       (todo-state (save-match-data (org-get-todo-state)))
   6361 	       (donep (member todo-state org-done-keywords))
   6362 	       (sexp? (string-prefix-p "%%" s))
   6363 	       ;; SCHEDULE is the scheduled date for the entry.  It is
   6364 	       ;; either the bare date or the last repeat, according
   6365 	       ;; to `org-agenda-prefer-last-repeat'.
   6366 	       (schedule
   6367 		(cond
   6368 		 (sexp? (org-agenda--timestamp-to-absolute s current))
   6369 		 ((or (eq org-agenda-prefer-last-repeat t)
   6370 		      (member todo-state org-agenda-prefer-last-repeat))
   6371 		  (org-agenda--timestamp-to-absolute
   6372 		   s today 'past (current-buffer) pos))
   6373 		 (t (org-agenda--timestamp-to-absolute s))))
   6374 	       ;; REPEAT is the future repeat closest from CURRENT,
   6375 	       ;; according to `org-agenda-show-future-repeats'. If
   6376 	       ;; the latter is nil, or if the time stamp has no
   6377 	       ;; repeat part, default to SCHEDULE.
   6378 	       (repeat
   6379 		(cond
   6380 		 (sexp? schedule)
   6381 		 ((<= current today) schedule)
   6382 		 ((not org-agenda-show-future-repeats) schedule)
   6383 		 (t
   6384 		  (let ((base (if (eq org-agenda-show-future-repeats 'next)
   6385 				  (1+ today)
   6386 				current)))
   6387 		    (org-agenda--timestamp-to-absolute
   6388 		     s base 'future (current-buffer) pos)))))
   6389 	       (diff (- current schedule))
   6390 	       (warntime (get-text-property (point) 'org-appt-warntime))
   6391 	       (pastschedp (< schedule today))
   6392 	       (futureschedp (> schedule today))
   6393 	       (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
   6394 	       (suppress-delay
   6395 		(let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
   6396 				     (org-entry-get nil "DEADLINE"))))
   6397 		  (cond
   6398 		   ((not deadline) nil)
   6399 		   ;; The current item has a deadline date, so
   6400 		   ;; evaluate its delay time.
   6401 		   ((integerp org-agenda-skip-scheduled-delay-if-deadline)
   6402 		    ;; Use global delay time.
   6403 		    (- org-agenda-skip-scheduled-delay-if-deadline))
   6404 		   ((eq org-agenda-skip-scheduled-delay-if-deadline
   6405 			'post-deadline)
   6406 		    ;; Set delay to no later than DEADLINE.
   6407 		    (min (- schedule
   6408 			    (org-agenda--timestamp-to-absolute deadline))
   6409 			 org-scheduled-delay-days))
   6410 		   (t 0))))
   6411 	       (ddays
   6412 		(cond
   6413 		 ;; Nullify delay when a repeater triggered already
   6414 		 ;; and the delay is of the form --Xd.
   6415 		 ((and (string-match-p "--[0-9]+[hdwmy]" s)
   6416 		       (> schedule (org-agenda--timestamp-to-absolute s)))
   6417 		  0)
   6418 		 (suppress-delay
   6419 		  (let ((org-scheduled-delay-days suppress-delay))
   6420 		    (org-get-wdays s t t)))
   6421 		 (t (org-get-wdays s t)))))
   6422 	  ;; Display scheduled items at base date (SCHEDULE), today if
   6423 	  ;; scheduled before the current date, and at any repeat past
   6424 	  ;; today.  However, skip delayed items and items that have
   6425 	  ;; been displayed for more than `org-scheduled-past-days'.
   6426 	  (unless (and todayp
   6427 		       habitp
   6428 		       (bound-and-true-p org-habit-show-all-today))
   6429 	    (when (or (and (> ddays 0) (< diff ddays))
   6430 		      (> diff (or (and habitp org-habit-scheduled-past-days)
   6431 				  org-scheduled-past-days))
   6432 		      (> schedule current)
   6433 		      (and (/= current schedule)
   6434 			   (/= current today)
   6435 			   (/= current repeat)))
   6436 	      (throw :skip nil)))
   6437 	  ;; Possibly skip done tasks.
   6438 	  (when (and donep
   6439 		     (or org-agenda-skip-scheduled-if-done
   6440 			 (/= schedule current)))
   6441 	    (throw :skip nil))
   6442 	  ;; Skip entry if it already appears as a deadline, per
   6443 	  ;; `org-agenda-skip-scheduled-if-deadline-is-shown'.  This
   6444 	  ;; doesn't apply to habits.
   6445 	  (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
   6446 		  ((guard
   6447 		    (or (not (memq (line-beginning-position 0) deadline-pos))
   6448 			habitp))
   6449 		   nil)
   6450 		  (`repeated-after-deadline
   6451 		   (let ((deadline (time-to-days
   6452 				    (org-get-deadline-time (point)))))
   6453 		     (and (<= schedule deadline) (> current deadline))))
   6454 		  (`not-today pastschedp)
   6455 		  (`t t)
   6456 		  (_ nil))
   6457 	    (throw :skip nil))
   6458 	  ;; Skip habits if `org-habit-show-habits' is nil, or if we
   6459 	  ;; only show them for today.  Also skip done habits.
   6460 	  (when (and habitp
   6461 		     (or donep
   6462 			 (not (bound-and-true-p org-habit-show-habits))
   6463 			 (and (not todayp)
   6464 			      (bound-and-true-p
   6465 			       org-habit-show-habits-only-for-today))))
   6466 	    (throw :skip nil))
   6467 	  (save-excursion
   6468 	    (re-search-backward "^\\*+[ \t]+" nil t)
   6469 	    (goto-char (match-end 0))
   6470 	    (let* ((category (org-get-category))
   6471 		   (inherited-tags
   6472 		    (or (eq org-agenda-show-inherited-tags 'always)
   6473 			(and (listp org-agenda-show-inherited-tags)
   6474 			     (memq 'agenda org-agenda-show-inherited-tags))
   6475 			(and (eq org-agenda-show-inherited-tags t)
   6476 			     (or (eq org-agenda-use-tag-inheritance t)
   6477 				 (memq 'agenda
   6478 				       org-agenda-use-tag-inheritance)))))
   6479 		   (tags (org-get-tags nil (not inherited-tags)))
   6480 		   (level (make-string (org-reduced-level (org-outline-level))
   6481 				       ?\s))
   6482 		   (head (buffer-substring (point) (line-end-position)))
   6483 		   (time
   6484 		    (cond
   6485 		     ;; No time of day designation if it is only a
   6486 		     ;; reminder, except for habits, which always show
   6487 		     ;; the time of day.  Habits are an exception
   6488 		     ;; because if there is a time of day, that is
   6489 		     ;; interpreted to mean they should usually happen
   6490 		     ;; then, even if doing the habit was missed.
   6491 		     ((and
   6492 		       (not habitp)
   6493 		       (/= current schedule)
   6494 		       (/= current repeat))
   6495 		      nil)
   6496 		     ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
   6497 		      (concat (substring s (match-beginning 1)) " "))
   6498 		     (t 'time)))
   6499 		   (item
   6500 		    (org-agenda-format-item
   6501 		     (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
   6502 		       ;; Show a reminder of a past scheduled today.
   6503 		       (if (and todayp pastschedp)
   6504 			   (format past diff)
   6505 			 first))
   6506 		     head level category tags time nil habitp))
   6507 		   (face (cond ((and (not habitp) pastschedp)
   6508 				'org-scheduled-previously)
   6509 			       ((and habitp futureschedp)
   6510 				'org-agenda-done)
   6511 			       (todayp 'org-scheduled-today)
   6512 			       (t 'org-scheduled)))
   6513 		   (habitp (and habitp (org-habit-parse-todo))))
   6514 	      (org-add-props item props
   6515 		'undone-face face
   6516 		'face (if donep 'org-agenda-done face)
   6517 		'org-marker (org-agenda-new-marker pos)
   6518 		'org-hd-marker (org-agenda-new-marker (line-beginning-position))
   6519 		'type (if pastschedp "past-scheduled" "scheduled")
   6520 		'date (if pastschedp schedule date)
   6521 		'ts-date schedule
   6522 		'warntime warntime
   6523 		'level level
   6524 		'priority (if habitp (org-habit-get-priority habitp)
   6525 			    (+ 99 diff (org-get-priority item)))
   6526 		'org-habit-p habitp
   6527 		'todo-state todo-state)
   6528 	      (push item scheduled-items))))))
   6529     (nreverse scheduled-items)))
   6530 
   6531 (defun org-agenda-get-blocks ()
   6532   "Return the date-range information for agenda display."
   6533   (with-no-warnings (defvar date))
   6534   (let* ((props (list 'face nil
   6535 		      'org-not-done-regexp org-not-done-regexp
   6536 		      'org-todo-regexp org-todo-regexp
   6537 		      'org-complex-heading-regexp org-complex-heading-regexp
   6538 		      'mouse-face 'highlight
   6539 		      'help-echo
   6540 		      (format "mouse-2 or RET jump to org file %s"
   6541 			      (abbreviate-file-name buffer-file-name))))
   6542 	 (regexp org-tr-regexp)
   6543 	 (d0 (calendar-absolute-from-gregorian date))
   6544 	 marker hdmarker ee txt d1 d2 s1 s2 category
   6545 	 level todo-state tags pos head donep inherited-tags)
   6546     (goto-char (point-min))
   6547     (while (re-search-forward regexp nil t)
   6548       (catch :skip
   6549 	(org-agenda-skip)
   6550 	(setq pos (point))
   6551 	(let ((start-time (match-string 1))
   6552 	      (end-time (match-string 2)))
   6553 	  (setq s1 (match-string 1)
   6554 		s2 (match-string 2)
   6555 		d1 (time-to-days
   6556 		    (condition-case err
   6557 			(org-time-string-to-time s1)
   6558 		      (error
   6559 		       (error
   6560 			"Bad timestamp %S at %d in buffer %S\nError was: %s"
   6561 			s1
   6562 			pos
   6563 			(current-buffer)
   6564 			(error-message-string err)))))
   6565 		d2 (time-to-days
   6566 		    (condition-case err
   6567 			(org-time-string-to-time s2)
   6568 		      (error
   6569 		       (error
   6570 			"Bad timestamp %S at %d in buffer %S\nError was: %s"
   6571 			s2
   6572 			pos
   6573 			(current-buffer)
   6574 			(error-message-string err))))))
   6575 	  (when (and (> (- d0 d1) -1) (> (- d2 d0) -1))
   6576 	    ;; Only allow days between the limits, because the normal
   6577 	    ;; date stamps will catch the limits.
   6578 	    (save-excursion
   6579 	      (setq todo-state (org-get-todo-state))
   6580 	      (setq donep (member todo-state org-done-keywords))
   6581 	      (when (and donep org-agenda-skip-timestamp-if-done)
   6582 		(throw :skip t))
   6583 	      (setq marker (org-agenda-new-marker (point))
   6584 		    category (org-get-category))
   6585 	      (if (not (re-search-backward org-outline-regexp-bol nil t))
   6586 		  (throw :skip nil)
   6587 		(goto-char (match-beginning 0))
   6588 		(setq hdmarker (org-agenda-new-marker (point))
   6589 		      inherited-tags
   6590 		      (or (eq org-agenda-show-inherited-tags 'always)
   6591 			  (and (listp org-agenda-show-inherited-tags)
   6592 			       (memq 'agenda org-agenda-show-inherited-tags))
   6593 			  (and (eq org-agenda-show-inherited-tags t)
   6594 			       (or (eq org-agenda-use-tag-inheritance t)
   6595 				   (memq 'agenda org-agenda-use-tag-inheritance))))
   6596 		      tags (org-get-tags nil (not inherited-tags)))
   6597 		(setq level (make-string (org-reduced-level (org-outline-level)) ? ))
   6598 		(looking-at "\\*+[ \t]+\\(.*\\)")
   6599 		(setq head (match-string 1))
   6600 		(let ((remove-re
   6601 		       (if org-agenda-remove-timeranges-from-blocks
   6602 			   (concat
   6603 			    "<" (regexp-quote s1) ".*?>"
   6604 			    "--"
   6605 			    "<" (regexp-quote s2) ".*?>")
   6606 			 nil)))
   6607 		  (setq txt (org-agenda-format-item
   6608 			     (format
   6609 			      (nth (if (= d1 d2) 0 1)
   6610 				   org-agenda-timerange-leaders)
   6611 			      (1+ (- d0 d1)) (1+ (- d2 d1)))
   6612 			     head level category tags
   6613 			     (save-match-data
   6614 			       (let ((hhmm1 (and (string-match org-ts-regexp1 s1)
   6615 						 (match-string 6 s1)))
   6616 				     (hhmm2 (and (string-match org-ts-regexp1 s2)
   6617 						 (match-string 6 s2))))
   6618 				 (cond ((string= hhmm1 hhmm2)
   6619 					(concat "<" start-time ">--<" end-time ">"))
   6620 				       ((and (= d1 d0) (= d2 d0))
   6621 					(concat "<" start-time ">--<" end-time ">"))
   6622                                        ((= d1 d0)
   6623 					(concat "<" start-time ">"))
   6624 				       ((= d2 d0)
   6625 					(concat "<" end-time ">")))))
   6626 			     remove-re))))
   6627 	      (org-add-props txt props
   6628 		'org-marker marker 'org-hd-marker hdmarker
   6629 		'type "block" 'date date
   6630 		'level level
   6631 		'todo-state todo-state
   6632 		'priority (org-get-priority txt))
   6633 	      (push txt ee))))
   6634 	(goto-char pos)))
   6635     ;; Sort the entries by expiration date.
   6636     (nreverse ee)))
   6637 
   6638 ;;; Agenda presentation and sorting
   6639 
   6640 (defvar org-prefix-has-time nil
   6641   "A flag, set by `org-compile-prefix-format'.
   6642 The flag is set if the currently compiled format contains a `%t'.")
   6643 (defvar org-prefix-has-tag nil
   6644   "A flag, set by `org-compile-prefix-format'.
   6645 The flag is set if the currently compiled format contains a `%T'.")
   6646 (defvar org-prefix-has-effort nil
   6647   "A flag, set by `org-compile-prefix-format'.
   6648 The flag is set if the currently compiled format contains a `%e'.")
   6649 (defvar org-prefix-has-breadcrumbs nil
   6650   "A flag, set by `org-compile-prefix-format'.
   6651 The flag is set if the currently compiled format contains a `%b'.")
   6652 (defvar org-prefix-category-length nil
   6653   "Used by `org-compile-prefix-format' to remember the category field width.")
   6654 (defvar org-prefix-category-max-length nil
   6655   "Used by `org-compile-prefix-format' to remember the category field width.")
   6656 
   6657 (defun org-agenda-get-category-icon (category)
   6658   "Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
   6659   (cl-dolist (entry org-agenda-category-icon-alist)
   6660     (when (string-match-p (car entry) category)
   6661       (if (listp (cadr entry))
   6662 	  (cl-return (cadr entry))
   6663 	(cl-return (apply #'create-image (cdr entry)))))))
   6664 
   6665 (defun org-agenda-format-item (extra txt &optional with-level with-category tags dotime
   6666 				     remove-re habitp)
   6667   "Format TXT to be inserted into the agenda buffer.
   6668 In particular, add the prefix and corresponding text properties.
   6669 
   6670 EXTRA must be a string to replace the `%s' specifier in the prefix format.
   6671 WITH-LEVEL may be a string to replace the `%l' specifier.
   6672 WITH-CATEGORY (a string, a symbol or nil) may be used to overrule the default
   6673 category taken from local variable or file name.  It will replace the `%c'
   6674 specifier in the format.
   6675 DOTIME, when non-nil, indicates that a time-of-day should be extracted from
   6676 TXT for sorting of this entry, and for the `%t' specifier in the format.
   6677 When DOTIME is a string, this string is searched for a time before TXT is.
   6678 TAGS can be the tags of the headline.
   6679 Any match of REMOVE-RE will be removed from TXT."
   6680   ;; We keep the org-prefix-* variable values along with a compiled
   6681   ;; formatter, so that multiple agendas existing at the same time do
   6682   ;; not step on each other toes.
   6683   ;;
   6684   ;; It was inconvenient to make these variables buffer local in
   6685   ;; Agenda buffers, because this function expects to be called with
   6686   ;; the buffer where item comes from being current, and not agenda
   6687   ;; buffer
   6688   (let* ((bindings (car org-prefix-format-compiled))
   6689 	 (formatter (cadr org-prefix-format-compiled)))
   6690     (cl-loop for (var value) in bindings
   6691 	     do (set var value))
   6692     (save-match-data
   6693       ;; Diary entries sometimes have extra whitespace at the beginning
   6694       (setq txt (org-trim txt))
   6695 
   6696       ;; Fix the tags part in txt
   6697       (setq txt (org-agenda-fix-displayed-tags
   6698 		 txt tags
   6699 		 org-agenda-show-inherited-tags
   6700 		 org-agenda-hide-tags-regexp))
   6701 
   6702       (with-no-warnings
   6703 	;; `time', `tag', `effort' are needed for the eval of the prefix format.
   6704 	;; Based on what I see in `org-compile-prefix-format', I added
   6705 	;; a few more.
   6706         (defvar breadcrumbs) (defvar category) (defvar category-icon)
   6707         (defvar effort) (defvar extra)
   6708         (defvar level) (defvar tag) (defvar time))
   6709       (let* ((category (or with-category
   6710 			   (if buffer-file-name
   6711 			       (file-name-sans-extension
   6712 				(file-name-nondirectory buffer-file-name))
   6713 			     "")))
   6714 	     (category-icon (org-agenda-get-category-icon category))
   6715 	     (category-icon (if category-icon
   6716 				(propertize " " 'display category-icon)
   6717 			      ""))
   6718 	     (effort (and (not (string= txt ""))
   6719 			  (get-text-property 1 'effort txt)))
   6720 	     (tag (if tags (nth (1- (length tags)) tags) ""))
   6721 	     (time-grid-trailing-characters (nth 2 org-agenda-time-grid))
   6722 	     (extra (or (and (not habitp) extra) ""))
   6723 	     time
   6724 	     (ts (when dotime (concat
   6725 			       (if (stringp dotime) dotime "")
   6726 			       (and org-agenda-search-headline-for-time txt))))
   6727 	     (time-of-day (and dotime (org-get-time-of-day ts)))
   6728 	     stamp plain s0 s1 s2 rtn srp l
   6729 	     duration breadcrumbs)
   6730 	(and (derived-mode-p 'org-mode) buffer-file-name
   6731 	     (add-to-list 'org-agenda-contributing-files buffer-file-name))
   6732 	(when (and dotime time-of-day)
   6733 	  ;; Extract starting and ending time and move them to prefix
   6734 	  (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
   6735 		    (setq plain (string-match org-plain-time-of-day-regexp ts)))
   6736 	    (setq s0 (match-string 0 ts)
   6737 		  srp (and stamp (match-end 3))
   6738 		  s1 (match-string (if plain 1 2) ts)
   6739 		  s2 (match-string (if plain 8 (if srp 4 6)) ts))
   6740 
   6741 	    ;; If the times are in TXT (not in DOTIMES), and the prefix will list
   6742 	    ;; them, we might want to remove them there to avoid duplication.
   6743 	    ;; The user can turn this off with a variable.
   6744 	    (when (and org-prefix-has-time
   6745 		       org-agenda-remove-times-when-in-prefix (or stamp plain)
   6746 		       (string-match (concat (regexp-quote s0) " *") txt)
   6747 		       (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
   6748 		       (if (eq org-agenda-remove-times-when-in-prefix 'beg)
   6749 			   (= (match-beginning 0) 0)
   6750 			 t))
   6751 	      (setq txt (replace-match "" nil nil txt))))
   6752           ;; Normalize the time(s) to 24 hour.
   6753 	  (when s1 (setq s1 (org-get-time-of-day s1 t)))
   6754 	  (when s2 (setq s2 (org-get-time-of-day s2 t)))
   6755 	  ;; Try to set s2 if s1 and
   6756 	  ;; `org-agenda-default-appointment-duration' are set
   6757 	  (when (and s1 (not s2) org-agenda-default-appointment-duration)
   6758 	    (setq s2
   6759 		  (org-duration-from-minutes
   6760 		   (+ (org-duration-to-minutes s1 t)
   6761 		      org-agenda-default-appointment-duration)
   6762 		   nil t)))
   6763 	  ;; Compute the duration
   6764 	  (when s2
   6765 	    (setq duration (- (org-duration-to-minutes s2)
   6766 			      (org-duration-to-minutes s1))))
   6767           ;; Format S1 and S2 for display.
   6768 	  (when s1 (setq s1 (org-get-time-of-day s1 'overtime)))
   6769 	  (when s2 (setq s2 (org-get-time-of-day s2 'overtime))))
   6770 	(when (string-match org-tag-group-re txt)
   6771 	  ;; Tags are in the string
   6772 	  (if (or (eq org-agenda-remove-tags t)
   6773 		  (and org-agenda-remove-tags
   6774 		       org-prefix-has-tag))
   6775 	      (setq txt (replace-match "" t t txt))
   6776 	    (setq txt (replace-match
   6777 		       (concat (make-string (max (- 50 (length txt)) 1) ?\ )
   6778 			       (match-string 1 txt))
   6779 		       t t txt))))
   6780 
   6781 	(when remove-re
   6782 	  (while (string-match remove-re txt)
   6783 	    (setq txt (replace-match "" t t txt))))
   6784 
   6785 	;; Set org-heading property on `txt' to mark the start of the
   6786 	;; heading.
   6787 	(add-text-properties 0 (length txt) '(org-heading t) txt)
   6788 
   6789 	;; Prepare the variables needed in the eval of the compiled format
   6790 	(when org-prefix-has-breadcrumbs
   6791 	  (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker)
   6792 			      (let ((s (org-format-outline-path (org-get-outline-path)
   6793 								(1- (frame-width))
   6794 								nil org-agenda-breadcrumbs-separator)))
   6795 				(if (eq "" s) "" (concat s org-agenda-breadcrumbs-separator))))))
   6796 	(setq time (cond (s2 (concat
   6797 			      (org-agenda-time-of-day-to-ampm-maybe s1)
   6798 			      "-" (org-agenda-time-of-day-to-ampm-maybe s2)
   6799 			      (when org-agenda-timegrid-use-ampm " ")))
   6800 			 (s1 (concat
   6801 			      (org-agenda-time-of-day-to-ampm-maybe s1)
   6802 			      (if org-agenda-timegrid-use-ampm
   6803                                   (concat time-grid-trailing-characters " ")
   6804                                 time-grid-trailing-characters)))
   6805 			 (t ""))
   6806 	      category (if (symbolp category) (symbol-name category) category)
   6807 	      level (or with-level ""))
   6808 	(if (string-match org-link-bracket-re category)
   6809 	    (progn
   6810 	      (setq l (string-width (or (match-string 2) (match-string 1))))
   6811 	      (when (< l (or org-prefix-category-length 0))
   6812 		(setq category (copy-sequence category))
   6813 		(org-add-props category nil
   6814 		  'extra-space (make-string
   6815 				(- org-prefix-category-length l 1) ?\ ))))
   6816 	  (when (and org-prefix-category-max-length
   6817 		     (>= (length category) org-prefix-category-max-length))
   6818 	    (setq category (substring category 0 (1- org-prefix-category-max-length)))))
   6819 	;; Evaluate the compiled format
   6820 	(setq rtn (concat (eval formatter t) txt))
   6821 
   6822 	;; And finally add the text properties
   6823 	(remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
   6824 	(org-add-props rtn nil
   6825 	  'org-category category
   6826           'tags tags
   6827           'org-priority-highest org-priority-highest
   6828 	  'org-priority-lowest org-priority-lowest
   6829 	  'time-of-day time-of-day
   6830 	  'duration duration
   6831 	  'breadcrumbs breadcrumbs
   6832 	  'txt txt
   6833 	  'level level
   6834 	  'time time
   6835 	  'extra extra
   6836 	  'format org-prefix-format-compiled
   6837 	  'dotime dotime)))))
   6838 
   6839 (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
   6840   "Remove tags string from TXT, and add a modified list of tags.
   6841 The modified list may contain inherited tags, and tags matched by
   6842 `org-agenda-hide-tags-regexp' will be removed."
   6843   (when (or add-inherited hide-re)
   6844     (when (string-match org-tag-group-re txt)
   6845       (setq txt (substring txt 0 (match-beginning 0))))
   6846     (setq tags
   6847 	  (delq nil
   6848 		(mapcar (lambda (tg)
   6849 			  (if (or (and hide-re (string-match hide-re tg))
   6850 				  (and (not add-inherited)
   6851 				       (get-text-property 0 'inherited tg)))
   6852 			      nil
   6853 			    tg))
   6854 			tags)))
   6855     (when tags
   6856       (let ((have-i (get-text-property 0 'inherited (car tags)))
   6857 	    i)
   6858 	(setq txt (concat txt " :"
   6859 			  (mapconcat
   6860 			   (lambda (x)
   6861 			     (setq i (get-text-property 0 'inherited x))
   6862 			     (if (and have-i (not i))
   6863 				 (progn
   6864 				   (setq have-i nil)
   6865 				   (concat ":" x))
   6866 			       x))
   6867 			   tags ":")
   6868 			  (if have-i "::" ":"))))))
   6869   txt)
   6870 
   6871 (defvar org-agenda-sorting-strategy) ;; because the def is in a let form
   6872 
   6873 (defun org-agenda-add-time-grid-maybe (list ndays todayp)
   6874   "Add a time-grid for agenda items which need it.
   6875 
   6876 LIST is the list of agenda items formatted by `org-agenda-list'.
   6877 NDAYS is the span of the current agenda view.
   6878 TODAYP is t when the current agenda view is on today."
   6879   (catch 'exit
   6880     (cond ((not org-agenda-use-time-grid) (throw 'exit list))
   6881 	  ((and todayp (member 'today (car org-agenda-time-grid))))
   6882 	  ((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
   6883 	  ((member 'weekly (car org-agenda-time-grid)))
   6884 	  (t (throw 'exit list)))
   6885     (let* ((have (delq nil (mapcar
   6886 			    (lambda (x) (get-text-property 1 'time-of-day x))
   6887 			    list)))
   6888 	   (string (nth 3 org-agenda-time-grid))
   6889 	   (gridtimes (nth 1 org-agenda-time-grid))
   6890 	   (req (car org-agenda-time-grid))
   6891 	   (remove (member 'remove-match req))
   6892 	   new time)
   6893       (when (and (member 'require-timed req) (not have))
   6894 	;; don't show empty grid
   6895 	(throw 'exit list))
   6896       (while (setq time (pop gridtimes))
   6897 	(unless (and remove (member time have))
   6898 	  (setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
   6899 	  (push (org-agenda-format-item
   6900 		 nil string nil "" nil
   6901 		 (concat (substring time 0 -2) ":" (substring time -2)))
   6902 		new)
   6903 	  (put-text-property
   6904 	   2 (length (car new)) 'face 'org-time-grid (car new))))
   6905       (when (and todayp org-agenda-show-current-time-in-grid)
   6906 	(push (org-agenda-format-item
   6907 	       nil org-agenda-current-time-string nil "" nil
   6908 	       (format-time-string "%H:%M "))
   6909 	      new)
   6910 	(put-text-property
   6911 	 2 (length (car new)) 'face 'org-agenda-current-time (car new)))
   6912 
   6913       (if (member 'time-up org-agenda-sorting-strategy-selected)
   6914 	  (append new list)
   6915 	(append list new)))))
   6916 
   6917 (defun org-compile-prefix-format (key)
   6918   "Compile the prefix format into a Lisp form that can be evaluated.
   6919 The resulting form and associated variable bindings is returned
   6920 and stored in the variable `org-prefix-format-compiled'."
   6921   (setq org-prefix-has-time nil
   6922 	org-prefix-has-tag nil
   6923 	org-prefix-category-length nil
   6924 	org-prefix-has-effort nil
   6925 	org-prefix-has-breadcrumbs nil)
   6926   (let ((s (cond
   6927 	    ((stringp org-agenda-prefix-format)
   6928 	     org-agenda-prefix-format)
   6929 	    ((assq key org-agenda-prefix-format)
   6930 	     (cdr (assq key org-agenda-prefix-format)))
   6931 	    (t "  %-12:c%?-12t% s")))
   6932 	(start 0)
   6933 	varform vars var c f opt) ;; e
   6934     (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)"
   6935 			 s start)
   6936       (setq var (or (cdr (assoc (match-string 4 s)
   6937 				'(("c" . category) ("t" . time) ("l" . level) ("s" . extra)
   6938 				  ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs))))
   6939 		    'eval)
   6940 	    c (or (match-string 3 s) "")
   6941 	    opt (match-beginning 1)
   6942 	    start (1+ (match-beginning 0)))
   6943       (cl-case var
   6944 	(time        (setq org-prefix-has-time        t))
   6945 	(tag         (setq org-prefix-has-tag         t))
   6946 	(effort      (setq org-prefix-has-effort      t))
   6947 	(breadcrumbs (setq org-prefix-has-breadcrumbs t)))
   6948       (setq f (concat "%" (match-string 2 s) "s"))
   6949       (when (eq var 'category)
   6950 	(setq org-prefix-category-length
   6951 	      (floor (abs (string-to-number (match-string 2 s)))))
   6952 	(setq org-prefix-category-max-length
   6953 	      (let ((x (match-string 2 s)))
   6954 		(save-match-data
   6955 		  (and (string-match "\\.[0-9]+" x)
   6956 		       (string-to-number (substring (match-string 0 x) 1)))))))
   6957       (if (eq var 'eval)
   6958 	  (setq varform `(format ,f (org-eval ,(read (substring s (match-beginning 4))))))
   6959 	(if opt
   6960 	    (setq varform
   6961 		  `(if (member ,var '("" nil))
   6962 		       ""
   6963 		     (format ,f (concat ,var ,c))))
   6964 	  (setq varform
   6965 		`(format ,f (if (member ,var '("" nil)) ""
   6966 			      (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
   6967       (if (eq var 'eval)
   6968           (setf (substring s (match-beginning 0)
   6969                            (+ (match-beginning 4)
   6970                               (length (format "%S" (read (substring s (match-beginning 4)))))))
   6971                 "%s")
   6972         (setq s (replace-match "%s" t nil s)))
   6973       (push varform vars))
   6974     (setq vars (nreverse vars))
   6975     (with-current-buffer (or org-agenda-buffer (current-buffer))
   6976       (setq org-prefix-format-compiled
   6977 	    (list
   6978 	     `((org-prefix-has-time ,org-prefix-has-time)
   6979 	       (org-prefix-has-tag ,org-prefix-has-tag)
   6980 	       (org-prefix-category-length ,org-prefix-category-length)
   6981 	       (org-prefix-has-effort ,org-prefix-has-effort)
   6982 	       (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs))
   6983 	     `(format ,s ,@vars))))))
   6984 
   6985 (defun org-set-sorting-strategy (key)
   6986   (setq org-agenda-sorting-strategy-selected
   6987         (if (symbolp (car org-agenda-sorting-strategy))
   6988             ;; the old format
   6989             org-agenda-sorting-strategy
   6990 	  (or (cdr (assq key org-agenda-sorting-strategy))
   6991 	      (cdr (assq 'agenda org-agenda-sorting-strategy))
   6992 	      '(time-up category-keep priority-down)))))
   6993 
   6994 (defun org-get-time-of-day (s &optional string)
   6995   "Check string S for a time of day.
   6996 
   6997 If found, return it as a military time number between 0 and 2400.
   6998 If not found, return nil.
   6999 
   7000 The optional STRING argument forces conversion into a 5 character wide string
   7001 HH:MM.  When it is `overtime', any time above 24:00 is turned into \"+H:MM\"
   7002 where H:MM is the duration above midnight."
   7003   (let ((case-fold-search t)
   7004         (time-regexp
   7005          (rx word-start
   7006              (group (opt (any "012")) digit)           ;group 1: hours
   7007              (or (and ":" (group (any "012345") digit) ;group 2: minutes
   7008                       (opt (group (or "am" "pm"))))    ;group 3: am/pm
   7009                  ;; Special "HHam/pm" case.
   7010                  (group-n 3 (or "am" "pm")))
   7011              word-end)))
   7012     (save-match-data
   7013       (when (and (string-match time-regexp s)
   7014                  (not (eq 'org-link (get-text-property 1 'face s))))
   7015         (let ((hours
   7016                (let* ((ampm (and (match-end 3) (downcase (match-string 3 s))))
   7017                       (am-p (equal ampm "am")))
   7018                  (pcase (string-to-number (match-string 1 s))
   7019                    ((and (guard (not ampm)) h) h)
   7020                    (12 (if am-p 0 12))
   7021                    (h (+ h (if am-p 0 12))))))
   7022               (minutes
   7023                (if (match-end 2)
   7024                    (string-to-number (match-string 2 s))
   7025                  0)))
   7026           (pcase string
   7027             (`nil (+ minutes (* hours 100)))
   7028             ((and `overtime
   7029                   (guard (or (> hours 24)
   7030                              (and (= hours 24)
   7031                                   (> minutes 0)))))
   7032              (format "+%d:%02d" (- hours 24) minutes))
   7033             ((guard org-agenda-time-leading-zero)
   7034              (format "%02d:%02d" hours minutes))
   7035             (_
   7036              (format "%d:%02d" hours minutes))))))))
   7037 
   7038 (defvar org-agenda-before-sorting-filter-function nil
   7039   "Function to be applied to agenda items prior to sorting.
   7040 Prior to sorting also means just before they are inserted into the agenda.
   7041 
   7042 To aid sorting, you may revisit the original entries and add more text
   7043 properties which will later be used by the sorting functions.
   7044 
   7045 The function should take a string argument, an agenda line.
   7046 It has access to the text properties in that line, which contain among
   7047 other things, the property `org-hd-marker' that points to the entry
   7048 where the line comes from.  Note that not all lines going into the agenda
   7049 have this property, only most.
   7050 
   7051 The function should return the modified string.  It is probably best
   7052 to ONLY change text properties.
   7053 
   7054 You can also use this function as a filter, by returning nil for lines
   7055 you don't want to have in the agenda at all.  For this application, you
   7056 could bind the variable in the options section of a custom command.")
   7057 
   7058 (defun org-agenda-finalize-entries (list &optional type)
   7059   "Sort, limit and concatenate the LIST of agenda items.
   7060 The optional argument TYPE tells the agenda type."
   7061   (let ((max-effort (cond ((listp org-agenda-max-effort)
   7062 			   (cdr (assoc type org-agenda-max-effort)))
   7063 			  (t org-agenda-max-effort)))
   7064 	(max-todo (cond ((listp org-agenda-max-todos)
   7065 			 (cdr (assoc type org-agenda-max-todos)))
   7066 			(t org-agenda-max-todos)))
   7067 	(max-tags (cond ((listp org-agenda-max-tags)
   7068 			 (cdr (assoc type org-agenda-max-tags)))
   7069 			(t org-agenda-max-tags)))
   7070 	(max-entries (cond ((listp org-agenda-max-entries)
   7071 			    (cdr (assoc type org-agenda-max-entries)))
   7072 			   (t org-agenda-max-entries))))
   7073     (when org-agenda-before-sorting-filter-function
   7074       (setq list
   7075 	    (delq nil
   7076 		  (mapcar
   7077 		   org-agenda-before-sorting-filter-function list))))
   7078     (setq list (mapcar #'org-agenda-highlight-todo list)
   7079 	  list (mapcar #'identity (sort list #'org-entries-lessp)))
   7080     (when max-effort
   7081       (setq list (org-agenda-limit-entries
   7082 		  list 'effort-minutes max-effort
   7083 		  (lambda (e) (or e (if org-agenda-sort-noeffort-is-high
   7084 					32767 -1))))))
   7085     (when max-todo
   7086       (setq list (org-agenda-limit-entries list 'todo-state max-todo)))
   7087     (when max-tags
   7088       (setq list (org-agenda-limit-entries list 'tags max-tags)))
   7089     (when max-entries
   7090       (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
   7091     (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
   7092       (setq list (mapcar #'org-agenda--mark-blocked-entry list)))
   7093     (mapconcat #'identity list "\n")))
   7094 
   7095 (defun org-agenda-limit-entries (list prop limit &optional fn)
   7096   "Limit the number of agenda entries."
   7097   (let ((include (and limit (< limit 0))))
   7098     (if limit
   7099 	(let ((fun (or fn (lambda (p) (when p 1))))
   7100 	      (lim 0))
   7101 	  (delq nil
   7102 		(mapcar
   7103 		 (lambda (e)
   7104 		   (let ((pval (funcall
   7105 				fun (get-text-property (1- (length e))
   7106 						       prop e))))
   7107 		     (when pval (setq lim (+ lim pval)))
   7108 		     (cond ((and pval (<= lim (abs limit))) e)
   7109 			   ((and include (not pval)) e))))
   7110 		 list)))
   7111       list)))
   7112 
   7113 (defun org-agenda-limit-interactively (remove)
   7114   "In agenda, interactively limit entries to various maximums."
   7115   (interactive "P")
   7116   (if remove
   7117       (progn (setq org-agenda-max-entries nil
   7118 		   org-agenda-max-todos nil
   7119 		   org-agenda-max-tags nil
   7120 		   org-agenda-max-effort nil)
   7121 	     (org-agenda-redo))
   7122     (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
   7123 	   (msg (cond ((= max ?E) "How many minutes? ")
   7124 		      ((= max ?e) "How many entries? ")
   7125 		      ((= max ?t) "How many TODO entries? ")
   7126 		      ((= max ?T) "How many tagged entries? ")
   7127 		      (t (user-error "Wrong input"))))
   7128 	   (num (string-to-number (read-from-minibuffer msg))))
   7129       (cond ((equal max ?e)
   7130 	     (let ((org-agenda-max-entries num)) (org-agenda-redo)))
   7131 	    ((equal max ?t)
   7132 	     (let ((org-agenda-max-todos num)) (org-agenda-redo)))
   7133 	    ((equal max ?T)
   7134 	     (let ((org-agenda-max-tags num)) (org-agenda-redo)))
   7135 	    ((equal max ?E)
   7136 	     (let ((org-agenda-max-effort num)) (org-agenda-redo))))))
   7137   (org-agenda-fit-window-to-buffer))
   7138 
   7139 (defun org-agenda-highlight-todo (x)
   7140   (let ((org-done-keywords org-done-keywords-for-agenda)
   7141 	(case-fold-search nil)
   7142 	re)
   7143     (if (eq x 'line)
   7144 	(save-excursion
   7145 	  (beginning-of-line 1)
   7146 	  (setq re (org-get-at-bol 'org-todo-regexp))
   7147 	  (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point)))
   7148 	  (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
   7149 	    (add-text-properties (match-beginning 0) (match-end 1)
   7150 				 (list 'face (org-get-todo-face 1)))
   7151 	    (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
   7152 	      (delete-region (match-beginning 1) (1- (match-end 0)))
   7153 	      (goto-char (match-beginning 1))
   7154 	      (insert (format org-agenda-todo-keyword-format s)))))
   7155       (let ((pl (text-property-any 0 (length x) 'org-heading t x)))
   7156 	(setq re (get-text-property 0 'org-todo-regexp x))
   7157 	(when (and re
   7158 		   ;; Test `pl' because if there's no heading content,
   7159 		   ;; there's no point matching to highlight.  Note
   7160 		   ;; that if we didn't test `pl' first, and there
   7161 		   ;; happened to be no keyword from `org-todo-regexp'
   7162 		   ;; on this heading line, then the `equal' comparison
   7163 		   ;; afterwards would spuriously succeed in the case
   7164 		   ;; where `pl' is nil -- causing an args-out-of-range
   7165 		   ;; error when we try to add text properties to text
   7166 		   ;; that isn't there.
   7167 		   pl
   7168 		   (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
   7169 					x pl)
   7170 			  pl))
   7171 	  (add-text-properties
   7172 	   (or (match-end 1) (match-end 0)) (match-end 0)
   7173 	   (list 'face (org-get-todo-face (match-string 2 x)))
   7174 	   x)
   7175 	  (when (match-end 1)
   7176 	    (setq x
   7177 		  (concat
   7178 		   (substring x 0 (match-end 1))
   7179                    (unless (string= org-agenda-todo-keyword-format "")
   7180 		     (format org-agenda-todo-keyword-format
   7181 			     (match-string 2 x)))
   7182                    ;; Remove `display' property as the icon could leak
   7183 		   ;; on the white space.
   7184 		   (org-add-props " " (org-plist-delete (text-properties-at 0 x)
   7185                                                         'display))
   7186                    (substring x (match-end 3)))))))
   7187       x)))
   7188 
   7189 (defsubst org-cmp-values (a b property)
   7190   "Compare the numeric value of text PROPERTY for string A and B."
   7191   (let ((pa (or (get-text-property (1- (length a)) property a) 0))
   7192 	(pb (or (get-text-property (1- (length b)) property b) 0)))
   7193     (cond ((> pa pb) +1)
   7194 	  ((< pa pb) -1))))
   7195 
   7196 (defsubst org-cmp-effort (a b)
   7197   "Compare the effort values of string A and B."
   7198   (let* ((def (if org-agenda-sort-noeffort-is-high 32767 -1))
   7199 	 ;; `effort-minutes' property is not directly accessible from
   7200 	 ;; the strings, but is stored as a property in `txt'.
   7201 	 (ea (or (get-text-property
   7202 		  0 'effort-minutes (get-text-property 0 'txt a))
   7203 		 def))
   7204 	 (eb (or (get-text-property
   7205 		  0 'effort-minutes (get-text-property 0 'txt b))
   7206 		 def)))
   7207     (cond ((> ea eb) +1)
   7208 	  ((< ea eb) -1))))
   7209 
   7210 (defsubst org-cmp-category (a b)
   7211   "Compare the string values of categories of strings A and B."
   7212   (let ((ca (or (get-text-property (1- (length a)) 'org-category a) ""))
   7213 	(cb (or (get-text-property (1- (length b)) 'org-category b) "")))
   7214     (cond ((string-lessp ca cb) -1)
   7215 	  ((string-lessp cb ca) +1))))
   7216 
   7217 (defsubst org-cmp-todo-state (a b)
   7218   "Compare the todo states of strings A and B."
   7219   (let* ((ma (or (get-text-property 1 'org-marker a)
   7220 		 (get-text-property 1 'org-hd-marker a)))
   7221 	 (mb (or (get-text-property 1 'org-marker b)
   7222 		 (get-text-property 1 'org-hd-marker b)))
   7223 	 (fa (and ma (marker-buffer ma)))
   7224 	 (fb (and mb (marker-buffer mb)))
   7225 	 (todo-kwds
   7226 	  (or (and fa (with-current-buffer fa org-todo-keywords-1))
   7227 	      (and fb (with-current-buffer fb org-todo-keywords-1))))
   7228 	 (ta (or (get-text-property 1 'todo-state a) ""))
   7229 	 (tb (or (get-text-property 1 'todo-state b) ""))
   7230 	 (la (- (length (member ta todo-kwds))))
   7231 	 (lb (- (length (member tb todo-kwds))))
   7232 	 (donepa (member ta org-done-keywords-for-agenda))
   7233 	 (donepb (member tb org-done-keywords-for-agenda)))
   7234     (cond ((and donepa (not donepb)) -1)
   7235 	  ((and (not donepa) donepb) +1)
   7236 	  ((< la lb) -1)
   7237 	  ((< lb la) +1))))
   7238 
   7239 (defsubst org-cmp-alpha (a b)
   7240   "Compare the headlines, alphabetically."
   7241   (let* ((pla (text-property-any 0 (length a) 'org-heading t a))
   7242 	 (plb (text-property-any 0 (length b) 'org-heading t b))
   7243 	 (ta (and pla (substring a pla)))
   7244 	 (tb (and plb (substring b plb)))
   7245 	 (case-fold-search nil))
   7246     (when pla
   7247       (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
   7248 				  "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *")
   7249 			  ta)
   7250 	(setq ta (substring ta (match-end 0))))
   7251       (setq ta (downcase ta)))
   7252     (when plb
   7253       (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "")
   7254 				  "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *")
   7255 			  tb)
   7256 	(setq tb (substring tb (match-end 0))))
   7257       (setq tb (downcase tb)))
   7258     (cond ((not (or ta tb)) nil)
   7259 	  ((not ta) +1)
   7260 	  ((not tb) -1)
   7261 	  ((string-lessp ta tb) -1)
   7262 	  ((string-lessp tb ta) +1))))
   7263 
   7264 (defsubst org-cmp-tag (a b)
   7265   "Compare the string values of the first tags of A and B."
   7266   (let ((ta (car (last (get-text-property 1 'tags a))))
   7267 	(tb (car (last (get-text-property 1 'tags b)))))
   7268     (cond ((not (or ta tb)) nil)
   7269 	  ((not ta) +1)
   7270 	  ((not tb) -1)
   7271 	  ((string-lessp ta tb) -1)
   7272 	  ((string-lessp tb ta) +1))))
   7273 
   7274 (defsubst org-cmp-time (a b)
   7275   "Compare the time-of-day values of strings A and B."
   7276   (let* ((def (if org-agenda-sort-notime-is-late 9901 -1))
   7277 	 (ta (or (get-text-property 1 'time-of-day a) def))
   7278 	 (tb (or (get-text-property 1 'time-of-day b) def)))
   7279     (cond ((< ta tb) -1)
   7280 	  ((< tb ta) +1))))
   7281 
   7282 (defsubst org-cmp-ts (a b type)
   7283   "Compare the timestamps values of entries A and B.
   7284 When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
   7285 \"timestamp_ia\", compare within each of these type.  When TYPE
   7286 is the empty string, compare all timestamps without respect of
   7287 their type."
   7288   (let* ((def (and (not org-agenda-sort-notime-is-late) -1))
   7289 	 (ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
   7290 		      (get-text-property 1 'ts-date a))
   7291 		 def))
   7292 	 (tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
   7293 		      (get-text-property 1 'ts-date b))
   7294 		 def)))
   7295     (cond ((if ta (and tb (< ta tb)) tb) -1)
   7296 	  ((if tb (and ta (< tb ta)) ta) +1))))
   7297 
   7298 (defsubst org-cmp-habit-p (a b)
   7299   "Compare the todo states of strings A and B."
   7300   (let ((ha (get-text-property 1 'org-habit-p a))
   7301 	(hb (get-text-property 1 'org-habit-p b)))
   7302     (cond ((and ha (not hb)) -1)
   7303 	  ((and (not ha) hb) +1))))
   7304 
   7305 (defun org-entries-lessp (a b)
   7306   "Predicate for sorting agenda entries."
   7307   ;; The following variables will be used when the form is evaluated.
   7308   ;; So even though the compiler complains, keep them.
   7309   (let ((ss org-agenda-sorting-strategy-selected))
   7310     (org-dlet
   7311 	((timestamp-up    (and (org-em 'timestamp-up 'timestamp-down ss)
   7312 			       (org-cmp-ts a b "")))
   7313 	 (timestamp-down  (if timestamp-up (- timestamp-up) nil))
   7314 	 (scheduled-up    (and (org-em 'scheduled-up 'scheduled-down ss)
   7315 			       (org-cmp-ts a b "scheduled")))
   7316 	 (scheduled-down  (if scheduled-up (- scheduled-up) nil))
   7317 	 (deadline-up     (and (org-em 'deadline-up 'deadline-down ss)
   7318 			       (org-cmp-ts a b "deadline")))
   7319 	 (deadline-down   (if deadline-up (- deadline-up) nil))
   7320 	 (tsia-up         (and (org-em 'tsia-up 'tsia-down ss)
   7321 			       (org-cmp-ts a b "timestamp_ia")))
   7322 	 (tsia-down       (if tsia-up (- tsia-up) nil))
   7323 	 (ts-up           (and (org-em 'ts-up 'ts-down ss)
   7324 			       (org-cmp-ts a b "timestamp")))
   7325 	 (ts-down         (if ts-up (- ts-up) nil))
   7326 	 (time-up         (and (org-em 'time-up 'time-down ss)
   7327 			       (org-cmp-time a b)))
   7328 	 (time-down       (if time-up (- time-up) nil))
   7329 	 (stats-up        (and (org-em 'stats-up 'stats-down ss)
   7330 			       (org-cmp-values a b 'org-stats)))
   7331 	 (stats-down      (if stats-up (- stats-up) nil))
   7332 	 (priority-up     (and (org-em 'priority-up 'priority-down ss)
   7333 			       (org-cmp-values a b 'priority)))
   7334 	 (priority-down   (if priority-up (- priority-up) nil))
   7335 	 (effort-up       (and (org-em 'effort-up 'effort-down ss)
   7336 			       (org-cmp-effort a b)))
   7337 	 (effort-down     (if effort-up (- effort-up) nil))
   7338 	 (category-up     (and (or (org-em 'category-up 'category-down ss)
   7339 				   (memq 'category-keep ss))
   7340 			       (org-cmp-category a b)))
   7341 	 (category-down   (if category-up (- category-up) nil))
   7342 	 (category-keep   (if category-up +1 nil))
   7343 	 (tag-up          (and (org-em 'tag-up 'tag-down ss)
   7344 			       (org-cmp-tag a b)))
   7345 	 (tag-down        (if tag-up (- tag-up) nil))
   7346 	 (todo-state-up   (and (org-em 'todo-state-up 'todo-state-down ss)
   7347 			       (org-cmp-todo-state a b)))
   7348 	 (todo-state-down (if todo-state-up (- todo-state-up) nil))
   7349 	 (habit-up        (and (org-em 'habit-up 'habit-down ss)
   7350 			       (org-cmp-habit-p a b)))
   7351 	 (habit-down      (if habit-up (- habit-up) nil))
   7352 	 (alpha-up        (and (org-em 'alpha-up 'alpha-down ss)
   7353 			       (org-cmp-alpha a b)))
   7354 	 (alpha-down      (if alpha-up (- alpha-up) nil))
   7355 	 (need-user-cmp   (org-em 'user-defined-up 'user-defined-down ss))
   7356 	 user-defined-up user-defined-down)
   7357       (when (and need-user-cmp org-agenda-cmp-user-defined
   7358 	         (functionp org-agenda-cmp-user-defined))
   7359 	(setq user-defined-up
   7360 	      (funcall org-agenda-cmp-user-defined a b)
   7361 	      user-defined-down (if user-defined-up (- user-defined-up) nil)))
   7362       (cdr (assoc
   7363 	    (eval (cons 'or org-agenda-sorting-strategy-selected) t)
   7364 	    '((-1 . t) (1 . nil) (nil . nil)))))))
   7365 
   7366 ;;; Agenda restriction lock
   7367 
   7368 (defvar org-agenda-restriction-lock-overlay (make-overlay 1 1)
   7369   "Overlay to mark the headline to which agenda commands are restricted.")
   7370 (overlay-put org-agenda-restriction-lock-overlay
   7371 	     'face 'org-agenda-restriction-lock)
   7372 (overlay-put org-agenda-restriction-lock-overlay
   7373 	     'help-echo "Agendas are currently limited to this subtree.")
   7374 (delete-overlay org-agenda-restriction-lock-overlay)
   7375 
   7376 (defun org-agenda-set-restriction-lock-from-agenda (arg)
   7377   "Set the restriction lock to the agenda item at point from within the agenda.
   7378 When called with a `\\[universal-argument]' prefix, restrict to
   7379 the file which contains the item.
   7380 Argument ARG is the prefix argument."
   7381   (interactive "P")
   7382   (unless  (derived-mode-p 'org-agenda-mode)
   7383     (user-error "Not in an Org agenda buffer"))
   7384   (let* ((marker (or (org-get-at-bol 'org-marker)
   7385                      (org-agenda-error)))
   7386          (buffer (marker-buffer marker))
   7387          (pos (marker-position marker)))
   7388     (with-current-buffer buffer
   7389       (goto-char pos)
   7390       (org-agenda-set-restriction-lock arg))))
   7391 
   7392 ;;;###autoload
   7393 (defun org-agenda-set-restriction-lock (&optional type)
   7394   "Set restriction lock for agenda to current subtree or file.
   7395 When in a restricted subtree, remove it.
   7396 
   7397 The restriction will span over the entire file if TYPE is `file',
   7398 or if type is '(4), or if the cursor is before the first headline
   7399 in the file.  Otherwise, only apply the restriction to the current
   7400 subtree."
   7401   (interactive "P")
   7402   (if (and org-agenda-overriding-restriction
   7403 	   (member org-agenda-restriction-lock-overlay
   7404 		   (overlays-at (point)))
   7405 	   (equal (overlay-start org-agenda-restriction-lock-overlay)
   7406 		  (point)))
   7407       (org-agenda-remove-restriction-lock 'noupdate)
   7408     (org-agenda-remove-restriction-lock 'noupdate)
   7409     (and (equal type '(4)) (setq type 'file))
   7410     (setq type (cond
   7411 		(type type)
   7412 		((org-at-heading-p) 'subtree)
   7413 		((condition-case nil (org-back-to-heading t) (error nil))
   7414 		 'subtree)
   7415 		(t 'file)))
   7416     (if (eq type 'subtree)
   7417 	(progn
   7418 	  (setq org-agenda-restrict (current-buffer))
   7419 	  (setq org-agenda-overriding-restriction 'subtree)
   7420 	  (put 'org-agenda-files 'org-restrict
   7421 	       (list (buffer-file-name (buffer-base-buffer))))
   7422 	  (org-back-to-heading t)
   7423 	  (move-overlay org-agenda-restriction-lock-overlay
   7424 			(point)
   7425 			(if org-agenda-restriction-lock-highlight-subtree
   7426 			    (save-excursion (org-end-of-subtree t t) (point))
   7427 			  (point-at-eol)))
   7428 	  (move-marker org-agenda-restrict-begin (point))
   7429 	  (move-marker org-agenda-restrict-end
   7430 		       (save-excursion (org-end-of-subtree t t)))
   7431 	  (message "Locking agenda restriction to subtree"))
   7432       (put 'org-agenda-files 'org-restrict
   7433 	   (list (buffer-file-name (buffer-base-buffer))))
   7434       (setq org-agenda-restrict nil)
   7435       (setq org-agenda-overriding-restriction 'file)
   7436       (move-marker org-agenda-restrict-begin nil)
   7437       (move-marker org-agenda-restrict-end nil)
   7438       (message "Locking agenda restriction to file"))
   7439     (setq current-prefix-arg nil))
   7440   (org-agenda-maybe-redo))
   7441 
   7442 (defun org-agenda-remove-restriction-lock (&optional noupdate)
   7443   "Remove agenda restriction lock."
   7444   (interactive "P")
   7445   (if (not org-agenda-restrict)
   7446       (message "No agenda restriction to remove.")
   7447     (delete-overlay org-agenda-restriction-lock-overlay)
   7448     (delete-overlay org-speedbar-restriction-lock-overlay)
   7449     (setq org-agenda-overriding-restriction nil)
   7450     (setq org-agenda-restrict nil)
   7451     (put 'org-agenda-files 'org-restrict nil)
   7452     (move-marker org-agenda-restrict-begin nil)
   7453     (move-marker org-agenda-restrict-end nil)
   7454     (setq current-prefix-arg nil)
   7455     (message "Agenda restriction lock removed")
   7456     (or noupdate (org-agenda-maybe-redo))))
   7457 
   7458 (defun org-agenda-maybe-redo ()
   7459   "If there is any window showing the agenda view, update it."
   7460   (let ((w (get-buffer-window (or org-agenda-this-buffer-name
   7461 				  org-agenda-buffer-name)
   7462 			      t))
   7463 	(w0 (selected-window)))
   7464     (when w
   7465       (select-window w)
   7466       (org-agenda-redo)
   7467       (select-window w0)
   7468       (if org-agenda-overriding-restriction
   7469 	  (message "Agenda view shifted to new %s restriction"
   7470 		   org-agenda-overriding-restriction)
   7471 	(message "Agenda restriction lock removed")))))
   7472 
   7473 ;;; Agenda commands
   7474 
   7475 (defun org-agenda-check-type (error &rest types)
   7476   "Check if agenda buffer or component is of allowed type.
   7477 If ERROR is non-nil, throw an error, otherwise just return nil.
   7478 Allowed types are `agenda' `todo' `tags' `search'."
   7479   (cond ((not org-agenda-type)
   7480 	 (error "No Org agenda currently displayed"))
   7481 	((memq org-agenda-type types) t)
   7482 	(error
   7483 	 (error "Not allowed in '%s'-type agenda buffer or component" org-agenda-type))
   7484 	(t nil)))
   7485 
   7486 (defun org-agenda-Quit ()
   7487   "Exit the agenda, killing the agenda buffer.
   7488 Like `org-agenda-quit', but kill the buffer even when
   7489 `org-agenda-sticky' is non-nil."
   7490   (interactive)
   7491   (org-agenda--quit))
   7492 
   7493 (defun org-agenda-quit ()
   7494   "Exit the agenda.
   7495 
   7496 When `org-agenda-sticky' is non-nil, bury the agenda buffer
   7497 instead of killing it.
   7498 
   7499 When `org-agenda-restore-windows-after-quit' is non-nil, restore
   7500 the pre-agenda window configuration.
   7501 
   7502 When column view is active, exit column view instead of the
   7503 agenda."
   7504   (interactive)
   7505   (org-agenda--quit org-agenda-sticky))
   7506 
   7507 (defun org-agenda--quit (&optional bury)
   7508   (if org-agenda-columns-active
   7509       (org-columns-quit)
   7510     (let ((wconf org-agenda-pre-window-conf)
   7511 	  (buf (current-buffer))
   7512 	  (org-agenda-last-indirect-window
   7513 	   (and (eq org-indirect-buffer-display 'other-window)
   7514 		org-agenda-last-indirect-buffer
   7515 		(get-buffer-window org-agenda-last-indirect-buffer))))
   7516       (cond
   7517        ((eq org-agenda-window-setup 'other-frame)
   7518 	(delete-frame))
   7519        ((eq org-agenda-window-setup 'other-tab)
   7520 	(if (fboundp 'tab-bar-close-tab)
   7521 	    (tab-bar-close-tab)
   7522 	  (user-error "Your version of Emacs does not have tab bar mode support")))
   7523        ((and org-agenda-restore-windows-after-quit
   7524 	     wconf)
   7525 	;; Maybe restore the pre-agenda window configuration.  Reset
   7526 	;; `org-agenda-pre-window-conf' before running
   7527 	;; `set-window-configuration', which loses the current buffer.
   7528 	(setq org-agenda-pre-window-conf nil)
   7529 	(set-window-configuration wconf))
   7530        (t
   7531 	(when org-agenda-last-indirect-window
   7532 	  (delete-window org-agenda-last-indirect-window))
   7533 	(and (not (eq org-agenda-window-setup 'current-window))
   7534 	     (not (one-window-p))
   7535 	     (delete-window))))
   7536       (if bury
   7537 	  ;; Set the agenda buffer as the current buffer instead of
   7538 	  ;; passing it as an argument to `bury-buffer' so that
   7539 	  ;; `bury-buffer' removes it from the window.
   7540 	  (with-current-buffer buf
   7541 	    (bury-buffer))
   7542 	(kill-buffer buf)
   7543 	(setq org-agenda-archives-mode nil
   7544 	      org-agenda-buffer nil)))))
   7545 
   7546 (defun org-agenda-exit ()
   7547   "Exit the agenda, killing Org buffers loaded by the agenda.
   7548 Like `org-agenda-Quit', but kill any buffers that were created by
   7549 the agenda.  Org buffers visited directly by the user will not be
   7550 touched.  Also, exit the agenda even if it is in column view."
   7551   (interactive)
   7552   (when org-agenda-columns-active
   7553     (org-columns-quit))
   7554   (org-release-buffers org-agenda-new-buffers)
   7555   (setq org-agenda-new-buffers nil)
   7556   (org-agenda-Quit))
   7557 
   7558 (defun org-agenda-kill-all-agenda-buffers ()
   7559   "Kill all buffers in `org-agenda-mode'.
   7560 This is used when toggling sticky agendas."
   7561   (interactive)
   7562   (let (blist)
   7563     (dolist (buf (buffer-list))
   7564       (when (with-current-buffer buf (eq major-mode 'org-agenda-mode))
   7565 	(push buf blist)))
   7566     (mapc #'kill-buffer blist)))
   7567 
   7568 (defun org-agenda-execute (arg)
   7569   "Execute another agenda command, keeping same window.
   7570 So this is just a shortcut for \\<global-map>`\\[org-agenda]', available
   7571 in the agenda."
   7572   (interactive "P")
   7573   (let ((org-agenda-window-setup 'current-window))
   7574     (org-agenda arg)))
   7575 
   7576 (defun org-agenda-redo (&optional all)
   7577   "Rebuild possibly ALL agenda view(s) in the current buffer."
   7578   (interactive "P")
   7579   (defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used?
   7580   (let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
   7581 	 (cpa (unless (eq all t) current-prefix-arg))
   7582 	 (org-agenda-doing-sticky-redo org-agenda-sticky)
   7583 	 (org-agenda-sticky nil)
   7584 	 (org-agenda-buffer-name (or org-agenda-this-buffer-name
   7585 				     org-agenda-buffer-name))
   7586 	 (org-agenda-keep-modes t)
   7587 	 (tag-filter org-agenda-tag-filter)
   7588 	 (tag-preset (get 'org-agenda-tag-filter :preset-filter))
   7589 	 (top-hl-filter org-agenda-top-headline-filter)
   7590 	 (cat-filter org-agenda-category-filter)
   7591 	 (cat-preset (get 'org-agenda-category-filter :preset-filter))
   7592 	 (re-filter org-agenda-regexp-filter)
   7593 	 (re-preset (get 'org-agenda-regexp-filter :preset-filter))
   7594 	 (effort-filter org-agenda-effort-filter)
   7595 	 (effort-preset (get 'org-agenda-effort-filter :preset-filter))
   7596 	 (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
   7597 	 (cols org-agenda-columns-active)
   7598 	 (line (org-current-line))
   7599 	 (window-line (- line (org-current-line (window-start))))
   7600 	 (lprops (get 'org-agenda-redo-command 'org-lprops))
   7601 	 (redo-cmd (get-text-property p 'org-redo-cmd))
   7602 	 (last-args (get-text-property p 'org-last-args))
   7603 	 (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd))
   7604 	 (org-agenda-overriding-cmd-arguments
   7605 	  (unless (eq all t)
   7606 	    (cond ((listp last-args)
   7607 		   (cons (or cpa (car last-args)) (cdr last-args)))
   7608 		  ((stringp last-args)
   7609 		   last-args))))
   7610 	 (series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
   7611     (put 'org-agenda-tag-filter :preset-filter nil)
   7612     (put 'org-agenda-category-filter :preset-filter nil)
   7613     (put 'org-agenda-regexp-filter :preset-filter nil)
   7614     (put 'org-agenda-effort-filter :preset-filter nil)
   7615     (and cols (org-columns-quit))
   7616     (message "Rebuilding agenda buffer...")
   7617     (if series-redo-cmd
   7618 	(eval series-redo-cmd t)
   7619       (cl-progv
   7620 	  (mapcar #'car lprops)
   7621 	  (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
   7622 	(eval redo-cmd t)))
   7623     (setq org-agenda-undo-list nil
   7624 	  org-agenda-pending-undo-list nil
   7625 	  org-agenda-tag-filter tag-filter
   7626 	  org-agenda-category-filter cat-filter
   7627 	  org-agenda-regexp-filter re-filter
   7628 	  org-agenda-effort-filter effort-filter
   7629 	  org-agenda-top-headline-filter top-hl-filter)
   7630     (message "Rebuilding agenda buffer...done")
   7631     (put 'org-agenda-tag-filter :preset-filter tag-preset)
   7632     (put 'org-agenda-category-filter :preset-filter cat-preset)
   7633     (put 'org-agenda-regexp-filter :preset-filter re-preset)
   7634     (put 'org-agenda-effort-filter :preset-filter effort-preset)
   7635     (let ((tag (or tag-filter tag-preset))
   7636 	  (cat (or cat-filter cat-preset))
   7637 	  (effort (or effort-filter effort-preset))
   7638 	  (re (or re-filter re-preset)))
   7639       (when tag (org-agenda-filter-apply tag 'tag t))
   7640       (when cat (org-agenda-filter-apply cat 'category))
   7641       (when effort (org-agenda-filter-apply effort 'effort))
   7642       (when re  (org-agenda-filter-apply re 'regexp)))
   7643     (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
   7644     (and cols (called-interactively-p 'any) (org-agenda-columns))
   7645     (org-goto-line line)
   7646     (when (called-interactively-p 'any) (recenter window-line))))
   7647 
   7648 (defun org-agenda-redo-all (&optional exhaustive)
   7649   "Rebuild all agenda views in the current buffer.
   7650 With a prefix argument, do so in all agenda buffers."
   7651   (interactive "P")
   7652   (if exhaustive
   7653       (dolist (buffer (buffer-list))
   7654         (with-current-buffer buffer
   7655           (when (derived-mode-p 'org-agenda-mode)
   7656             (org-agenda-redo t))))
   7657     (org-agenda-redo t)))
   7658 
   7659 (defvar org-global-tags-completion-table nil)
   7660 (defvar org-agenda-filter-form nil)
   7661 (defvar org-agenda-filtered-by-category nil)
   7662 
   7663 (defsubst org-agenda-get-category ()
   7664   "Return the category of the agenda line."
   7665   (org-get-at-bol 'org-category))
   7666 
   7667 (defun org-agenda-filter-by-category (strip)
   7668   "Filter lines in the agenda buffer that have a specific category.
   7669 The category is that of the current line.
   7670 With a `\\[universal-argument]' prefix argument, exclude the lines of that category.
   7671 When there is already a category filter in place, this command removes the
   7672 filter."
   7673   (interactive "P")
   7674   (if (and org-agenda-filtered-by-category
   7675 	   org-agenda-category-filter)
   7676       (org-agenda-filter-show-all-cat)
   7677     (let ((cat (org-no-properties (org-get-at-eol 'org-category 1))))
   7678       (cond
   7679        ((and cat strip)
   7680         (org-agenda-filter-apply
   7681          (push (concat "-" cat) org-agenda-category-filter) 'category))
   7682        (cat
   7683         (org-agenda-filter-apply
   7684          (setq org-agenda-category-filter
   7685 	       (list (concat "+" cat)))
   7686 	 'category))
   7687        (t (error "No category at point"))))))
   7688 
   7689 (defun org-find-top-headline (&optional pos)
   7690   "Find the topmost parent headline and return it.
   7691 POS when non-nil is the marker or buffer position to start the
   7692 search from."
   7693   (save-excursion
   7694     (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
   7695       (when pos (goto-char pos))
   7696       ;; Skip up to the topmost parent.
   7697       (while (org-up-heading-safe))
   7698       (ignore-errors
   7699 	(replace-regexp-in-string
   7700 	 "^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" ""
   7701 	 (nth 4 (org-heading-components)))))))
   7702 
   7703 (defvar org-agenda-filtered-by-top-headline nil)
   7704 (defun org-agenda-filter-by-top-headline (strip)
   7705   "Keep only those lines that are descendants from the same top headline.
   7706 The top headline is that of the current line.  With prefix arg STRIP, hide
   7707 all lines of the category at point."
   7708   (interactive "P")
   7709   (if org-agenda-filtered-by-top-headline
   7710       (progn
   7711         (setq org-agenda-filtered-by-top-headline nil
   7712 	      org-agenda-top-headline-filter nil)
   7713         (org-agenda-filter-show-all-top-filter))
   7714     (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
   7715       (if toph (org-agenda-filter-top-headline-apply toph strip)
   7716         (error "No top-level headline at point")))))
   7717 
   7718 (defvar org-agenda-regexp-filter nil)
   7719 (defun org-agenda-filter-by-regexp (strip-or-accumulate)
   7720   "Filter agenda entries by a regular expressions.
   7721 You will be prompted for the regular expression, and the agenda
   7722 view will only show entries that are matched by that expression.
   7723 
   7724 With one `\\[universal-argument]' prefix argument, hide entries matching the regexp.
   7725 When there is already a regexp filter active, this command removed the
   7726 filter.  However, with two `\\[universal-argument]' prefix arguments, add a new condition to
   7727 an already existing regexp filter."
   7728   (interactive "P")
   7729   (let* ((strip (equal strip-or-accumulate '(4)))
   7730 	 (accumulate (equal strip-or-accumulate '(16))))
   7731     (cond
   7732      ((and org-agenda-regexp-filter (not accumulate))
   7733       (org-agenda-filter-show-all-re)
   7734       (message "Regexp filter removed"))
   7735      (t (let ((flt (concat (if strip "-" "+")
   7736 			   (read-from-minibuffer
   7737 			    (if strip
   7738 				"Hide entries matching regexp: "
   7739 			      "Narrow to entries matching regexp: ")))))
   7740 	  (push flt org-agenda-regexp-filter)
   7741 	  (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))))))
   7742 
   7743 (defvar org-agenda-effort-filter nil)
   7744 (defun org-agenda-filter-by-effort (strip-or-accumulate)
   7745   "Filter agenda entries by effort.
   7746 With no `\\[universal-argument]' prefix argument, keep entries matching the effort condition.
   7747 With one `\\[universal-argument]' prefix argument, filter out entries matching the condition.
   7748 With two `\\[universal-argument]' prefix arguments, add a second condition to the existing filter.
   7749 This last option is in practice not very useful, but it is available for
   7750 consistency with the other filter commands."
   7751   (interactive "P")
   7752   (let* ((efforts (split-string
   7753 		   (or (cdr (assoc-string (concat org-effort-property "_ALL")
   7754 					  org-global-properties
   7755 					  t))
   7756 		       "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")))
   7757 	 ;; XXX: the following handles only up to 10 different
   7758 	 ;; effort values.
   7759 	 (allowed-keys (if (null efforts) nil
   7760 			 (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0
   7761 				 (number-sequence 1 (length efforts)))))
   7762 	 (keep (equal strip-or-accumulate '(16)))
   7763 	 (negative (equal strip-or-accumulate '(4)))
   7764 	 (current org-agenda-effort-filter)
   7765 	 (op nil))
   7766     (while (not (memq op '(?< ?> ?= ?_)))
   7767       (setq op (read-char-exclusive
   7768 		"Effort operator? (> = or <)     or press `_' again to remove filter")))
   7769     ;; Select appropriate duration.  Ignore non-digit characters.
   7770     (if (eq op ?_)
   7771 	(progn
   7772 	  (org-agenda-filter-show-all-effort)
   7773 	  (message "Effort filter removed"))
   7774       (let ((prompt
   7775 	     (apply #'format
   7776 		    (concat "Effort %c "
   7777 			    (mapconcat (lambda (s) (concat "[%d]" s))
   7778 				       efforts
   7779 				       " "))
   7780 		    op allowed-keys))
   7781 	    (eff -1))
   7782 	(while (not (memq eff allowed-keys))
   7783 	  (message prompt)
   7784 	  (setq eff (- (read-char-exclusive) 48)))
   7785 	(org-agenda-filter-show-all-effort)
   7786 	(setq org-agenda-effort-filter
   7787 	      (append
   7788 	       (list (concat (if negative "-" "+")
   7789 			     (char-to-string op)
   7790 			     ;; Numbering is 1 2 3 ... 9 0, but we want
   7791 			     ;; 0 1 2 ... 8 9.
   7792 			     (nth (mod (1- eff) 10) efforts)))
   7793 	       (if keep current nil)))
   7794 	(org-agenda-filter-apply org-agenda-effort-filter 'effort)))))
   7795 
   7796 (defun org-agenda-filter (&optional strip-or-accumulate)
   7797   "Prompt for a general filter string and apply it to the agenda.
   7798 
   7799 The string may contain filter elements like
   7800 
   7801 +category
   7802 +tag
   7803 +<effort        > and = are also allowed as effort operators
   7804 +/regexp/
   7805 
   7806 Instead of `+', `-' is allowed to strip the agenda of matching entries.
   7807 `+' is optional if it is not required to separate two string parts.
   7808 Multiple filter elements can be concatenated without spaces, for example
   7809 
   7810      +work-John<0:10-/plot/
   7811 
   7812 selects entries with category `work' and effort estimates below 10 minutes,
   7813 and deselects entries with tag `John' or matching the regexp `plot'.
   7814 
   7815 During entry of the filter, completion for tags, categories and effort
   7816 values is offered.  Since the syntax for categories and tags is identical
   7817 there should be no overlap between categories and tags.  If there is, tags
   7818 get priority.
   7819 
   7820 A single `\\[universal-argument]' prefix arg STRIP-OR-ACCUMULATE will negate the
   7821 entire filter, which can be useful in connection with the prompt history.
   7822 
   7823 A double `\\[universal-argument] \\[universal-argument]' prefix arg will add the new filter elements to the
   7824 existing ones.  A shortcut for this is to add an additional `+' at the
   7825 beginning of the string, like `+-John'.
   7826 
   7827 With a triple prefix argument, execute the computed filtering defined in
   7828 the variable `org-agenda-auto-exclude-function'."
   7829   (interactive "P")
   7830   (if (equal strip-or-accumulate '(64))
   7831       ;; Execute the auto-exclude action
   7832       (if (not org-agenda-auto-exclude-function)
   7833 	  (user-error "`org-agenda-auto-exclude-function' is undefined")
   7834 	(org-agenda-filter-show-all-tag)
   7835 	(setq org-agenda-tag-filter nil)
   7836 	(dolist (tag (org-agenda-get-represented-tags))
   7837 	  (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
   7838 	    (when modifier
   7839 	      (push modifier org-agenda-tag-filter))))
   7840 	(unless (null org-agenda-tag-filter)
   7841 	  (org-agenda-filter-apply org-agenda-tag-filter 'tag 'expand)))
   7842     ;; Prompt for a filter and act
   7843     (let* ((tag-list (org-agenda-get-represented-tags))
   7844 	   (category-list (org-agenda-get-represented-categories))
   7845 	   (negate (equal strip-or-accumulate '(4)))
   7846 	   (cf (mapconcat #'identity org-agenda-category-filter ""))
   7847 	   (tf (mapconcat #'identity org-agenda-tag-filter ""))
   7848 	   ;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) ""))))
   7849 	   (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) "")))
   7850 	   (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) "")))
   7851 	   (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/"))))
   7852 	   (f-string (completing-read
   7853 		      (concat
   7854 		       (if negate "Negative filter" "Filter")
   7855 		       " [+cat-tag<0:10-/regexp/]: ")
   7856 		      #'org-agenda-filter-completion-function
   7857 		      nil nil ff))
   7858 	   (keep (or (if (string-match "^\\+[+-]" f-string)
   7859 			 (progn (setq f-string (substring f-string 1)) t))
   7860 		     (equal strip-or-accumulate '(16))))
   7861 	   (fc (if keep org-agenda-category-filter))
   7862 	   (ft (if keep org-agenda-tag-filter))
   7863 	   (fe (if keep org-agenda-effort-filter))
   7864 	   (fr (if keep org-agenda-regexp-filter))
   7865 	   pm s)
   7866       ;; If the filter contains a double-quoted string, replace a
   7867       ;; single hyphen by the arbitrary and temporary string "~~~"
   7868       ;; to disambiguate such hyphens from syntactic ones.
   7869       (setq f-string (replace-regexp-in-string
   7870 		      "\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string))
   7871       (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string)
   7872 	(setq pm (if (match-beginning 1) (match-string 1 f-string) "+"))
   7873 	(when negate
   7874 	  (setq pm (if (equal pm "+") "-" "+")))
   7875 	(cond
   7876 	 ((match-beginning 3)
   7877 	  ;; category or tag
   7878 	  (setq s (replace-regexp-in-string ; Remove the temporary special string.
   7879 		   "~~~" "-" (match-string 3 f-string)))
   7880 	  (cond
   7881 	   ((member s tag-list)
   7882 	    (org-pushnew-to-end (concat pm s) ft))
   7883 	   ((member s category-list)
   7884 	    (org-pushnew-to-end (concat pm ; Remove temporary double quotes.
   7885 				        (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s))
   7886 				fc))
   7887 	   (t (message
   7888 	       "`%s%s' filter ignored because tag/category is not represented"
   7889 	       pm s))))
   7890 	 ((match-beginning 4)
   7891 	  ;; effort
   7892 	  (org-pushnew-to-end (concat pm (match-string 4 f-string)) fe))
   7893 	 ((match-beginning 5)
   7894 	  ;; regexp
   7895 	  (org-pushnew-to-end (concat pm (match-string 6 f-string)) fr)))
   7896 	(setq f-string (substring f-string (match-end 0))))
   7897       (org-agenda-filter-remove-all)
   7898       (and fc (org-agenda-filter-apply
   7899 	       (setq org-agenda-category-filter fc) 'category))
   7900       (and ft (org-agenda-filter-apply
   7901 	       (setq org-agenda-tag-filter ft) 'tag 'expand))
   7902       (and fe (org-agenda-filter-apply
   7903 	       (setq org-agenda-effort-filter fe) 'effort))
   7904       (and fr (org-agenda-filter-apply
   7905 	       (setq org-agenda-regexp-filter fr) 'regexp))
   7906       (run-hooks 'org-agenda-filter-hook))))
   7907 
   7908 (defun org-agenda-filter-completion-function (string _predicate &optional flag)
   7909   "Complete a complex filter string.
   7910 FLAG specifies the type of completion operation to perform.  This
   7911 function is passed as a collection function to `completing-read',
   7912 which see."
   7913   (let ((completion-ignore-case t)	;tags are case-sensitive
   7914 	(confirm (lambda (x) (stringp x)))
   7915 	(prefix "")
   7916 	(operator "")
   7917 	table)
   7918     (when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string)
   7919       (setq prefix (match-string 1 string)
   7920 	    operator (match-string 2 string)
   7921 	    string (match-string 3 string)))
   7922     (cond
   7923      ((member operator '("+" "-" "" nil))
   7924       (setq table (append (org-agenda-get-represented-categories)
   7925 			  (org-agenda-get-represented-tags))))
   7926      ((member operator '("<" ">" "="))
   7927       (setq table (split-string
   7928 		   (or (cdr (assoc-string (concat org-effort-property "_ALL")
   7929 					  org-global-properties
   7930 					  t))
   7931 		       "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")
   7932 		   " +")))
   7933      (t (setq table nil)))
   7934     (pcase flag
   7935       (`t (all-completions string table confirm))
   7936       (`lambda (assoc string table)) ;exact match?
   7937       (`nil
   7938        (pcase (try-completion string table confirm)
   7939 	 ((and completion (pred stringp))
   7940 	  (concat prefix completion))
   7941 	 (completion completion)))
   7942       (_ nil))))
   7943 
   7944 (defun org-agenda-filter-remove-all ()
   7945   "Remove all filters from the current agenda buffer."
   7946   (interactive)
   7947   (when org-agenda-tag-filter
   7948     (org-agenda-filter-show-all-tag))
   7949   (when org-agenda-category-filter
   7950     (org-agenda-filter-show-all-cat))
   7951   (when org-agenda-regexp-filter
   7952     (org-agenda-filter-show-all-re))
   7953   (when org-agenda-top-headline-filter
   7954     (org-agenda-filter-show-all-top-filter))
   7955   (when org-agenda-effort-filter
   7956     (org-agenda-filter-show-all-effort))
   7957   (org-agenda-finalize)
   7958   (when (called-interactively-p 'interactive)
   7959     (message "All agenda filters removed")))
   7960 
   7961 (defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude)
   7962   "Keep only those lines in the agenda buffer that have a specific tag.
   7963 
   7964 The tag is selected with its fast selection letter, as configured.
   7965 
   7966 With a `\\[universal-argument]' prefix, apply the filter negatively, stripping all matches.
   7967 
   7968 With a `\\[universal-argument] \\[universal-argument]' prefix, add the new tag to the existing filter
   7969 instead of replacing it.
   7970 
   7971 With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \
   7972 i.e. don't
   7973 filter on all its group members.
   7974 
   7975 A Lisp caller can specify CHAR.  EXCLUDE means that the new tag
   7976 should be used to exclude the search - the interactive user can
   7977 also press `-' or `+' to switch between filtering and excluding."
   7978   (interactive "P")
   7979   (let* ((alist org-tag-alist-for-agenda)
   7980 	 (seen-chars nil)
   7981 	 (tag-chars (mapconcat
   7982 		     (lambda (x) (if (and (not (symbolp (car x)))
   7983 					  (cdr x)
   7984 					  (not (member (cdr x) seen-chars)))
   7985 				     (progn
   7986 				       (push (cdr x) seen-chars)
   7987 				       (char-to-string (cdr x)))
   7988 				   ""))
   7989 		     org-tag-alist-for-agenda ""))
   7990 	 (valid-char-list (append '(?\t ?\r ?\\ ?. ?\s ?q)
   7991 				  (string-to-list tag-chars)))
   7992 	 (exclude (or exclude (equal strip-or-accumulate '(4))))
   7993 	 (accumulate (equal strip-or-accumulate '(16)))
   7994 	 (expand (not (equal strip-or-accumulate '(64))))
   7995 	 (inhibit-read-only t)
   7996 	 (current org-agenda-tag-filter)
   7997 	 a tag) ;; n
   7998     (unless char
   7999       (while (not (memq char valid-char-list))
   8000 	(org-unlogged-message
   8001 	 "%s by tag%s: [%s ]tag-char [TAB]tag %s[\\]off [q]uit"
   8002 	 (if exclude "Exclude[+]" "Filter[-]")
   8003 	 (if expand "" " (no grouptag expand)")
   8004 	 tag-chars
   8005 	 (if org-agenda-auto-exclude-function "[RET] " ""))
   8006 	(setq char (read-char-exclusive))
   8007 	;; Excluding or filtering down
   8008 	(cond ((eq char ?-) (setq exclude t))
   8009 	      ((eq char ?+) (setq exclude nil)))))
   8010     (when (eq char ?\t)
   8011       (unless (local-variable-p 'org-global-tags-completion-table)
   8012 	(setq-local org-global-tags-completion-table
   8013 		    (org-global-tags-completion-table)))
   8014       (let ((completion-ignore-case t))
   8015 	(setq tag (completing-read
   8016 		   "Tag: " org-global-tags-completion-table nil t))))
   8017     (cond
   8018      ((eq char ?\r)
   8019       (org-agenda-filter-show-all-tag)
   8020       (when org-agenda-auto-exclude-function
   8021 	(setq org-agenda-tag-filter nil)
   8022 	(dolist (tag (org-agenda-get-represented-tags))
   8023 	  (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
   8024 	    (when modifier
   8025 	      (push modifier org-agenda-tag-filter))))
   8026 	(unless (null org-agenda-tag-filter)
   8027 	  (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
   8028      ((eq char ?\\)
   8029       (org-agenda-filter-show-all-tag)
   8030       (when (get 'org-agenda-tag-filter :preset-filter)
   8031 	(org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
   8032      ((eq char ?.)
   8033       (setq org-agenda-tag-filter
   8034 	    (mapcar (lambda(tag) (concat "+" tag))
   8035 		    (org-get-at-bol 'tags)))
   8036       (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
   8037      ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
   8038      ((or (eq char ?\s)
   8039 	  (setq a (rassoc char alist))
   8040 	  (and tag (setq a (cons tag nil))))
   8041       (org-agenda-filter-show-all-tag)
   8042       (setq tag (car a))
   8043       (setq org-agenda-tag-filter
   8044 	    (cons (concat (if exclude "-" "+") tag)
   8045 		  (if accumulate current nil)))
   8046       (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
   8047      (t (error "Invalid tag selection character %c" char)))))
   8048 
   8049 (defun org-agenda-get-represented-categories ()
   8050   "Return a list of all categories used in this agenda buffer."
   8051   (or org-agenda-represented-categories
   8052       (when (derived-mode-p 'org-agenda-mode)
   8053 	(let ((pos (point-min)) categories)
   8054 	  (while (and (< pos (point-max))
   8055 		      (setq pos (next-single-property-change
   8056 				 pos 'org-category nil (point-max))))
   8057 	    (push (get-text-property pos 'org-category) categories))
   8058 	  (setq org-agenda-represented-categories
   8059 		;; Enclose category names with a hyphen in double
   8060 		;; quotes to process them specially in `org-agenda-filter'.
   8061 		(mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s))
   8062 			(nreverse (org-uniquify (delq nil categories)))))))))
   8063 
   8064 (defvar org-tag-groups-alist-for-agenda)
   8065 (defun org-agenda-get-represented-tags ()
   8066   "Return a list of all tags used in this agenda buffer.
   8067 These will be lower-case, for filtering."
   8068   (or org-agenda-represented-tags
   8069       (when (derived-mode-p 'org-agenda-mode)
   8070 	(let ((pos (point-min)) tags-lists tt)
   8071 	  (while (and (< pos (point-max))
   8072 		      (setq pos (next-single-property-change
   8073 				 pos 'tags nil (point-max))))
   8074 	    (setq tt (get-text-property pos 'tags))
   8075 	    (if tt (push tt tags-lists)))
   8076 	  (setq tags-lists
   8077 		(nreverse (org-uniquify
   8078 			   (delq nil (apply #'append tags-lists)))))
   8079 	  (dolist (tag tags-lists)
   8080 	    (mapc
   8081 	     (lambda (group)
   8082 	       (when (member tag group)
   8083 		 (push (car group) tags-lists)))
   8084 	     org-tag-groups-alist-for-agenda))
   8085 	  (setq org-agenda-represented-tags tags-lists)))))
   8086 
   8087 (defun org-agenda-filter-make-matcher (filter type &optional expand)
   8088   "Create the form that tests a line for agenda filter.
   8089 Optional argument EXPAND can be used for the TYPE tag and will
   8090 expand the tags in the FILTER if any of the tags in FILTER are
   8091 grouptags."
   8092   (let ((multi-pos-cats
   8093 	 (and (eq type 'category)
   8094 	      (string-match-p "\\+.*\\+"
   8095 			      (mapconcat (lambda (cat) (substring cat 0 1))
   8096 					 filter ""))))
   8097 	f f1)
   8098     (cond
   8099      ;; Tag filter
   8100      ((eq type 'tag)
   8101       (setq filter
   8102 	    (delete-dups
   8103 	     (append (get 'org-agenda-tag-filter :preset-filter)
   8104 		     filter)))
   8105       (dolist (x filter)
   8106 	(let ((op (string-to-char x)))
   8107 	  (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
   8108 	    (setq x (list x)))
   8109 	  (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
   8110 	  (push f1 f))))
   8111      ;; Category filter
   8112      ((eq type 'category)
   8113       (setq filter
   8114 	    (delete-dups
   8115 	     (append (get 'org-agenda-category-filter :preset-filter)
   8116 		     filter)))
   8117       (dolist (x filter)
   8118 	(if (equal "-" (substring x 0 1))
   8119 	    (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
   8120 	  (setq f1 (list 'equal (substring x 1) 'cat)))
   8121 	(push f1 f)))
   8122      ;; Regexp filter
   8123      ((eq type 'regexp)
   8124       (setq filter
   8125 	    (delete-dups
   8126 	     (append (get 'org-agenda-regexp-filter :preset-filter)
   8127 		     filter)))
   8128       (dolist (x filter)
   8129 	(if (equal "-" (substring x 0 1))
   8130 	    (setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
   8131 	  (setq f1 (list 'string-match (substring x 1) 'txt)))
   8132 	(push f1 f)))
   8133      ;; Effort filter
   8134      ((eq type 'effort)
   8135       (setq filter
   8136 	    (delete-dups
   8137 	     (append (get 'org-agenda-effort-filter :preset-filter)
   8138 		     filter)))
   8139       (dolist (x filter)
   8140 	(push (org-agenda-filter-effort-form x) f))))
   8141     (cons (if multi-pos-cats 'or 'and) (nreverse f))))
   8142 
   8143 (defun org-agenda-filter-make-matcher-tag-exp (tags op)
   8144   "Return a form associated to tag-expression TAGS.
   8145 Build a form testing a line for agenda filter for
   8146 tag-expressions.  OP is an operator of type CHAR that allows the
   8147 function to set the right switches in the returned form."
   8148   (let (form)
   8149     ;; Any of the expressions can match if OP is +, all must match if
   8150     ;; the operator is -.
   8151     (dolist (x tags (cons (if (eq op ?-) 'and 'or) form))
   8152       (let* ((tag (substring x 1))
   8153 	     (f (cond
   8154 		 ((string= "" tag) 'tags)
   8155 		 ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag))
   8156 		  ;; TAG is a regexp.
   8157 		  (list 'org-match-any-p (substring tag 1 -1) 'tags))
   8158 		 (t (list 'member tag 'tags)))))
   8159 	(push (if (eq op ?-) (list 'not f) f) form)))))
   8160 
   8161 (defun org-agenda-filter-effort-form (e)
   8162   "Return the form to compare the effort of the current line with what E says.
   8163 E looks like \"+<2:25\"."
   8164   (let (op)
   8165     (setq e (substring e 1))
   8166     (setq op (string-to-char e) e (substring e 1))
   8167     (setq op (cond ((equal op ?<) '<=)
   8168 		   ((equal op ?>) '>=)
   8169 		   ((equal op ??) op)
   8170 		   (t '=)))
   8171     (list 'org-agenda-compare-effort (list 'quote op)
   8172 	  (org-duration-to-minutes e))))
   8173 
   8174 (defun org-agenda-compare-effort (op value)
   8175   "Compare the effort of the current line with VALUE, using OP.
   8176 If the line does not have an effort defined, return nil."
   8177   ;; `effort-minutes' property cannot be extracted directly from
   8178   ;; current line but is stored as a property in `txt'.
   8179   (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt))))
   8180     (funcall op
   8181 	     (or effort (if org-agenda-sort-noeffort-is-high 32767 -1))
   8182 	     value)))
   8183 
   8184 (defun org-agenda-filter-expand-tags (filter &optional no-operator)
   8185   "Expand group tags in FILTER for the agenda.
   8186 When NO-OPERATOR is non-nil, do not add the + operator to
   8187 returned tags."
   8188   (if org-group-tags
   8189       (let (case-fold-search rtn)
   8190 	(mapc
   8191 	 (lambda (f)
   8192 	   (let (f0 dir)
   8193 	     (if (string-match "^\\([+-]\\)\\(.+\\)" f)
   8194 		 (setq dir (match-string 1 f) f0 (match-string 2 f))
   8195 	       (setq dir (if no-operator "" "+") f0 f))
   8196 	     (setq rtn (append (mapcar (lambda(f1) (concat dir f1))
   8197 				       (org-tags-expand f0 t))
   8198 			       rtn))))
   8199 	 filter)
   8200 	(reverse rtn))
   8201     filter))
   8202 
   8203 (defun org-agenda-filter-apply (filter type &optional expand)
   8204   "Set FILTER as the new agenda filter and apply it.
   8205 Optional argument EXPAND can be used for the TYPE tag and will
   8206 expand the tags in the FILTER if any of the tags in FILTER are
   8207 grouptags."
   8208   ;; Deactivate `org-agenda-entry-text-mode' when filtering
   8209   (when org-agenda-entry-text-mode (org-agenda-entry-text-mode))
   8210   (setq org-agenda-filter-form (org-agenda-filter-make-matcher
   8211 				filter type expand))
   8212   ;; Only set `org-agenda-filtered-by-category' to t when a unique
   8213   ;; category is used as the filter:
   8214   (setq org-agenda-filtered-by-category
   8215 	(and (eq type 'category)
   8216 	     (not (equal (substring (car filter) 0 1) "-"))))
   8217   (org-agenda-set-mode-name)
   8218   (save-excursion
   8219     (goto-char (point-min))
   8220     (while (not (eobp))
   8221       (when (or (org-get-at-bol 'org-hd-marker)
   8222 		(org-get-at-bol 'org-marker))
   8223 	(org-dlet
   8224 	    ((tags (org-get-at-bol 'tags))
   8225 	     (cat (org-agenda-get-category))
   8226 	     (txt (or (org-get-at-bol 'txt) "")))
   8227 	  (unless (eval org-agenda-filter-form t)
   8228 	    (org-agenda-filter-hide-line type))))
   8229       (beginning-of-line 2)))
   8230   (when (get-char-property (point) 'invisible)
   8231     (ignore-errors (org-agenda-previous-line))))
   8232 
   8233 (defun org-agenda-filter-top-headline-apply (hl &optional negative)
   8234   "Filter by top headline HL."
   8235   (org-agenda-set-mode-name)
   8236   (save-excursion
   8237     (goto-char (point-min))
   8238     (while (not (eobp))
   8239       (let* ((pos (org-get-at-bol 'org-hd-marker))
   8240              (tophl (and pos (org-find-top-headline pos))))
   8241         (when (and tophl (funcall (if negative 'identity 'not)
   8242 				  (string= hl tophl)))
   8243           (org-agenda-filter-hide-line 'top-headline)))
   8244       (beginning-of-line 2)))
   8245   (when (get-char-property (point) 'invisible)
   8246     (org-agenda-previous-line))
   8247   (setq org-agenda-top-headline-filter hl
   8248 	org-agenda-filtered-by-top-headline t))
   8249 
   8250 (defun org-agenda-filter-hide-line (type)
   8251   "If current line is TYPE, hide it in the agenda buffer."
   8252   (let* (buffer-invisibility-spec
   8253 	 (beg (max (point-min) (1- (point-at-bol))))
   8254 	 (end (point-at-eol)))
   8255     (let ((inhibit-read-only t))
   8256       (add-text-properties
   8257        beg end `(invisible org-filtered org-filter-type ,type)))))
   8258 
   8259 (defun org-agenda-remove-filter (type)
   8260   "Remove filter of type TYPE from the agenda buffer."
   8261   (interactive)
   8262   (save-excursion
   8263     (goto-char (point-min))
   8264     (let ((inhibit-read-only t) pos)
   8265       (while (setq pos (text-property-any (point) (point-max)
   8266 					  'org-filter-type type))
   8267 	(goto-char pos)
   8268 	(remove-text-properties
   8269 	 (point) (next-single-property-change (point) 'org-filter-type)
   8270 	 `(invisible org-filtered org-filter-type ,type))))
   8271     (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil)
   8272     (setq org-agenda-filter-form nil)
   8273     (org-agenda-set-mode-name)
   8274     (org-agenda-finalize)))
   8275 
   8276 (defun org-agenda-filter-show-all-tag nil
   8277   (org-agenda-remove-filter 'tag))
   8278 (defun org-agenda-filter-show-all-re nil
   8279   (org-agenda-remove-filter 'regexp))
   8280 (defun org-agenda-filter-show-all-effort nil
   8281   (org-agenda-remove-filter 'effort))
   8282 (defun org-agenda-filter-show-all-cat nil
   8283   (org-agenda-remove-filter 'category))
   8284 (defun org-agenda-filter-show-all-top-filter nil
   8285   (org-agenda-remove-filter 'top-headline))
   8286 
   8287 (defun org-agenda-manipulate-query-add ()
   8288   "Manipulate the query by adding a search term with positive selection.
   8289 Positive selection means the term must be matched for selection of an entry."
   8290   (interactive)
   8291   (org-agenda-manipulate-query ?\[))
   8292 (defun org-agenda-manipulate-query-subtract ()
   8293   "Manipulate the query by adding a search term with negative selection.
   8294 Negative selection means term must not be matched for selection of an entry."
   8295   (interactive)
   8296   (org-agenda-manipulate-query ?\]))
   8297 (defun org-agenda-manipulate-query-add-re ()
   8298   "Manipulate the query by adding a search regexp with positive selection.
   8299 Positive selection means the regexp must match for selection of an entry."
   8300   (interactive)
   8301   (org-agenda-manipulate-query ?\{))
   8302 (defun org-agenda-manipulate-query-subtract-re ()
   8303   "Manipulate the query by adding a search regexp with negative selection.
   8304 Negative selection means regexp must not match for selection of an entry."
   8305   (interactive)
   8306   (org-agenda-manipulate-query ?\}))
   8307 (defun org-agenda-manipulate-query (char)
   8308   (cond
   8309    ((eq org-agenda-type 'agenda)
   8310     (let ((org-agenda-include-inactive-timestamps t))
   8311       (org-agenda-redo))
   8312     (message "Display now includes inactive timestamps as well"))
   8313    ((eq org-agenda-type 'search)
   8314     (org-add-to-string
   8315      'org-agenda-query-string
   8316      (if org-agenda-last-search-view-search-was-boolean
   8317 	 (cdr (assoc char '((?\[ . " +") (?\] . " -")
   8318 			    (?\{ . " +{}") (?\} . " -{}"))))
   8319        " "))
   8320     (setq org-agenda-redo-command
   8321 	  (list 'org-search-view
   8322 		(car (get-text-property (min (1- (point-max)) (point))
   8323 					'org-last-args))
   8324 		org-agenda-query-string
   8325 		(+ (length org-agenda-query-string)
   8326 		   (if (member char '(?\{ ?\})) 0 1))))
   8327     (set-register org-agenda-query-register org-agenda-query-string)
   8328     (let ((org-agenda-overriding-arguments
   8329 	   (cdr org-agenda-redo-command)))
   8330       (org-agenda-redo)))
   8331    (t (error "Cannot manipulate query for %s-type agenda buffers"
   8332 	     org-agenda-type))))
   8333 
   8334 (defun org-add-to-string (var string)
   8335   (set var (concat (symbol-value var) string)))
   8336 
   8337 (defun org-agenda-goto-date (date)
   8338   "Jump to DATE in agenda."
   8339   (interactive
   8340    (list
   8341     (let ((org-read-date-prefer-future org-agenda-jump-prefer-future))
   8342       (org-read-date))))
   8343   (let* ((day (time-to-days (org-time-string-to-time date)))
   8344 	 (org-agenda-sticky-orig org-agenda-sticky)
   8345 	 (org-agenda-buffer-tmp-name (buffer-name))
   8346 	 (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
   8347 	 (0-arg (or current-prefix-arg (car args)))
   8348 	 (2-arg (nth 2 args))
   8349 	 (with-hour-p (nth 4 org-agenda-redo-command))
   8350 	 (newcmd (list 'org-agenda-list 0-arg date
   8351 		       (org-agenda-span-to-ndays
   8352 			2-arg (org-time-string-to-absolute date))
   8353 		       with-hour-p))
   8354 	 (newargs (cdr newcmd))
   8355 	 (inhibit-read-only t)
   8356 	 org-agenda-sticky)
   8357     (if (not (org-agenda-check-type t 'agenda))
   8358 	(error "Not available in non-agenda views")
   8359       (add-text-properties (point-min) (point-max)
   8360 			   `(org-redo-cmd ,newcmd org-last-args ,newargs))
   8361       (org-agenda-redo)
   8362       (goto-char (point-min))
   8363       (while (not (or (= (or (get-text-property (point) 'day) 0) day)
   8364 		      (save-excursion (move-beginning-of-line 2) (eobp))))
   8365 	(move-beginning-of-line 2))
   8366       (setq org-agenda-sticky org-agenda-sticky-orig
   8367 	    org-agenda-this-buffer-is-sticky org-agenda-sticky))))
   8368 
   8369 (defun org-agenda-goto-today ()
   8370   "Go to today."
   8371   (interactive)
   8372   (org-agenda-check-type t 'agenda)
   8373   (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
   8374 	 (curspan (nth 2 args))
   8375 	 (tdpos (text-property-any (point-min) (point-max) 'org-today t)))
   8376     (cond
   8377      (tdpos (goto-char tdpos))
   8378      ((eq org-agenda-type 'agenda)
   8379       (let* ((sd (org-agenda-compute-starting-span
   8380 		  (org-today) (or curspan org-agenda-span)))
   8381 	     (org-agenda-overriding-arguments args))
   8382 	(setf (nth 1 org-agenda-overriding-arguments) sd)
   8383 	(org-agenda-redo)
   8384 	(org-agenda-find-same-or-today-or-agenda)))
   8385      (t (error "Cannot find today")))))
   8386 
   8387 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
   8388   (goto-char
   8389    (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
   8390        (text-property-any (point-min) (point-max) 'org-today t)
   8391        (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
   8392        (and (get-text-property (min (1- (point-max)) (point)) 'org-series)
   8393 	    (org-agenda-backward-block))
   8394        (point-min))))
   8395 
   8396 (defun org-agenda-backward-block ()
   8397   "Move backward by one agenda block."
   8398   (interactive)
   8399   (org-agenda-forward-block 'backward))
   8400 
   8401 (defun org-agenda-forward-block (&optional backward)
   8402   "Move forward by one agenda block.
   8403 When optional argument BACKWARD is set, go backward."
   8404   (interactive)
   8405   (cond ((not (derived-mode-p 'org-agenda-mode))
   8406 	 (user-error
   8407 	  "Cannot execute this command outside of org-agenda-mode buffers"))
   8408 	((looking-at (if backward "\\`" "\\'"))
   8409 	 (message "Already at the %s block" (if backward "first" "last")))
   8410 	(t (let ((_pos (prog1 (point)
   8411 			 (ignore-errors (if backward (backward-char 1)
   8412 					  (move-end-of-line 1)))))
   8413 		 (f (if backward
   8414 			#'previous-single-property-change
   8415 		      #'next-single-property-change))
   8416 		 moved dest)
   8417 	     (while (and (setq dest (funcall
   8418 				     f (point) 'org-agenda-structural-header))
   8419 			 (not (get-text-property
   8420 			       (point) 'org-agenda-structural-header)))
   8421 	       (setq moved t)
   8422 	       (goto-char dest))
   8423 	     (if moved (move-beginning-of-line 1)
   8424 	       (goto-char (if backward (point-min) (point-max)))
   8425 	       (move-beginning-of-line 1)
   8426 	       (message "No %s block" (if backward "previous" "further")))))))
   8427 
   8428 (defun org-agenda-later (arg)
   8429   "Go forward in time by the current span.
   8430 With prefix ARG, go forward that many times the current span."
   8431   (interactive "p")
   8432   (org-agenda-check-type t 'agenda)
   8433   (let* ((wstart (window-start))
   8434          (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
   8435 	 (span (or (nth 2 args) org-agenda-current-span))
   8436 	 (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day))
   8437 	 (greg (calendar-gregorian-from-absolute sd))
   8438 	 (cnt (org-get-at-bol 'org-day-cnt))
   8439 	 greg2)
   8440     (cond
   8441      ((numberp span)
   8442       (setq sd (+ (* span arg) sd)))
   8443      ((eq span 'day)
   8444       (setq sd (+ arg sd)))
   8445      ((eq span 'week)
   8446       (setq sd (+ (* 7 arg) sd)))
   8447      ((eq span 'fortnight)
   8448       (setq sd (+ (* 14 arg) sd)))
   8449      ((eq span 'month)
   8450       (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
   8451 	    sd (calendar-absolute-from-gregorian greg2))
   8452       (setcar greg2 (1+ (car greg2))))
   8453      ((eq span 'year)
   8454       (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
   8455 	    sd (calendar-absolute-from-gregorian greg2))
   8456       (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
   8457      (t
   8458       (setq sd (+ (* span arg) sd))))
   8459     (let ((org-agenda-overriding-cmd
   8460 	   ;; `cmd' may have been set by `org-agenda-run-series' which
   8461 	   ;; uses `org-agenda-overriding-cmd' to decide whether
   8462 	   ;; overriding is allowed for `cmd'
   8463 	   (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
   8464 	  (org-agenda-overriding-arguments
   8465 	   (list (car args) sd span)))
   8466       (org-agenda-redo)
   8467       (org-agenda-find-same-or-today-or-agenda cnt))
   8468     (set-window-start nil wstart)))
   8469 
   8470 (defun org-agenda-earlier (arg)
   8471   "Go backward in time by the current span.
   8472 With prefix ARG, go backward that many times the current span."
   8473   (interactive "p")
   8474   (org-agenda-later (- arg)))
   8475 
   8476 (defun org-agenda-view-mode-dispatch ()
   8477   "Call one of the view mode commands."
   8478   (interactive)
   8479   (org-unlogged-message
   8480    "View: [d]ay  [w]eek  for[t]night  [m]onth  [y]ear  [SPC]reset  [q]uit/abort
   8481        time[G]rid   [[]inactive  [f]ollow      [l]og    [L]og-all   [c]lockcheck
   8482        [a]rch-trees [A]rch-files clock[R]eport include[D]iary       [E]ntryText")
   8483   (pcase (read-char-exclusive)
   8484     (?\ (call-interactively 'org-agenda-reset-view))
   8485     (?d (call-interactively 'org-agenda-day-view))
   8486     (?w (call-interactively 'org-agenda-week-view))
   8487     (?t (call-interactively 'org-agenda-fortnight-view))
   8488     (?m (call-interactively 'org-agenda-month-view))
   8489     (?y (call-interactively 'org-agenda-year-view))
   8490     (?l (call-interactively 'org-agenda-log-mode))
   8491     (?L (org-agenda-log-mode '(4)))
   8492     (?c (org-agenda-log-mode 'clockcheck))
   8493     ((or ?F ?f) (call-interactively 'org-agenda-follow-mode))
   8494     (?a (call-interactively 'org-agenda-archives-mode))
   8495     (?A (org-agenda-archives-mode 'files))
   8496     ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode))
   8497     ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode))
   8498     (?G (call-interactively 'org-agenda-toggle-time-grid))
   8499     (?D (call-interactively 'org-agenda-toggle-diary))
   8500     (?\! (call-interactively 'org-agenda-toggle-deadlines))
   8501     (?\[ (let ((org-agenda-include-inactive-timestamps t))
   8502 	   (org-agenda-check-type t 'agenda)
   8503 	   (org-agenda-redo))
   8504 	 (message "Display now includes inactive timestamps as well"))
   8505     (?q (message "Abort"))
   8506     (key (user-error "Invalid key: %s" key))))
   8507 
   8508 (defun org-agenda-reset-view ()
   8509   "Switch to default view for agenda."
   8510   (interactive)
   8511   (org-agenda-change-time-span org-agenda-span))
   8512 
   8513 (defun org-agenda-day-view (&optional day-of-month)
   8514   "Switch to daily view for agenda.
   8515 With argument DAY-OF-MONTH, switch to that day of the month."
   8516   (interactive "P")
   8517   (org-agenda-change-time-span 'day day-of-month))
   8518 
   8519 (defun org-agenda-week-view (&optional iso-week)
   8520   "Switch to weekly view for agenda.
   8521 With argument ISO-WEEK, switch to the corresponding ISO week.
   8522 If ISO-WEEK has more then 2 digits, only the last two encode
   8523 the week.  Any digits before this encode a year.  So 200712
   8524 means week 12 of year 2007.  Years ranging from 70 years ago
   8525 to 30 years in the future can also be written as 2-digit years."
   8526   (interactive "P")
   8527   (org-agenda-change-time-span 'week iso-week))
   8528 
   8529 (defun org-agenda-fortnight-view (&optional iso-week)
   8530   "Switch to fortnightly view for agenda.
   8531 With argument ISO-WEEK, switch to the corresponding ISO week.
   8532 If ISO-WEEK has more then 2 digits, only the last two encode
   8533 the week.  Any digits before this encode a year.  So 200712
   8534 means week 12 of year 2007.  Years ranging from 70 years ago
   8535 to 30 years in the future can also be written as 2-digit years."
   8536   (interactive "P")
   8537   (org-agenda-change-time-span 'fortnight iso-week))
   8538 
   8539 (defun org-agenda-month-view (&optional month)
   8540   "Switch to monthly view for agenda.
   8541 With argument MONTH, switch to that month.  If MONTH has more
   8542 then 2 digits, only the last two encode the month.  Any digits
   8543 before this encode a year.  So 200712 means December year 2007.
   8544 Years ranging from 70 years ago to 30 years in the future can
   8545 also be written as 2-digit years."
   8546   (interactive "P")
   8547   (org-agenda-change-time-span 'month month))
   8548 
   8549 (defun org-agenda-year-view (&optional year)
   8550   "Switch to yearly view for agenda.
   8551 With argument YEAR, switch to that year.  Years ranging from 70
   8552 years ago to 30 years in the future can also be written as
   8553 2-digit years."
   8554   (interactive "P")
   8555   (when year
   8556     (setq year (org-small-year-to-year year)))
   8557   (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ")
   8558       (org-agenda-change-time-span 'year year)
   8559     (error "Abort")))
   8560 
   8561 (defun org-agenda-change-time-span (span &optional n)
   8562   "Change the agenda view to SPAN.
   8563 SPAN may be `day', `week', `fortnight', `month', `year'."
   8564   (org-agenda-check-type t 'agenda)
   8565   (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
   8566 	 (curspan (nth 2 args)))
   8567     (when (and (not n) (equal curspan span))
   8568       (error "Viewing span is already \"%s\"" span))
   8569     (let* ((sd (or (org-get-at-bol 'day)
   8570 		   (nth 1 args)
   8571 		   org-starting-day))
   8572 	   (sd (org-agenda-compute-starting-span sd span n))
   8573 	   (org-agenda-overriding-cmd
   8574 	    (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
   8575 	   (org-agenda-overriding-arguments
   8576 	    (list (car args) sd span)))
   8577       (org-agenda-redo)
   8578       (org-agenda-find-same-or-today-or-agenda))
   8579     (org-agenda-set-mode-name)
   8580     (message "Switched to %s view" span)))
   8581 
   8582 (defun org-agenda-compute-starting-span (sd span &optional n)
   8583   "Compute starting date for agenda.
   8584 SPAN may be `day', `week', `fortnight', `month', `year'.  The return value
   8585 is a cons cell with the starting date and the number of days,
   8586 so that the date SD will be in that range."
   8587   (let* ((greg (calendar-gregorian-from-absolute sd))
   8588 	 ;; (dg (nth 1 greg))
   8589 	 (mg (car greg))
   8590 	 (yg (nth 2 greg)))
   8591     (cond
   8592      ((eq span 'day)
   8593       (when n
   8594 	(setq sd (+ (calendar-absolute-from-gregorian
   8595 		     (list mg 1 yg))
   8596 		    n -1))))
   8597      ((or (eq span 'week) (eq span 'fortnight))
   8598       (let* ((nt (calendar-day-of-week
   8599 		  (calendar-gregorian-from-absolute sd)))
   8600 	     (d (if org-agenda-start-on-weekday
   8601 		    (- nt org-agenda-start-on-weekday)
   8602 		  0))
   8603 	     y1)
   8604 	(setq sd (- sd (+ (if (< d 0) 7 0) d)))
   8605 	(when n
   8606 	  (require 'cal-iso)
   8607 	  (when (> n 99)
   8608 	    (setq y1 (org-small-year-to-year (/ n 100))
   8609 		  n (mod n 100)))
   8610 	  (setq sd
   8611 		(calendar-iso-to-absolute
   8612 		 (list n 1
   8613 		       (or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
   8614      ((eq span 'month)
   8615       (let (y1)
   8616 	(when (and n (> n 99))
   8617 	  (setq y1 (org-small-year-to-year (/ n 100))
   8618 		n (mod n 100)))
   8619 	(setq sd (calendar-absolute-from-gregorian
   8620 		  (list (or n mg) 1 (or y1 yg))))))
   8621      ((eq span 'year)
   8622       (setq sd (calendar-absolute-from-gregorian
   8623 		(list 1 1 (or n yg))))))
   8624     sd))
   8625 
   8626 (defun org-agenda-next-date-line (&optional arg)
   8627   "Jump to the next line indicating a date in agenda buffer."
   8628   (interactive "p")
   8629   (org-agenda-check-type t 'agenda)
   8630   (beginning-of-line 1)
   8631   ;; This does not work if user makes date format that starts with a blank
   8632   (when (looking-at-p "^\\S-") (forward-char 1))
   8633   (unless (re-search-forward "^\\S-" nil t arg)
   8634     (backward-char 1)
   8635     (error "No next date after this line in this buffer"))
   8636   (goto-char (match-beginning 0)))
   8637 
   8638 (defun org-agenda-previous-date-line (&optional arg)
   8639   "Jump to the previous line indicating a date in agenda buffer."
   8640   (interactive "p")
   8641   (org-agenda-check-type t 'agenda)
   8642   (beginning-of-line 1)
   8643   (unless (re-search-backward "^\\S-" nil t arg)
   8644     (error "No previous date before this line in this buffer")))
   8645 
   8646 ;; Initialize the highlight
   8647 (defvar org-hl (make-overlay 1 1))
   8648 (overlay-put org-hl 'face 'highlight)
   8649 
   8650 (defun org-highlight (begin end &optional buffer)
   8651   "Highlight a region with overlay."
   8652   (move-overlay org-hl begin end (or buffer (current-buffer))))
   8653 
   8654 (defun org-unhighlight ()
   8655   "Detach overlay INDEX."
   8656   (delete-overlay org-hl))
   8657 
   8658 (defun org-unhighlight-once ()
   8659   "Remove the highlight from its position, and this function from the hook."
   8660   (remove-hook 'pre-command-hook #'org-unhighlight-once)
   8661   (org-unhighlight))
   8662 
   8663 (defvar org-agenda-pre-follow-window-conf nil)
   8664 (defun org-agenda-follow-mode ()
   8665   "Toggle follow mode in an agenda buffer."
   8666   (interactive)
   8667   (unless org-agenda-follow-mode
   8668     (setq org-agenda-pre-follow-window-conf
   8669 	  (current-window-configuration)))
   8670   (setq org-agenda-follow-mode (not org-agenda-follow-mode))
   8671   (unless org-agenda-follow-mode
   8672     (set-window-configuration org-agenda-pre-follow-window-conf))
   8673   (org-agenda-set-mode-name)
   8674   (org-agenda-do-context-action)
   8675   (message "Follow mode is %s"
   8676 	   (if org-agenda-follow-mode "on" "off")))
   8677 
   8678 (defun org-agenda-entry-text-mode (&optional arg)
   8679   "Toggle entry text mode in an agenda buffer."
   8680   (interactive "P")
   8681   (if (or org-agenda-tag-filter
   8682 	  org-agenda-category-filter
   8683 	  org-agenda-regexp-filter
   8684 	  org-agenda-top-headline-filter)
   8685       (user-error "Can't show entry text in filtered views")
   8686     (setq org-agenda-entry-text-mode (or (integerp arg)
   8687 					 (not org-agenda-entry-text-mode)))
   8688     (org-agenda-entry-text-hide)
   8689     (and org-agenda-entry-text-mode
   8690 	 (let ((org-agenda-entry-text-maxlines
   8691 		(if (integerp arg) arg org-agenda-entry-text-maxlines)))
   8692 	   (org-agenda-entry-text-show)))
   8693     (org-agenda-set-mode-name)
   8694     (message "Entry text mode is %s%s"
   8695 	     (if org-agenda-entry-text-mode "on" "off")
   8696 	     (if (not org-agenda-entry-text-mode) ""
   8697 	       (format " (maximum number of lines is %d)"
   8698 		       (if (integerp arg) arg org-agenda-entry-text-maxlines))))))
   8699 
   8700 (defun org-agenda-clockreport-mode ()
   8701   "Toggle clocktable mode in an agenda buffer."
   8702   (interactive)
   8703   (org-agenda-check-type t 'agenda)
   8704   (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))
   8705   (org-agenda-set-mode-name)
   8706   (org-agenda-redo)
   8707   (message "Clocktable mode is %s"
   8708 	   (if org-agenda-clockreport-mode "on" "off")))
   8709 
   8710 (defun org-agenda-log-mode (&optional special)
   8711   "Toggle log mode in an agenda buffer.
   8712 
   8713 With argument SPECIAL, show all possible log items, not only the ones
   8714 configured in `org-agenda-log-mode-items'.
   8715 
   8716 With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
   8717 log items, nothing else."
   8718   (interactive "P")
   8719   (org-agenda-check-type t 'agenda)
   8720   (setq org-agenda-show-log
   8721 	(cond
   8722 	 ((equal special '(16)) 'only)
   8723 	 ((eq special 'clockcheck)
   8724 	  (if (eq org-agenda-show-log 'clockcheck)
   8725 	      nil 'clockcheck))
   8726 	 (special '(closed clock state))
   8727 	 (t (not org-agenda-show-log))))
   8728   (org-agenda-set-mode-name)
   8729   (org-agenda-redo)
   8730   (message "Log mode is %s" (if org-agenda-show-log "on" "off")))
   8731 
   8732 (defun org-agenda-archives-mode (&optional with-files)
   8733   "Toggle inclusion of items in trees marked with :ARCHIVE:.
   8734 When called with a prefix argument, include all archive files as well."
   8735   (interactive "P")
   8736   (setq org-agenda-archives-mode
   8737 	(cond ((and with-files (eq org-agenda-archives-mode t)) nil)
   8738 	      (with-files t)
   8739 	      (org-agenda-archives-mode nil)
   8740 	      (t 'trees)))
   8741   (org-agenda-set-mode-name)
   8742   (org-agenda-redo)
   8743   (message
   8744    "%s"
   8745    (cond
   8746     ((eq org-agenda-archives-mode nil)
   8747      "No archives are included")
   8748     ((eq org-agenda-archives-mode 'trees)
   8749      (format "Trees with :%s: tag are included" org-archive-tag))
   8750     ((eq org-agenda-archives-mode t)
   8751      (format "Trees with :%s: tag and all active archive files are included"
   8752 	     org-archive-tag)))))
   8753 
   8754 (defun org-agenda-toggle-diary ()
   8755   "Toggle diary inclusion in an agenda buffer."
   8756   (interactive)
   8757   (org-agenda-check-type t 'agenda)
   8758   (setq org-agenda-include-diary (not org-agenda-include-diary))
   8759   (org-agenda-redo)
   8760   (org-agenda-set-mode-name)
   8761   (message "Diary inclusion turned %s"
   8762 	   (if org-agenda-include-diary "on" "off")))
   8763 
   8764 (defun org-agenda-toggle-deadlines ()
   8765   "Toggle inclusion of entries with a deadline in an agenda buffer."
   8766   (interactive)
   8767   (org-agenda-check-type t 'agenda)
   8768   (setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
   8769   (org-agenda-redo)
   8770   (org-agenda-set-mode-name)
   8771   (message "Deadlines inclusion turned %s"
   8772 	   (if org-agenda-include-deadlines "on" "off")))
   8773 
   8774 (defun org-agenda-toggle-time-grid ()
   8775   "Toggle time grid in an agenda buffer."
   8776   (interactive)
   8777   (org-agenda-check-type t 'agenda)
   8778   (setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
   8779   (org-agenda-redo)
   8780   (org-agenda-set-mode-name)
   8781   (message "Time-grid turned %s"
   8782 	   (if org-agenda-use-time-grid "on" "off")))
   8783 
   8784 (defun org-agenda-set-mode-name ()
   8785   "Set the mode name to indicate all the small mode settings."
   8786   (setq mode-name
   8787 	(list "Org-Agenda"
   8788 	      (if (get 'org-agenda-files 'org-restrict) " []" "")
   8789 	      " "
   8790 	      '(:eval (org-agenda-span-name org-agenda-current-span))
   8791 	      (if org-agenda-follow-mode     " Follow" "")
   8792 	      (if org-agenda-entry-text-mode " ETxt"   "")
   8793 	      (if org-agenda-include-diary   " Diary"  "")
   8794 	      (if org-agenda-include-deadlines " Ddl"  "")
   8795 	      (if org-agenda-use-time-grid   " Grid"   "")
   8796 	      (if (and (boundp 'org-habit-show-habits)
   8797 		       org-habit-show-habits)
   8798 		  " Habit"   "")
   8799 	      (cond
   8800 	       ((consp org-agenda-show-log) " LogAll")
   8801 	       ((eq org-agenda-show-log 'clockcheck) " ClkCk")
   8802 	       (org-agenda-show-log " Log")
   8803 	       (t ""))
   8804 	      (if (org-agenda-filter-any) " " "")
   8805 	      (if (or org-agenda-category-filter
   8806 		      (get 'org-agenda-category-filter :preset-filter))
   8807 		  '(:eval (propertize
   8808 			   (concat "["
   8809 	      			   (mapconcat
   8810                                     #'identity
   8811 	      			    (append
   8812 	      			     (get 'org-agenda-category-filter :preset-filter)
   8813 	      			     org-agenda-category-filter)
   8814 	      			    "")
   8815 				   "]")
   8816 	      		   'face 'org-agenda-filter-category
   8817                            'help-echo "Category used in filtering"))
   8818                 "")
   8819 	      (if (or org-agenda-tag-filter
   8820 		      (get 'org-agenda-tag-filter :preset-filter))
   8821 		  '(:eval (propertize
   8822 			   (concat (mapconcat
   8823 				    #'identity
   8824 				    (append
   8825 				     (get 'org-agenda-tag-filter :preset-filter)
   8826 				     org-agenda-tag-filter)
   8827 				    ""))
   8828 			   'face 'org-agenda-filter-tags
   8829 			   'help-echo "Tags used in filtering"))
   8830 		"")
   8831 	      (if (or org-agenda-effort-filter
   8832 		      (get 'org-agenda-effort-filter :preset-filter))
   8833 		  '(:eval (propertize
   8834 			   (concat (mapconcat
   8835 				    #'identity
   8836 				    (append
   8837 				     (get 'org-agenda-effort-filter :preset-filter)
   8838 				     org-agenda-effort-filter)
   8839 				    ""))
   8840 			   'face 'org-agenda-filter-effort
   8841 			   'help-echo "Effort conditions used in filtering"))
   8842 		"")
   8843 	      (if (or org-agenda-regexp-filter
   8844 		      (get 'org-agenda-regexp-filter :preset-filter))
   8845 		  '(:eval (propertize
   8846 			   (concat (mapconcat
   8847 				    (lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/"))
   8848 				    (append
   8849 				     (get 'org-agenda-regexp-filter :preset-filter)
   8850 				     org-agenda-regexp-filter)
   8851 				    ""))
   8852 			   'face 'org-agenda-filter-regexp
   8853 			   'help-echo "Regexp used in filtering"))
   8854 		"")
   8855 	      (if org-agenda-archives-mode
   8856 		  (if (eq org-agenda-archives-mode t)
   8857 		      " Archives"
   8858 		    (format " :%s:" org-archive-tag))
   8859 		"")
   8860 	      (if org-agenda-clockreport-mode " Clock" "")))
   8861   (force-mode-line-update))
   8862 
   8863 (defun org-agenda-update-agenda-type ()
   8864   "Update the agenda type after each command."
   8865   (setq org-agenda-type
   8866 	(or (get-text-property (point) 'org-agenda-type)
   8867 	    (get-text-property (max (point-min) (1- (point))) 'org-agenda-type))))
   8868 
   8869 (defun org-agenda-next-line ()
   8870   "Move cursor to the next line, and show if follow mode is active."
   8871   (interactive)
   8872   (call-interactively 'next-line)
   8873   (org-agenda-do-context-action))
   8874 
   8875 (defun org-agenda-previous-line ()
   8876   "Move cursor to the previous line, and show if follow-mode is active."
   8877   (interactive)
   8878   (call-interactively 'previous-line)
   8879   (org-agenda-do-context-action))
   8880 
   8881 (defun org-agenda-next-item (n)
   8882   "Move cursor to next agenda item."
   8883   (interactive "p")
   8884   (let ((col (current-column)))
   8885     (dotimes (_ n)
   8886       (when (next-single-property-change (point-at-eol) 'org-marker)
   8887 	(move-end-of-line 1)
   8888 	(goto-char (next-single-property-change (point) 'org-marker))))
   8889     (org-move-to-column col))
   8890   (org-agenda-do-context-action))
   8891 
   8892 (defun org-agenda-previous-item (n)
   8893   "Move cursor to next agenda item."
   8894   (interactive "p")
   8895   (dotimes (_ n)
   8896     (let ((col (current-column))
   8897 	  (goto (save-excursion
   8898 		  (move-end-of-line 0)
   8899 		  (previous-single-property-change (point) 'org-marker))))
   8900       (when goto (goto-char goto))
   8901       (org-move-to-column col)))
   8902   (org-agenda-do-context-action))
   8903 
   8904 (defun org-agenda-do-context-action ()
   8905   "Show outline path and, maybe, follow mode window."
   8906   (let ((m (org-get-at-bol 'org-marker)))
   8907     (when (and (markerp m) (marker-buffer m))
   8908       (and org-agenda-follow-mode
   8909 	   (if org-agenda-follow-indirect
   8910 	       (org-agenda-tree-to-indirect-buffer nil)
   8911 	     (org-agenda-show)))
   8912       (and org-agenda-show-outline-path
   8913 	   (org-with-point-at m (org-display-outline-path t))))))
   8914 
   8915 (defun org-agenda-show-tags ()
   8916   "Show the tags applicable to the current item."
   8917   (interactive)
   8918   (let* ((tags (org-get-at-bol 'tags)))
   8919     (if tags
   8920 	(message "Tags are :%s:"
   8921 		 (org-no-properties (mapconcat #'identity tags ":")))
   8922       (message "No tags associated with this line"))))
   8923 
   8924 (defun org-agenda-goto (&optional highlight)
   8925   "Go to the entry at point in the corresponding Org file."
   8926   (interactive)
   8927   (let* ((marker (or (org-get-at-bol 'org-marker)
   8928 		     (org-agenda-error)))
   8929 	 (buffer (marker-buffer marker))
   8930 	 (pos (marker-position marker)))
   8931     ;; FIXME: use `org-switch-to-buffer-other-window'?
   8932     (switch-to-buffer-other-window buffer)
   8933     (widen)
   8934     (push-mark)
   8935     (goto-char pos)
   8936     (when (derived-mode-p 'org-mode)
   8937       (org-show-context 'agenda)
   8938       (recenter (/ (window-height) 2))
   8939       (org-back-to-heading t)
   8940       (let ((case-fold-search nil))
   8941 	(when (re-search-forward org-complex-heading-regexp nil t)
   8942 	  (goto-char (match-beginning 4)))))
   8943     (run-hooks 'org-agenda-after-show-hook)
   8944     (and highlight (org-highlight (point-at-bol) (point-at-eol)))))
   8945 
   8946 (defvar org-agenda-after-show-hook nil
   8947   "Normal hook run after an item has been shown from the agenda.
   8948 Point is in the buffer where the item originated.")
   8949 
   8950 ;; Defined later in org-agenda.el
   8951 (defvar org-agenda-loop-over-headlines-in-active-region nil)
   8952 
   8953 (defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete)
   8954   "Between region BEG and END, call agenda command CMD.
   8955 When optional argument ARG is non-nil or FORCE-ARG is t, pass
   8956 ARG to CMD.  When optional argument DELETE is non-nil, assume CMD
   8957 deletes the agenda entry and don't move to the next entry."
   8958   (save-excursion
   8959     (goto-char beg)
   8960     (let ((mend (move-marker (make-marker) end))
   8961 	  (all (eq org-agenda-loop-over-headlines-in-active-region t))
   8962 	  (match (and (stringp org-agenda-loop-over-headlines-in-active-region)
   8963 		      org-agenda-loop-over-headlines-in-active-region))
   8964 	  (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level)
   8965 		      (org-get-at-bol 'level))))
   8966       (while (< (point) mend)
   8967 	(let ((ov (make-overlay (point) (point-at-eol))))
   8968 	  (if (not (or all
   8969 		       (and match (looking-at-p match))
   8970 		       (eq level (org-get-at-bol 'level))))
   8971 	      (org-agenda-next-item 1)
   8972 	    (overlay-put ov 'face 'region)
   8973 	    (if (or arg force-arg) (funcall cmd arg) (funcall cmd))
   8974 	    (when (not delete) (org-agenda-next-item 1))
   8975 	    (delete-overlay ov)))))))
   8976 
   8977 ;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*,
   8978 ;; kill,set-property,set-effort] commands may loop over agenda
   8979 ;; entries.  Commands `org-agenda-set-tags' and `org-agenda-bulk-mark'
   8980 ;; use their own mechanisms on active regions.
   8981 (defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body)
   8982   "Maybe loop over agenda entries and perform CMD.
   8983 Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'."
   8984   (declare (debug t))
   8985   `(if (and (called-interactively-p 'any)
   8986 	    org-agenda-loop-over-headlines-in-active-region
   8987 	    (org-region-active-p))
   8988        (org-agenda-do-in-region
   8989 	(region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete)
   8990      ,@body))
   8991 
   8992 (defun org-agenda-kill ()
   8993   "Kill the entry or subtree belonging to the current agenda entry."
   8994   (interactive)
   8995   (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
   8996   (org-agenda-maybe-loop
   8997    #'org-agenda-kill nil nil t
   8998    (let* ((bufname-orig (buffer-name))
   8999 	  (marker (or (org-get-at-bol 'org-marker)
   9000 		      (org-agenda-error)))
   9001 	  (buffer (marker-buffer marker))
   9002 	  (pos (marker-position marker))
   9003 	  (type (org-get-at-bol 'type))
   9004 	  dbeg dend (n 0))
   9005      (org-with-remote-undo buffer
   9006        (with-current-buffer buffer
   9007 	 (save-excursion
   9008 	   (goto-char pos)
   9009 	   (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
   9010 	       (setq dbeg (progn (org-back-to-heading t) (point))
   9011 		     dend (org-end-of-subtree t t))
   9012 	     (setq dbeg (point-at-bol)
   9013 		   dend (min (point-max) (1+ (point-at-eol)))))
   9014 	   (goto-char dbeg)
   9015 	   (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
   9016        (when (or (eq t org-agenda-confirm-kill)
   9017 		 (and (numberp org-agenda-confirm-kill)
   9018 		      (> n org-agenda-confirm-kill)))
   9019 	 (let ((win-conf (current-window-configuration)))
   9020 	   (unwind-protect
   9021 	       (and
   9022 		(prog2
   9023 		    (org-agenda-tree-to-indirect-buffer nil)
   9024 		    (not (y-or-n-p
   9025 			  (format "Delete entry with %d lines in buffer \"%s\"? "
   9026 				  n (buffer-name buffer))))
   9027 		  (kill-buffer org-last-indirect-buffer))
   9028 		(error "Abort"))
   9029 	     (set-window-configuration win-conf))))
   9030        (let ((org-agenda-buffer-name bufname-orig))
   9031 	 (org-remove-subtree-entries-from-agenda buffer dbeg dend))
   9032        (with-current-buffer buffer (delete-region dbeg dend))
   9033        (message "Agenda item and source killed")))))
   9034 
   9035 (defvar org-archive-default-command) ; defined in org-archive.el
   9036 (defun org-agenda-archive-default ()
   9037   "Archive the entry or subtree belonging to the current agenda entry."
   9038   (interactive)
   9039   (require 'org-archive)
   9040   (funcall-interactively
   9041    #'org-agenda-archive-with org-archive-default-command))
   9042 
   9043 (defun org-agenda-archive-default-with-confirmation ()
   9044   "Archive the entry or subtree belonging to the current agenda entry."
   9045   (interactive)
   9046   (require 'org-archive)
   9047   (funcall-interactively
   9048    #'org-agenda-archive-with org-archive-default-command 'confirm))
   9049 
   9050 (defun org-agenda-archive ()
   9051   "Archive the entry or subtree belonging to the current agenda entry."
   9052   (interactive)
   9053   (funcall-interactively
   9054    #'org-agenda-archive-with 'org-archive-subtree))
   9055 
   9056 (defun org-agenda-archive-to-archive-sibling ()
   9057   "Move the entry to the archive sibling."
   9058   (interactive)
   9059   (funcall-interactively
   9060    #'org-agenda-archive-with 'org-archive-to-archive-sibling))
   9061 
   9062 (defvar org-archive-from-agenda)
   9063 
   9064 (defun org-agenda-archive-with (cmd &optional confirm)
   9065   "Move the entry to the archive sibling."
   9066   (interactive)
   9067   (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
   9068   (org-agenda-maybe-loop
   9069    #'org-agenda-archive-with cmd nil t
   9070    (let* ((bufname-orig (buffer-name))
   9071 	  (marker (or (org-get-at-bol 'org-marker)
   9072 		      (org-agenda-error)))
   9073 	  (buffer (marker-buffer marker))
   9074 	  (pos (marker-position marker)))
   9075      (org-with-remote-undo buffer
   9076        (with-current-buffer buffer
   9077 	 (if (derived-mode-p 'org-mode)
   9078 	     (if (and confirm
   9079 		      (not (y-or-n-p "Archive this subtree or entry? ")))
   9080 		 (error "Abort")
   9081 	       (save-window-excursion
   9082 		 (goto-char pos)
   9083 		 (let ((org-agenda-buffer-name bufname-orig))
   9084 		   (org-remove-subtree-entries-from-agenda))
   9085 		 (org-back-to-heading t)
   9086 		 (let ((org-archive-from-agenda t))
   9087 		   (funcall cmd))))
   9088 	   (error "Archiving works only in Org files")))))))
   9089 
   9090 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
   9091   "Remove all lines in the agenda that correspond to a given subtree.
   9092 The subtree is the one in buffer BUF, starting at BEG and ending at END.
   9093 If this information is not given, the function uses the tree at point."
   9094   (let ((buf (or buf (current-buffer))) m p)
   9095     (save-excursion
   9096       (unless (and beg end)
   9097 	(org-back-to-heading t)
   9098 	(setq beg (point))
   9099 	(org-end-of-subtree t)
   9100 	(setq end (point)))
   9101       (set-buffer (get-buffer org-agenda-buffer-name))
   9102       (save-excursion
   9103 	(goto-char (point-max))
   9104 	(beginning-of-line 1)
   9105 	(while (not (bobp))
   9106 	  (when (and (setq m (org-get-at-bol 'org-marker))
   9107 		     (equal buf (marker-buffer m))
   9108 		     (setq p (marker-position m))
   9109 		     (>= p beg)
   9110 		     (< p end))
   9111 	    (let ((inhibit-read-only t))
   9112 	      (delete-region (point-at-bol) (1+ (point-at-eol)))))
   9113 	  (beginning-of-line 0))))))
   9114 
   9115 (defun org-agenda-refile (&optional goto rfloc no-update)
   9116   "Refile the item at point.
   9117 
   9118 When called with `\\[universal-argument] \\[universal-argument]', \
   9119 go to the location of the last
   9120 refiled item.
   9121 
   9122 When called with `\\[universal-argument] \\[universal-argument] \
   9123 \\[universal-argument]' prefix or when GOTO is 0, clear
   9124 the refile cache.
   9125 
   9126 RFLOC can be a refile location obtained in a different way.
   9127 
   9128 When NO-UPDATE is non-nil, don't redo the agenda buffer."
   9129   (interactive "P")
   9130   (cond
   9131    ((member goto '(0 (64)))
   9132     (org-refile-cache-clear))
   9133    ((equal goto '(16))
   9134     (org-refile-goto-last-stored))
   9135    (t
   9136     (let* ((buffer-orig (buffer-name))
   9137 	   (marker (or (org-get-at-bol 'org-hd-marker)
   9138 		       (org-agenda-error)))
   9139 	   (buffer (marker-buffer marker))
   9140 	   ;; (pos (marker-position marker))
   9141 	   (rfloc (or rfloc
   9142 		      (org-refile-get-location
   9143 		       (if goto "Goto" "Refile to") buffer
   9144 		       org-refile-allow-creating-parent-nodes))))
   9145       (with-current-buffer buffer
   9146 	(org-with-wide-buffer
   9147 	 (goto-char marker)
   9148 	 (let ((org-agenda-buffer-name buffer-orig))
   9149 	   (org-remove-subtree-entries-from-agenda))
   9150 	 (org-refile goto buffer rfloc))))
   9151     (unless no-update (org-agenda-redo)))))
   9152 
   9153 (defun org-agenda-open-link (&optional arg)
   9154   "Open the link(s) in the current entry, if any.
   9155 This looks for a link in the displayed line in the agenda.
   9156 It also looks at the text of the entry itself."
   9157   (interactive "P")
   9158   (let* ((marker (or (org-get-at-bol 'org-hd-marker)
   9159 		     (org-get-at-bol 'org-marker)))
   9160 	 (buffer (and marker (marker-buffer marker)))
   9161 	 (prefix (buffer-substring (point-at-bol) (point-at-eol)))
   9162 	 (lkall (and buffer (org-offer-links-in-entry
   9163 			     buffer marker arg prefix)))
   9164 	 (lk0 (car lkall))
   9165 	 (lk (if (stringp lk0) (list lk0) lk0))
   9166 	 (lkend (cdr lkall))
   9167 	 trg)
   9168     (cond
   9169      ((and buffer lk)
   9170       (mapcar (lambda(l)
   9171 		(with-current-buffer buffer
   9172 		  (setq trg (and (string-match org-link-bracket-re l)
   9173 				 (match-string 1 l)))
   9174 		  (if (or (not trg) (string-match org-link-any-re trg))
   9175 		      ;; Don't use `org-with-wide-buffer' here as
   9176 		      ;; opening the link may result in moving the point
   9177 		      (save-restriction
   9178 			(widen)
   9179 			(goto-char marker)
   9180 			(when (search-forward l nil lkend)
   9181 			  (goto-char (match-beginning 0))
   9182 			  (org-open-at-point)))
   9183 		    ;; This is an internal link, widen the buffer
   9184 		    ;; FIXME: use `org-switch-to-buffer-other-window'?
   9185 		    (switch-to-buffer-other-window buffer)
   9186 		    (widen)
   9187 		    (goto-char marker)
   9188 		    (when (search-forward l nil lkend)
   9189 		      (goto-char (match-beginning 0))
   9190 		      (org-open-at-point)))))
   9191 	      lk))
   9192      ((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)"))
   9193 	  (save-excursion
   9194 	    (beginning-of-line 1)
   9195 	    (looking-at (concat ".*?\\(" org-link-bracket-re "\\)"))))
   9196       (org-link-open-from-string (match-string 1)))
   9197      (t (message "No link to open here")))))
   9198 
   9199 (defun org-agenda-copy-local-variable (var)
   9200   "Get a variable from a referenced buffer and install it here."
   9201   (let ((m (org-get-at-bol 'org-marker)))
   9202     (when (and m (buffer-live-p (marker-buffer m)))
   9203       (set (make-local-variable var)
   9204 	   (with-current-buffer (marker-buffer m)
   9205 	     (symbol-value var))))))
   9206 
   9207 (defun org-agenda-switch-to (&optional delete-other-windows)
   9208   "Go to the Org mode file which contains the item at point.
   9209 When optional argument DELETE-OTHER-WINDOWS is non-nil, the
   9210 displayed Org file fills the frame."
   9211   (interactive)
   9212   (if (and org-return-follows-link
   9213 	   (not (org-get-at-bol 'org-marker))
   9214 	   (org-in-regexp org-link-bracket-re))
   9215       (org-link-open-from-string (match-string 0))
   9216     (let* ((marker (or (org-get-at-bol 'org-marker)
   9217 		       (org-agenda-error)))
   9218 	   (buffer (marker-buffer marker))
   9219 	   (pos (marker-position marker)))
   9220       (unless buffer (user-error "Trying to switch to non-existent buffer"))
   9221       (pop-to-buffer-same-window buffer)
   9222       (when delete-other-windows (delete-other-windows))
   9223       (widen)
   9224       (goto-char pos)
   9225       (when (derived-mode-p 'org-mode)
   9226 	(org-show-context 'agenda)
   9227 	(run-hooks 'org-agenda-after-show-hook)))))
   9228 
   9229 (defun org-agenda-goto-mouse (ev)
   9230   "Go to the Org file which contains the item at the mouse click."
   9231   (interactive "e")
   9232   (mouse-set-point ev)
   9233   (org-agenda-goto))
   9234 
   9235 (defun org-agenda-show (&optional full-entry)
   9236   "Display the Org file which contains the item at point.
   9237 With prefix argument FULL-ENTRY, make the entire entry visible
   9238 if it was hidden in the outline."
   9239   (interactive "P")
   9240   (let ((win (selected-window)))
   9241     (org-agenda-goto t)
   9242     (when full-entry (org-show-entry))
   9243     (select-window win)))
   9244 
   9245 (defvar org-agenda-show-window nil)
   9246 (defun org-agenda-show-and-scroll-up (&optional arg)
   9247   "Display the Org file which contains the item at point.
   9248 
   9249 When called repeatedly, scroll the window that is displaying the buffer.
   9250 
   9251 With a `\\[universal-argument]' prefix argument, display the item, but \
   9252 fold drawers."
   9253   (interactive "P")
   9254   (let ((win (selected-window)))
   9255     (if (and (window-live-p org-agenda-show-window)
   9256 	     (eq this-command last-command))
   9257 	(progn
   9258 	  (select-window org-agenda-show-window)
   9259 	  (ignore-errors (scroll-up)))
   9260       (org-agenda-goto t)
   9261       (org-show-entry)
   9262       (if arg (org-cycle-hide-drawers 'children)
   9263 	(org-with-wide-buffer
   9264 	 (narrow-to-region (org-entry-beginning-position)
   9265 			   (org-entry-end-position))
   9266 	 (org-show-all '(drawers))))
   9267       (setq org-agenda-show-window (selected-window)))
   9268     (select-window win)))
   9269 
   9270 (defun org-agenda-show-scroll-down ()
   9271   "Scroll down the window showing the agenda."
   9272   (interactive)
   9273   (let ((win (selected-window)))
   9274     (when (window-live-p org-agenda-show-window)
   9275       (select-window org-agenda-show-window)
   9276       (ignore-errors (scroll-down))
   9277       (select-window win))))
   9278 
   9279 (defun org-agenda-show-1 (&optional more)
   9280   "Display the Org file which contains the item at point.
   9281 The prefix arg selects the amount of information to display:
   9282 
   9283 0   hide the subtree
   9284 1   just show the entry according to defaults.
   9285 2   show the children view
   9286 3   show the subtree view
   9287 4   show the entire subtree and any drawers
   9288 With prefix argument FULL-ENTRY, make the entire entry visible
   9289 if it was hidden in the outline."
   9290   (interactive "p")
   9291   (let ((win (selected-window)))
   9292     (org-agenda-goto t)
   9293     (org-back-to-heading)
   9294     (set-window-start (selected-window) (point-at-bol))
   9295     (cond
   9296      ((= more 0)
   9297       (org-flag-subtree t)
   9298       (save-excursion
   9299 	(org-back-to-heading)
   9300 	(run-hook-with-args 'org-cycle-hook 'folded))
   9301       (message "Remote: FOLDED"))
   9302      ((and (called-interactively-p 'any) (= more 1))
   9303       (message "Remote: show with default settings"))
   9304      ((= more 2)
   9305       (outline-show-entry)
   9306       (org-show-children)
   9307       (save-excursion
   9308 	(org-back-to-heading)
   9309 	(run-hook-with-args 'org-cycle-hook 'children))
   9310       (message "Remote: CHILDREN"))
   9311      ((= more 3)
   9312       (outline-show-subtree)
   9313       (save-excursion
   9314 	(org-back-to-heading)
   9315 	(run-hook-with-args 'org-cycle-hook 'subtree))
   9316       (message "Remote: SUBTREE"))
   9317      ((> more 3)
   9318       (outline-show-subtree)
   9319       (message "Remote: SUBTREE AND ALL DRAWERS")))
   9320     (select-window win)))
   9321 
   9322 (defvar org-agenda-cycle-counter nil)
   9323 (defun org-agenda-cycle-show (&optional n)
   9324   "Show the current entry in another window, with default settings.
   9325 
   9326 Default settings are taken from `org-show-context-detail'.  When
   9327 use repeatedly in immediate succession, the remote entry will
   9328 cycle through visibility
   9329 
   9330   children -> subtree -> folded
   9331 
   9332 When called with a numeric prefix arg, that arg will be passed through to
   9333 `org-agenda-show-1'.  For the interpretation of that argument, see the
   9334 docstring of `org-agenda-show-1'."
   9335   (interactive "P")
   9336   (if (integerp n)
   9337       (setq org-agenda-cycle-counter n)
   9338     (if (not (eq last-command this-command))
   9339 	(setq org-agenda-cycle-counter 1)
   9340       (if (equal org-agenda-cycle-counter 0)
   9341 	  (setq org-agenda-cycle-counter 2)
   9342 	(setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter))
   9343 	(when (> org-agenda-cycle-counter 3)
   9344 	  (setq org-agenda-cycle-counter 0)))))
   9345   (org-agenda-show-1 org-agenda-cycle-counter))
   9346 
   9347 (defun org-agenda-recenter (arg)
   9348   "Display the Org file which contains the item at point and recenter."
   9349   (interactive "P")
   9350   (let ((win (selected-window)))
   9351     (org-agenda-goto t)
   9352     (recenter arg)
   9353     (select-window win)))
   9354 
   9355 (defun org-agenda-show-mouse (ev)
   9356   "Display the Org file which contains the item at the mouse click."
   9357   (interactive "e")
   9358   (mouse-set-point ev)
   9359   (org-agenda-show))
   9360 
   9361 (defun org-agenda-check-no-diary ()
   9362   "Check if the entry is a diary link and abort if yes."
   9363   (when (org-get-at-bol 'org-agenda-diary-link)
   9364     (org-agenda-error)))
   9365 
   9366 (defun org-agenda-error ()
   9367   "Throw an error when a command is not allowed in the agenda."
   9368   (user-error "Command not allowed in this line"))
   9369 
   9370 (defun org-agenda-tree-to-indirect-buffer (arg)
   9371   "Show the subtree corresponding to the current entry in an indirect buffer.
   9372 This calls the command `org-tree-to-indirect-buffer' from the original buffer.
   9373 
   9374 With a numerical prefix ARG, go up to this level and then take that tree.
   9375 With a negative numeric ARG, go up by this number of levels.
   9376 
   9377 With a `\\[universal-argument]' prefix, make a separate frame for this tree, \
   9378 i.e. don't use
   9379 the dedicated frame."
   9380   (interactive "P")
   9381   (if current-prefix-arg
   9382       (org-agenda-do-tree-to-indirect-buffer arg)
   9383     (let ((agenda-buffer (buffer-name))
   9384 	  (agenda-window (selected-window))
   9385           (indirect-window
   9386 	   (and org-last-indirect-buffer
   9387 		(get-buffer-window org-last-indirect-buffer))))
   9388       (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg))
   9389       (unless (or (eq org-indirect-buffer-display 'new-frame)
   9390 		  (eq org-indirect-buffer-display 'dedicated-frame))
   9391 	(unwind-protect
   9392 	    (unless (and indirect-window (window-live-p indirect-window))
   9393 	      (setq indirect-window (split-window agenda-window)))
   9394 	  (and indirect-window (select-window indirect-window))
   9395 	  (switch-to-buffer org-last-indirect-buffer :norecord)
   9396 	  (fit-window-to-buffer indirect-window)))
   9397       (select-window (get-buffer-window agenda-buffer))
   9398       (setq org-agenda-last-indirect-buffer org-last-indirect-buffer))))
   9399 
   9400 (defun org-agenda-do-tree-to-indirect-buffer (arg)
   9401   "Same as `org-agenda-tree-to-indirect-buffer' without saving window."
   9402   (org-agenda-check-no-diary)
   9403   (let* ((marker (or (org-get-at-bol 'org-marker)
   9404 		     (org-agenda-error)))
   9405 	 (buffer (marker-buffer marker))
   9406 	 (pos (marker-position marker)))
   9407     (with-current-buffer buffer
   9408       (save-excursion
   9409 	(goto-char pos)
   9410 	(org-tree-to-indirect-buffer arg)))))
   9411 
   9412 (defvar org-last-heading-marker (make-marker)
   9413   "Marker pointing to the headline that last changed its TODO state
   9414 by a remote command from the agenda.")
   9415 
   9416 (defun org-agenda-todo-nextset ()
   9417   "Switch TODO entry to next sequence."
   9418   (interactive)
   9419   (org-agenda-todo 'nextset))
   9420 
   9421 (defun org-agenda-todo-previousset ()
   9422   "Switch TODO entry to previous sequence."
   9423   (interactive)
   9424   (org-agenda-todo 'previousset))
   9425 
   9426 (defvar org-agenda-headline-snapshot-before-repeat)
   9427 
   9428 (defun org-agenda-todo (&optional arg)
   9429   "Cycle TODO state of line at point, also in Org file.
   9430 This changes the line at point, all other lines in the agenda referring to
   9431 the same tree node, and the headline of the tree node in the Org file."
   9432   (interactive "P")
   9433   (org-agenda-check-no-diary)
   9434   (org-agenda-maybe-loop
   9435    #'org-agenda-todo arg nil nil
   9436    (let* ((col (current-column))
   9437 	  (marker (or (org-get-at-bol 'org-marker)
   9438 		      (org-agenda-error)))
   9439 	  (buffer (marker-buffer marker))
   9440 	  (pos (marker-position marker))
   9441 	  (hdmarker (org-get-at-bol 'org-hd-marker))
   9442 	  (todayp (org-agenda-today-p (org-get-at-bol 'day)))
   9443 	  (inhibit-read-only t)
   9444 	  org-loop-over-headlines-in-active-region
   9445 	  org-agenda-headline-snapshot-before-repeat newhead just-one)
   9446      (org-with-remote-undo buffer
   9447        (with-current-buffer buffer
   9448 	 (widen)
   9449 	 (goto-char pos)
   9450 	 (org-show-context 'agenda)
   9451 	 (let ((current-prefix-arg arg))
   9452 	   (call-interactively 'org-todo)
   9453            ;; Make sure that log is recorded in current undo.
   9454            (when (and org-log-setup
   9455                       (not (eq org-log-note-how 'note)))
   9456              (org-add-log-note)))
   9457 	 (and (bolp) (forward-char 1))
   9458 	 (setq newhead (org-get-heading))
   9459 	 (when (and org-agenda-headline-snapshot-before-repeat
   9460 		    (not (equal org-agenda-headline-snapshot-before-repeat
   9461 				newhead))
   9462 		    todayp)
   9463 	   (setq newhead org-agenda-headline-snapshot-before-repeat
   9464 		 just-one t))
   9465 	 (save-excursion
   9466 	   (org-back-to-heading)
   9467 	   (move-marker org-last-heading-marker (point))))
   9468        (beginning-of-line 1)
   9469        (save-window-excursion
   9470 	 (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
   9471        (when (bound-and-true-p org-clock-out-when-done)
   9472 	 (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
   9473 		       newhead)
   9474 	 (org-agenda-unmark-clocking-task))
   9475        (org-move-to-column col)
   9476        (org-agenda-mark-clocking-task)))))
   9477 
   9478 (defun org-agenda-add-note (&optional _arg)
   9479   "Add a time-stamped note to the entry at point."
   9480   (interactive) ;; "P"
   9481   (org-agenda-check-no-diary)
   9482   (let* ((marker (or (org-get-at-bol 'org-marker)
   9483 		     (org-agenda-error)))
   9484 	 (buffer (marker-buffer marker))
   9485 	 (pos (marker-position marker))
   9486 	 (_hdmarker (org-get-at-bol 'org-hd-marker))
   9487 	 (inhibit-read-only t))
   9488     (with-current-buffer buffer
   9489       (widen)
   9490       (goto-char pos)
   9491       (org-show-context 'agenda)
   9492       (org-add-note))))
   9493 
   9494 (defun org-agenda-change-all-lines (newhead hdmarker
   9495 					    &optional fixface just-this)
   9496   "Change all lines in the agenda buffer which match HDMARKER.
   9497 The new content of the line will be NEWHEAD (as modified by
   9498 `org-agenda-format-item').  HDMARKER is checked with
   9499 `equal' against all `org-hd-marker' text properties in the file.
   9500 If FIXFACE is non-nil, the face of each item is modified according to
   9501 the new TODO state.
   9502 If JUST-THIS is non-nil, change just the current line, not all.
   9503 If FORCE-TAGS is non-nil, the car of it returns the new tags."
   9504   (let* ((inhibit-read-only t)
   9505 	 (line (org-current-line))
   9506 	 (org-agenda-buffer (current-buffer))
   9507 	 (thetags (with-current-buffer (marker-buffer hdmarker)
   9508 		    (org-get-tags hdmarker)))
   9509 	 props m undone-face done-face finish new dotime level cat tags) ;; pl
   9510     (save-excursion
   9511       (goto-char (point-max))
   9512       (beginning-of-line 1)
   9513       (while (not finish)
   9514 	(setq finish (bobp))
   9515 	(when (and (setq m (org-get-at-bol 'org-hd-marker))
   9516 		   (or (not just-this) (= (org-current-line) line))
   9517 		   (equal m hdmarker))
   9518 	  (setq props (text-properties-at (point))
   9519 		dotime (org-get-at-bol 'dotime)
   9520 		cat (org-agenda-get-category)
   9521 		level (org-get-at-bol 'level)
   9522 		tags thetags
   9523 		new
   9524 		(let ((org-prefix-format-compiled
   9525 		       (or (get-text-property (min (1- (point-max)) (point)) 'format)
   9526 			   org-prefix-format-compiled))
   9527 		      (extra (org-get-at-bol 'extra)))
   9528 		  (with-current-buffer (marker-buffer hdmarker)
   9529 		    (org-with-wide-buffer
   9530 		     (org-agenda-format-item extra newhead level cat tags dotime))))
   9531 		;; pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
   9532 		undone-face (org-get-at-bol 'undone-face)
   9533 		done-face (org-get-at-bol 'done-face))
   9534 	  (beginning-of-line 1)
   9535 	  (cond
   9536 	   ((equal new "") (delete-region (point) (line-beginning-position 2)))
   9537 	   ((looking-at ".*")
   9538 	    ;; When replacing the whole line, preserve bulk mark
   9539 	    ;; overlay, if any.
   9540 	    (let ((mark (catch :overlay
   9541 			  (dolist (o (overlays-in (point) (+ 2 (point))))
   9542 			    (when (eq (overlay-get o 'type)
   9543 				      'org-marked-entry-overlay)
   9544 			      (throw :overlay o))))))
   9545 	      (replace-match new t t)
   9546 	      (beginning-of-line)
   9547 	      (when mark (move-overlay mark (point) (+ 2 (point)))))
   9548 	    (add-text-properties (point-at-bol) (point-at-eol) props)
   9549 	    (when fixface
   9550 	      (add-text-properties
   9551 	       (point-at-bol) (point-at-eol)
   9552 	       (list 'face
   9553 		     (if org-last-todo-state-is-todo
   9554 			 undone-face done-face))))
   9555 	    (org-agenda-highlight-todo 'line)
   9556 	    (beginning-of-line 1))
   9557 	   (t (error "Line update did not work")))
   9558 	  (save-restriction
   9559 	    (narrow-to-region (point-at-bol) (point-at-eol))
   9560 	    (org-agenda-finalize)))
   9561 	(beginning-of-line 0)))))
   9562 
   9563 (defun org-agenda-align-tags (&optional line)
   9564   "Align all tags in agenda items to `org-agenda-tags-column'.
   9565 When optional argument LINE is non-nil, align tags only on the
   9566 current line."
   9567   (let ((inhibit-read-only t)
   9568 	(org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
   9569 				    (- (window-text-width))
   9570 				  org-agenda-tags-column))
   9571 	(end (and line (line-end-position)))
   9572 	l c)
   9573     (save-excursion
   9574       (goto-char (if line (line-beginning-position) (point-min)))
   9575       (while (re-search-forward org-tag-group-re end t)
   9576 	(add-text-properties
   9577 	 (match-beginning 1) (match-end 1)
   9578 	 (list 'face (delq nil (let ((prop (get-text-property
   9579 					    (match-beginning 1) 'face)))
   9580 				 (or (listp prop) (setq prop (list prop)))
   9581 				 (if (memq 'org-tag prop)
   9582 				     prop
   9583 				   (cons 'org-tag prop))))))
   9584 	(setq l (string-width (match-string 1))
   9585 	      c (if (< org-agenda-tags-column 0)
   9586 		    (- (abs org-agenda-tags-column) l)
   9587 		  org-agenda-tags-column))
   9588 	(goto-char (match-beginning 1))
   9589 	(delete-region (save-excursion (skip-chars-backward " \t") (point))
   9590 		       (point))
   9591 	(insert (org-add-props
   9592 		    (make-string (max 1 (- c (current-column))) ?\s)
   9593 		    (plist-put (copy-sequence (text-properties-at (point)))
   9594 			       'face nil))))
   9595       (goto-char (point-min))
   9596       (org-font-lock-add-tag-faces (point-max)))))
   9597 
   9598 (defun org-agenda-priority-up ()
   9599   "Increase the priority of line at point, also in Org file."
   9600   (interactive)
   9601   (org-agenda-priority 'up))
   9602 
   9603 (defun org-agenda-priority-down ()
   9604   "Decrease the priority of line at point, also in Org file."
   9605   (interactive)
   9606   (org-agenda-priority 'down))
   9607 
   9608 (defun org-agenda-priority (&optional force-direction)
   9609   "Set the priority of line at point, also in Org file.
   9610 This changes the line at point, all other lines in the agenda
   9611 referring to the same tree node, and the headline of the tree
   9612 node in the Org file.
   9613 
   9614 Called with one universal prefix arg, show the priority instead
   9615 of setting it.
   9616 
   9617 When called programmatically, FORCE-DIRECTION can be `set', `up',
   9618 `down', or a character."
   9619   (interactive "P")
   9620   (unless org-priority-enable-commands
   9621     (user-error "Priority commands are disabled"))
   9622   (org-agenda-check-no-diary)
   9623   (let* ((col (current-column))
   9624 	 (hdmarker (org-get-at-bol 'org-hd-marker))
   9625 	 (buffer (marker-buffer hdmarker))
   9626 	 (pos (marker-position hdmarker))
   9627 	 (inhibit-read-only t)
   9628 	 newhead)
   9629     (org-with-remote-undo buffer
   9630       (with-current-buffer buffer
   9631 	(widen)
   9632 	(goto-char pos)
   9633 	(org-show-context 'agenda)
   9634 	(org-priority force-direction)
   9635 	(end-of-line 1)
   9636 	(setq newhead (org-get-heading)))
   9637       (org-agenda-change-all-lines newhead hdmarker)
   9638       (org-move-to-column col))))
   9639 
   9640 ;; FIXME: should fix the tags property of the agenda line.
   9641 (defun org-agenda-set-tags (&optional tag onoff)
   9642   "Set tags for the current headline."
   9643   (interactive)
   9644   (org-agenda-check-no-diary)
   9645   (if (and (org-region-active-p) (called-interactively-p 'any))
   9646       (call-interactively 'org-change-tag-in-region)
   9647     (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
   9648 			 (org-agenda-error)))
   9649 	   (buffer (marker-buffer hdmarker))
   9650 	   (pos (marker-position hdmarker))
   9651 	   (inhibit-read-only t)
   9652 	   newhead)
   9653       (org-with-remote-undo buffer
   9654 	(with-current-buffer buffer
   9655 	  (widen)
   9656 	  (goto-char pos)
   9657 	  (org-show-context 'agenda)
   9658 	  (if tag
   9659 	      (org-toggle-tag tag onoff)
   9660 	    (call-interactively #'org-set-tags-command))
   9661 	  (end-of-line 1)
   9662 	  (setq newhead (org-get-heading)))
   9663 	(org-agenda-change-all-lines newhead hdmarker)
   9664 	(beginning-of-line 1)))))
   9665 
   9666 (defun org-agenda-set-property ()
   9667   "Set a property for the current headline."
   9668   (interactive)
   9669   (org-agenda-check-no-diary)
   9670   (org-agenda-maybe-loop
   9671    #'org-agenda-set-property nil nil nil
   9672    (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
   9673 			(org-agenda-error)))
   9674 	  (buffer (marker-buffer hdmarker))
   9675 	  (pos (marker-position hdmarker))
   9676 	  (inhibit-read-only t)
   9677 	  ) ;; newhead
   9678      (org-with-remote-undo buffer
   9679        (with-current-buffer buffer
   9680 	 (widen)
   9681 	 (goto-char pos)
   9682 	 (org-show-context 'agenda)
   9683 	 (call-interactively 'org-set-property))))))
   9684 
   9685 (defun org-agenda-set-effort ()
   9686   "Set the effort property for the current headline."
   9687   (interactive)
   9688   (org-agenda-check-no-diary)
   9689   (org-agenda-maybe-loop
   9690    #'org-agenda-set-effort nil nil nil
   9691    (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
   9692 			(org-agenda-error)))
   9693 	  (buffer (marker-buffer hdmarker))
   9694 	  (pos (marker-position hdmarker))
   9695 	  (inhibit-read-only t)
   9696 	  newhead)
   9697      (org-with-remote-undo buffer
   9698        (with-current-buffer buffer
   9699 	 (widen)
   9700 	 (goto-char pos)
   9701 	 (org-show-context 'agenda)
   9702 	 (call-interactively 'org-set-effort)
   9703 	 (end-of-line 1)
   9704 	 (setq newhead (org-get-heading)))
   9705        (org-agenda-change-all-lines newhead hdmarker)))))
   9706 
   9707 (defun org-agenda-toggle-archive-tag ()
   9708   "Toggle the archive tag for the current entry."
   9709   (interactive)
   9710   (org-agenda-check-no-diary)
   9711   (org-agenda-maybe-loop
   9712    #'org-agenda-toggle-archive-tag nil nil nil
   9713    (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
   9714 			(org-agenda-error)))
   9715 	  (buffer (marker-buffer hdmarker))
   9716 	  (pos (marker-position hdmarker))
   9717 	  (inhibit-read-only t)
   9718 	  newhead)
   9719      (org-with-remote-undo buffer
   9720        (with-current-buffer buffer
   9721 	 (widen)
   9722 	 (goto-char pos)
   9723 	 (org-show-context 'agenda)
   9724 	 (call-interactively 'org-toggle-archive-tag)
   9725 	 (end-of-line 1)
   9726 	 (setq newhead (org-get-heading)))
   9727        (org-agenda-change-all-lines newhead hdmarker)
   9728        (beginning-of-line 1)))))
   9729 
   9730 (defun org-agenda-do-date-later (arg)
   9731   (interactive "P")
   9732   (cond
   9733    ((or (equal arg '(16))
   9734 	(memq last-command
   9735 	      '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
   9736     (setq this-command 'org-agenda-date-later-minutes)
   9737     (org-agenda-date-later-minutes 1))
   9738    ((or (equal arg '(4))
   9739 	(memq last-command
   9740 	      '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
   9741     (setq this-command 'org-agenda-date-later-hours)
   9742     (org-agenda-date-later-hours 1))
   9743    (t
   9744     (org-agenda-date-later (prefix-numeric-value arg)))))
   9745 
   9746 (defun org-agenda-do-date-earlier (arg)
   9747   (interactive "P")
   9748   (cond
   9749    ((or (equal arg '(16))
   9750 	(memq last-command
   9751 	      '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
   9752     (setq this-command 'org-agenda-date-earlier-minutes)
   9753     (org-agenda-date-earlier-minutes 1))
   9754    ((or (equal arg '(4))
   9755 	(memq last-command
   9756 	      '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
   9757     (setq this-command 'org-agenda-date-earlier-hours)
   9758     (org-agenda-date-earlier-hours 1))
   9759    (t
   9760     (org-agenda-date-earlier (prefix-numeric-value arg)))))
   9761 
   9762 (defun org-agenda-date-later (arg &optional what)
   9763   "Change the date of this item to ARG day(s) later."
   9764   (interactive "p")
   9765   (org-agenda-check-type t 'agenda)
   9766   (org-agenda-check-no-diary)
   9767   (let* ((marker (or (org-get-at-bol 'org-marker)
   9768 		     (org-agenda-error)))
   9769 	 (buffer (marker-buffer marker))
   9770 	 (pos (marker-position marker))
   9771 	 cdate today)
   9772     (org-with-remote-undo buffer
   9773       (with-current-buffer buffer
   9774 	(widen)
   9775 	(goto-char pos)
   9776 	(unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
   9777 	(when (and org-agenda-move-date-from-past-immediately-to-today
   9778 		   (equal arg 1)
   9779 		   (or (not what) (eq what 'day))
   9780 		   (not (save-match-data (org-at-date-range-p))))
   9781 	  (setq cdate (org-parse-time-string (match-string 0) 'nodefault)
   9782 		cdate (calendar-absolute-from-gregorian
   9783 		       (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
   9784 		today (org-today))
   9785 	  (when (> today cdate)
   9786 	    ;; immediately shift to today
   9787 	    (setq arg (- today cdate))))
   9788 	(org-timestamp-change arg (or what 'day))
   9789 	(when (and (org-at-date-range-p)
   9790 		   (re-search-backward org-tr-regexp-both (point-at-bol)))
   9791 	  (let ((end org-last-changed-timestamp))
   9792 	    (org-timestamp-change arg (or what 'day))
   9793 	    (setq org-last-changed-timestamp
   9794 		  (concat org-last-changed-timestamp "--" end)))))
   9795       (org-agenda-show-new-time marker org-last-changed-timestamp))
   9796     (message "Time stamp changed to %s" org-last-changed-timestamp)))
   9797 
   9798 (defun org-agenda-date-earlier (arg &optional what)
   9799   "Change the date of this item to ARG day(s) earlier."
   9800   (interactive "p")
   9801   (org-agenda-date-later (- arg) what))
   9802 
   9803 (defun org-agenda-date-later-minutes (arg)
   9804   "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
   9805   (interactive "p")
   9806   (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
   9807   (org-agenda-date-later arg 'minute))
   9808 
   9809 (defun org-agenda-date-earlier-minutes (arg)
   9810   "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
   9811   (interactive "p")
   9812   (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
   9813   (org-agenda-date-earlier arg 'minute))
   9814 
   9815 (defun org-agenda-date-later-hours (arg)
   9816   "Change the time of this item, in hour steps."
   9817   (interactive "p")
   9818   (org-agenda-date-later arg 'hour))
   9819 
   9820 (defun org-agenda-date-earlier-hours (arg)
   9821   "Change the time of this item, in hour steps."
   9822   (interactive "p")
   9823   (org-agenda-date-earlier arg 'hour))
   9824 
   9825 (defun org-agenda-show-new-time (marker stamp &optional prefix)
   9826   "Show new date stamp via text properties."
   9827   ;; We use text properties to make this undoable
   9828   (let ((inhibit-read-only t))
   9829     (setq stamp (concat prefix " => " stamp " "))
   9830     (save-excursion
   9831       (goto-char (point-max))
   9832       (while (not (bobp))
   9833 	(when (equal marker (org-get-at-bol 'org-marker))
   9834           (remove-text-properties (line-beginning-position)
   9835 				  (line-end-position)
   9836 				  '(display nil))
   9837 	  (org-move-to-column
   9838            (- (if (fboundp 'window-font-width)
   9839                   (/ (window-width nil t) (window-font-width))
   9840                 ;; Fall back to pre-9.3.3 behavior on Emacs <25.
   9841                 (window-width))
   9842               (length stamp))
   9843            t)
   9844           (add-text-properties
   9845 	   (1- (point)) (point-at-eol)
   9846 	   (list 'display (org-add-props stamp nil
   9847 			    'face '(secondary-selection default))))
   9848 	  (beginning-of-line 1))
   9849 	(beginning-of-line 0)))))
   9850 
   9851 (defun org-agenda-date-prompt (arg)
   9852   "Change the date of this item.  Date is prompted for, with default today.
   9853 The prefix ARG is passed to the `org-time-stamp' command and can therefore
   9854 be used to request time specification in the time stamp."
   9855   (interactive "P")
   9856   (org-agenda-check-type t 'agenda)
   9857   (org-agenda-check-no-diary)
   9858   (org-agenda-maybe-loop
   9859    #'org-agenda-date-prompt arg t nil
   9860    (let* ((marker (or (org-get-at-bol 'org-marker)
   9861 		      (org-agenda-error)))
   9862 	  (buffer (marker-buffer marker))
   9863 	  (pos (marker-position marker)))
   9864      (org-with-remote-undo buffer
   9865        (with-current-buffer buffer
   9866 	 (widen)
   9867 	 (goto-char pos)
   9868 	 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
   9869 	 (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
   9870        (org-agenda-show-new-time marker org-last-changed-timestamp))
   9871      (message "Time stamp changed to %s" org-last-changed-timestamp))))
   9872 
   9873 (defun org-agenda-schedule (arg &optional time)
   9874   "Schedule the item at point.
   9875 ARG is passed through to `org-schedule'."
   9876   (interactive "P")
   9877   (org-agenda-check-type t 'agenda 'todo 'tags 'search)
   9878   (org-agenda-check-no-diary)
   9879   (org-agenda-maybe-loop
   9880    #'org-agenda-schedule arg t nil
   9881    (let* ((marker (or (org-get-at-bol 'org-marker)
   9882 		      (org-agenda-error)))
   9883 	  ;; (type (marker-insertion-type marker))
   9884 	  (buffer (marker-buffer marker))
   9885 	  (pos (marker-position marker))
   9886 	  ts)
   9887      (set-marker-insertion-type marker t)
   9888      (org-with-remote-undo buffer
   9889        (with-current-buffer buffer
   9890 	 (widen)
   9891 	 (goto-char pos)
   9892 	 (setq ts (org-schedule arg time)))
   9893        (org-agenda-show-new-time marker ts " S"))
   9894      (message "%s" ts))))
   9895 
   9896 (defun org-agenda-deadline (arg &optional time)
   9897   "Schedule the item at point.
   9898 ARG is passed through to `org-deadline'."
   9899   (interactive "P")
   9900   (org-agenda-check-type t 'agenda 'todo 'tags 'search)
   9901   (org-agenda-check-no-diary)
   9902   (org-agenda-maybe-loop
   9903    #'org-agenda-deadline arg t nil
   9904    (let* ((marker (or (org-get-at-bol 'org-marker)
   9905 		      (org-agenda-error)))
   9906 	  (buffer (marker-buffer marker))
   9907 	  (pos (marker-position marker))
   9908 	  ts)
   9909      (org-with-remote-undo buffer
   9910        (with-current-buffer buffer
   9911 	 (widen)
   9912 	 (goto-char pos)
   9913 	 (setq ts (org-deadline arg time)))
   9914        (org-agenda-show-new-time marker ts " D"))
   9915      (message "%s" ts))))
   9916 
   9917 (defun org-agenda-clock-in (&optional arg)
   9918   "Start the clock on the currently selected item."
   9919   (interactive "P")
   9920   (org-agenda-check-no-diary)
   9921   (if (equal arg '(4))
   9922       (org-clock-in arg)
   9923     (let* ((marker (or (org-get-at-bol 'org-marker)
   9924 		       (org-agenda-error)))
   9925 	   (hdmarker (or (org-get-at-bol 'org-hd-marker) marker))
   9926 	   (pos (marker-position marker))
   9927 	   (col (current-column))
   9928 	   newhead)
   9929       (org-with-remote-undo (marker-buffer marker)
   9930         (with-current-buffer (marker-buffer marker)
   9931 	  (widen)
   9932 	  (goto-char pos)
   9933 	  (org-show-context 'agenda)
   9934 	  (org-clock-in arg)
   9935 	  (setq newhead (org-get-heading)))
   9936 	(org-agenda-change-all-lines newhead hdmarker))
   9937       (org-move-to-column col))))
   9938 
   9939 (defun org-agenda-clock-out ()
   9940   "Stop the currently running clock."
   9941   (interactive)
   9942   (unless (marker-buffer org-clock-marker)
   9943     (user-error "No running clock"))
   9944   (let ((marker (make-marker)) (col (current-column)) newhead)
   9945     (org-with-remote-undo (marker-buffer org-clock-marker)
   9946       (with-current-buffer (marker-buffer org-clock-marker)
   9947 	(org-with-wide-buffer
   9948 	 (goto-char org-clock-marker)
   9949 	 (org-back-to-heading t)
   9950 	 (move-marker marker (point))
   9951 	 (org-clock-out)
   9952 	 (setq newhead (org-get-heading)))))
   9953     (org-agenda-change-all-lines newhead marker)
   9954     (move-marker marker nil)
   9955     (org-move-to-column col)
   9956     (org-agenda-unmark-clocking-task)))
   9957 
   9958 (defun org-agenda-clock-cancel (&optional _arg)
   9959   "Cancel the currently running clock."
   9960   (interactive) ;; "P"
   9961   (unless (marker-buffer org-clock-marker)
   9962     (user-error "No running clock"))
   9963   (org-with-remote-undo (marker-buffer org-clock-marker)
   9964     (org-clock-cancel)))
   9965 
   9966 (defun org-agenda-clock-goto ()
   9967   "Jump to the currently clocked in task within the agenda.
   9968 If the currently clocked in task is not listed in the agenda
   9969 buffer, display it in another window."
   9970   (interactive)
   9971   (let (pos)
   9972     (mapc (lambda (o)
   9973 	    (when (eq (overlay-get o 'type) 'org-agenda-clocking)
   9974 	      (setq pos (overlay-start o))))
   9975 	  (overlays-in (point-min) (point-max)))
   9976     (cond (pos (goto-char pos))
   9977 	  ;; If the currently clocked entry is not in the agenda
   9978 	  ;; buffer, we visit it in another window:
   9979 	  ((bound-and-true-p org-clock-current-task)
   9980 	   (org-switch-to-buffer-other-window (org-clock-goto)))
   9981 	  (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
   9982 
   9983 (defun org-agenda-diary-entry-in-org-file ()
   9984   "Make a diary entry in the file `org-agenda-diary-file'."
   9985   (let (d1 d2 char (text "") dp1 dp2)
   9986     (if (equal (buffer-name) "*Calendar*")
   9987 	(setq d1 (calendar-cursor-to-date t)
   9988 	      d2 (car calendar-mark-ring))
   9989       (setq dp1 (get-text-property (point-at-bol) 'day))
   9990       (unless dp1 (user-error "No date defined in current line"))
   9991       (setq d1 (calendar-gregorian-from-absolute dp1)
   9992 	    d2 (and (ignore-errors (mark))
   9993 		    (save-excursion
   9994 		      (goto-char (mark))
   9995 		      (setq dp2 (get-text-property (point-at-bol) 'day)))
   9996 		    (calendar-gregorian-from-absolute dp2))))
   9997     (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree")
   9998     (setq char (read-char-exclusive))
   9999     (cond
  10000      ((equal char ?d)
  10001       (setq text (read-string "Day entry: "))
  10002       (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1)
  10003       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
  10004      ((equal char ?a)
  10005       (setq d1 (list (car d1) (nth 1 d1)
  10006 		     (read-number (format "Reference year [%d]: " (nth 2 d1))
  10007 				  (nth 2 d1))))
  10008       (setq text (read-string "Anniversary (use %d to show years): "))
  10009       (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1)
  10010       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
  10011      ((equal char ?b)
  10012       (setq text (read-string "Block entry: "))
  10013       (unless (and d1 d2 (not (equal d1 d2)))
  10014 	(user-error "No block of days selected"))
  10015       (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2)
  10016       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
  10017      ((equal char ?j)
  10018       (org-switch-to-buffer-other-window
  10019        (find-file-noselect org-agenda-diary-file))
  10020       (require 'org-datetree)
  10021       (org-datetree-find-date-create d1)
  10022       (org-reveal t))
  10023      (t (user-error "Invalid selection character `%c'" char)))))
  10024 
  10025 (defcustom org-agenda-insert-diary-strategy 'date-tree
  10026   "Where in `org-agenda-diary-file' should new entries be added?
  10027 Valid values:
  10028 
  10029 date-tree         in the date tree, as first child of the date
  10030 date-tree-last    in the date tree, as last child of the date
  10031 top-level         as top-level entries at the end of the file."
  10032   :group 'org-agenda
  10033   :type '(choice
  10034 	  (const :tag "first in a date tree" date-tree)
  10035 	  (const :tag "last in a date tree" date-tree-last)
  10036 	  (const :tag "as top level at end of file" top-level)))
  10037 
  10038 (defcustom org-agenda-insert-diary-extract-time nil
  10039   "Non-nil means extract any time specification from the diary entry."
  10040   :group 'org-agenda
  10041   :version "24.1"
  10042   :type 'boolean)
  10043 
  10044 (defcustom org-agenda-bulk-mark-char ">"
  10045   "A single-character string to be used as the bulk mark."
  10046   :group 'org-agenda
  10047   :version "24.1"
  10048   :type 'string)
  10049 
  10050 (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
  10051   "Add a diary entry with TYPE to `org-agenda-diary-file'.
  10052 If TEXT is not empty, it will become the headline of the new entry, and
  10053 the resulting entry will not be shown.  When TEXT is empty, switch to
  10054 `org-agenda-diary-file' and let the user finish the entry there."
  10055   (let ((cw (current-window-configuration)))
  10056     (org-switch-to-buffer-other-window
  10057      (find-file-noselect org-agenda-diary-file))
  10058     (widen)
  10059     (goto-char (point-min))
  10060     (cl-case type
  10061       (anniversary
  10062        (or (re-search-forward "^\\*[ \t]+Anniversaries" nil t)
  10063 	   (progn
  10064 	     (or (org-at-heading-p t)
  10065 		 (progn
  10066 		   (outline-next-heading)
  10067 		   (insert "* Anniversaries\n\n")
  10068 		   (beginning-of-line -1)))))
  10069        (outline-next-heading)
  10070        (org-back-over-empty-lines)
  10071        (backward-char 1)
  10072        (insert "\n")
  10073        (insert (format "%%%%(org-anniversary %d %2d %2d) %s"
  10074 		       (nth 2 d1) (car d1) (nth 1 d1) text)))
  10075       (day
  10076        (let ((org-prefix-has-time t)
  10077 	     (org-agenda-time-leading-zero t)
  10078 	     fmt time time2)
  10079 	 (when org-agenda-insert-diary-extract-time
  10080 	   ;; Use org-agenda-format-item to parse text for a time-range and
  10081 	   ;; remove it.  FIXME: This is a hack, we should refactor
  10082 	   ;; that function to make time extraction available separately
  10083 	   (setq fmt (org-agenda-format-item nil text nil nil nil t)
  10084 		 time (get-text-property 0 'time fmt)
  10085 		 time2 (if (> (length time) 0)
  10086 			   ;; split-string removes trailing ...... if
  10087 			   ;; no end time given.  First space
  10088 			   ;; separates time from date.
  10089 			   (concat " " (car (split-string time "\\.")))
  10090 			 nil)
  10091 		 text (get-text-property 0 'txt fmt)))
  10092 	 (if (eq org-agenda-insert-diary-strategy 'top-level)
  10093 	     (org-agenda-insert-diary-as-top-level text)
  10094 	   (require 'org-datetree)
  10095 	   (org-datetree-find-date-create d1)
  10096 	   (org-agenda-insert-diary-make-new-entry text))
  10097 	 (org-insert-time-stamp (org-time-from-absolute
  10098 				 (calendar-absolute-from-gregorian d1))
  10099 				nil nil nil nil time2))
  10100        (end-of-line 0))
  10101       ((block) ;; Wrap this in (strictly unnecessary) parens because
  10102        ;; otherwise the indentation gets confused by the
  10103        ;; special meaning of 'block
  10104        (when (> (calendar-absolute-from-gregorian d1)
  10105 		(calendar-absolute-from-gregorian d2))
  10106 	 (setq d1 (prog1 d2 (setq d2 d1))))
  10107        (if (eq org-agenda-insert-diary-strategy 'top-level)
  10108 	   (org-agenda-insert-diary-as-top-level text)
  10109 	 (require 'org-datetree)
  10110 	 (org-datetree-find-date-create d1)
  10111 	 (org-agenda-insert-diary-make-new-entry text))
  10112        (org-insert-time-stamp (org-time-from-absolute
  10113 			       (calendar-absolute-from-gregorian d1)))
  10114        (insert "--")
  10115        (org-insert-time-stamp (org-time-from-absolute
  10116 			       (calendar-absolute-from-gregorian d2)))
  10117        (end-of-line 0)))
  10118     (if (string-match "\\S-" text)
  10119 	(progn
  10120 	  (set-window-configuration cw)
  10121 	  (message "%s entry added to %s"
  10122 		   (capitalize (symbol-name type))
  10123 		   (abbreviate-file-name org-agenda-diary-file)))
  10124       (org-reveal t)
  10125       (message "Please finish entry here"))))
  10126 
  10127 (defun org-agenda-insert-diary-as-top-level (text)
  10128   "Make new entry as a top-level entry at the end of the file.
  10129 Add TEXT as headline, and position the cursor in the second line so that
  10130 a timestamp can be added there."
  10131   (widen)
  10132   (goto-char (point-max))
  10133   (unless (bolp) (insert "\n"))
  10134   (org-insert-heading nil t t)
  10135   (insert text)
  10136   (org-end-of-meta-data)
  10137   (unless (bolp) (insert "\n"))
  10138   (when org-adapt-indentation (indent-to-column 2)))
  10139 
  10140 (defun org-agenda-insert-diary-make-new-entry (text)
  10141   "Make a new entry with TEXT as a child of the current subtree.
  10142 Position the point in the heading's first body line so that
  10143 a timestamp can be added there."
  10144   (cond
  10145    ((eq org-agenda-insert-diary-strategy 'date-tree-last)
  10146     (end-of-line)
  10147     (org-insert-heading '(4) t)
  10148     (org-do-demote))
  10149    (t
  10150     (outline-next-heading)
  10151     (org-back-over-empty-lines)
  10152     (unless (looking-at "[ \t]*$") (save-excursion (insert "\n")))
  10153     (org-insert-heading nil t)
  10154     (org-do-demote)))
  10155   (let ((col (current-column)))
  10156     (insert text)
  10157     (org-end-of-meta-data)
  10158     ;; Ensure point is left on a blank line, at proper indentation.
  10159     (unless (bolp) (insert "\n"))
  10160     (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
  10161     (when org-adapt-indentation (indent-to-column col)))
  10162   (org-show-set-visibility 'lineage))
  10163 
  10164 (defun org-agenda-diary-entry ()
  10165   "Make a diary entry, like the `i' command from the calendar.
  10166 All the standard commands work: block, weekly etc.
  10167 When `org-agenda-diary-file' points to a file,
  10168 `org-agenda-diary-entry-in-org-file' is called instead to create
  10169 entries in that Org file."
  10170   (interactive)
  10171   (if (not (eq org-agenda-diary-file 'diary-file))
  10172       (org-agenda-diary-entry-in-org-file)
  10173     (require 'diary-lib)
  10174     (let* ((char (read-char-exclusive
  10175 		  "Diary entry: [d]ay [w]eekly [m]onthly [y]early\
  10176  [a]nniversary [b]lock [c]yclic"))
  10177 	   (cmd (cdr (assoc char
  10178 			    '((?d . diary-insert-entry)
  10179 			      (?w . diary-insert-weekly-entry)
  10180 			      (?m . diary-insert-monthly-entry)
  10181 			      (?y . diary-insert-yearly-entry)
  10182 			      (?a . diary-insert-anniversary-entry)
  10183 			      (?b . diary-insert-block-entry)
  10184 			      (?c . diary-insert-cyclic-entry)))))
  10185 	   (oldf (symbol-function 'calendar-cursor-to-date))
  10186 	   ;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
  10187 	   (point (point))
  10188 	   (mark (or (mark t) (point))))
  10189       (unless cmd
  10190 	(user-error "No command associated with <%c>" char))
  10191       (unless (and (get-text-property point 'day)
  10192 		   (or (not (equal ?b char))
  10193 		       (get-text-property mark 'day)))
  10194 	(user-error "Don't know which date to use for diary entry"))
  10195       ;; We implement this by hacking the `calendar-cursor-to-date' function
  10196       ;; and the `calendar-mark-ring' variable.  Saves a lot of code.
  10197       (let ((calendar-mark-ring
  10198 	     (list (calendar-gregorian-from-absolute
  10199 		    (or (get-text-property mark 'day)
  10200 			(get-text-property point 'day))))))
  10201 	(unwind-protect
  10202 	    (progn
  10203 	      (fset 'calendar-cursor-to-date
  10204 		    (lambda (&optional _error _dummy)
  10205 		      (calendar-gregorian-from-absolute
  10206 		       (get-text-property point 'day))))
  10207 	      (call-interactively cmd))
  10208 	  (fset 'calendar-cursor-to-date oldf))))))
  10209 
  10210 (defun org-agenda-execute-calendar-command (cmd)
  10211   "Execute a calendar command from the agenda with date from cursor."
  10212   (org-agenda-check-type t 'agenda)
  10213   (require 'diary-lib)
  10214   (unless (get-text-property (min (1- (point-max)) (point)) 'day)
  10215     (user-error "Don't know which date to use for the calendar command"))
  10216   (let* ((oldf (symbol-function 'calendar-cursor-to-date))
  10217 	 (point (point))
  10218 	 (date (calendar-gregorian-from-absolute
  10219 		(get-text-property point 'day))))
  10220     ;; the following 2 vars are needed in the calendar
  10221     (org-dlet
  10222 	((displayed-month (car date))
  10223 	 (displayed-year (nth 2 date)))
  10224       (unwind-protect
  10225 	  (progn
  10226 	    (fset 'calendar-cursor-to-date
  10227 		  (lambda (&optional _error _dummy)
  10228 		    (calendar-gregorian-from-absolute
  10229 		     (get-text-property point 'day))))
  10230 	    (call-interactively cmd))
  10231 	(fset 'calendar-cursor-to-date oldf)))))
  10232 
  10233 (defun org-agenda-phases-of-moon ()
  10234   "Display the phases of the moon for the 3 months around the cursor date."
  10235   (interactive)
  10236   (org-agenda-execute-calendar-command 'calendar-lunar-phases))
  10237 
  10238 (defun org-agenda-holidays ()
  10239   "Display the holidays for the 3 months around the cursor date."
  10240   (interactive)
  10241   (org-agenda-execute-calendar-command 'calendar-list-holidays))
  10242 
  10243 (defvar calendar-longitude)      ; defined in calendar.el
  10244 (defvar calendar-latitude)       ; defined in calendar.el
  10245 (defvar calendar-location-name)  ; defined in calendar.el
  10246 
  10247 (defun org-agenda-sunrise-sunset (arg)
  10248   "Display sunrise and sunset for the cursor date.
  10249 Latitude and longitude can be specified with the variables
  10250 `calendar-latitude' and `calendar-longitude'.  When called with prefix
  10251 argument, latitude and longitude will be prompted for."
  10252   (interactive "P")
  10253   (require 'solar)
  10254   (let ((calendar-longitude (if arg nil calendar-longitude))
  10255 	(calendar-latitude  (if arg nil calendar-latitude))
  10256 	(calendar-location-name
  10257 	 (if arg "the given coordinates" calendar-location-name)))
  10258     (org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
  10259 
  10260 (defun org-agenda-goto-calendar ()
  10261   "Open the Emacs calendar with the date at the cursor."
  10262   (interactive)
  10263   (org-agenda-check-type t 'agenda)
  10264   (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
  10265 		  (user-error "Don't know which date to open in calendar")))
  10266 	 (date (calendar-gregorian-from-absolute day))
  10267 	 (calendar-move-hook nil)
  10268 	 (calendar-view-holidays-initially-flag nil)
  10269 	 (calendar-view-diary-initially-flag nil))
  10270     (calendar)
  10271     (calendar-goto-date date)))
  10272 
  10273 ;;;###autoload
  10274 (defun org-calendar-goto-agenda ()
  10275   "Compute the Org agenda for the calendar date displayed at the cursor.
  10276 This is a command that has to be installed in `calendar-mode-map'."
  10277   (interactive)
  10278   ;; Temporarily disable sticky agenda since user clearly wants to
  10279   ;; refresh view anyway.
  10280   (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*")
  10281 	(org-agenda-sticky nil))
  10282     (org-agenda-list nil (calendar-absolute-from-gregorian
  10283 			  (calendar-cursor-to-date))
  10284 		     nil)))
  10285 
  10286 (defun org-agenda-convert-date ()
  10287   (interactive)
  10288   (org-agenda-check-type t 'agenda)
  10289   (let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
  10290 	date s)
  10291     (unless day
  10292       (user-error "Don't know which date to convert"))
  10293     (setq date (calendar-gregorian-from-absolute day))
  10294     (setq s (concat
  10295 	     "Gregorian:  " (calendar-date-string date) "\n"
  10296 	     "ISO:        " (calendar-iso-date-string date) "\n"
  10297 	     "Day of Yr:  " (calendar-day-of-year-string date) "\n"
  10298 	     "Julian:     " (calendar-julian-date-string date) "\n"
  10299 	     "Astron. JD: " (calendar-astro-date-string date)
  10300 	     " (Julian date number at noon UTC)\n"
  10301 	     "Hebrew:     " (calendar-hebrew-date-string date) " (until sunset)\n"
  10302 	     "Islamic:    " (calendar-islamic-date-string date) " (until sunset)\n"
  10303 	     "French:     " (calendar-french-date-string date) "\n"
  10304 	     "Bahá’í:     " (calendar-bahai-date-string date) " (until sunset)\n"
  10305 	     "Mayan:      " (calendar-mayan-date-string date) "\n"
  10306 	     "Coptic:     " (calendar-coptic-date-string date) "\n"
  10307 	     "Ethiopic:   " (calendar-ethiopic-date-string date) "\n"
  10308 	     "Persian:    " (calendar-persian-date-string date) "\n"
  10309 	     "Chinese:    " (calendar-chinese-date-string date) "\n"))
  10310     (with-output-to-temp-buffer "*Dates*"
  10311       (princ s))
  10312     (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
  10313 
  10314 ;;; Bulk commands
  10315 
  10316 (defun org-agenda-bulk-marked-p ()
  10317   "Non-nil when current entry is marked for bulk action."
  10318   (eq (get-char-property (point-at-bol) 'type)
  10319       'org-marked-entry-overlay))
  10320 
  10321 (defun org-agenda-bulk-mark (&optional arg)
  10322   "Mark entries for future bulk action.
  10323 
  10324 When ARG is nil or one and region is not active then mark the
  10325 entry at point.
  10326 
  10327 When ARG is nil or one and region is active then mark the entries
  10328 in the region.
  10329 
  10330 When ARG is greater than one mark ARG lines."
  10331   (interactive "p")
  10332   (when (and (or (not arg) (= arg 1)) (use-region-p))
  10333     (setq arg (count-lines (region-beginning) (region-end)))
  10334     (goto-char (region-beginning))
  10335     (deactivate-mark))
  10336   (dotimes (_ (or arg 1))
  10337     (unless (org-get-at-bol 'org-agenda-diary-link)
  10338       (let* ((m (org-get-at-bol 'org-hd-marker))
  10339 	     ov)
  10340 	(unless (org-agenda-bulk-marked-p)
  10341 	  (unless m (user-error "Nothing to mark at point"))
  10342 	  (push m org-agenda-bulk-marked-entries)
  10343 	  (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol))))
  10344 	  (org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
  10345 			       (org-get-todo-face "TODO")
  10346 			       'evaporate)
  10347 	  (overlay-put ov 'type 'org-marked-entry-overlay))
  10348 	(end-of-line 1)
  10349 	(or (ignore-errors
  10350 	      (goto-char (next-single-property-change (point) 'org-hd-marker)))
  10351 	    (beginning-of-line 2))
  10352 	(while (and (get-char-property (point) 'invisible) (not (eobp)))
  10353 	  (beginning-of-line 2)))))
  10354   (message "%d entries marked for bulk action"
  10355 	   (length org-agenda-bulk-marked-entries)))
  10356 
  10357 (defun org-agenda-bulk-mark-all ()
  10358   "Mark all entries for future agenda bulk action."
  10359   (interactive)
  10360   (org-agenda-bulk-mark-regexp "."))
  10361 
  10362 (defun org-agenda-bulk-mark-regexp (regexp)
  10363   "Mark entries matching REGEXP for future agenda bulk action."
  10364   (interactive "sMark entries matching regexp: ")
  10365   (let ((entries-marked 0) txt-at-point)
  10366     (save-excursion
  10367       (goto-char (point-min))
  10368       (goto-char (next-single-property-change (point) 'org-hd-marker))
  10369       (while (and (re-search-forward regexp nil t)
  10370 		  (setq txt-at-point
  10371 			(get-text-property (match-beginning 0) 'txt)))
  10372 	(if (get-char-property (point) 'invisible)
  10373 	    (beginning-of-line 2)
  10374 	  (when (string-match-p regexp txt-at-point)
  10375 	    (setq entries-marked (1+ entries-marked))
  10376 	    (call-interactively 'org-agenda-bulk-mark)))))
  10377     (unless entries-marked
  10378       (message "No entry matching this regexp."))))
  10379 
  10380 (defun org-agenda-bulk-unmark (&optional arg)
  10381   "Unmark the entry at point for future bulk action."
  10382   (interactive "P")
  10383   (if arg
  10384       (org-agenda-bulk-unmark-all)
  10385     (cond ((org-agenda-bulk-marked-p)
  10386 	   (org-agenda-bulk-remove-overlays
  10387 	    (point-at-bol) (+ 2 (point-at-bol)))
  10388 	   (setq org-agenda-bulk-marked-entries
  10389 		 (delete (org-get-at-bol 'org-hd-marker)
  10390 			 org-agenda-bulk-marked-entries))
  10391 	   (end-of-line 1)
  10392 	   (or (ignore-errors
  10393 		 (goto-char (next-single-property-change (point) 'txt)))
  10394 	       (beginning-of-line 2))
  10395 	   (while (and (get-char-property (point) 'invisible) (not (eobp)))
  10396 	     (beginning-of-line 2))
  10397 	   (message "%d entries left marked for bulk action"
  10398 		    (length org-agenda-bulk-marked-entries)))
  10399 	  (t (message "No entry to unmark here")))))
  10400 
  10401 (defun org-agenda-bulk-toggle-all ()
  10402   "Toggle all marks for bulk action."
  10403   (interactive)
  10404   (save-excursion
  10405     (goto-char (point-min))
  10406     (while (ignore-errors
  10407 	     (goto-char (next-single-property-change (point) 'org-hd-marker)))
  10408       (org-agenda-bulk-toggle))))
  10409 
  10410 (defun org-agenda-bulk-toggle ()
  10411   "Toggle the mark at point for bulk action."
  10412   (interactive)
  10413   (if (org-agenda-bulk-marked-p)
  10414       (org-agenda-bulk-unmark)
  10415     (org-agenda-bulk-mark)))
  10416 
  10417 (defun org-agenda-bulk-remove-overlays (&optional beg end)
  10418   "Remove the mark overlays between BEG and END in the agenda buffer.
  10419 BEG and END default to the buffer limits.
  10420 
  10421 This only removes the overlays, it does not remove the markers
  10422 from the list in `org-agenda-bulk-marked-entries'."
  10423   (interactive)
  10424   (mapc (lambda (ov)
  10425 	  (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay)
  10426 	       (delete-overlay ov)))
  10427 	(overlays-in (or beg (point-min)) (or end (point-max)))))
  10428 
  10429 (defun org-agenda-bulk-unmark-all ()
  10430   "Remove all marks in the agenda buffer.
  10431 This will remove the markers and the overlays."
  10432   (interactive)
  10433   (if (null org-agenda-bulk-marked-entries)
  10434       (message "No entry to unmark")
  10435     (setq org-agenda-bulk-marked-entries nil)
  10436     (org-agenda-bulk-remove-overlays (point-min) (point-max))))
  10437 
  10438 (defcustom org-agenda-persistent-marks nil
  10439   "Non-nil means marked items will stay marked after a bulk action.
  10440 You can toggle this interactively by typing `p' when prompted for a
  10441 bulk action."
  10442   :group 'org-agenda
  10443   :version "24.1"
  10444   :type 'boolean)
  10445 
  10446 (defcustom org-agenda-loop-over-headlines-in-active-region t
  10447   "Shall some commands act upon headlines in the active region?
  10448 
  10449 When set to t, some commands will be performed in all headlines
  10450 within the active region.
  10451 
  10452 When set to `start-level', some commands will be performed in all
  10453 headlines within the active region, provided that these headlines
  10454 are of the same level than the first one.
  10455 
  10456 When set to a regular expression, those commands will be
  10457 performed on the matching headlines within the active region.
  10458 
  10459 The list of commands is: `org-agenda-schedule',
  10460 `org-agenda-deadline', `org-agenda-date-prompt',
  10461 `org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'.
  10462 
  10463 See `org-loop-over-headlines-in-active-region' for the equivalent
  10464 option for Org buffers."
  10465   :type '(choice (const :tag "Don't loop" nil)
  10466 		 (const :tag "All headlines in active region" t)
  10467 		 (const :tag "In active region, headlines at the same level than the first one" start-level)
  10468 		 (regexp :tag "Regular expression matcher"))
  10469   :version "27.1"
  10470   :package-version '(Org . "9.4")
  10471   :group 'org-agenda)
  10472 
  10473 (defun org-agenda-bulk-action (&optional arg)
  10474   "Execute an remote-editing action on all marked entries.
  10475 The prefix arg is passed through to the command if possible."
  10476   (interactive "P")
  10477   ;; When there is no mark, act on the agenda entry at point.
  10478   (if (not org-agenda-bulk-marked-entries)
  10479       (save-excursion (org-agenda-bulk-mark)))
  10480   (dolist (m org-agenda-bulk-marked-entries)
  10481     (unless (and (markerp m)
  10482 		 (marker-buffer m)
  10483 		 (buffer-live-p (marker-buffer m))
  10484 		 (marker-position m))
  10485       (user-error "Marker %s for bulk command is invalid" m)))
  10486 
  10487   ;; Prompt for the bulk command.
  10488   (org-unlogged-message
  10489    (concat "Bulk (" (if org-agenda-persistent-marks "" "don't ") "[p]ersist marks): "
  10490 	   "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
  10491 	   "[S]catter [f]unction    "
  10492 	   (and org-agenda-bulk-custom-functions
  10493 		(format " Custom: [%s]"
  10494 			(mapconcat (lambda (f) (char-to-string (car f)))
  10495 				   org-agenda-bulk-custom-functions
  10496 				   "")))))
  10497   (catch 'exit
  10498     (let* ((org-log-refile (if org-log-refile 'time nil))
  10499 	   (entries (reverse org-agenda-bulk-marked-entries))
  10500 	   (org-overriding-default-time
  10501 	    (and (get-text-property (point) 'org-agenda-date-header)
  10502 		 (org-get-cursor-date)))
  10503 	   redo-at-end
  10504 	   cmd)
  10505       (pcase (read-char-exclusive)
  10506 	(?p
  10507 	 (let ((org-agenda-persistent-marks
  10508 		(not org-agenda-persistent-marks)))
  10509 	   (org-agenda-bulk-action)
  10510 	   (throw 'exit nil)))
  10511 
  10512 	(?$
  10513 	 (setq cmd #'org-agenda-archive))
  10514 
  10515 	(?A
  10516 	 (setq cmd #'org-agenda-archive-to-archive-sibling))
  10517 
  10518 	((or ?r ?w)
  10519 	 (let ((refile-location
  10520 		(org-refile-get-location
  10521 		 "Refile to"
  10522 		 (marker-buffer (car entries))
  10523 		 org-refile-allow-creating-parent-nodes)))
  10524 	   (when (nth 3 refile-location)
  10525 	     (setcar (nthcdr 3 refile-location)
  10526 		     (move-marker
  10527 		      (make-marker)
  10528 		      (nth 3 refile-location)
  10529 		      (or (get-file-buffer (nth 1 refile-location))
  10530 			  (find-buffer-visiting (nth 1 refile-location))
  10531 			  (error "This should not happen")))))
  10532 
  10533 	   (setq cmd (lambda () (org-agenda-refile nil refile-location t)))
  10534 	   (setq redo-at-end t)))
  10535 
  10536 	(?t
  10537 	 (let ((state (completing-read
  10538 		       "Todo state: "
  10539 		       (with-current-buffer (marker-buffer (car entries))
  10540 			 (mapcar #'list org-todo-keywords-1)))))
  10541 	   (setq cmd (lambda ()
  10542 		       (let ((org-inhibit-blocking t)
  10543 			     (org-inhibit-logging 'note))
  10544 			 (org-agenda-todo state))))))
  10545 
  10546 	((and (or ?- ?+) action)
  10547 	 (let ((tag (completing-read
  10548 		     (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
  10549 		     (with-current-buffer (marker-buffer (car entries))
  10550 		       (delq nil
  10551 			     (mapcar (lambda (x) (and (stringp (car x)) x))
  10552 				     org-current-tag-alist))))))
  10553 	   (setq cmd
  10554 		 (lambda ()
  10555 		   (org-agenda-set-tags tag
  10556 					(if (eq action ?+) 'on 'off))))))
  10557 
  10558 	((and (or ?s ?d) c)
  10559 	 (let* ((schedule? (eq c ?s))
  10560 		(prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to"))
  10561 		(time
  10562 		 (and (not arg)
  10563 		      (let ((new (org-read-date
  10564 				  nil nil nil prompt org-overriding-default-time)))
  10565 			;; A "double plus" answer applies to every
  10566 			;; scheduled time.  Do not turn it into
  10567 			;; a fixed date yet.
  10568 			(if (string-match-p "\\`[ \t]*\\+\\+"
  10569 					    org-read-date-final-answer)
  10570 			    org-read-date-final-answer
  10571 			  new)))))
  10572 	   ;; Make sure to not prompt for a note when bulk
  10573 	   ;; rescheduling/resetting deadline as Org cannot cope with
  10574 	   ;; simultaneous notes.  Besides, it could be annoying
  10575 	   ;; depending on the number of marked items.
  10576 	   (setq cmd
  10577 		 (if schedule?
  10578 		     (lambda ()
  10579 		       (let ((org-log-reschedule
  10580 			      (and org-log-reschedule 'time)))
  10581 			 (org-agenda-schedule arg time)))
  10582 		   (lambda ()
  10583 		     (let ((org-log-redeadline (and org-log-redeadline 'time)))
  10584 		       (org-agenda-deadline arg time)))))))
  10585 
  10586 	(?S
  10587 	 (unless (org-agenda-check-type nil 'agenda 'todo)
  10588 	   (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type))
  10589 	 (let ((days (read-number
  10590 		      (format "Scatter tasks across how many %sdays: "
  10591 			      (if arg "week" ""))
  10592 		      7)))
  10593 	   (setq cmd
  10594 		 (lambda ()
  10595 		   (let ((distance (1+ (random days))))
  10596 		     (when arg
  10597 		       (let ((dist distance)
  10598 			     (day-of-week
  10599 			      (calendar-day-of-week
  10600 			       (calendar-gregorian-from-absolute (org-today)))))
  10601 			 (dotimes (_ (1+ dist))
  10602 			   (while (member day-of-week org-agenda-weekend-days)
  10603 			     (cl-incf distance)
  10604 			     (cl-incf day-of-week)
  10605 			     (when (= day-of-week 7)
  10606 			       (setq day-of-week 0)))
  10607 			   (cl-incf day-of-week)
  10608 			   (when (= day-of-week 7)
  10609 			     (setq day-of-week 0)))))
  10610 		     ;; Silently fail when try to replan a sexp entry.
  10611 		     (ignore-errors
  10612 		       (let* ((date (calendar-gregorian-from-absolute
  10613 				     (+ (org-today) distance)))
  10614 			      (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
  10615 						 (nth 2 date))))
  10616 			 (org-agenda-schedule nil time))))))))
  10617 
  10618 	(?f
  10619 	 (setq cmd
  10620 	       (intern
  10621 		(completing-read "Function: " obarray #'fboundp t nil nil))))
  10622 
  10623 	(action
  10624          (setq cmd
  10625                (pcase (assoc action org-agenda-bulk-custom-functions)
  10626                  (`(,_ ,fn)
  10627                   fn)
  10628                  (`(,_ ,fn ,arg-fn)
  10629                   (apply #'apply-partially fn (funcall arg-fn)))
  10630                  (_
  10631                   (user-error "Invalid bulk action: %c" action))))
  10632          (setq redo-at-end t)))
  10633       ;; Sort the markers, to make sure that parents are handled
  10634       ;; before children.
  10635       (setq entries (sort entries
  10636 			  (lambda (a b)
  10637 			    (cond
  10638 			     ((eq (marker-buffer a) (marker-buffer b))
  10639 			      (< (marker-position a) (marker-position b)))
  10640 			     (t
  10641 			      (string< (buffer-name (marker-buffer a))
  10642 				       (buffer-name (marker-buffer b))))))))
  10643 
  10644       ;; Now loop over all markers and apply CMD.
  10645       (let ((processed 0)
  10646 	    (skipped 0))
  10647 	(dolist (e entries)
  10648 	  (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
  10649 	    (if (not pos)
  10650 		(progn (message "Skipping removed entry at %s" e)
  10651 		       (cl-incf skipped))
  10652 	      (goto-char pos)
  10653 	      (let (org-loop-over-headlines-in-active-region) (funcall cmd))
  10654 	      ;; `post-command-hook' is not run yet.  We make sure any
  10655 	      ;; pending log note is processed.
  10656 	      (when org-log-setup (org-add-log-note))
  10657 	      (cl-incf processed))))
  10658 	(when redo-at-end (org-agenda-redo))
  10659 	(unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
  10660 	(message "Acted on %d entries%s%s"
  10661 		 processed
  10662 		 (if (= skipped 0)
  10663 		     ""
  10664 		   (format ", skipped %d (disappeared before their turn)"
  10665 			   skipped))
  10666 		 (if (not org-agenda-persistent-marks) "" " (kept marked)"))))))
  10667 
  10668 (defun org-agenda-capture (&optional with-time)
  10669   "Call `org-capture' with the date at point.
  10670 With a `C-1' prefix, use the HH:MM value at point (if any) or the
  10671 current HH:MM time."
  10672   (interactive "P")
  10673   (if (not (eq major-mode 'org-agenda-mode))
  10674       (user-error "You cannot do this outside of agenda buffers")
  10675     (let ((org-overriding-default-time
  10676 	   (org-get-cursor-date (equal with-time 1))))
  10677       (call-interactively 'org-capture))))
  10678 
  10679 ;;; Dragging agenda lines forward/backward
  10680 
  10681 (defun org-agenda-reapply-filters ()
  10682   "Re-apply all agenda filters."
  10683   (mapcar
  10684    (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
  10685    `((,org-agenda-tag-filter tag)
  10686      (,org-agenda-category-filter category)
  10687      (,org-agenda-regexp-filter regexp)
  10688      (,org-agenda-effort-filter effort)
  10689      (,(get 'org-agenda-tag-filter :preset-filter) tag)
  10690      (,(get 'org-agenda-category-filter :preset-filter) category)
  10691      (,(get 'org-agenda-effort-filter :preset-filter) effort)
  10692      (,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
  10693 
  10694 (defun org-agenda-drag-line-forward (arg &optional backward)
  10695   "Drag an agenda line forward by ARG lines.
  10696 When the optional argument `backward' is non-nil, move backward."
  10697   (interactive "p")
  10698   (let ((inhibit-read-only t) lst line)
  10699     (if (or (not (get-text-property (point) 'txt))
  10700 	    (save-excursion
  10701 	      (dotimes (_ arg)
  10702 		(move-beginning-of-line (if backward 0 2))
  10703 		(push (not (get-text-property (point) 'txt)) lst))
  10704 	      (delq nil lst)))
  10705 	(message "Cannot move line forward")
  10706       (let ((end (save-excursion (move-beginning-of-line 2) (point))))
  10707 	(move-beginning-of-line 1)
  10708 	(setq line (buffer-substring (point) end))
  10709 	(delete-region (point) end)
  10710 	(move-beginning-of-line (funcall (if backward '1- '1+) arg))
  10711 	(insert line)
  10712 	(org-agenda-reapply-filters)
  10713 	(org-agenda-mark-clocking-task)
  10714 	(move-beginning-of-line 0)))))
  10715 
  10716 (defun org-agenda-drag-line-backward (arg)
  10717   "Drag an agenda line backward by ARG lines."
  10718   (interactive "p")
  10719   (org-agenda-drag-line-forward arg t))
  10720 
  10721 ;;; Flagging notes
  10722 
  10723 (defun org-agenda-show-the-flagging-note ()
  10724   "Display the flagging note in the other window.
  10725 When called a second time in direct sequence, offer to remove the FLAGGING
  10726 tag and (if present) the flagging note."
  10727   (interactive)
  10728   (let ((hdmarker (org-get-at-bol 'org-hd-marker))
  10729 	(win (selected-window))
  10730 	note) ;; heading newhead
  10731     (unless hdmarker
  10732       (user-error "No linked entry at point"))
  10733     (if (and (eq this-command last-command)
  10734 	     (y-or-n-p "Unflag and remove any flagging note? "))
  10735 	(progn
  10736 	  (org-agenda-remove-flag hdmarker)
  10737 	  (let ((win (get-buffer-window "*Flagging Note*")))
  10738 	    (and win (delete-window win)))
  10739 	  (message "Entry unflagged"))
  10740       (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
  10741       (unless note
  10742 	(user-error "No flagging note"))
  10743       (org-kill-new note)
  10744       (org-switch-to-buffer-other-window "*Flagging Note*")
  10745       (erase-buffer)
  10746       (insert note)
  10747       (goto-char (point-min))
  10748       (while (re-search-forward "\\\\n" nil t)
  10749 	(replace-match "\n" t t))
  10750       (goto-char (point-min))
  10751       (select-window win)
  10752       (message "%s" (substitute-command-keys "Flagging note pushed to \
  10753 kill ring.  Press `\\[org-agenda-show-the-flagging-note]' again to remove \
  10754 tag and note")))))
  10755 
  10756 (defun org-agenda-remove-flag (marker)
  10757   "Remove the FLAGGED tag and any flagging note in the entry."
  10758   (let ((newhead
  10759          (org-with-point-at marker
  10760            (org-toggle-tag "FLAGGED" 'off)
  10761            (org-entry-delete nil "THEFLAGGINGNOTE")
  10762            (org-get-heading))))
  10763     (org-agenda-change-all-lines newhead marker)
  10764     (message "Entry unflagged")))
  10765 
  10766 (defun org-agenda-get-any-marker (&optional pos)
  10767   (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker)
  10768       (get-text-property (or pos (point-at-bol)) 'org-marker)))
  10769 
  10770 ;;; Appointment reminders
  10771 
  10772 (defvar appt-time-msg-list) ; defined in appt.el
  10773 
  10774 ;;;###autoload
  10775 (defun org-agenda-to-appt (&optional refresh filter &rest args)
  10776   "Activate appointments found in `org-agenda-files'.
  10777 
  10778 With a `\\[universal-argument]' prefix, refresh the list of \
  10779 appointments.
  10780 
  10781 If FILTER is t, interactively prompt the user for a regular
  10782 expression, and filter out entries that don't match it.
  10783 
  10784 If FILTER is a string, use this string as a regular expression
  10785 for filtering entries out.
  10786 
  10787 If FILTER is a function, filter out entries against which
  10788 calling the function returns nil.  This function takes one
  10789 argument: an entry from `org-agenda-get-day-entries'.
  10790 
  10791 FILTER can also be an alist with the car of each cell being
  10792 either `headline' or `category'.  For example:
  10793 
  10794   \\='((headline \"IMPORTANT\")
  10795     (category \"Work\"))
  10796 
  10797 will only add headlines containing IMPORTANT or headlines
  10798 belonging to the \"Work\" category.
  10799 
  10800 ARGS are symbols indicating what kind of entries to consider.
  10801 By default `org-agenda-to-appt' will use :deadline*, :scheduled*
  10802 \(i.e., deadlines and scheduled items with a hh:mm specification)
  10803 and :timestamp entries.  See the docstring of `org-diary' for
  10804 details and examples.
  10805 
  10806 If an entry has a APPT_WARNTIME property, its value will be used
  10807 to override `appt-message-warning-time'."
  10808   (interactive "P")
  10809   (when refresh (setq appt-time-msg-list nil))
  10810   (when (eq filter t)
  10811     (setq filter (read-from-minibuffer "Regexp filter: ")))
  10812   (let* ((cnt 0)                        ; count added events
  10813          (scope (or args '(:deadline* :scheduled* :timestamp)))
  10814          (org-agenda-new-buffers nil)
  10815          (org-deadline-warning-days 0)
  10816          ;; Do not use `org-today' here because appt only takes
  10817          ;; time and without date as argument, so it may pass wrong
  10818          ;; information otherwise
  10819          (today (org-date-to-gregorian
  10820                  (time-to-days nil)))
  10821          (org-agenda-restrict nil)
  10822          (files (org-agenda-files 'unrestricted)) entries file
  10823          (org-agenda-buffer nil))
  10824     ;; Get all entries which may contain an appt
  10825     (org-agenda-prepare-buffers files)
  10826     (while (setq file (pop files))
  10827       (setq entries
  10828             (delq nil
  10829                   (append entries
  10830                           (apply #'org-agenda-get-day-entries
  10831                                  file today scope)))))
  10832     ;; Map through entries and find if we should filter them out
  10833     (mapc
  10834      (lambda (x)
  10835        (let* ((evt (org-trim
  10836                     (replace-regexp-in-string
  10837                      org-link-bracket-re "\\2"
  10838                      (or (get-text-property 1 'txt x) ""))))
  10839               (cat (get-text-property (1- (length x)) 'org-category x))
  10840               (tod (get-text-property 1 'time-of-day x))
  10841               (ok (or (null filter)
  10842                       (and (stringp filter) (string-match filter evt))
  10843                       (and (functionp filter) (funcall filter x))
  10844                       (and (listp filter)
  10845                            (let ((cat-filter (cadr (assq 'category filter)))
  10846                                  (evt-filter (cadr (assq 'headline filter))))
  10847                              (or (and (stringp cat-filter)
  10848                                       (string-match cat-filter cat))
  10849                                  (and (stringp evt-filter)
  10850                                       (string-match evt-filter evt)))))))
  10851               (wrn (get-text-property 1 'warntime x)))
  10852          ;; FIXME: Shall we remove text-properties for the appt text?
  10853          ;; (setq evt (set-text-properties 0 (length evt) nil evt))
  10854          (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt)))
  10855            (setq tod (concat "00" (number-to-string tod)))
  10856            (setq tod (when (string-match
  10857                             "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
  10858                        (concat (match-string 1 tod) ":"
  10859                                (match-string 2 tod))))
  10860            (when (appt-add tod evt wrn)
  10861              (setq cnt (1+ cnt))))))
  10862      entries)
  10863     (org-release-buffers org-agenda-new-buffers)
  10864     (if (eq cnt 0)
  10865         (message "No event to add")
  10866       (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
  10867 
  10868 (defun org-agenda-today-p (date)
  10869   "Non-nil when DATE means today.
  10870 DATE is either a list of the form (month day year) or a number of
  10871 days as returned by `calendar-absolute-from-gregorian' or
  10872 `org-today'.  This function considers `org-extend-today-until'
  10873 when defining today."
  10874   (eq (org-today)
  10875       (if (consp date) (calendar-absolute-from-gregorian date) date)))
  10876 
  10877 (defun org-agenda-todo-yesterday (&optional arg)
  10878   "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
  10879   (interactive "P")
  10880   (let* ((org-use-effective-time t)
  10881 	 (hour (nth 2 (decode-time (org-current-time))))
  10882          (org-extend-today-until (1+ hour)))
  10883     (org-agenda-todo arg)))
  10884 
  10885 (defun org-agenda-ctrl-c-ctrl-c ()
  10886   "Set tags in agenda buffer."
  10887   (interactive)
  10888   (org-agenda-set-tags))
  10889 
  10890 (provide 'org-agenda)
  10891 
  10892 ;;; org-agenda.el ends here