dotemacs

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

org-agenda.el (460551B)


      1 ;;; org-agenda.el --- Dynamic task and appointment lists for Org  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2004-2023 Free Software Foundation, Inc.
      4 
      5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
      6 ;; Keywords: outlines, hypermedia, calendar, wp
      7 ;; URL: 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 'org-macs)
     49 (org-assert-version)
     50 
     51 (require 'cl-lib)
     52 (require 'ol)
     53 (require 'org-fold-core)
     54 (require 'org)
     55 (require 'org-macs)
     56 (require 'org-refile)
     57 
     58 (declare-function diary-add-to-list "diary-lib"
     59                   (date string specifier &optional marker globcolor literal))
     60 (declare-function calendar-iso-to-absolute      "cal-iso"    (date))
     61 (declare-function calendar-astro-date-string    "cal-julian" (&optional date))
     62 (declare-function calendar-bahai-date-string    "cal-bahai"  (&optional date))
     63 (declare-function calendar-chinese-date-string  "cal-china"  (&optional date))
     64 (declare-function calendar-coptic-date-string   "cal-coptic" (&optional date))
     65 (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date))
     66 (declare-function calendar-french-date-string   "cal-french" (&optional date))
     67 (declare-function calendar-goto-date            "cal-move"   (date))
     68 (declare-function calendar-hebrew-date-string   "cal-hebrew" (&optional date))
     69 (declare-function calendar-islamic-date-string  "cal-islam"  (&optional date))
     70 (declare-function calendar-iso-date-string      "cal-iso"    (&optional date))
     71 (declare-function calendar-iso-from-absolute    "cal-iso"    (date))
     72 (declare-function calendar-julian-date-string   "cal-julian" (&optional date))
     73 (declare-function calendar-mayan-date-string    "cal-mayan"  (&optional date))
     74 (declare-function calendar-persian-date-string  "cal-persia" (&optional date))
     75 (declare-function calendar-check-holidays       "holidays" (date))
     76 
     77 (declare-function org-columns-remove-overlays "org-colview" ())
     78 (declare-function org-datetree-find-date-create "org-datetree"
     79 		  (date &optional keep-restriction))
     80 (declare-function org-columns-quit              "org-colview" ())
     81 (declare-function diary-date-display-form       "diary-lib"  (&optional type))
     82 (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
     83 (declare-function org-element-property "org-element" (property element))
     84 (declare-function org-element--cache-active-p "org-element"
     85                   (&optional called-from-cache-change-func-p))
     86 (declare-function org-element-lineage "org-element"
     87                   (datum &optional types with-self))
     88 (declare-function org-habit-insert-consistency-graphs
     89 		  "org-habit" (&optional line))
     90 (declare-function org-is-habit-p "org-habit" (&optional pom))
     91 (declare-function org-habit-parse-todo "org-habit" (&optional pom))
     92 (declare-function org-habit-get-priority "org-habit" (habit &optional moment))
     93 (declare-function org-agenda-columns "org-colview" ())
     94 (declare-function org-add-archive-files "org-archive" (files))
     95 (declare-function org-capture "org-capture" (&optional goto keys))
     96 (declare-function org-clock-modify-effort-estimate "org-clock" (&optional value))
     97 
     98 (declare-function org-element-type "org-element" (&optional element))
     99 
    100 (defvar calendar-mode-map)
    101 (defvar org-clock-current-task)
    102 (defvar org-current-tag-alist)
    103 (defvar org-mobile-force-id-on-agenda-items)
    104 (defvar org-habit-show-habits)
    105 (defvar org-habit-show-habits-only-for-today)
    106 (defvar org-habit-show-all-today)
    107 (defvar org-habit-scheduled-past-days)
    108 
    109 ;; Defined somewhere in this file, but used before definition.
    110 (defvar org-agenda-buffer-name "*Org Agenda*")
    111 (defvar org-agenda-title-append nil)
    112 (defvar org-agenda-overriding-header)
    113 ;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
    114 ;; (with-no-warnings (defvar date))  ;; unprefixed, from calendar.el
    115 (defvar original-date) ; dynamically scoped, calendar.el does scope this
    116 
    117 (defvar org-agenda-undo-list nil
    118   "List of undoable operations in the agenda since last refresh.")
    119 (defvar org-agenda-pending-undo-list nil
    120   "In a series of undo commands, this is the list of remaining undo items.")
    121 
    122 (defcustom org-agenda-confirm-kill 1
    123   "When set, remote killing from the agenda buffer needs confirmation.
    124 When t, a confirmation is always needed.  When a number N, confirmation is
    125 only needed when the text to be killed contains more than N non-white lines."
    126   :group 'org-agenda
    127   :type '(choice
    128 	  (const :tag "Never" nil)
    129 	  (const :tag "Always" t)
    130 	  (integer :tag "When more than N lines")))
    131 
    132 (defcustom org-agenda-compact-blocks nil
    133   "Non-nil means make the block agenda more compact.
    134 This is done globally by leaving out lines like the agenda span
    135 name and week number or the separator lines."
    136   :group 'org-agenda
    137   :type 'boolean)
    138 
    139 (defcustom org-agenda-block-separator
    140   (if (and (display-graphic-p)
    141            (char-displayable-p ?─))
    142       ?─
    143     ?=)
    144   "The separator between blocks in the agenda.
    145 If this is a string, it will be used as the separator, with a newline added.
    146 If it is a character, it will be repeated to fill the window width.
    147 If nil the separator is disabled.  In `org-agenda-custom-commands' this
    148 addresses the separator between the current and the previous block."
    149   :group 'org-agenda
    150   :package-version '(Org . "9.6")
    151   :type '(choice
    152 	  (const :tag "Disabled" nil)
    153 	  (character)
    154 	  (string)))
    155 
    156 (defgroup org-agenda-export nil
    157   "Options concerning exporting agenda views in Org mode."
    158   :tag "Org Agenda Export"
    159   :group 'org-agenda)
    160 
    161 (defcustom org-agenda-with-colors t
    162   "Non-nil means use colors in agenda views."
    163   :group 'org-agenda-export
    164   :type 'boolean)
    165 
    166 (defcustom org-agenda-exporter-settings nil
    167   ;; FIXME: Do we really want to evaluate those settings and thus force
    168   ;; the user to use `quote' all the time?
    169   "Alist of variable/value pairs that should be active during agenda export.
    170 This is a good place to set options for ps-print and for htmlize.
    171 Note that the way this is implemented, the values will be evaluated
    172 before assigned to the variables.  So make sure to quote values you do
    173 *not* want evaluated, for example
    174 
    175    (setq org-agenda-exporter-settings
    176          \\='((ps-print-color-p \\='black-white)))"
    177   :group 'org-agenda-export
    178   :type '(repeat
    179 	  (list
    180 	   (variable)
    181 	   (sexp :tag "Value"))))
    182 
    183 (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text)
    184   "Hook run in a temporary buffer before writing the agenda to an export file.
    185 A useful function for this hook is `org-agenda-add-entry-text'."
    186   :group 'org-agenda-export
    187   :type 'hook
    188   :options '(org-agenda-add-entry-text))
    189 
    190 (defcustom org-agenda-add-entry-text-maxlines 0
    191   "Maximum number of entry text lines to be added to agenda.
    192 This is only relevant when `org-agenda-add-entry-text' is part of
    193 `org-agenda-before-write-hook', which is the default.
    194 When this is 0, nothing will happen.  When it is greater than 0, it
    195 specifies the maximum number of lines that will be added for each entry
    196 that is listed in the agenda view.
    197 
    198 Note that this variable is not used during display, only when exporting
    199 the agenda.  For agenda display, see the variables `org-agenda-entry-text-mode'
    200 and `org-agenda-entry-text-maxlines'."
    201   :group 'org-agenda
    202   :type 'integer)
    203 
    204 (defcustom org-agenda-add-entry-text-descriptive-links t
    205   "Non-nil means export org-links as descriptive links in agenda added text.
    206 This variable applies to the text added to the agenda when
    207 `org-agenda-add-entry-text-maxlines' is larger than 0.
    208 When this variable is nil, the URL will (also) be shown."
    209   :group 'org-agenda
    210   :type 'boolean)
    211 
    212 (defcustom org-agenda-export-html-style nil
    213   "The style specification for exported HTML Agenda files.
    214 If this variable contains a string, it will replace the default <style>
    215 section as produced by `htmlize'.
    216 Since there are different ways of setting style information, this variable
    217 needs to contain the full HTML structure to provide a style, including the
    218 surrounding HTML tags.  The style specifications should include definitions
    219 the fonts used by the agenda, here is an example:
    220 
    221    <style type=\"text/css\">
    222        p { font-weight: normal; color: gray; }
    223        .org-agenda-structure {
    224           font-size: 110%;
    225           color: #003399;
    226           font-weight: 600;
    227        }
    228        .org-todo {
    229           color: #cc6666;
    230           font-weight: bold;
    231        }
    232        .org-agenda-done {
    233           color: #339933;
    234        }
    235        .org-done {
    236           color: #339933;
    237        }
    238        .title { text-align: center; }
    239        .todo, .deadline { color: red; }
    240        .done { color: green; }
    241     </style>
    242 
    243 or, if you want to keep the style in a file,
    244 
    245    <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
    246 
    247 As the value of this option simply gets inserted into the HTML <head> header,
    248 you can \"misuse\" it to also add other text to the header."
    249   :group 'org-agenda-export
    250   :group 'org-export-html
    251   :type '(choice
    252 	  (const nil)
    253 	  (string)))
    254 
    255 (defcustom org-agenda-persistent-filter nil
    256   "When set, keep filters from one agenda view to the next."
    257   :group 'org-agenda
    258   :type 'boolean)
    259 
    260 (defgroup org-agenda-custom-commands nil
    261   "Options concerning agenda views in Org mode."
    262   :tag "Org Agenda Custom Commands"
    263   :group 'org-agenda)
    264 
    265 (defconst org-sorting-choice
    266   '(choice
    267     (const time-up) (const time-down)
    268     (const timestamp-up) (const timestamp-down)
    269     (const scheduled-up) (const scheduled-down)
    270     (const deadline-up)  (const deadline-down)
    271     (const ts-up) (const ts-down)
    272     (const tsia-up) (const tsia-down)
    273     (const category-keep) (const category-up) (const category-down)
    274     (const tag-down) (const tag-up)
    275     (const priority-up) (const priority-down)
    276     (const todo-state-up) (const todo-state-down)
    277     (const effort-up) (const effort-down)
    278     (const habit-up) (const habit-down)
    279     (const alpha-up) (const alpha-down)
    280     (const user-defined-up) (const user-defined-down))
    281   "Sorting choices.")
    282 
    283 ;; Keep custom values for `org-agenda-filter-preset' compatible with
    284 ;; the new variable `org-agenda-tag-filter-preset'.
    285 (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
    286 (defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
    287 
    288 (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
    289   "List of types searched for when creating the daily/weekly agenda.
    290 This variable is a list of symbols that controls the types of
    291 items that appear in the daily/weekly agenda.  Allowed symbols in this
    292 list are
    293 
    294   :timestamp   List items containing a date stamp or date range matching
    295                the selected date.  This includes sexp entries in angular
    296                brackets.
    297 
    298   :sexp        List entries resulting from plain diary-like sexps.
    299 
    300   :deadline    List deadline due on that date.  When the date is today,
    301                also list any deadlines past due, or due within
    302 	       `org-deadline-warning-days'.
    303 
    304   :deadline*   Same as above, but only include the deadline if it has an
    305                hour specification as [h]h:mm.
    306 
    307   :scheduled   List all items which are scheduled for the given date.
    308 	       The diary for *today* also contains items which were
    309 	       scheduled earlier and are not yet marked DONE.
    310 
    311   :scheduled*  Same as above, but only include the scheduled item if it
    312                has an hour specification as [h]h:mm.
    313 
    314 By default, all four non-starred types are turned on.
    315 
    316 When :scheduled* or :deadline* are included, :schedule or :deadline
    317 will be ignored.
    318 
    319 Never set this variable globally using `setq', because then it
    320 will apply to all future agenda commands.  Instead, bind it with
    321 `let' to scope it dynamically into the agenda-constructing
    322 command.  A good way to set it is through options in
    323 `org-agenda-custom-commands'.  For a more flexible (though
    324 somewhat less efficient) way of determining what is included in
    325 the daily/weekly agenda, see `org-agenda-skip-function'.")
    326 
    327 (defconst org-agenda-custom-commands-local-options
    328   `(repeat :tag "Local settings for this command.  Remember to quote values"
    329 	   (choice :tag "Setting"
    330 		   (list :tag "Heading for this block"
    331 			 (const org-agenda-overriding-header)
    332 			 (string :tag "Headline"))
    333 		   (list :tag "Files to be searched"
    334 			 (const org-agenda-files)
    335 			 (list
    336 			  (const :format "" quote)
    337 			  (repeat (file))))
    338 		   (list :tag "Sorting strategy"
    339 			 (const org-agenda-sorting-strategy)
    340 			 (list
    341 			  (const :format "" quote)
    342 			  (repeat
    343 			   ,org-sorting-choice)))
    344 		   (list :tag "Prefix format"
    345 			 (const org-agenda-prefix-format :value "  %-12:c%?-12t% s")
    346 			 (string))
    347 		   (list :tag "Number of days in agenda"
    348 			 (const org-agenda-span)
    349 			 (list
    350 			  (const :format "" quote)
    351 			  (choice (const :tag "Day" day)
    352 				  (const :tag "Week" week)
    353 				  (const :tag "Fortnight" fortnight)
    354 				  (const :tag "Month" month)
    355 				  (const :tag "Year" year)
    356 				  (integer :tag "Custom"))))
    357 		   (list :tag "Fixed starting date"
    358 			 (const org-agenda-start-day)
    359 			 (string :value "2007-11-01"))
    360 		   (list :tag "Start on day of week"
    361 			 (const org-agenda-start-on-weekday)
    362 			 (choice :value 1
    363 				 (const :tag "Today" nil)
    364 				 (integer :tag "Weekday No.")))
    365 		   (list :tag "Include data from diary"
    366 			 (const org-agenda-include-diary)
    367 			 (boolean))
    368 		   (list :tag "Deadline Warning days"
    369 			 (const org-deadline-warning-days)
    370 			 (integer :value 1))
    371 		   (list :tag "Category filter preset"
    372 			 (const org-agenda-category-filter-preset)
    373 			 (list
    374 			  (const :format "" quote)
    375 			  (repeat
    376 			   (string :tag "+category or -category"))))
    377 		   (list :tag "Tags filter preset"
    378 			 (const org-agenda-tag-filter-preset)
    379 			 (list
    380 			  (const :format "" quote)
    381 			  (repeat
    382 			   (string :tag "+tag or -tag"))))
    383 		   (list :tag "Effort filter preset"
    384 			 (const org-agenda-effort-filter-preset)
    385 			 (list
    386 			  (const :format "" quote)
    387 			  (repeat
    388 			   (string :tag "+=10 or -=10 or +<10 or ->10"))))
    389 		   (list :tag "Regexp filter preset"
    390 			 (const org-agenda-regexp-filter-preset)
    391 			 (list
    392 			  (const :format "" quote)
    393 			  (repeat
    394 			   (string :tag "+regexp or -regexp"))))
    395 		   (list :tag "Set daily/weekly entry types"
    396 			 (const org-agenda-entry-types)
    397 			 (list
    398 			  (const :format "" quote)
    399 			  (set :greedy t :value ,org-agenda-entry-types
    400 			       (const :deadline)
    401 			       (const :scheduled)
    402 			       (const :deadline*)
    403 			       (const :scheduled*)
    404 			       (const :timestamp)
    405 			       (const :sexp))))
    406 		   (list :tag "Columns format"
    407 			 (const org-overriding-columns-format)
    408 			 (string :tag "Format"))
    409 		   (list :tag "Standard skipping condition"
    410 			 :value (org-agenda-skip-function '(org-agenda-skip-entry-if))
    411 			 (const org-agenda-skip-function)
    412 			 (list
    413 			  (const :format "" quote)
    414 			  (list
    415 			   (choice
    416 			    :tag "Skipping range"
    417 			    (const :tag "Skip entry" org-agenda-skip-entry-if)
    418 			    (const :tag "Skip subtree" org-agenda-skip-subtree-if))
    419 			   (repeat :inline t :tag "Conditions for skipping"
    420 				   (choice
    421 				    :tag "Condition type"
    422 				    (list :tag "Regexp matches" :inline t
    423 					  (const :format "" regexp)
    424 					  (regexp))
    425 				    (list :tag "Regexp does not match" :inline t
    426 					  (const :format "" notregexp)
    427 					  (regexp))
    428 				    (list :tag "TODO state is" :inline t
    429 					  (const todo)
    430 					  (choice
    431 					   (const :tag "Any not-done state" todo)
    432 					   (const :tag "Any done state" done)
    433 					   (const :tag "Any state" any)
    434 					   (list :tag "Keyword list"
    435 						 (const :format "" quote)
    436 						 (repeat (string :tag "Keyword")))))
    437 				    (list :tag "TODO state is not" :inline t
    438 					  (const nottodo)
    439 					  (choice
    440 					   (const :tag "Any not-done state" todo)
    441 					   (const :tag "Any done state" done)
    442 					   (const :tag "Any state" any)
    443 					   (list :tag "Keyword list"
    444 						 (const :format "" quote)
    445 						 (repeat (string :tag "Keyword")))))
    446 				    (const :tag "scheduled" scheduled)
    447 				    (const :tag "not scheduled" notscheduled)
    448 				    (const :tag "deadline" deadline)
    449 				    (const :tag "no deadline" notdeadline)
    450 				    (const :tag "timestamp" timestamp)
    451 				    (const :tag "no timestamp" nottimestamp))))))
    452 		   (list :tag "Non-standard skipping condition"
    453 			 :value (org-agenda-skip-function)
    454 			 (const org-agenda-skip-function)
    455 			 (sexp :tag "Function or form (quoted!)"))
    456 		   (list :tag "Any variable"
    457 			 (variable :tag "Variable")
    458 			 (sexp :tag "Value (sexp)"))))
    459   "Selection of examples for agenda command settings.
    460 This will be spliced into the custom type of
    461 `org-agenda-custom-commands'.")
    462 
    463 
    464 (defcustom org-agenda-custom-commands
    465   '(("n" "Agenda and all TODOs" ((agenda "") (alltodo ""))))
    466   "Custom commands for the agenda.
    467 \\<org-mode-map>
    468 These commands will be offered on the splash screen displayed by the
    469 agenda dispatcher `\\[org-agenda]'.  Each entry is a list like this:
    470 
    471    (key desc type match settings files)
    472 
    473 key      The key (one or more characters as a string) to be associated
    474          with the command.
    475 desc     A description of the command.  When omitted or nil, a default
    476          description is built using MATCH.
    477 type     The command type, any of the following symbols:
    478           agenda      The daily/weekly agenda.
    479           agenda*     Appointments for current week/day.
    480           todo        Entries with a specific TODO keyword, in all agenda files.
    481           search      Entries containing search words entry or headline.
    482           tags        Tags/Property/TODO match in all agenda files.
    483           tags-todo   Tags/P/T match in all agenda files, TODO entries only.
    484           todo-tree   Sparse tree of specific TODO keyword in *current* file.
    485           tags-tree   Sparse tree with all tags matches in *current* file.
    486           occur-tree  Occur sparse tree for *current* file.
    487           alltodo     The global TODO list.
    488           stuck       Stuck projects.
    489           ...         A user-defined function.
    490 match    What to search for:
    491           - a single keyword for TODO keyword searches
    492           - a tags/property/todo match expression for searches
    493           - a word search expression for text searches.
    494           - a regular expression for occur searches
    495           For all other commands, this should be the empty string.
    496 settings  A list of option settings, similar to that in a let form, so like
    497           this: ((opt1 val1) (opt2 val2) ...).   The values will be
    498           evaluated at the moment of execution, so quote them when needed.
    499 files     A list of files to write the produced agenda buffer to with
    500           the command `org-store-agenda-views'.
    501           If a file name ends in \".html\", an HTML version of the buffer
    502           is written out.  If it ends in \".ps\", a PostScript version is
    503           produced.  Otherwise, only the plain text is written to the file.
    504 
    505 You can also define a set of commands, to create a composite agenda buffer.
    506 In this case, an entry looks like this:
    507 
    508   (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files)
    509 
    510 where
    511 
    512 desc   A description string to be displayed in the dispatcher menu.
    513 cmd    An agenda command, similar to the above.  However, tree commands
    514        are not allowed.  Valid commands for a set are:
    515        (agenda \"\" settings)
    516        (agenda* \"\" settings)
    517        (alltodo \"\" settings)
    518        (stuck \"\" settings)
    519        (todo \"match\" settings files)
    520        (search \"match\" settings files)
    521        (tags \"match\" settings files)
    522        (tags-todo \"match\" settings files)
    523 
    524 Each command can carry a list of options, and another set of options can be
    525 given for the whole set of commands.  Individual command options take
    526 precedence over the general options.
    527 
    528 When using several characters as key to a command, the first characters
    529 are prefix commands.  For the dispatcher to display useful information, you
    530 should provide a description for the prefix, like
    531 
    532  (setq org-agenda-custom-commands
    533    \\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
    534      (\"hl\" tags \"+HOME+Lisa\")
    535      (\"hp\" tags \"+HOME+Peter\")
    536      (\"hk\" tags \"+HOME+Kim\")))
    537 
    538 See also Info node `(org) Custom Agenda Views'."
    539   :group 'org-agenda-custom-commands
    540   :type `(repeat
    541 	  (choice :value ("x" "Describe command here" tags "" nil)
    542 		  (list :tag "Single command"
    543 			(string :tag "Access Key(s) ")
    544 			(option (string :tag "Description"))
    545 			(choice
    546 			 (const :tag "Agenda" agenda)
    547 			 (const :tag "TODO list" alltodo)
    548 			 (const :tag "Search words" search)
    549 			 (const :tag "Stuck projects" stuck)
    550 			 (const :tag "Tags/Property match (all agenda files)" tags)
    551 			 (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
    552 			 (const :tag "TODO keyword search (all agenda files)" todo)
    553 			 (const :tag "Tags sparse tree (current buffer)" tags-tree)
    554 			 (const :tag "TODO keyword tree (current buffer)" todo-tree)
    555 			 (const :tag "Occur tree (current buffer)" occur-tree)
    556 			 (sexp :tag "Other, user-defined function"))
    557 			(string :tag "Match (only for some commands)")
    558 			,org-agenda-custom-commands-local-options
    559 			(option (repeat :tag "Export" (file :tag "Export to"))))
    560 		  (list :tag "Command series, all agenda files"
    561 			(string :tag "Access Key(s)")
    562 			(string :tag "Description  ")
    563 			(repeat :tag "Component"
    564 				(choice
    565 				 (list :tag "Agenda"
    566 				       (const :format "" agenda)
    567 				       (const :tag "" :format "" "")
    568 				       ,org-agenda-custom-commands-local-options)
    569 				 (list :tag "TODO list (all keywords)"
    570 				       (const :format "" alltodo)
    571 				       (const :tag "" :format "" "")
    572 				       ,org-agenda-custom-commands-local-options)
    573 				 (list :tag "Search words"
    574 				       (const :format "" search)
    575 				       (string :tag "Match")
    576 				       ,org-agenda-custom-commands-local-options)
    577 				 (list :tag "Stuck projects"
    578 				       (const :format "" stuck)
    579 				       (const :tag "" :format "" "")
    580 				       ,org-agenda-custom-commands-local-options)
    581 				 (list :tag "Tags/Property match (all agenda files)"
    582 				       (const :format "" tags)
    583 				       (string :tag "Match")
    584 				       ,org-agenda-custom-commands-local-options)
    585 				 (list :tag "Tags/Property match of TODO entries (all agenda files)"
    586 				       (const :format "" tags-todo)
    587 				       (string :tag "Match")
    588 				       ,org-agenda-custom-commands-local-options)
    589 				 (list :tag "TODO keyword search"
    590 				       (const :format "" todo)
    591 				       (string :tag "Match")
    592 				       ,org-agenda-custom-commands-local-options)
    593 				 (list :tag "Other, user-defined function"
    594 				       (symbol :tag "function")
    595 				       (string :tag "Match")
    596 				       ,org-agenda-custom-commands-local-options)))
    597 
    598 			(repeat :tag "Settings for entire command set"
    599 				(list (variable :tag "Any variable")
    600 				      (sexp :tag "Value")))
    601 			(option (repeat :tag "Export" (file :tag "Export to"))))
    602 		  (cons :tag "Prefix key documentation"
    603 			(string :tag "Access Key(s)")
    604 			(string :tag "Description  ")))))
    605 
    606 (defcustom org-agenda-query-register ?o
    607   "The register holding the current query string.
    608 The purpose of this is that if you construct a query string interactively,
    609 you can then use it to define a custom command."
    610   :group 'org-agenda-custom-commands
    611   :type 'character)
    612 
    613 (defcustom org-stuck-projects
    614   '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
    615   "How to identify stuck projects.
    616 This is a list of four items:
    617 
    618 1. A tags/todo/property matcher string that is used to identify a project.
    619    See Info node `(org) Matching tags and properties' for a
    620    description of tag and property searches.  The entire tree
    621    below a headline matched by this is considered one project.
    622 
    623 2. A list of TODO keywords identifying non-stuck projects.
    624    If the project subtree contains any headline with one of these todo
    625    keywords, the project is considered to be not stuck.  If you specify
    626    \"*\" as a keyword, any TODO keyword will mark the project unstuck.
    627 
    628 3. A list of tags identifying non-stuck projects.
    629    If the project subtree contains any headline with one of these tags,
    630    the project is considered to be not stuck.  If you specify \"*\" as
    631    a tag, any tag will mark the project unstuck.  Note that this is about
    632    the explicit presence of a tag somewhere in the subtree, inherited
    633    tags do not count here.  If inherited tags make a project not stuck,
    634    use \"-TAG\" in the tags part of the matcher under (1.) above.
    635 
    636 4. An arbitrary regular expression matching non-stuck projects.
    637 
    638 If the project turns out to be not stuck, search continues also in the
    639 subtree to see if any of the subtasks have project status.
    640 
    641 See also the variable `org-tags-match-list-sublevels' which applies
    642 to projects matched by this search as well.
    643 
    644 After defining this variable, you may use `org-agenda-list-stuck-projects'
    645 \(bound to `\\[org-agenda] #') to produce the list."
    646   :group 'org-agenda-custom-commands
    647   :type '(list
    648 	  (string :tag "Tags/TODO match to identify a project")
    649 	  (repeat :tag "Projects are *not* stuck if they have an entry with \
    650 TODO keyword any of" (string))
    651 	  (repeat :tag "Projects are *not* stuck if they have an entry with \
    652 TAG being any of" (string))
    653 	  (regexp :tag "Projects are *not* stuck if this regexp matches inside \
    654 the subtree")))
    655 
    656 (defgroup org-agenda-skip nil
    657   "Options concerning skipping parts of agenda files."
    658   :tag "Org Agenda Skip"
    659   :group 'org-agenda)
    660 
    661 (defcustom org-agenda-skip-function-global nil
    662   "Function to be called at each match during agenda construction.
    663 If this function returns nil, the current match should not be skipped.
    664 If the function decided to skip an agenda match, is must return the
    665 buffer position from which the search should be continued.
    666 This may also be a Lisp form, which will be evaluated.
    667 
    668 This variable will be applied to every agenda match, including
    669 tags/property searches and TODO lists.  So try to make the test function
    670 do its checking as efficiently as possible.  To implement a skipping
    671 condition just for specific agenda commands, use the variable
    672 `org-agenda-skip-function' which can be set in the options section
    673 of custom agenda commands."
    674   :group 'org-agenda-skip
    675   :type 'sexp)
    676 
    677 (defgroup org-agenda-daily/weekly nil
    678   "Options concerning the daily/weekly agenda."
    679   :tag "Org Agenda Daily/Weekly"
    680   :group 'org-agenda)
    681 (defgroup org-agenda-todo-list nil
    682   "Options concerning the global todo list agenda view."
    683   :tag "Org Agenda Todo List"
    684   :group 'org-agenda)
    685 (defgroup org-agenda-match-view nil
    686   "Options concerning the general tags/property/todo match agenda view."
    687   :tag "Org Agenda Match View"
    688   :group 'org-agenda)
    689 (defgroup org-agenda-search-view nil
    690   "Options concerning the search agenda view."
    691   :tag "Org Agenda Search View"
    692   :group 'org-agenda)
    693 
    694 (defvar org-agenda-archives-mode nil
    695   "Non-nil means the agenda will include archived items.
    696 If this is the symbol `trees', trees in the selected agenda scope
    697 that are marked with the ARCHIVE tag will be included anyway.  When this is
    698 t, also all archive files associated with the current selection of agenda
    699 files will be included.")
    700 
    701 (defcustom org-agenda-restriction-lock-highlight-subtree t
    702   "Non-nil means highlight the whole subtree when restriction is active.
    703 Otherwise only highlight the headline.  Highlighting the whole subtree is
    704 useful to ensure no edits happen beyond the restricted region."
    705   :group 'org-agenda
    706   :type 'boolean)
    707 
    708 (defcustom org-agenda-skip-comment-trees t
    709   "Non-nil means skip trees that start with the COMMENT keyword.
    710 When nil, these trees are also scanned by agenda commands."
    711   :group 'org-agenda-skip
    712   :type 'boolean)
    713 
    714 (defcustom org-agenda-todo-list-sublevels t
    715   "Non-nil means check also the sublevels of a TODO entry for TODO entries.
    716 When nil, the sublevels of a TODO entry are not checked, resulting in
    717 potentially much shorter TODO lists."
    718   :group 'org-agenda-skip
    719   :group 'org-agenda-todo-list
    720   :type 'boolean)
    721 
    722 (defcustom org-agenda-todo-ignore-with-date nil
    723   "Non-nil means don't show entries with a date in the global todo list.
    724 You can use this if you prefer to mark mere appointments with a TODO keyword,
    725 but don't want them to show up in the TODO list.
    726 When this is set, it also covers deadlines and scheduled items, the settings
    727 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
    728 will be ignored.
    729 See also the variable `org-agenda-tags-todo-honor-ignore-options'."
    730   :group 'org-agenda-skip
    731   :group 'org-agenda-todo-list
    732   :type 'boolean)
    733 
    734 (defcustom org-agenda-todo-ignore-timestamp nil
    735   "Non-nil means don't show entries with a timestamp.
    736 This applies when creating the global todo list.
    737 Valid values are:
    738 
    739 past     Don't show entries for today or in the past.
    740 
    741 future   Don't show entries with a timestamp in the future.
    742          The idea behind this is that if it has a future
    743          timestamp, you don't want to think about it until the
    744          date.
    745 
    746 all      Don't show any entries with a timestamp in the global todo list.
    747          The idea behind this is that by setting a timestamp, you
    748          have already \"taken care\" of this item.
    749 
    750 This variable can also have an integer as a value.  If positive (N),
    751 todos with a timestamp N or more days in the future will be ignored.  If
    752 negative (-N), todos with a timestamp N or more days in the past will be
    753 ignored.  If 0, todos with a timestamp either today or in the future will
    754 be ignored.  For example, a value of -1 will exclude todos with a
    755 timestamp in the past (yesterday or earlier), while a value of 7 will
    756 exclude todos with a timestamp a week or more in the future.
    757 
    758 See also `org-agenda-todo-ignore-with-date'.
    759 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
    760 to make his option also apply to the tags-todo list."
    761   :group 'org-agenda-skip
    762   :group 'org-agenda-todo-list
    763   :version "24.1"
    764   :type '(choice
    765 	  (const :tag "Ignore future timestamp todos" future)
    766 	  (const :tag "Ignore past or present timestamp todos" past)
    767 	  (const :tag "Ignore all timestamp todos" all)
    768 	  (const :tag "Show timestamp todos" nil)
    769 	  (integer :tag "Ignore if N or more days in past(-) or future(+).")))
    770 
    771 (defcustom org-agenda-todo-ignore-scheduled nil
    772   "Non-nil means, ignore some scheduled TODO items when making TODO list.
    773 This applies when creating the global todo list.
    774 Valid values are:
    775 
    776 past     Don't show entries scheduled today or in the past.
    777 
    778 future   Don't show entries scheduled in the future.
    779          The idea behind this is that by scheduling it, you don't want to
    780          think about it until the scheduled date.
    781 
    782 all      Don't show any scheduled entries in the global todo list.
    783          The idea behind this is that by scheduling it, you have already
    784          \"taken care\" of this item.
    785 
    786 t        Same as `all', for backward compatibility.
    787 
    788 This variable can also have an integer as a value.  See
    789 `org-agenda-todo-ignore-timestamp' for more details.
    790 
    791 See also `org-agenda-todo-ignore-with-date'.
    792 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
    793 to make his option also apply to the tags-todo list."
    794   :group 'org-agenda-skip
    795   :group 'org-agenda-todo-list
    796   :type '(choice
    797 	  (const :tag "Ignore future-scheduled todos" future)
    798 	  (const :tag "Ignore past- or present-scheduled todos" past)
    799 	  (const :tag "Ignore all scheduled todos" all)
    800 	  (const :tag "Ignore all scheduled todos (compatibility)" t)
    801 	  (const :tag "Show scheduled todos" nil)
    802 	  (integer :tag "Ignore if N or more days in past(-) or future(+).")))
    803 
    804 (defcustom org-agenda-todo-ignore-deadlines nil
    805   "Non-nil means ignore some deadline TODO items when making TODO list.
    806 
    807 There are different motivations for using different values, please think
    808 carefully when configuring this variable.
    809 
    810 This applies when creating the global TODO list.
    811 
    812 Valid values are:
    813 
    814 near    Don't show near deadline entries.  A deadline is near when it is
    815         closer than `org-deadline-warning-days' days.  The idea behind this
    816         is that such items will appear in the agenda anyway.
    817 
    818 far     Don't show TODO entries where a deadline has been defined, but
    819         is not going to happen anytime soon.  This is useful if you want to use
    820         the TODO list to figure out what to do now.
    821 
    822 past    Don't show entries with a deadline timestamp for today or in the past.
    823 
    824 future  Don't show entries with a deadline timestamp in the future, not even
    825         when they become `near' ones.  Use it with caution.
    826 
    827 all     Ignore all TODO entries that do have a deadline.
    828 
    829 t       Same as `near', for backward compatibility.
    830 
    831 This variable can also have an integer as a value.  See
    832 `org-agenda-todo-ignore-timestamp' for more details.
    833 
    834 See also `org-agenda-todo-ignore-with-date'.
    835 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
    836 to make his option also apply to the tags-todo list."
    837   :group 'org-agenda-skip
    838   :group 'org-agenda-todo-list
    839   :type '(choice
    840 	  (const :tag "Ignore near deadlines" near)
    841 	  (const :tag "Ignore near deadlines (compatibility)" t)
    842 	  (const :tag "Ignore far deadlines" far)
    843 	  (const :tag "Ignore all TODOs with a deadlines" all)
    844 	  (const :tag "Show all TODOs, even if they have a deadline" nil)
    845 	  (integer :tag "Ignore if N or more days in past(-) or future(+).")))
    846 
    847 (defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil
    848   "Time unit to use when possibly ignoring an agenda item.
    849 
    850 See the docstring of various `org-agenda-todo-ignore-*' options.
    851 The default is to compare time stamps using days.  An item is thus
    852 considered to be in the future if it is at least one day after today.
    853 Non-nil means to compare time stamps using seconds.  An item is then
    854 considered future if it has a time value later than current time."
    855   :group 'org-agenda-skip
    856   :group 'org-agenda-todo-list
    857   :version "24.4"
    858   :package-version '(Org . "8.0")
    859   :type '(choice
    860 	  (const :tag "Compare time with days" nil)
    861 	  (const :tag "Compare time with seconds" t)))
    862 
    863 (defcustom org-agenda-tags-todo-honor-ignore-options nil
    864   "Non-nil means honor todo-list ignores options also in tags-todo search.
    865 The variables
    866    `org-agenda-todo-ignore-with-date',
    867    `org-agenda-todo-ignore-timestamp',
    868    `org-agenda-todo-ignore-scheduled',
    869    `org-agenda-todo-ignore-deadlines'
    870 make the global TODO list skip entries that have time stamps of certain
    871 kinds.  If this option is set, the same options will also apply for the
    872 tags-todo search, which is the general tags/property matcher
    873 restricted to unfinished TODO entries only."
    874   :group 'org-agenda-skip
    875   :group 'org-agenda-todo-list
    876   :group 'org-agenda-match-view
    877   :type 'boolean)
    878 
    879 (defcustom org-agenda-skip-scheduled-if-done nil
    880   "Non-nil means don't show scheduled items in agenda when they are done.
    881 This is relevant for the daily/weekly agenda, not for the TODO list.  It
    882 applies only to the actual date of the scheduling.  Warnings about an item
    883 with a past scheduling dates are always turned off when the item is DONE."
    884   :group 'org-agenda-skip
    885   :group 'org-agenda-daily/weekly
    886   :type 'boolean)
    887 
    888 (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil
    889   "Non-nil means skip scheduling line if same entry shows because of deadline.
    890 
    891 In the agenda of today, an entry can show up multiple times
    892 because it is both scheduled and has a nearby deadline, and maybe
    893 a plain time stamp as well.
    894 
    895 When this variable is nil, the entry will be shown several times.
    896 
    897 When set to t, then only the deadline is shown and the fact that
    898 the entry is scheduled today or was scheduled previously is not
    899 shown.
    900 
    901 When set to the symbol `not-today', skip scheduled previously,
    902 but not scheduled today.
    903 
    904 When set to the symbol `repeated-after-deadline', skip scheduled
    905 items if they are repeated beyond the current deadline."
    906   :group 'org-agenda-skip
    907   :group 'org-agenda-daily/weekly
    908   :type '(choice
    909 	  (const :tag "Never" nil)
    910 	  (const :tag "Always" t)
    911 	  (const :tag "Not when scheduled today" not-today)
    912 	  (const :tag "When repeated past deadline" repeated-after-deadline)))
    913 
    914 (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
    915   "Non-nil means skip timestamp line if same entry shows because of deadline.
    916 In the agenda of today, an entry can show up multiple times
    917 because it has both a plain timestamp and has a nearby deadline.
    918 When this variable is t, then only the deadline is shown and the
    919 fact that the entry has a timestamp for or including today is not
    920 shown.  When this variable is nil, the entry will be shown
    921 several times."
    922   :group 'org-agenda-skip
    923   :group 'org-agenda-daily/weekly
    924   :version "24.1"
    925   :type '(choice
    926 	  (const :tag "Never" nil)
    927 	  (const :tag "Always" t)))
    928 
    929 (defcustom org-agenda-skip-deadline-if-done nil
    930   "Non-nil means don't show deadlines when the corresponding item is done.
    931 When nil, the deadline is still shown and should give you a happy feeling.
    932 This is relevant for the daily/weekly agenda.  It applies only to the
    933 actual date of the deadline.  Warnings about approaching and past-due
    934 deadlines are always turned off when the item is DONE."
    935   :group 'org-agenda-skip
    936   :group 'org-agenda-daily/weekly
    937   :type 'boolean)
    938 
    939 (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil
    940   "Non-nil means skip deadline prewarning when entry is also scheduled.
    941 This will apply on all days where a prewarning for the deadline would
    942 be shown, but not at the day when the entry is actually due.  On that day,
    943 the deadline will be shown anyway.
    944 This variable may be set to nil, t, the symbol `pre-scheduled',
    945 or a number which will then give the number of days before the actual
    946 deadline when the prewarnings should resume.  The symbol `pre-scheduled'
    947 eliminates the deadline prewarning only prior to the scheduled date.
    948 This can be used in a workflow where the first showing of the deadline will
    949 trigger you to schedule it, and then you don't want to be reminded of it
    950 because you will take care of it on the day when scheduled."
    951   :group 'org-agenda-skip
    952   :group 'org-agenda-daily/weekly
    953   :version "24.1"
    954   :type '(choice
    955 	  (const :tag "Always show prewarning" nil)
    956 	  (const :tag "Remove prewarning prior to scheduled date" pre-scheduled)
    957 	  (const :tag "Remove prewarning if entry is scheduled" t)
    958 	  (integer :tag "Restart prewarning N days before deadline")))
    959 
    960 (defcustom org-agenda-skip-scheduled-delay-if-deadline nil
    961   "Non-nil means skip scheduled delay when entry also has a deadline.
    962 This variable may be set to nil, t, the symbol `post-deadline',
    963 or a number which will then give the number of days after the actual
    964 scheduled date when the delay should expire.  The symbol `post-deadline'
    965 eliminates the schedule delay when the date is posterior to the deadline."
    966   :group 'org-agenda-skip
    967   :group 'org-agenda-daily/weekly
    968   :version "24.4"
    969   :package-version '(Org . "8.0")
    970   :type '(choice
    971 	  (const :tag "Always honor delay" nil)
    972 	  (const :tag "Ignore delay if posterior to the deadline" post-deadline)
    973 	  (const :tag "Ignore delay if entry has a deadline" t)
    974 	  (integer :tag "Honor delay up until N days after the scheduled date")))
    975 
    976 (defcustom org-agenda-skip-additional-timestamps-same-entry nil
    977   "When nil, multiple same-day timestamps in entry make multiple agenda lines.
    978 When non-nil, after the search for timestamps has matched once in an
    979 entry, the rest of the entry will not be searched."
    980   :group 'org-agenda-skip
    981   :type 'boolean)
    982 
    983 (defcustom org-agenda-skip-timestamp-if-done nil
    984   "Non-nil means don't select item by timestamp or -range if it is DONE."
    985   :group 'org-agenda-skip
    986   :group 'org-agenda-daily/weekly
    987   :type 'boolean)
    988 
    989 (defcustom org-agenda-dim-blocked-tasks t
    990   "Non-nil means dim blocked tasks in the agenda display.
    991 This causes some overhead during agenda construction, but if you
    992 have turned on `org-enforce-todo-dependencies',
    993 `org-enforce-todo-checkbox-dependencies', or any other blocking
    994 mechanism, this will create useful feedback in the agenda.
    995 
    996 Instead of t, this variable can also have the value `invisible'.
    997 Then blocked tasks will be invisible and only become visible when
    998 they become unblocked.  An exemption to this behavior is when a task is
    999 blocked because of unchecked checkboxes below it.  Since checkboxes do
   1000 not show up in the agenda views, making this task invisible you remove any
   1001 trace from agenda views that there is something to do.  Therefore, a task
   1002 that is blocked because of checkboxes will never be made invisible, it
   1003 will only be dimmed."
   1004   :group 'org-agenda-daily/weekly
   1005   :group 'org-agenda-todo-list
   1006   :version "24.3"
   1007   :type '(choice
   1008 	  (const :tag "Do not dim" nil)
   1009 	  (const :tag "Dim to a gray face" t)
   1010 	  (const :tag "Make invisible" invisible)))
   1011 
   1012 (defgroup org-agenda-startup nil
   1013   "Options concerning initial settings in the Agenda in Org Mode."
   1014   :tag "Org Agenda Startup"
   1015   :group 'org-agenda)
   1016 
   1017 (defcustom org-agenda-menu-show-matcher t
   1018   "Non-nil means show the match string in the agenda dispatcher menu.
   1019 When nil, the matcher string is not shown, but is put into the help-echo
   1020 property so than moving the mouse over the command shows it.
   1021 Setting it to nil is good if matcher strings are very long and/or if
   1022 you want to use two-columns display (see `org-agenda-menu-two-columns')."
   1023   :group 'org-agenda
   1024   :version "24.1"
   1025   :type 'boolean)
   1026 
   1027 (defcustom org-agenda-menu-two-columns nil
   1028   "Non-nil means, use two columns to show custom commands in the dispatcher.
   1029 If you use this, you probably want to set `org-agenda-menu-show-matcher'
   1030 to nil."
   1031   :group 'org-agenda
   1032   :version "24.1"
   1033   :type 'boolean)
   1034 
   1035 (defcustom org-agenda-finalize-hook nil
   1036   "Hook run just before displaying an agenda buffer.
   1037 The buffer is still writable when the hook is called.
   1038 
   1039 You can modify some of the buffer substrings but you should be
   1040 extra careful not to modify the text properties of the agenda
   1041 headlines as the agenda display heavily relies on them."
   1042   :group 'org-agenda-startup
   1043   :type 'hook)
   1044 
   1045 (defcustom org-agenda-filter-hook nil
   1046   "Hook run just after filtering with `org-agenda-filter'."
   1047   :group 'org-agenda-startup
   1048   :package-version '(Org . "9.4")
   1049   :type 'hook)
   1050 
   1051 (defcustom org-agenda-mouse-1-follows-link nil
   1052   "Non-nil means mouse-1 on a link will follow the link in the agenda.
   1053 A longer mouse click will still set point.  Needs to be set
   1054 before org.el is loaded."
   1055   :group 'org-agenda-startup
   1056   :type 'boolean)
   1057 
   1058 (defcustom org-agenda-start-with-follow-mode nil
   1059   "The initial value of follow mode in a newly created agenda window."
   1060   :group 'org-agenda-startup
   1061   :type 'boolean)
   1062 
   1063 (defcustom org-agenda-follow-indirect nil
   1064   "Non-nil means `org-agenda-follow-mode' displays only the
   1065 current item's tree, in an indirect buffer."
   1066   :group 'org-agenda
   1067   :version "24.1"
   1068   :type 'boolean)
   1069 
   1070 (defcustom org-agenda-show-outline-path t
   1071   "Non-nil means show outline path in echo area after line motion.
   1072 
   1073 If set to `title', show outline path with prepended document
   1074 title.  Fallback to file name is no title is present."
   1075   :group 'org-agenda-startup
   1076   :type '(choice
   1077 	  (const :tag "Don't show outline path in agenda view." nil)
   1078 	  (const :tag "Show outline path with prepended file name." t)
   1079 	  (const :tag "Show outline path with prepended document title." title))
   1080   :package-version '(Org . "9.6"))
   1081 
   1082 (defcustom org-agenda-start-with-entry-text-mode nil
   1083   "The initial value of entry-text-mode in a newly created agenda window."
   1084   :group 'org-agenda-startup
   1085   :type 'boolean)
   1086 
   1087 (defcustom org-agenda-entry-text-maxlines 5
   1088   "Number of text lines to be added when `E' is pressed in the agenda.
   1089 
   1090 Note that this variable only used during agenda display.  To add entry text
   1091 when exporting the agenda, configure the variable
   1092 `org-agenda-add-entry-text-maxlines'."
   1093   :group 'org-agenda
   1094   :type 'integer)
   1095 
   1096 (defcustom org-agenda-entry-text-exclude-regexps nil
   1097   "List of regular expressions to clean up entry text.
   1098 The complete matches of all regular expressions in this list will be
   1099 removed from entry text before it is shown in the agenda."
   1100   :group 'org-agenda
   1101   :type '(repeat (regexp)))
   1102 
   1103 (defcustom org-agenda-entry-text-leaders "    > "
   1104   "Text prepended to the entry text in agenda buffers."
   1105   :version "24.4"
   1106   :package-version '(Org . "8.0")
   1107   :group 'org-agenda
   1108   :type 'string)
   1109 
   1110 (defvar org-agenda-entry-text-cleanup-hook nil
   1111   "Hook that is run after basic cleanup of entry text to be shown in agenda.
   1112 This cleanup is done in a temporary buffer, so the function may inspect and
   1113 change the entire buffer.
   1114 Some default stuff like drawers and scheduling/deadline dates will already
   1115 have been removed when this is called, as will any matches for regular
   1116 expressions listed in `org-agenda-entry-text-exclude-regexps'.")
   1117 
   1118 (defvar org-agenda-include-inactive-timestamps nil
   1119   "Non-nil means include inactive time stamps in agenda.
   1120 Dynamically scoped.")
   1121 
   1122 (defgroup org-agenda-windows nil
   1123   "Options concerning the windows used by the Agenda in Org Mode."
   1124   :tag "Org Agenda Windows"
   1125   :group 'org-agenda)
   1126 
   1127 (defcustom org-agenda-window-setup 'reorganize-frame
   1128   "How the agenda buffer should be displayed.
   1129 Possible values for this option are:
   1130 
   1131 current-window    Show agenda in the current window, keeping all other windows.
   1132 other-window      Use `switch-to-buffer-other-window' to display agenda.
   1133 only-window       Show agenda, deleting all other windows.
   1134 reorganize-frame  Show only two windows on the current frame, the current
   1135                   window and the agenda.
   1136 other-frame       Use `switch-to-buffer-other-frame' to display agenda.
   1137                   Also, when exiting the agenda, kill that frame.
   1138 other-tab         Use `switch-to-buffer-other-tab' to display the
   1139                   agenda, making use of the `tab-bar-mode' introduced
   1140                   in Emacs version 27.1.  Also, kill that tab when
   1141                   exiting the agenda view.
   1142 
   1143 See also the variable `org-agenda-restore-windows-after-quit'."
   1144   :group 'org-agenda-windows
   1145   :type '(choice
   1146 	  (const current-window)
   1147 	  (const other-frame)
   1148 	  (const other-tab)
   1149 	  (const other-window)
   1150 	  (const only-window)
   1151 	  (const reorganize-frame))
   1152   :package-version '(Org . "9.4"))
   1153 
   1154 (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
   1155   "The min and max height of the agenda window as a fraction of frame height.
   1156 The value of the variable is a cons cell with two numbers between 0 and 1.
   1157 It only matters if `org-agenda-window-setup' is `reorganize-frame'."
   1158   :group 'org-agenda-windows
   1159   :type '(cons (number :tag "Minimum") (number :tag "Maximum")))
   1160 
   1161 (defcustom org-agenda-restore-windows-after-quit nil
   1162   "Non-nil means restore window configuration upon exiting agenda.
   1163 Before the window configuration is changed for displaying the
   1164 agenda, the current status is recorded.  When the agenda is
   1165 exited with `q' or `x' and this option is set, the old state is
   1166 restored.  If `org-agenda-window-setup' is `other-frame' or
   1167 `other-tab', the value of this option will be ignored."
   1168   :group 'org-agenda-windows
   1169   :type 'boolean)
   1170 
   1171 (defcustom org-agenda-span 'week
   1172   "Number of days to include in overview display.
   1173 Can be day, week, month, year, or any number of days.
   1174 Custom commands can set this variable in the options section."
   1175   :group 'org-agenda-daily/weekly
   1176   :type '(choice (const :tag "Day" day)
   1177 		 (const :tag "Week" week)
   1178 		 (const :tag "Fortnight" fortnight)
   1179 		 (const :tag "Month" month)
   1180 		 (const :tag "Year" year)
   1181 		 (integer :tag "Custom")))
   1182 
   1183 (defcustom org-agenda-start-on-weekday 1
   1184   "Non-nil means start the overview always on the specified weekday.
   1185 0 denotes Sunday, 1 denotes Monday, etc.
   1186 When nil, always start on the current day.
   1187 Custom commands can set this variable in the options section."
   1188   :group 'org-agenda-daily/weekly
   1189   :type '(choice (const :tag "Today" nil)
   1190 		 (integer :tag "Weekday No.")))
   1191 
   1192 (defcustom org-agenda-show-all-dates t
   1193   "Non-nil means `org-agenda' shows every day in the selected range.
   1194 When nil, only the days which actually have entries are shown."
   1195   :group 'org-agenda-daily/weekly
   1196   :type 'boolean)
   1197 
   1198 (defcustom org-agenda-format-date 'org-agenda-format-date-aligned
   1199   "Format string for displaying dates in the agenda.
   1200 Used by the daily/weekly agenda.  This should be a format string
   1201 understood by `format-time-string', or a function returning the
   1202 formatted date as a string.  The function must take a single
   1203 argument, a calendar-style date list like (month day year)."
   1204   :group 'org-agenda-daily/weekly
   1205   :type '(choice
   1206 	  (string :tag "Format string")
   1207 	  (function :tag "Function")))
   1208 
   1209 (defun org-agenda-end-of-line ()
   1210   "Go to the end of visible line."
   1211   (interactive)
   1212   (goto-char (line-end-position)))
   1213 
   1214 (defun org-agenda-format-date-aligned (date)
   1215   "Format a DATE string for display in the daily/weekly agenda.
   1216 This function makes sure that dates are aligned for easy reading."
   1217   (require 'cal-iso)
   1218   (let* ((dayname (calendar-day-name date))
   1219 	 (day (cadr date))
   1220 	 (day-of-week (calendar-day-of-week date))
   1221 	 (month (car date))
   1222 	 (monthname (calendar-month-name month))
   1223 	 (year (nth 2 date))
   1224 	 (iso-week (org-days-to-iso-week
   1225 		    (calendar-absolute-from-gregorian date)))
   1226 	 ;; (weekyear (cond ((and (= month 1) (>= iso-week 52))
   1227 	 ;;        	  (1- year))
   1228 	 ;;        	 ((and (= month 12) (<= iso-week 1))
   1229 	 ;;        	  (1+ year))
   1230 	 ;;        	 (t year)))
   1231 	 (weekstring (if (= day-of-week 1)
   1232 			 (format " W%02d" iso-week)
   1233 		       "")))
   1234     (format "%-10s %2d %s %4d%s"
   1235 	    dayname day monthname year weekstring)))
   1236 
   1237 (defcustom org-agenda-time-leading-zero nil
   1238   "Non-nil means use leading zero for military times in agenda.
   1239 For example, 9:30am would become 09:30 rather than  9:30."
   1240   :group 'org-agenda-daily/weekly
   1241   :version "24.1"
   1242   :type 'boolean)
   1243 
   1244 (defcustom org-agenda-timegrid-use-ampm nil
   1245   "When set, show AM/PM style timestamps on the timegrid."
   1246   :group 'org-agenda
   1247   :version "24.1"
   1248   :type 'boolean)
   1249 
   1250 (defcustom org-agenda-clock-report-header nil
   1251   "Header inserted before the table in Org agenda clock report mode.
   1252 
   1253 See Info node `(org) Agenda Commands' for more details."
   1254   :group 'org-agenda
   1255   :type '(choice
   1256           (string :tag "Header")
   1257           (const :tag "No header" nil))
   1258   :safe #'stringp
   1259   :package-version '(Org . "9.6"))
   1260 
   1261 (defun org-agenda-time-of-day-to-ampm (time)
   1262   "Convert TIME of a string like \"13:45\" to an AM/PM style time string."
   1263   (let* ((hour-number (string-to-number (substring time 0 -3)))
   1264          (minute (substring time -2))
   1265          (ampm "am"))
   1266     (cond
   1267      ((equal hour-number 12)
   1268       (setq ampm "pm"))
   1269      ((> hour-number 12)
   1270       (setq ampm "pm")
   1271       (setq hour-number (- hour-number 12))))
   1272     (concat
   1273      (if org-agenda-time-leading-zero
   1274 	 (format "%02d" hour-number)
   1275        (format "%02s" (number-to-string hour-number)))
   1276      ":" minute ampm)))
   1277 
   1278 (defun org-agenda-time-of-day-to-ampm-maybe (time)
   1279   "Conditionally convert TIME to AM/PM format.
   1280 This is based on `org-agenda-timegrid-use-ampm'."
   1281   (if org-agenda-timegrid-use-ampm
   1282       (org-agenda-time-of-day-to-ampm time)
   1283     time))
   1284 
   1285 (defcustom org-agenda-weekend-days '(6 0)
   1286   "Which days are weekend?
   1287 These days get the special face `org-agenda-date-weekend' in the agenda."
   1288   :group 'org-agenda-daily/weekly
   1289   :type '(set :greedy t
   1290 	      (const :tag "Monday" 1)
   1291 	      (const :tag "Tuesday" 2)
   1292 	      (const :tag "Wednesday" 3)
   1293 	      (const :tag "Thursday" 4)
   1294 	      (const :tag "Friday" 5)
   1295 	      (const :tag "Saturday" 6)
   1296 	      (const :tag "Sunday" 0)))
   1297 
   1298 (defcustom org-agenda-move-date-from-past-immediately-to-today t
   1299   "Non-nil means jump to today when moving a past date forward in time.
   1300 When using S-right in the agenda to move a date forward, and the date
   1301 stamp currently points to the past, the first key press will move it
   1302 to today.  When nil, just move one day forward even if the date stays
   1303 in the past."
   1304   :group 'org-agenda-daily/weekly
   1305   :version "24.1"
   1306   :type 'boolean)
   1307 
   1308 (defcustom org-agenda-diary-file 'diary-file
   1309   "File to which to add new entries with the `i' key in agenda and calendar.
   1310 When this is the symbol `diary-file', the functionality in the Emacs
   1311 calendar will be used to add entries to the `diary-file'.  But when this
   1312 points to a file, `org-agenda-diary-entry' will be used instead."
   1313   :group 'org-agenda
   1314   :type '(choice
   1315 	  (const :tag "The standard Emacs diary file" diary-file)
   1316 	  (file :tag "Special Org file diary entries")))
   1317 
   1318 (defcustom org-agenda-include-diary nil
   1319   "If non-nil, include in the agenda entries from the Emacs Calendar's diary.
   1320 Custom commands can set this variable in the options section."
   1321   :group 'org-agenda-daily/weekly
   1322   :type 'boolean)
   1323 
   1324 (defcustom org-agenda-include-deadlines t
   1325   "If non-nil, include entries within their deadline warning period.
   1326 Custom commands can set this variable in the options section."
   1327   :group 'org-agenda-daily/weekly
   1328   :version "24.1"
   1329   :type 'boolean)
   1330 
   1331 (defcustom org-agenda-show-future-repeats t
   1332   "Non-nil shows repeated entries in the future part of the agenda.
   1333 When set to the symbol `next' only the first future repeat is shown."
   1334   :group 'org-agenda-daily/weekly
   1335   :type '(choice
   1336 	  (const :tag "Show all repeated entries" t)
   1337 	  (const :tag "Show next repeated entry" next)
   1338 	  (const :tag "Do not show repeated entries" nil))
   1339   :version "26.1"
   1340   :package-version '(Org . "9.1")
   1341   :safe #'symbolp)
   1342 
   1343 (defcustom org-agenda-prefer-last-repeat nil
   1344   "Non-nil sets date for repeated entries to their last repeat.
   1345 
   1346 When nil, display SCHEDULED and DEADLINE dates at their base
   1347 date, and in today's agenda, as a reminder.  Display plain
   1348 time-stamps, on the other hand, at every repeat date in the past
   1349 in addition to the base date.
   1350 
   1351 When non-nil, show a repeated entry at its latest repeat date,
   1352 possibly being today even if it wasn't marked as done.  This
   1353 setting is useful if you do not always mark repeated entries as
   1354 done and, yet, consider that reaching repeat date starts the task
   1355 anew.
   1356 
   1357 When set to a list of strings, prefer last repeats only for
   1358 entries with these TODO keywords."
   1359   :group 'org-agenda-daily/weekly
   1360   :type '(choice
   1361 	  (const :tag "Prefer last repeat" t)
   1362 	  (const :tag "Prefer base date" nil)
   1363 	  (repeat :tag "Prefer last repeat for entries with these TODO keywords"
   1364 		  (string :tag "TODO keyword")))
   1365   :version "26.1"
   1366   :package-version '(Org . "9.1")
   1367   :safe (lambda (x) (or (booleanp x) (consp x))))
   1368 
   1369 (defcustom org-scheduled-past-days 10000
   1370   "Number of days to continue listing scheduled items not marked DONE.
   1371 When an item is scheduled on a date, it shows up in the agenda on
   1372 this day and will be listed until it is marked done or for the
   1373 number of days given here."
   1374   :group 'org-agenda-daily/weekly
   1375   :type 'integer
   1376   :safe 'integerp)
   1377 
   1378 (defcustom org-deadline-past-days 10000
   1379   "Number of days to warn about missed deadlines.
   1380 When an item has deadline on a date, it shows up in the agenda on
   1381 this day and will appear as a reminder until it is marked DONE or
   1382 for the number of days given here."
   1383   :group 'org-agenda-daily/weekly
   1384   :type 'integer
   1385   :version "26.1"
   1386   :package-version '(Org . "9.1")
   1387   :safe 'integerp)
   1388 
   1389 (defcustom org-agenda-log-mode-items '(closed clock)
   1390   "List of items that should be shown in agenda log mode.
   1391 \\<org-agenda-mode-map>\
   1392 This list may contain the following symbols:
   1393 
   1394   closed    Show entries that have been closed on that day.
   1395   clock     Show entries that have received clocked time on that day.
   1396   state     Show all logged state changes.
   1397 Note that instead of changing this variable, you can also press \
   1398 `\\[universal-argument] \\[org-agenda-log-mode]' in
   1399 the agenda to display all available LOG items temporarily."
   1400   :group 'org-agenda-daily/weekly
   1401   :type '(set :greedy t (const closed) (const clock) (const state)))
   1402 
   1403 (defcustom org-agenda-clock-consistency-checks
   1404   '(:max-duration "10:00" :min-duration 0 :max-gap "0:05"
   1405 		  :gap-ok-around ("4:00")
   1406 		  :default-face ((:background "DarkRed") (:foreground "white"))
   1407 		  :overlap-face nil :gap-face nil :no-end-time-face nil
   1408 		  :long-face nil :short-face nil)
   1409   "This is a property list, with the following keys:
   1410 
   1411 :max-duration    Mark clocking chunks that are longer than this time.
   1412                  This is a time string like \"HH:MM\", or the number
   1413                  of minutes as an integer.
   1414 
   1415 :min-duration    Mark clocking chunks that are shorter that this.
   1416                  This is a time string like \"HH:MM\", or the number
   1417                  of minutes as an integer.
   1418 
   1419 :max-gap         Mark gaps between clocking chunks that are longer than
   1420                  this duration.  A number of minutes, or a string
   1421                  like \"HH:MM\".
   1422 
   1423 :gap-ok-around   List of times during the day which are usually not working
   1424                  times.  When a gap is detected, but the gap contains any
   1425                  of these times, the gap is *not* reported.  For example,
   1426                  if this is (\"4:00\" \"13:00\") then gaps that contain
   1427                  4:00 in the morning (i.e. the night) and 13:00
   1428                  (i.e. a typical lunch time) do not cause a warning.
   1429                  You should have at least one time during the night in this
   1430                  list, or otherwise the first task each morning will trigger
   1431                  a warning because it follows a long gap.
   1432 
   1433 Furthermore, the following properties can be used to define faces for
   1434 issue display.
   1435 
   1436 :default-face         the default face, if the specific face is undefined
   1437 :overlap-face         face for overlapping clocks
   1438 :gap-face             face for gaps between clocks
   1439 :no-end-time-face     face for incomplete clocks
   1440 :long-face            face for clock intervals that are too long
   1441 :short-face           face for clock intervals that are too short"
   1442   :group 'org-agenda-daily/weekly
   1443   :group 'org-clock
   1444   :version "24.1"
   1445   :type 'plist)
   1446 
   1447 (defcustom org-agenda-log-mode-add-notes t
   1448   "Non-nil means add first line of notes to log entries in agenda views.
   1449 If a log item like a state change or a clock entry is associated with
   1450 notes, the first line of these notes will be added to the entry in the
   1451 agenda display."
   1452   :group 'org-agenda-daily/weekly
   1453   :type 'boolean)
   1454 
   1455 (defcustom org-agenda-start-with-log-mode nil
   1456   "The initial value of log-mode in a newly created agenda window.
   1457 See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further
   1458 explanations on the possible values."
   1459   :group 'org-agenda-startup
   1460   :group 'org-agenda-daily/weekly
   1461   :type '(choice (const :tag "Don't show log items" nil)
   1462 		 (const :tag "Show only log items" only)
   1463 		 (const :tag "Show all possible log items" clockcheck)
   1464 		 (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
   1465 			 (choice (const :tag "Show closed log items" closed)
   1466 				 (const :tag "Show clocked log items" clock)
   1467 				 (const :tag "Show all logged state changes" state)))))
   1468 
   1469 (defcustom org-agenda-start-with-clockreport-mode nil
   1470   "The initial value of clockreport-mode in a newly created agenda window."
   1471   :group 'org-agenda-startup
   1472   :group 'org-agenda-daily/weekly
   1473   :type 'boolean)
   1474 
   1475 (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2)
   1476   "Property list with parameters for the clocktable in clockreport mode.
   1477 This is the display mode that shows a clock table in the daily/weekly
   1478 agenda, the properties for this dynamic block can be set here.
   1479 The usual clocktable parameters are allowed here, but you cannot set
   1480 the properties :name, :tstart, :tend, :block, and :scope - these will
   1481 be overwritten to make sure the content accurately reflects the
   1482 current display in the agenda."
   1483   :group 'org-agenda-daily/weekly
   1484   :type 'plist)
   1485 
   1486 (defvaralias 'org-agenda-search-view-search-words-only
   1487   'org-agenda-search-view-always-boolean)
   1488 
   1489 (defcustom org-agenda-search-view-always-boolean nil
   1490   "Non-nil means the search string is interpreted as individual parts.
   1491 
   1492 The search string for search view can either be interpreted as a phrase,
   1493 or as a list of snippets that define a boolean search for a number of
   1494 strings.
   1495 
   1496 When this is non-nil, the string will be split on whitespace, and each
   1497 snippet will be searched individually, and all must match in order to
   1498 select an entry.  A snippet is then a single string of non-white
   1499 characters, or a string in double quotes, or a regexp in {} braces.
   1500 If a snippet is preceded by \"-\", the snippet must *not* match.
   1501 \"+\" is syntactic sugar for positive selection.  Each snippet may
   1502 be found as a full word or a partial word, but see the variable
   1503 `org-agenda-search-view-force-full-words'.
   1504 
   1505 When this is nil, search will look for the entire search phrase as one,
   1506 with each space character matching any amount of whitespace, including
   1507 line breaks.
   1508 
   1509 Even when this is nil, you can still switch to Boolean search dynamically
   1510 by preceding the first snippet with \"+\" or \"-\".  If the first snippet
   1511 is a regexp marked with braces like \"{abc}\", this will also switch to
   1512 boolean search."
   1513   :group 'org-agenda-search-view
   1514   :version "24.1"
   1515   :type 'boolean)
   1516 
   1517 (defcustom org-agenda-search-view-force-full-words nil
   1518   "Non-nil means, search words must be matches as complete words.
   1519 When nil, they may also match part of a word."
   1520   :group 'org-agenda-search-view
   1521   :version "24.1"
   1522   :type 'boolean)
   1523 
   1524 (defcustom org-agenda-search-view-max-outline-level 0
   1525   "Maximum outline level to display in search view.
   1526 E.g. when this is set to 1, the search view will only
   1527 show headlines of level 1.  When set to 0, the default
   1528 value, don't limit agenda view by outline level."
   1529   :group 'org-agenda-search-view
   1530   :version "26.1"
   1531   :package-version '(Org . "8.3")
   1532   :type 'integer)
   1533 
   1534 (defgroup org-agenda-time-grid nil
   1535   "Options concerning the time grid in the Org Agenda."
   1536   :tag "Org Agenda Time Grid"
   1537   :group 'org-agenda)
   1538 
   1539 (defcustom org-agenda-search-headline-for-time t
   1540   "Non-nil means search headline for a time-of-day.
   1541 If the headline contains a time-of-day in one format or another, it will
   1542 be used to sort the entry into the time sequence of items for a day.
   1543 Some people have time stamps in the headline that refer to the creation
   1544 time or so, and then this produces an unwanted side effect.  If this is
   1545 the case for your, use this variable to turn off searching the headline
   1546 for a time."
   1547   :group 'org-agenda-time-grid
   1548   :type 'boolean)
   1549 
   1550 (defcustom org-agenda-use-time-grid t
   1551   "Non-nil means show a time grid in the agenda schedule.
   1552 A time grid is a set of lines for specific times (like every two hours between
   1553 8:00 and 20:00).  The items scheduled for a day at specific times are
   1554 sorted in between these lines.
   1555 For details about when the grid will be shown, and what it will look like, see
   1556 the variable `org-agenda-time-grid'."
   1557   :group 'org-agenda-time-grid
   1558   :type 'boolean)
   1559 
   1560 (defcustom org-agenda-time-grid
   1561   (let ((graphical (and (display-graphic-p)
   1562                         (char-displayable-p ?┄))))
   1563     `((daily today require-timed)
   1564       (800 1000 1200 1400 1600 1800 2000)
   1565       ,(if graphical " ┄┄┄┄┄ " "......")
   1566       ,(if graphical "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄" "----------------")))
   1567   "The settings for time grid for agenda display.
   1568 This is a list of four items.  The first item is again a list.  It contains
   1569 symbols specifying conditions when the grid should be displayed:
   1570 
   1571  daily         if the agenda shows a single day
   1572  weekly        if the agenda shows an entire week
   1573  today         show grid on current date, independent of daily/weekly display
   1574  require-timed show grid only if at least one item has a time specification
   1575  remove-match  skip grid times already present in an entry
   1576 
   1577 The second item is a list of integers, indicating the times that
   1578 should have a grid line.
   1579 
   1580 The third item is a string which will be placed right after the
   1581 times that have a grid line.
   1582 
   1583 The fourth item is a string placed after the grid times.  This
   1584 will align with agenda items."
   1585   :group 'org-agenda-time-grid
   1586   :package-version '(Org . "9.6")
   1587   :type
   1588   '(list
   1589     (set :greedy t :tag "Grid Display Options"
   1590 	 (const :tag "Show grid in single day agenda display" daily)
   1591 	 (const :tag "Show grid in weekly agenda display" weekly)
   1592 	 (const :tag "Always show grid for today" today)
   1593 	 (const :tag "Show grid only if any timed entries are present"
   1594 		require-timed)
   1595 	 (const :tag "Skip grid times already present in an entry"
   1596 		remove-match))
   1597     (repeat :tag "Grid Times" (integer :tag "Time"))
   1598     (string :tag "Grid String (after agenda times)")
   1599     (string :tag "Grid String (aligns with agenda items)")))
   1600 
   1601 (defcustom org-agenda-show-current-time-in-grid t
   1602   "Non-nil means show the current time in the time grid."
   1603   :group 'org-agenda-time-grid
   1604   :version "24.1"
   1605   :type 'boolean)
   1606 
   1607 (defcustom org-agenda-current-time-string
   1608   (if (and (display-graphic-p)
   1609            (char-displayable-p ?←)
   1610            (char-displayable-p ?─))
   1611       "← now ───────────────────────────────────────────────"
   1612     "now - - - - - - - - - - - - - - - - - - - - - - - - -")
   1613   "The string for the current time marker in the agenda."
   1614   :group 'org-agenda-time-grid
   1615   :package-version '(Org . "9.6")
   1616   :type 'string)
   1617 
   1618 (defgroup org-agenda-sorting nil
   1619   "Options concerning sorting in the Org Agenda."
   1620   :tag "Org Agenda Sorting"
   1621   :group 'org-agenda)
   1622 
   1623 (defcustom org-agenda-sorting-strategy
   1624   '((agenda habit-down time-up priority-down category-keep)
   1625     (todo   priority-down category-keep)
   1626     (tags   priority-down category-keep)
   1627     (search category-keep))
   1628   "Sorting structure for the agenda items of a single day.
   1629 This is a list of symbols which will be used in sequence to determine
   1630 if an entry should be listed before another entry.  The following
   1631 symbols are recognized:
   1632 
   1633 time-up            Put entries with time-of-day indications first, early first.
   1634 time-down          Put entries with time-of-day indications first, late first.
   1635 timestamp-up       Sort by any timestamp, early first.
   1636 timestamp-down     Sort by any timestamp, late first.
   1637 scheduled-up       Sort by scheduled timestamp, early first.
   1638 scheduled-down     Sort by scheduled timestamp, late first.
   1639 deadline-up        Sort by deadline timestamp, early first.
   1640 deadline-down      Sort by deadline timestamp, late first.
   1641 ts-up              Sort by active timestamp, early first.
   1642 ts-down            Sort by active timestamp, late first.
   1643 tsia-up            Sort by inactive timestamp, early first.
   1644 tsia-down          Sort by inactive timestamp, late first.
   1645 category-keep      Keep the default order of categories, corresponding to the
   1646 		   sequence in `org-agenda-files'.
   1647 category-up        Sort alphabetically by category, A-Z.
   1648 category-down      Sort alphabetically by category, Z-A.
   1649 tag-up             Sort alphabetically by last tag, A-Z.
   1650 tag-down           Sort alphabetically by last tag, Z-A.
   1651 priority-up        Sort numerically by priority, high priority last.
   1652 priority-down      Sort numerically by priority, high priority first.
   1653 todo-state-up      Sort by todo state, tasks that are done last.
   1654 todo-state-down    Sort by todo state, tasks that are done first.
   1655 effort-up          Sort numerically by estimated effort, high effort last.
   1656 effort-down        Sort numerically by estimated effort, high effort first.
   1657 user-defined-up    Sort according to `org-agenda-cmp-user-defined', high last.
   1658 user-defined-down  Sort according to `org-agenda-cmp-user-defined', high first.
   1659 habit-up           Put entries that are habits first.
   1660 habit-down         Put entries that are habits last.
   1661 alpha-up           Sort headlines alphabetically.
   1662 alpha-down         Sort headlines alphabetically, reversed.
   1663 
   1664 The different possibilities will be tried in sequence, and testing stops
   1665 if one comparison returns a \"not-equal\".  For example,
   1666   (setq org-agenda-sorting-strategy
   1667         \\='(time-up category-keep priority-down))
   1668 means: Pull out all entries having a specified time of day and sort them,
   1669 in order to make a time schedule for the current day the first thing in the
   1670 agenda listing for the day.  Of the entries without a time indication, keep
   1671 the grouped in categories, don't sort the categories, but keep them in
   1672 the sequence given in `org-agenda-files'.  Within each category sort by
   1673 priority.
   1674 
   1675 Leaving out `category-keep' would mean that items will be sorted across
   1676 categories by priority.
   1677 
   1678 Instead of a single list, this can also be a set of list for specific
   1679 contents, with a context symbol in the car of the list, any of
   1680 `agenda', `todo', `tags', `search' for the corresponding agenda views.
   1681 
   1682 Custom commands can bind this variable in the options section."
   1683   :group 'org-agenda-sorting
   1684   :type `(choice
   1685 	  (repeat :tag "General" ,org-sorting-choice)
   1686 	  (list :tag "Individually"
   1687 		(cons (const :tag "Strategy for Weekly/Daily agenda" agenda)
   1688 		      (repeat ,org-sorting-choice))
   1689 		(cons (const :tag "Strategy for TODO lists" todo)
   1690 		      (repeat ,org-sorting-choice))
   1691 		(cons (const :tag "Strategy for Tags matches" tags)
   1692 		      (repeat ,org-sorting-choice))
   1693 		(cons (const :tag "Strategy for search matches" search)
   1694 		      (repeat ,org-sorting-choice)))))
   1695 
   1696 (defcustom org-agenda-cmp-user-defined nil
   1697   "A function to define the comparison `user-defined'.
   1698 This function must receive two arguments, agenda entry a and b.
   1699 If a>b, return +1.  If a<b, return -1.  If they are equal as seen by
   1700 the user comparison, return nil.
   1701 When this is defined, you can make `user-defined-up' and `user-defined-down'
   1702 part of an agenda sorting strategy."
   1703   :group 'org-agenda-sorting
   1704   :type 'symbol)
   1705 
   1706 (defcustom org-agenda-sort-notime-is-late t
   1707   "Non-nil means items without time are considered late.
   1708 This is only relevant for sorting.  When t, items which have no explicit
   1709 time like 15:30 will be considered as 99:01, i.e. later than any items which
   1710 do have a time.  When nil, the default time is before 0:00.  You can use this
   1711 option to decide if the schedule for today should come before or after timeless
   1712 agenda entries."
   1713   :group 'org-agenda-sorting
   1714   :type 'boolean)
   1715 
   1716 (defcustom org-agenda-sort-noeffort-is-high t
   1717   "Non-nil means items without effort estimate are sorted as high effort.
   1718 This also applies when filtering an agenda view with respect to the
   1719 < or > effort operator.  Then, tasks with no effort defined will be treated
   1720 as tasks with high effort.
   1721 When nil, such items are sorted as 0 minutes effort."
   1722   :group 'org-agenda-sorting
   1723   :type 'boolean)
   1724 
   1725 (defgroup org-agenda-line-format nil
   1726   "Options concerning the entry prefix in the Org agenda display."
   1727   :tag "Org Agenda Line Format"
   1728   :group 'org-agenda)
   1729 
   1730 (defcustom org-agenda-prefix-format
   1731   '((agenda  . " %i %-12:c%?-12t% s")
   1732     (todo  . " %i %-12:c")
   1733     (tags  . " %i %-12:c")
   1734     (search . " %i %-12:c"))
   1735   "Format specifications for the prefix of items in the agenda views.
   1736 
   1737 An alist with one entry per agenda type.  The keys of the
   1738 sublists are `agenda', `todo', `search' and `tags'.  The values
   1739 are format strings.
   1740 
   1741 This format works similar to a printf format, with the following meaning:
   1742 
   1743   %c   the category of the item, \"Diary\" for entries from the diary,
   1744        or as given by the CATEGORY keyword or derived from the file name
   1745   %e   the effort required by the item
   1746   %l   the level of the item (insert X space(s) if item is of level X)
   1747   %i   the icon category of the item, see `org-agenda-category-icon-alist'
   1748   %T   the last tag of the item (ignore inherited tags, which come first)
   1749   %t   the HH:MM time-of-day specification if one applies to the entry
   1750   %s   Scheduling/Deadline information, a short string
   1751   %b   show breadcrumbs, i.e., the names of the higher levels
   1752   %(expression) Eval EXPRESSION and replace the control string
   1753                 by the result
   1754 
   1755 All specifiers work basically like the standard `%s' of printf, but may
   1756 contain two additional characters: a question mark just after the `%'
   1757 and a whitespace/punctuation character just before the final letter.
   1758 
   1759 If the first character after `%' is a question mark, the entire field
   1760 will only be included if the corresponding value applies to the current
   1761 entry.  This is useful for fields which should have fixed width when
   1762 present, but zero width when absent.  For example, \"%?-12t\" will
   1763 result in a 12 character time field if a time of the day is specified,
   1764 but will completely disappear in entries which do not contain a time.
   1765 
   1766 If there is punctuation or whitespace character just before the
   1767 final format letter, this character will be appended to the field
   1768 value if the value is not empty.  For example, the format
   1769 \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\".  If
   1770 the category is empty, no additional colon is inserted.
   1771 
   1772 The default value for the agenda sublist is \"  %-12:c%?-12t% s\",
   1773 which means:
   1774 
   1775 - Indent the line with two space characters
   1776 - Give the category a 12 chars wide field, padded with whitespace on
   1777   the right (because of `-').  Append a colon if there is a category
   1778   (because of `:').
   1779 - If there is a time-of-day, put it into a 12 chars wide field.  If no
   1780   time, don't put in an empty field, just skip it (because of '?').
   1781 - Finally, put the scheduling information.
   1782 
   1783 See also the variables `org-agenda-remove-times-when-in-prefix' and
   1784 `org-agenda-remove-tags'.
   1785 
   1786 Custom commands can set this variable in the options section."
   1787   :type '(choice
   1788 	  (string :tag "General format")
   1789 	  (list :greedy t :tag "View dependent"
   1790 		(cons  (const agenda) (string :tag "Format"))
   1791 		(cons  (const todo) (string :tag "Format"))
   1792 		(cons  (const tags) (string :tag "Format"))
   1793 		(cons  (const search) (string :tag "Format"))))
   1794   :group 'org-agenda-line-format
   1795   :version "26.1"
   1796   :package-version '(Org . "9.1"))
   1797 
   1798 (defcustom org-agenda-breadcrumbs-separator "->"
   1799   "The separator of breadcrumbs in agenda lines."
   1800   :group 'org-agenda-line-format
   1801   :package-version '(Org . "9.3")
   1802   :type 'string
   1803   :safe #'stringp)
   1804 
   1805 (defvar org-prefix-format-compiled nil
   1806   "The compiled prefix format and associated variables.
   1807 This is a list where first element is a list of variable bindings, and second
   1808 element is the compiled format expression.  See the variable
   1809 `org-agenda-prefix-format'.")
   1810 
   1811 (defcustom org-agenda-todo-keyword-format "%-1s"
   1812   "Format for the TODO keyword in agenda lines.
   1813 Set this to something like \"%-12s\" if you want all TODO keywords
   1814 to occupy a fixed space in the agenda display."
   1815   :group 'org-agenda-line-format
   1816   :type 'string)
   1817 
   1818 (defcustom org-agenda-diary-sexp-prefix nil
   1819   "A regexp that matches part of a diary sexp entry
   1820 which should be treated as scheduling/deadline information in
   1821 `org-agenda'.
   1822 
   1823 For example, you can use this to extract the `diary-remind-message' from
   1824 `diary-remind' entries."
   1825   :group 'org-agenda-line-format
   1826   :type '(choice (const :tag "None" nil) (regexp :tag "Regexp")))
   1827 
   1828 (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ")
   1829   "Text preceding timerange entries in the agenda view.
   1830 This is a list with two strings.  The first applies when the range
   1831 is entirely on one day.  The second applies if the range spans several days.
   1832 The strings may have two \"%d\" format specifiers which will be filled
   1833 with the sequence number of the days, and the total number of days in the
   1834 range, respectively."
   1835   :group 'org-agenda-line-format
   1836   :type '(list
   1837 	  (string :tag "Deadline today   ")
   1838 	  (choice :tag "Deadline relative"
   1839 		  (string :tag "Format string")
   1840 		  (function))))
   1841 
   1842 (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
   1843   "Text preceding scheduled items in the agenda view.
   1844 This is a list with two strings.  The first applies when the item is
   1845 scheduled on the current day.  The second applies when it has been scheduled
   1846 previously, it may contain a %d indicating that this is the nth time that
   1847 this item is scheduled, due to automatic rescheduling of unfinished items
   1848 for the following day.  So this number is one larger than the number of days
   1849 that passed since this item was scheduled first."
   1850   :group 'org-agenda-line-format
   1851   :version "24.4"
   1852   :package-version '(Org . "8.0")
   1853   :type '(list
   1854 	  (string :tag "Scheduled today     ")
   1855 	  (string :tag "Scheduled previously")))
   1856 
   1857 (defcustom org-agenda-inactive-leader "["
   1858   "Text preceding item pulled into the agenda by inactive time stamps.
   1859 These entries are added to the agenda when pressing \"[\"."
   1860   :group 'org-agenda-line-format
   1861   :version "24.1"
   1862   :type 'string)
   1863 
   1864 (defcustom org-agenda-deadline-leaders '("Deadline:  " "In %3d d.: " "%2d d. ago: ")
   1865   "Text preceding deadline items in the agenda view.
   1866 This is a list with three strings.  The first applies when the item has its
   1867 deadline on the current day.  The second applies when the deadline is in the
   1868 future, the third one when it is in the past.  The strings may contain %d
   1869 to capture the number of days."
   1870   :group 'org-agenda-line-format
   1871   :version "24.4"
   1872   :package-version '(Org . "8.0")
   1873   :type '(list
   1874 	  (string :tag "Deadline today          ")
   1875 	  (string :tag "Deadline in the future  ")
   1876 	  (string :tag "Deadline in the past    ")))
   1877 
   1878 (defcustom org-agenda-remove-times-when-in-prefix t
   1879   "Non-nil means remove duplicate time specifications in agenda items.
   1880 When the format `org-agenda-prefix-format' contains a `%t' specifier, a
   1881 time-of-day specification in a headline or diary entry is extracted and
   1882 placed into the prefix.  If this option is non-nil, the original specification
   1883 \(a timestamp or -range, or just a plain time(range) specification like
   1884 11:30-4pm) will be removed for agenda display.  This makes the agenda less
   1885 cluttered.
   1886 The option can be t or nil.  It may also be the symbol `beg', indicating
   1887 that the time should only be removed when it is located at the beginning of
   1888 the headline/diary entry."
   1889   :group 'org-agenda-line-format
   1890   :type '(choice
   1891 	  (const :tag "Always" t)
   1892 	  (const :tag "Never" nil)
   1893 	  (const :tag "When at beginning of entry" beg)))
   1894 
   1895 (defcustom org-agenda-remove-timeranges-from-blocks nil
   1896   "Non-nil means remove time ranges specifications in agenda
   1897 items that span on several days."
   1898   :group 'org-agenda-line-format
   1899   :version "24.1"
   1900   :type 'boolean)
   1901 
   1902 (defcustom org-agenda-default-appointment-duration nil
   1903   "Default duration for appointments that only have a starting time.
   1904 When nil, no duration is specified in such cases.
   1905 When non-nil, this must be the number of minutes, e.g. 60 for one hour."
   1906   :group 'org-agenda-line-format
   1907   :type '(choice
   1908 	  (integer :tag "Minutes")
   1909 	  (const :tag "No default duration")))
   1910 
   1911 (defcustom org-agenda-show-inherited-tags t
   1912   "Non-nil means show inherited tags in each agenda line.
   1913 
   1914 When this option is set to `always', it takes precedence over
   1915 `org-agenda-use-tag-inheritance' and inherited tags are shown
   1916 in every agenda.
   1917 
   1918 When this option is set to t (the default), inherited tags are
   1919 shown when they are available, i.e. when the value of
   1920 `org-agenda-use-tag-inheritance' enables tag inheritance for the
   1921 given agenda type.
   1922 
   1923 This can be set to a list of agenda types in which the agenda
   1924 must display the inherited tags.  Available types are `todo',
   1925 `agenda' and `search'.
   1926 
   1927 When set to nil, never show inherited tags in agenda lines."
   1928   :group 'org-agenda-line-format
   1929   :group 'org-agenda
   1930   :version "24.3"
   1931   :type '(choice
   1932 	  (const :tag "Show inherited tags when available" t)
   1933 	  (const :tag "Always show inherited tags" always)
   1934 	  (repeat :tag "Show inherited tags only in selected agenda types"
   1935 		  (symbol :tag "Agenda type"))))
   1936 
   1937 (defcustom org-agenda-use-tag-inheritance '(todo search agenda)
   1938   "List of agenda view types where to use tag inheritance.
   1939 
   1940 In tags/tags-todo/tags-tree agenda views, tag inheritance is
   1941 controlled by `org-use-tag-inheritance'.  In other agenda types,
   1942 `org-use-tag-inheritance' is not used for the selection of the
   1943 agenda entries.  Still, you may want the agenda to be aware of
   1944 the inherited tags anyway, e.g. for later tag filtering.
   1945 
   1946 Allowed value are `todo', `search' and `agenda'.
   1947 
   1948 This variable has no effect if `org-agenda-show-inherited-tags'
   1949 is set to `always'.  In that case, the agenda is aware of those
   1950 tags.
   1951 
   1952 The default value sets tags in every agenda type.  Setting this
   1953 option to nil will speed up non-tags agenda view a lot."
   1954   :group 'org-agenda
   1955   :version "26.1"
   1956   :package-version '(Org . "9.1")
   1957   :type '(choice
   1958 	  (const :tag "Use tag inheritance in all agenda types" t)
   1959 	  (repeat :tag "Use tag inheritance in selected agenda types"
   1960 		  (symbol :tag "Agenda type"))))
   1961 
   1962 (defcustom org-agenda-hide-tags-regexp nil
   1963   "Regular expression used to filter away specific tags in agenda views.
   1964 This means that these tags will be present, but not be shown in the agenda
   1965 line.  Secondary filtering will still work on the hidden tags.
   1966 Nil means don't hide any tags."
   1967   :group 'org-agenda-line-format
   1968   :type '(choice
   1969 	  (const  :tag "Hide none" nil)
   1970 	  (regexp :tag "Regexp   ")))
   1971 
   1972 (defvaralias 'org-agenda-remove-tags-when-in-prefix
   1973   'org-agenda-remove-tags)
   1974 
   1975 (defcustom org-agenda-remove-tags nil
   1976   "Non-nil means remove the tags from the headline copy in the agenda.
   1977 When this is the symbol `prefix', only remove tags when
   1978 `org-agenda-prefix-format' contains a `%T' specifier."
   1979   :group 'org-agenda-line-format
   1980   :type '(choice
   1981 	  (const :tag "Always" t)
   1982 	  (const :tag "Never" nil)
   1983 	  (const :tag "When prefix format contains %T" prefix)))
   1984 
   1985 (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
   1986 
   1987 (defcustom org-agenda-tags-column 'auto
   1988   "Shift tags in agenda items to this column.
   1989 If set to `auto', tags will be automatically aligned to the right
   1990 edge of the window.
   1991 
   1992 If set to a positive number, tags will be left-aligned to that
   1993 column.  If set to a negative number, tags will be right-aligned
   1994 to that column.  For example, -80 works well for a normal 80
   1995 character screen."
   1996   :group 'org-agenda-line-format
   1997   :type '(choice
   1998 	  (const :tag "Automatically align to right edge of window" auto)
   1999 	  (integer :tag "Specific column" -80))
   2000   :package-version '(Org . "9.1")
   2001   :version "26.1")
   2002 
   2003 (defcustom org-agenda-fontify-priorities 'cookies
   2004   "Non-nil means highlight low and high priorities in agenda.
   2005 When t, the highest priority entries are bold, lowest priority italic.
   2006 However, settings in `org-priority-faces' will overrule these faces.
   2007 When this variable is the symbol `cookies', only fontify the
   2008 cookies, not the entire task.
   2009 This may also be an association list of priority faces, whose
   2010 keys are the character values of `org-priority-highest',
   2011 `org-priority-default', and `org-priority-lowest' (the default values
   2012 are ?A, ?B, and ?C, respectively).  The face may be a named face, a
   2013 color as a string, or a list like `(:background \"Red\")'.
   2014 If it is a color, the variable `org-faces-easy-properties'
   2015 determines if it is a foreground or a background color."
   2016   :group 'org-agenda-line-format
   2017   :type '(choice
   2018 	  (const :tag "Never" nil)
   2019 	  (const :tag "Defaults" t)
   2020 	  (const :tag "Cookies only" cookies)
   2021 	  (repeat :tag "Specify"
   2022 		  (list (character :tag "Priority" :value ?A)
   2023 			(choice    :tag "Face    "
   2024 				   (string :tag "Color")
   2025 				   (sexp :tag "Face"))))))
   2026 
   2027 (defcustom org-agenda-day-face-function nil
   2028   "Function called to determine what face should be used to display a day.
   2029 The only argument passed to that function is the day.  It should
   2030 returns a face, or nil if does not want to specify a face and let
   2031 the normal rules apply."
   2032   :group 'org-agenda-line-format
   2033   :version "24.1"
   2034   :type '(choice (const nil) (function)))
   2035 
   2036 (defcustom org-agenda-category-icon-alist nil
   2037   "Alist of category icon to be displayed in agenda views.
   2038 
   2039 Each entry should have the following format:
   2040 
   2041   (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS)
   2042 
   2043 Where CATEGORY-REGEXP is a regexp matching the categories where
   2044 the icon should be displayed.
   2045 FILE-OR-DATA either a file path or a string containing image data.
   2046 
   2047 The other fields can be omitted safely if not needed:
   2048 TYPE indicates the image type.
   2049 DATA-P is a boolean indicating whether the FILE-OR-DATA string is
   2050 image data.
   2051 PROPS are additional image attributes to assign to the image,
   2052 like, e.g. `:ascent center'.
   2053 
   2054    (\"Org\" \"/path/to/icon.png\" nil nil :ascent center)
   2055 
   2056 If you want to set the display properties yourself, just put a
   2057 list as second element:
   2058 
   2059   (CATEGORY-REGEXP (MY PROPERTY LIST))
   2060 
   2061 For example, to display a 16px horizontal space for Emacs
   2062 category, you can use:
   2063 
   2064   (\"Emacs\" \\='(space . (:width (16))))"
   2065   :group 'org-agenda-line-format
   2066   :version "24.1"
   2067   :type '(alist :key-type (regexp :tag "Regexp matching category")
   2068 		:value-type (choice (list :tag "Icon"
   2069 					  (string :tag "File or data")
   2070 					  (symbol :tag "Type")
   2071 					  (boolean :tag "Data?")
   2072 					  (repeat :tag "Extra image properties" :inline t sexp))
   2073 				    (list :tag "Display properties" sexp))))
   2074 
   2075 (defgroup org-agenda-column-view nil
   2076   "Options concerning column view in the agenda."
   2077   :tag "Org Agenda Column View"
   2078   :group 'org-agenda)
   2079 
   2080 (defcustom org-agenda-view-columns-initially nil
   2081   "When non-nil, switch to columns view right after creating the agenda."
   2082   :group 'org-agenda-column-view
   2083   :type 'boolean
   2084   :version "26.1"
   2085   :package-version '(Org . "9.0")
   2086   :safe #'booleanp)
   2087 
   2088 (defcustom org-agenda-columns-show-summaries t
   2089   "Non-nil means show summaries for columns displayed in the agenda view."
   2090   :group 'org-agenda-column-view
   2091   :type 'boolean)
   2092 
   2093 (defcustom org-agenda-columns-compute-summary-properties t
   2094   "Non-nil means recompute all summary properties before column view.
   2095 When column view in the agenda is listing properties that have a summary
   2096 operator, it can go to all relevant buffers and recompute the summaries
   2097 there.  This can mean overhead for the agenda column view, but is necessary
   2098 to have thing up to date.
   2099 As a special case, a CLOCKSUM property also makes sure that the clock
   2100 computations are current."
   2101   :group 'org-agenda-column-view
   2102   :type 'boolean)
   2103 
   2104 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil
   2105   "Non-nil means the duration of an appointment will add to day effort.
   2106 The property to which appointment durations will be added is the one given
   2107 in the option `org-effort-property'.  If an appointment does not have
   2108 an end time, `org-agenda-default-appointment-duration' will be used.  If that
   2109 is not set, an appointment without end time will not contribute to the time
   2110 estimate."
   2111   :group 'org-agenda-column-view
   2112   :type 'boolean)
   2113 
   2114 (defcustom org-agenda-auto-exclude-function nil
   2115   "A function called with a tag to decide if it is filtered on \
   2116 \\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] RET'.
   2117 The sole argument to the function, which is called once for each
   2118 possible tag, is a string giving the name of the tag.  The
   2119 function should return either nil if the tag should be included
   2120 as normal, \"-<TAG>\" to exclude the tag, or \"+<TAG>\" to exclude
   2121 lines not carrying this tag.
   2122 Note that for the purpose of tag filtering, only the lower-case version of
   2123 all tags will be considered, so that this function will only ever see
   2124 the lower-case version of all tags."
   2125   :group 'org-agenda
   2126   :type '(choice (const nil) (function)))
   2127 
   2128 (defcustom org-agenda-bulk-custom-functions nil
   2129   "Alist of characters and custom functions for bulk actions.
   2130 For example, this makes those two functions available:
   2131 
   2132   (setq org-agenda-bulk-custom-functions
   2133         \\='((?R set-category)
   2134           (?C bulk-cut)))
   2135 
   2136 With selected entries in an agenda buffer, `B R' will call
   2137 the custom function `set-category' on the selected entries.
   2138 Note that functions in this alist don't need to be quoted.
   2139 
   2140 You can also specify a function which collects arguments to be
   2141 used for each call to your bulk custom function.  The argument
   2142 collecting function will be run once and should return a list of
   2143 arguments to pass to the bulk function.  For example:
   2144 
   2145   (setq org-agenda-bulk-custom-functions
   2146         \\='((?R set-category get-category)))
   2147 
   2148 Now, `B R' will call the custom `get-category' which would prompt
   2149 the user once for a category.  That category is then passed as an
   2150 argument to `set-category' for each entry it's called against."
   2151   :type
   2152   '(alist :key-type character
   2153 	  :value-type
   2154           (group (function :tag "Bulk Custom Function")
   2155 		 (choice (function :tag "Bulk Custom Argument Function")
   2156 		         (const :tag "No Bulk Custom Argument Function" nil))))
   2157   :package-version '(Org . "9.5")
   2158   :group 'org-agenda)
   2159 
   2160 (defmacro org-agenda-with-point-at-orig-entry (string &rest body)
   2161   "Execute BODY with point at location given by `org-hd-marker' property.
   2162 If STRING is non-nil, the text property will be fetched from position 0
   2163 in that string.  If STRING is nil, it will be fetched from the beginning
   2164 of the current line."
   2165   (declare (debug t) (indent 1))
   2166   (org-with-gensyms (marker)
   2167     `(let ((,marker (get-text-property (if ,string 0 (line-beginning-position))
   2168 				       'org-hd-marker ,string)))
   2169        (with-current-buffer (marker-buffer ,marker)
   2170 	 (save-excursion
   2171 	   (goto-char ,marker)
   2172 	   ,@body)))))
   2173 
   2174 (defun org-add-agenda-custom-command (entry)
   2175   "Replace or add a command in `org-agenda-custom-commands'.
   2176 This is mostly for hacking and trying a new command - once the command
   2177 works you probably want to add it to `org-agenda-custom-commands' for good."
   2178   (let ((ass (assoc (car entry) org-agenda-custom-commands)))
   2179     (if ass
   2180 	(setcdr ass (cdr entry))
   2181       (push entry org-agenda-custom-commands))))
   2182 
   2183 (defmacro org-agenda--insert-overriding-header (default)
   2184   "Insert header into agenda view.
   2185 The inserted header depends on `org-agenda-overriding-header'.
   2186 If the empty string, don't insert a header.  If any other string,
   2187 insert it as a header.  If nil, insert DEFAULT, which should
   2188 evaluate to a string.  If a function, call it and insert the
   2189 string that it returns."
   2190   (declare (debug (form)) (indent defun))
   2191   `(cond
   2192     ((not org-agenda-overriding-header) (insert ,default))
   2193     ((equal org-agenda-overriding-header "") nil)
   2194     ((stringp org-agenda-overriding-header)
   2195      (insert (propertize org-agenda-overriding-header
   2196 			 'face 'org-agenda-structure)
   2197 	     "\n"))
   2198     ((functionp org-agenda-overriding-header)
   2199      (insert (funcall org-agenda-overriding-header)))
   2200     (t (user-error "Invalid value for `org-agenda-overriding-header': %S"
   2201 		   org-agenda-overriding-header))))
   2202 
   2203 ;;; Define the org-agenda-mode
   2204 
   2205 (defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
   2206 (defvar org-agenda-mode-map (make-sparse-keymap)
   2207   "Keymap for `org-agenda-mode'.")
   2208 
   2209 (org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line)
   2210 
   2211 (defvar org-agenda-menu) ; defined later in this file.
   2212 (defvar org-agenda-restrict nil
   2213   "Non-nil means agenda restriction is active.
   2214 This is an internal flag indicating either temporary or extended
   2215 agenda restriction.  Specifically, it is set to t if the agenda
   2216 is restricted to an entire file, and is set to the corresponding
   2217 buffer if the agenda is restricted to a part of a file, e.g. a
   2218 region or a substree.  In the latter case,
   2219 `org-agenda-restrict-begin' and `org-agenda-restrict-end' are set
   2220 to the beginning and the end of the part.
   2221 
   2222 See also `org-agenda-set-restriction-lock'.")
   2223 (defvar org-agenda-follow-mode nil)
   2224 (defvar org-agenda-entry-text-mode nil)
   2225 (defvar org-agenda-clockreport-mode nil)
   2226 (defvar org-agenda-show-log nil
   2227   "When non-nil, show the log in the agenda.
   2228 Do not set this directly; instead use
   2229 `org-agenda-start-with-log-mode', which see.")
   2230 (defvar org-agenda-redo-command nil)
   2231 (defvar org-agenda-query-string nil)
   2232 (defvar org-agenda-mode-hook nil
   2233   "Hook run after `org-agenda-mode' is turned on.
   2234 The buffer is still writable when this hook is called.")
   2235 (defvar org-agenda-type nil)
   2236 (defvar org-agenda-force-single-file nil)
   2237 (defvar org-agenda-bulk-marked-entries nil
   2238   "List of markers that refer to marked entries in the agenda.")
   2239 (defvar org-agenda-current-date nil
   2240   "Active date when building the agenda.")
   2241 
   2242 ;;; Multiple agenda buffers support
   2243 
   2244 (defcustom org-agenda-sticky nil
   2245   "Non-nil means agenda q key will bury agenda buffers.
   2246 Agenda commands will then show existing buffer instead of generating new ones.
   2247 When nil, `q' will kill the single agenda buffer."
   2248   :group 'org-agenda
   2249   :version "24.3"
   2250   :type 'boolean)
   2251 
   2252 
   2253 ;;;###autoload
   2254 (defun org-toggle-sticky-agenda (&optional arg)
   2255   "Toggle `org-agenda-sticky'."
   2256   (interactive "P")
   2257   (let ((new-value (if arg
   2258 		       (> (prefix-numeric-value arg) 0)
   2259 		     (not org-agenda-sticky))))
   2260     (if (equal new-value org-agenda-sticky)
   2261 	(and (called-interactively-p 'interactive)
   2262 	     (message "Sticky agenda was already %s"
   2263 		      (if org-agenda-sticky "enabled" "disabled")))
   2264       (setq org-agenda-sticky new-value)
   2265       (org-agenda-kill-all-agenda-buffers)
   2266       (and (called-interactively-p 'interactive)
   2267 	   (message "Sticky agenda %s"
   2268 		    (if org-agenda-sticky "enabled" "disabled"))))))
   2269 
   2270 (defvar org-agenda-buffer nil
   2271   "Agenda buffer currently being generated.")
   2272 
   2273 (defvar org-agenda-last-prefix-arg nil)
   2274 (defvar org-agenda-this-buffer-name nil)
   2275 (defvar org-agenda-doing-sticky-redo nil)
   2276 (defvar org-agenda-this-buffer-is-sticky nil)
   2277 (defvar org-agenda-last-indirect-buffer nil
   2278   "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.")
   2279 
   2280 (defconst org-agenda-local-vars
   2281   '(org-agenda-this-buffer-name
   2282     org-agenda-undo-list
   2283     org-agenda-pending-undo-list
   2284     org-agenda-follow-mode
   2285     org-agenda-entry-text-mode
   2286     org-agenda-clockreport-mode
   2287     org-agenda-show-log
   2288     org-agenda-redo-command
   2289     org-agenda-query-string
   2290     org-agenda-type
   2291     org-agenda-bulk-marked-entries
   2292     org-agenda-undo-has-started-in
   2293     org-agenda-info
   2294     org-agenda-pre-window-conf
   2295     org-agenda-columns-active
   2296     org-agenda-tag-filter
   2297     org-agenda-category-filter
   2298     org-agenda-top-headline-filter
   2299     org-agenda-regexp-filter
   2300     org-agenda-effort-filter
   2301     org-agenda-filters-preset
   2302     org-agenda-markers
   2303     org-agenda-last-search-view-search-was-boolean
   2304     org-agenda-last-indirect-buffer
   2305     org-agenda-filtered-by-category
   2306     org-agenda-filter-form
   2307     org-agenda-cycle-counter
   2308     org-agenda-last-prefix-arg)
   2309   "Variables that must be local in agenda buffers to allow multiple buffers.")
   2310 
   2311 (defun org-agenda-mode ()
   2312   "Mode for time-sorted view on action items in Org files.
   2313 
   2314 The following commands are available:
   2315 
   2316 \\{org-agenda-mode-map}"
   2317   (interactive)
   2318   (ignore-errors (require 'face-remap))
   2319   (let ((agenda-local-vars-to-keep
   2320 	 '(text-scale-mode-amount
   2321 	   text-scale-mode
   2322 	   text-scale-mode-lighter
   2323 	   face-remapping-alist))
   2324 	(save (buffer-local-variables)))
   2325     (kill-all-local-variables)
   2326     (cl-flet ((reset-saved (var-set)
   2327 		"Reset variables in VAR-SET to possibly stored value in SAVE."
   2328 		(dolist (elem save)
   2329 		  (pcase elem
   2330 		    (`(,var . ,val)		;ignore unbound variables
   2331 		     (when (and val (memq var var-set))
   2332 		       (set var val)))))))
   2333       (cond (org-agenda-doing-sticky-redo
   2334 	      ;; Refreshing sticky agenda-buffer
   2335 	      ;;
   2336 	      ;; Preserve the value of `org-agenda-local-vars' variables.
   2337 	      (mapc #'make-local-variable org-agenda-local-vars)
   2338 	      (reset-saved org-agenda-local-vars)
   2339 	      (setq-local org-agenda-this-buffer-is-sticky t))
   2340 	    (org-agenda-sticky
   2341 	      ;; Creating a sticky Agenda buffer for the first time
   2342 	      (mapc #'make-local-variable org-agenda-local-vars)
   2343 	      (setq-local org-agenda-this-buffer-is-sticky t))
   2344 	    (t
   2345 	      ;; Creating a non-sticky agenda buffer
   2346 	      (setq-local org-agenda-this-buffer-is-sticky nil)))
   2347       (mapc #'make-local-variable agenda-local-vars-to-keep)
   2348       (reset-saved agenda-local-vars-to-keep)))
   2349   (setq org-agenda-undo-list nil
   2350 	org-agenda-pending-undo-list nil
   2351 	org-agenda-bulk-marked-entries nil)
   2352   (setq major-mode 'org-agenda-mode)
   2353   ;; Keep global-font-lock-mode from turning on font-lock-mode
   2354   (setq-local font-lock-global-modes (list 'not major-mode))
   2355   (setq mode-name "Org-Agenda")
   2356   (setq indent-tabs-mode nil)
   2357   (use-local-map org-agenda-mode-map)
   2358   (when org-startup-truncated (setq truncate-lines t))
   2359   (setq-local line-move-visual nil)
   2360   (add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local)
   2361   (add-hook 'pre-command-hook #'org-unhighlight nil 'local)
   2362   ;; Make sure properties are removed when copying text
   2363   (if (boundp 'filter-buffer-substring-functions)
   2364       (add-hook 'filter-buffer-substring-functions
   2365 		(lambda (fun start end delete)
   2366                   (substring-no-properties (funcall fun start end delete)))
   2367 		nil t)
   2368     ;; Emacs >= 24.4.
   2369     (add-function :filter-return (local 'filter-buffer-substring-function)
   2370                   #'substring-no-properties))
   2371   (unless org-agenda-keep-modes
   2372     (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
   2373 	  org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
   2374 	  org-agenda-show-log org-agenda-start-with-log-mode
   2375 	  org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode))
   2376   (add-to-invisibility-spec '(org-filtered))
   2377   (org-fold-core-initialize `(,org-link--description-folding-spec
   2378                               ,org-link--link-folding-spec))
   2379   (easy-menu-change
   2380    '("Agenda") "Agenda Files"
   2381    (append
   2382     (list
   2383      (vector
   2384       (if (get 'org-agenda-files 'org-restrict)
   2385 	  "Restricted to single file"
   2386 	"Edit File List")
   2387       '(org-edit-agenda-file-list)
   2388       (not (get 'org-agenda-files 'org-restrict)))
   2389      "--")
   2390     (mapcar #'org-file-menu-entry (org-agenda-files))))
   2391   (org-agenda-set-mode-name)
   2392   (run-mode-hooks 'org-agenda-mode-hook))
   2393 
   2394 (substitute-key-definition #'undo #'org-agenda-undo
   2395 			   org-agenda-mode-map global-map)
   2396 (org-defkey org-agenda-mode-map "\C-i" #'org-agenda-goto)
   2397 (org-defkey org-agenda-mode-map [(tab)] #'org-agenda-goto)
   2398 (org-defkey org-agenda-mode-map "\C-m" #'org-agenda-switch-to)
   2399 (org-defkey org-agenda-mode-map "\C-k" #'org-agenda-kill)
   2400 (org-defkey org-agenda-mode-map "\C-c\C-w" #'org-agenda-refile)
   2401 (org-defkey org-agenda-mode-map [(meta down)] #'org-agenda-drag-line-forward)
   2402 (org-defkey org-agenda-mode-map [(meta up)] #'org-agenda-drag-line-backward)
   2403 (org-defkey org-agenda-mode-map "m" #'org-agenda-bulk-mark)
   2404 (org-defkey org-agenda-mode-map "\M-m" #'org-agenda-bulk-toggle)
   2405 (org-defkey org-agenda-mode-map "*" #'org-agenda-bulk-mark-all)
   2406 (org-defkey org-agenda-mode-map "\M-*" #'org-agenda-bulk-toggle-all)
   2407 (org-defkey org-agenda-mode-map "#" #'org-agenda-dim-blocked-tasks)
   2408 (org-defkey org-agenda-mode-map "%" #'org-agenda-bulk-mark-regexp)
   2409 (org-defkey org-agenda-mode-map "u" #'org-agenda-bulk-unmark)
   2410 (org-defkey org-agenda-mode-map "U" #'org-agenda-bulk-unmark-all)
   2411 (org-defkey org-agenda-mode-map "B" #'org-agenda-bulk-action)
   2412 (org-defkey org-agenda-mode-map "k" #'org-agenda-capture)
   2413 (org-defkey org-agenda-mode-map "A" #'org-agenda-append-agenda)
   2414 (org-defkey org-agenda-mode-map "\C-c\C-x!" #'org-reload)
   2415 (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" #'org-agenda-archive-default)
   2416 (org-defkey org-agenda-mode-map "\C-c\C-xa" #'org-agenda-toggle-archive-tag)
   2417 (org-defkey org-agenda-mode-map "\C-c\C-xA" #'org-agenda-archive-to-archive-sibling)
   2418 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" #'org-agenda-archive)
   2419 (org-defkey org-agenda-mode-map "\C-c$" #'org-agenda-archive)
   2420 (org-defkey org-agenda-mode-map "$" #'org-agenda-archive)
   2421 (org-defkey org-agenda-mode-map "\C-c\C-o" #'org-agenda-open-link)
   2422 (org-defkey org-agenda-mode-map " " #'org-agenda-show-and-scroll-up)
   2423 (org-defkey org-agenda-mode-map [backspace] #'org-agenda-show-scroll-down)
   2424 (org-defkey org-agenda-mode-map "\d" #'org-agenda-show-scroll-down)
   2425 (org-defkey org-agenda-mode-map [(control shift right)] #'org-agenda-todo-nextset)
   2426 (org-defkey org-agenda-mode-map [(control shift left)] #'org-agenda-todo-previousset)
   2427 (org-defkey org-agenda-mode-map "\C-c\C-xb" #'org-agenda-tree-to-indirect-buffer)
   2428 (org-defkey org-agenda-mode-map "o" #'delete-other-windows)
   2429 (org-defkey org-agenda-mode-map "L" #'org-agenda-recenter)
   2430 (org-defkey org-agenda-mode-map "\C-c\C-t" #'org-agenda-todo)
   2431 (org-defkey org-agenda-mode-map "t" #'org-agenda-todo)
   2432 (org-defkey org-agenda-mode-map "a" #'org-agenda-archive-default-with-confirmation)
   2433 (org-defkey org-agenda-mode-map ":" #'org-agenda-set-tags)
   2434 (org-defkey org-agenda-mode-map "\C-c\C-q" #'org-agenda-set-tags)
   2435 (org-defkey org-agenda-mode-map "." #'org-agenda-goto-today)
   2436 (org-defkey org-agenda-mode-map "j" #'org-agenda-goto-date)
   2437 (org-defkey org-agenda-mode-map "d" #'org-agenda-day-view)
   2438 (org-defkey org-agenda-mode-map "w" #'org-agenda-week-view)
   2439 (org-defkey org-agenda-mode-map "y" #'org-agenda-year-view)
   2440 (org-defkey org-agenda-mode-map "\C-c\C-z" #'org-agenda-add-note)
   2441 (org-defkey org-agenda-mode-map "z" #'org-agenda-add-note)
   2442 (org-defkey org-agenda-mode-map [(shift right)] #'org-agenda-do-date-later)
   2443 (org-defkey org-agenda-mode-map [(shift left)] #'org-agenda-do-date-earlier)
   2444 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] #'org-agenda-do-date-later)
   2445 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] #'org-agenda-do-date-earlier)
   2446 (org-defkey org-agenda-mode-map ">" #'org-agenda-date-prompt)
   2447 (org-defkey org-agenda-mode-map "\C-c\C-s" #'org-agenda-schedule)
   2448 (org-defkey org-agenda-mode-map "\C-c\C-d" #'org-agenda-deadline)
   2449 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
   2450   (while l (org-defkey org-agenda-mode-map
   2451 		       (number-to-string (pop l)) #'digit-argument)))
   2452 (org-defkey org-agenda-mode-map "F" #'org-agenda-follow-mode)
   2453 (org-defkey org-agenda-mode-map "R" #'org-agenda-clockreport-mode)
   2454 (org-defkey org-agenda-mode-map "E" #'org-agenda-entry-text-mode)
   2455 (org-defkey org-agenda-mode-map "l" #'org-agenda-log-mode)
   2456 (org-defkey org-agenda-mode-map "v" #'org-agenda-view-mode-dispatch)
   2457 (org-defkey org-agenda-mode-map "D" #'org-agenda-toggle-diary)
   2458 (org-defkey org-agenda-mode-map "!" #'org-agenda-toggle-deadlines)
   2459 (org-defkey org-agenda-mode-map "G" #'org-agenda-toggle-time-grid)
   2460 (org-defkey org-agenda-mode-map "r" #'org-agenda-redo)
   2461 (org-defkey org-agenda-mode-map "g" #'org-agenda-redo-all)
   2462 (org-defkey org-agenda-mode-map "e" #'org-agenda-set-effort)
   2463 (org-defkey org-agenda-mode-map "\C-c\C-xe" #'org-agenda-set-effort)
   2464 (org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
   2465 	    #'org-clock-modify-effort-estimate)
   2466 (org-defkey org-agenda-mode-map "\C-c\C-xp" #'org-agenda-set-property)
   2467 (org-defkey org-agenda-mode-map "q" #'org-agenda-quit)
   2468 (org-defkey org-agenda-mode-map "Q" #'org-agenda-Quit)
   2469 (org-defkey org-agenda-mode-map "x" #'org-agenda-exit)
   2470 (org-defkey org-agenda-mode-map "\C-x\C-w" #'org-agenda-write)
   2471 (org-defkey org-agenda-mode-map "\C-x\C-s" #'org-save-all-org-buffers)
   2472 (org-defkey org-agenda-mode-map "s" #'org-save-all-org-buffers)
   2473 (org-defkey org-agenda-mode-map "T" #'org-agenda-show-tags)
   2474 (org-defkey org-agenda-mode-map "n" #'org-agenda-next-line)
   2475 (org-defkey org-agenda-mode-map "p" #'org-agenda-previous-line)
   2476 (org-defkey org-agenda-mode-map "N" #'org-agenda-next-item)
   2477 (org-defkey org-agenda-mode-map "P" #'org-agenda-previous-item)
   2478 (substitute-key-definition #'next-line #'org-agenda-next-line
   2479 			   org-agenda-mode-map global-map)
   2480 (substitute-key-definition #'previous-line #'org-agenda-previous-line
   2481 			   org-agenda-mode-map global-map)
   2482 (org-defkey org-agenda-mode-map "\C-c\C-a" #'org-attach)
   2483 (org-defkey org-agenda-mode-map "\C-c\C-n" #'org-agenda-next-date-line)
   2484 (org-defkey org-agenda-mode-map "\C-c\C-p" #'org-agenda-previous-date-line)
   2485 (org-defkey org-agenda-mode-map "\C-c," #'org-agenda-priority)
   2486 (org-defkey org-agenda-mode-map "," #'org-agenda-priority)
   2487 (org-defkey org-agenda-mode-map "i" #'org-agenda-diary-entry)
   2488 (org-defkey org-agenda-mode-map "c" #'org-agenda-goto-calendar)
   2489 (org-defkey org-agenda-mode-map "C" #'org-agenda-convert-date)
   2490 (org-defkey org-agenda-mode-map "M" #'org-agenda-phases-of-moon)
   2491 (org-defkey org-agenda-mode-map "S" #'org-agenda-sunrise-sunset)
   2492 (org-defkey org-agenda-mode-map "h" #'org-agenda-holidays)
   2493 (org-defkey org-agenda-mode-map "H" #'org-agenda-holidays)
   2494 (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" #'org-agenda-clock-in)
   2495 (org-defkey org-agenda-mode-map "I" #'org-agenda-clock-in)
   2496 (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" #'org-agenda-clock-out)
   2497 (org-defkey org-agenda-mode-map "O" #'org-agenda-clock-out)
   2498 (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" #'org-agenda-clock-cancel)
   2499 (org-defkey org-agenda-mode-map "X" #'org-agenda-clock-cancel)
   2500 (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" #'org-clock-goto)
   2501 (org-defkey org-agenda-mode-map "J" #'org-agenda-clock-goto)
   2502 (org-defkey org-agenda-mode-map "+" #'org-agenda-priority-up)
   2503 (org-defkey org-agenda-mode-map "-" #'org-agenda-priority-down)
   2504 (org-defkey org-agenda-mode-map [(shift up)] #'org-agenda-priority-up)
   2505 (org-defkey org-agenda-mode-map [(shift down)] #'org-agenda-priority-down)
   2506 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] #'org-agenda-priority-up)
   2507 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] #'org-agenda-priority-down)
   2508 (org-defkey org-agenda-mode-map "f" #'org-agenda-later)
   2509 (org-defkey org-agenda-mode-map "b" #'org-agenda-earlier)
   2510 (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" #'org-agenda-columns)
   2511 (org-defkey org-agenda-mode-map "\C-c\C-x>" #'org-agenda-remove-restriction-lock)
   2512 (org-defkey org-agenda-mode-map "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda)
   2513 (org-defkey org-agenda-mode-map "[" #'org-agenda-manipulate-query-add)
   2514 (org-defkey org-agenda-mode-map "]" #'org-agenda-manipulate-query-subtract)
   2515 (org-defkey org-agenda-mode-map "{" #'org-agenda-manipulate-query-add-re)
   2516 (org-defkey org-agenda-mode-map "}" #'org-agenda-manipulate-query-subtract-re)
   2517 (org-defkey org-agenda-mode-map "\\" #'org-agenda-filter-by-tag)
   2518 (org-defkey org-agenda-mode-map "_" #'org-agenda-filter-by-effort)
   2519 (org-defkey org-agenda-mode-map "=" #'org-agenda-filter-by-regexp)
   2520 (org-defkey org-agenda-mode-map "/" #'org-agenda-filter)
   2521 (org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all)
   2522 (org-defkey org-agenda-mode-map "~" #'org-agenda-limit-interactively)
   2523 (org-defkey org-agenda-mode-map "<" #'org-agenda-filter-by-category)
   2524 (org-defkey org-agenda-mode-map "^" #'org-agenda-filter-by-top-headline)
   2525 (org-defkey org-agenda-mode-map ";" #'org-timer-set-timer)
   2526 (org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop)
   2527 (org-defkey org-agenda-mode-map "?" #'org-agenda-show-the-flagging-note)
   2528 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" #'org-mobile-pull)
   2529 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" #'org-mobile-push)
   2530 (org-defkey org-agenda-mode-map "\C-c\C-xI" #'org-info-find-node)
   2531 (org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse)
   2532 (org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse)
   2533 (org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block)
   2534 (org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block)
   2535 (org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c)
   2536 
   2537 (when org-agenda-mouse-1-follows-link
   2538   (org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
   2539 
   2540 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu."
   2541   '("Agenda"
   2542     ("Agenda Files")
   2543     "--"
   2544     ("Agenda Dates"
   2545      ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)]
   2546      ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
   2547      ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
   2548      ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
   2549     "--"
   2550     ("View"
   2551      ["Day View" org-agenda-day-view
   2552       :active (org-agenda-check-type nil 'agenda)
   2553       :style radio :selected (eq org-agenda-current-span 'day)
   2554       :keys "v d  (or just d)"]
   2555      ["Week View" org-agenda-week-view
   2556       :active (org-agenda-check-type nil 'agenda)
   2557       :style radio :selected (eq org-agenda-current-span 'week)
   2558       :keys "v w"]
   2559      ["Fortnight View" org-agenda-fortnight-view
   2560       :active (org-agenda-check-type nil 'agenda)
   2561       :style radio :selected (eq org-agenda-current-span 'fortnight)
   2562       :keys "v t"]
   2563      ["Month View" org-agenda-month-view
   2564       :active (org-agenda-check-type nil 'agenda)
   2565       :style radio :selected (eq org-agenda-current-span 'month)
   2566       :keys "v m"]
   2567      ["Year View" org-agenda-year-view
   2568       :active (org-agenda-check-type nil 'agenda)
   2569       :style radio :selected (eq org-agenda-current-span 'year)
   2570       :keys "v y"]
   2571      "--"
   2572      ["Include Diary" org-agenda-toggle-diary
   2573       :style toggle :selected org-agenda-include-diary
   2574       :active (org-agenda-check-type nil 'agenda)]
   2575      ["Include Deadlines" org-agenda-toggle-deadlines
   2576       :style toggle :selected org-agenda-include-deadlines
   2577       :active (org-agenda-check-type nil 'agenda)]
   2578      ["Use Time Grid" org-agenda-toggle-time-grid
   2579       :style toggle :selected org-agenda-use-time-grid
   2580       :active (org-agenda-check-type nil 'agenda)]
   2581      "--"
   2582      ["Show clock report" org-agenda-clockreport-mode
   2583       :style toggle :selected org-agenda-clockreport-mode
   2584       :active (org-agenda-check-type nil 'agenda)]
   2585      ["Show some entry text" org-agenda-entry-text-mode
   2586       :style toggle :selected org-agenda-entry-text-mode
   2587       :active t]
   2588      "--"
   2589      ["Show Logbook entries" org-agenda-log-mode
   2590       :style toggle :selected org-agenda-show-log
   2591       :active (org-agenda-check-type nil 'agenda)
   2592       :keys "v l (or just l)"]
   2593      ["Include archived trees" org-agenda-archives-mode
   2594       :style toggle :selected org-agenda-archives-mode :active t
   2595       :keys "v a"]
   2596      ["Include archive files" (org-agenda-archives-mode t)
   2597       :style toggle :selected (eq org-agenda-archives-mode t) :active t
   2598       :keys "v A"]
   2599      "--"
   2600      ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
   2601     ("Filter current view"
   2602      ["with generic interface" org-agenda-filter t]
   2603      "--"
   2604      ["by category at cursor" org-agenda-filter-by-category t]
   2605      ["by tag" org-agenda-filter-by-tag t]
   2606      ["by effort" org-agenda-filter-by-effort t]
   2607      ["by regexp" org-agenda-filter-by-regexp t]
   2608      ["by top-level headline" org-agenda-filter-by-top-headline t]
   2609      "--"
   2610      ["Remove all filtering" org-agenda-filter-remove-all t]
   2611      "--"
   2612      ["limit" org-agenda-limit-interactively t])
   2613     ["Rebuild buffer" org-agenda-redo t]
   2614     ["Write view to file" org-agenda-write t]
   2615     ["Save all Org buffers" org-save-all-org-buffers t]
   2616     "--"
   2617     ["Show original entry" org-agenda-show t]
   2618     ["Go To (other window)" org-agenda-goto t]
   2619     ["Go To (this window)" org-agenda-switch-to t]
   2620     ["Capture with cursor date" org-agenda-capture t]
   2621     ["Follow Mode" org-agenda-follow-mode
   2622      :style toggle :selected org-agenda-follow-mode :active t]
   2623     ;;    ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
   2624     "--"
   2625     ("TODO"
   2626      ["Cycle TODO" org-agenda-todo t]
   2627      ["Next TODO set" org-agenda-todo-nextset t]
   2628      ["Previous TODO set" org-agenda-todo-previousset t]
   2629      ["Add note" org-agenda-add-note t])
   2630     ("Archive/Refile/Delete"
   2631      ["Archive default" org-agenda-archive-default t]
   2632      ["Archive default" org-agenda-archive-default-with-confirmation t]
   2633      ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
   2634      ["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
   2635      ["Archive subtree" org-agenda-archive t]
   2636      "--"
   2637      ["Refile" org-agenda-refile t]
   2638      "--"
   2639      ["Delete subtree" org-agenda-kill t])
   2640     ("Bulk action"
   2641      ["Mark entry" org-agenda-bulk-mark t]
   2642      ["Mark all" org-agenda-bulk-mark-all t]
   2643      ["Unmark entry" org-agenda-bulk-unmark t]
   2644      ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"]
   2645      ["Toggle mark" org-agenda-bulk-toggle t]
   2646      ["Toggle all" org-agenda-bulk-toggle-all t]
   2647      ["Mark regexp" org-agenda-bulk-mark-regexp t])
   2648     ["Act on all marked" org-agenda-bulk-action t]
   2649     "--"
   2650     ("Tags and Properties"
   2651      ["Show all Tags" org-agenda-show-tags t]
   2652      ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))]
   2653      ["Change tag in region" org-agenda-set-tags (org-region-active-p)]
   2654      "--"
   2655      ["Column View" org-columns t])
   2656     ("Deadline/Schedule"
   2657      ["Schedule" org-agenda-schedule t]
   2658      ["Set Deadline" org-agenda-deadline t]
   2659      "--"
   2660      ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)]
   2661      ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)]
   2662      ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"]
   2663      ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"]
   2664      ["Change Time +  min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"]
   2665      ["Change Time -  min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"]
   2666      ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)])
   2667     ("Clock and Effort"
   2668      ["Clock in" org-agenda-clock-in t]
   2669      ["Clock out" org-agenda-clock-out t]
   2670      ["Clock cancel" org-agenda-clock-cancel t]
   2671      ["Goto running clock" org-clock-goto t]
   2672      "--"
   2673      ["Set Effort" org-agenda-set-effort t]
   2674      ["Change clocked effort" org-clock-modify-effort-estimate
   2675       (org-clock-is-active)])
   2676     ("Priority"
   2677      ["Set Priority" org-agenda-priority t]
   2678      ["Increase Priority" org-agenda-priority-up t]
   2679      ["Decrease Priority" org-agenda-priority-down t]
   2680      ["Show Priority" org-priority-show t])
   2681     ("Calendar/Diary"
   2682      ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)]
   2683      ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)]
   2684      ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)]
   2685      ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)]
   2686      ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)]
   2687      ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)]
   2688      "--"
   2689      ["Create iCalendar File" org-icalendar-combine-agenda-files t])
   2690     "--"
   2691     ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
   2692     "--"
   2693     ("MobileOrg"
   2694      ["Push Files and Views" org-mobile-push t]
   2695      ["Get Captured and Flagged" org-mobile-pull t]
   2696      ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"]
   2697      ["Show note / unflag" org-agenda-show-the-flagging-note t]
   2698      "--"
   2699      ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
   2700     "--"
   2701     ["Quit" org-agenda-quit t]
   2702     ["Exit and Release Buffers" org-agenda-exit t]
   2703     ))
   2704 
   2705 ;;; Agenda undo
   2706 
   2707 (defvar org-agenda-allow-remote-undo t
   2708   "Non-nil means allow remote undo from the agenda buffer.")
   2709 (defvar org-agenda-undo-has-started-in nil
   2710   "Buffers that have already seen `undo-start' in the current undo sequence.")
   2711 
   2712 (defun org-agenda-undo ()
   2713   "Undo a remote editing step in the agenda.
   2714 This undoes changes both in the agenda buffer and in the remote buffer
   2715 that have been changed along."
   2716   (interactive)
   2717   (or org-agenda-allow-remote-undo
   2718       (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
   2719   (when (not (eq this-command last-command))
   2720     (setq org-agenda-undo-has-started-in nil
   2721 	  org-agenda-pending-undo-list org-agenda-undo-list))
   2722   (when (not org-agenda-pending-undo-list)
   2723     (user-error "No further undo information"))
   2724   (let* ((entry (pop org-agenda-pending-undo-list))
   2725 	 buf line cmd rembuf)
   2726     (setq cmd (pop entry) line (pop entry))
   2727     (setq rembuf (nth 2 entry))
   2728     (org-with-remote-undo rembuf
   2729       (while (bufferp (setq buf (pop entry)))
   2730 	(when (pop entry)
   2731 	  (with-current-buffer buf
   2732 	    (let (;; (last-undo-buffer buf)
   2733                   (inhibit-read-only t))
   2734 	      (unless (memq buf org-agenda-undo-has-started-in)
   2735 		(push buf org-agenda-undo-has-started-in)
   2736 		(make-local-variable 'pending-undo-list)
   2737 		(undo-start))
   2738 	      (while (and pending-undo-list
   2739 			  (listp pending-undo-list)
   2740 			  (not (car pending-undo-list)))
   2741 		(pop pending-undo-list))
   2742 	      (undo-more 1))))))
   2743     (org-goto-line line)
   2744     (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf))))
   2745 
   2746 (defun org-verify-change-for-undo (l1 l2)
   2747   "Verify that a real change occurred between the undo lists L1 and L2."
   2748   (while (and l1 (listp l1) (null (car l1))) (pop l1))
   2749   (while (and l2 (listp l2) (null (car l2))) (pop l2))
   2750   (not (eq l1 l2)))
   2751 
   2752 ;;; Agenda dispatch
   2753 
   2754 (defvar org-agenda-restrict-begin (make-marker)
   2755   "Internal variable used to mark the restriction beginning.
   2756 It is only relevant when `org-agenda-restrict' is a buffer.")
   2757 (defvar org-agenda-restrict-end (make-marker)
   2758   "Internal variable used to mark the restriction end.
   2759 It is only relevant when `org-agenda-restrict' is a buffer.")
   2760 (defvar org-agenda-overriding-restriction nil
   2761   "Non-nil means extended agenda restriction is active.
   2762 This is an internal flag set by `org-agenda-set-restriction-lock'.")
   2763 
   2764 (defcustom org-agenda-custom-commands-contexts nil
   2765   "Alist of custom agenda keys and contextual rules.
   2766 
   2767 For example, if you have a custom agenda command \"p\" and you
   2768 want this command to be accessible only from plain text files,
   2769 use this:
   2770 
   2771   (setq org-agenda-custom-commands-contexts
   2772         \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\")))))
   2773 
   2774 Here are the available contexts definitions:
   2775 
   2776       in-file: command displayed only in matching files
   2777       in-mode: command displayed only in matching modes
   2778   not-in-file: command not displayed in matching files
   2779   not-in-mode: command not displayed in matching modes
   2780     in-buffer: command displayed only in matching buffers
   2781 not-in-buffer: command not displayed in matching buffers
   2782    [function]: a custom function taking no argument
   2783 
   2784 If you define several checks, the agenda command will be
   2785 accessible if there is at least one valid check.
   2786 
   2787 You can also bind a key to another agenda custom command
   2788 depending on contextual rules.
   2789 
   2790   (setq org-agenda-custom-commands-contexts
   2791         \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\")))))
   2792 
   2793 Here it means: in .txt files, use \"p\" as the key for the
   2794 agenda command otherwise associated with \"q\".  (The command
   2795 originally associated with \"q\" is not displayed to avoid
   2796 duplicates.)"
   2797   :version "24.3"
   2798   :group 'org-agenda-custom-commands
   2799   :type '(repeat (list :tag "Rule"
   2800 		       (string :tag "        Agenda key")
   2801 		       (string :tag "Replace by command")
   2802 		       (repeat :tag "Available when"
   2803 			       (choice
   2804 				(cons :tag "Condition"
   2805 				      (choice
   2806 				       (const :tag "In file" in-file)
   2807 				       (const :tag "Not in file" not-in-file)
   2808 				       (const :tag "In buffer" in-buffer)
   2809 				       (const :tag "Not in buffer" not-in-buffer)
   2810 				       (const :tag "In mode" in-mode)
   2811 				       (const :tag "Not in mode" not-in-mode))
   2812 				      (regexp))
   2813 				(function :tag "Custom function"))))))
   2814 
   2815 (defcustom org-agenda-max-entries nil
   2816   "Maximum number of entries to display in an agenda.
   2817 This can be nil (no limit) or an integer or an alist of agenda
   2818 types with an associated number of entries to display in this
   2819 type."
   2820   :version "24.4"
   2821   :package-version '(Org . "8.0")
   2822   :group 'org-agenda-custom-commands
   2823   :type '(choice (symbol :tag "No limit" nil)
   2824 		 (integer :tag "Max number of entries")
   2825 		 (repeat
   2826 		  (cons (choice :tag "Agenda type"
   2827 				(const agenda)
   2828 				(const todo)
   2829 				(const tags)
   2830 				(const search))
   2831 			(integer :tag "Max number of entries")))))
   2832 
   2833 (defcustom org-agenda-max-todos nil
   2834   "Maximum number of TODOs to display in an agenda.
   2835 This can be nil (no limit) or an integer or an alist of agenda
   2836 types with an associated number of entries to display in this
   2837 type."
   2838   :version "24.4"
   2839   :package-version '(Org . "8.0")
   2840   :group 'org-agenda-custom-commands
   2841   :type '(choice (symbol :tag "No limit" nil)
   2842 		 (integer :tag "Max number of TODOs")
   2843 		 (repeat
   2844 		  (cons (choice :tag "Agenda type"
   2845 				(const agenda)
   2846 				(const todo)
   2847 				(const tags)
   2848 				(const search))
   2849 			(integer :tag "Max number of TODOs")))))
   2850 
   2851 (defcustom org-agenda-max-tags nil
   2852   "Maximum number of tagged entries to display in an agenda.
   2853 This can be nil (no limit) or an integer or an alist of agenda
   2854 types with an associated number of entries to display in this
   2855 type."
   2856   :version "24.4"
   2857   :package-version '(Org . "8.0")
   2858   :group 'org-agenda-custom-commands
   2859   :type '(choice (symbol :tag "No limit" nil)
   2860 		 (integer :tag "Max number of tagged entries")
   2861 		 (repeat
   2862 		  (cons (choice :tag "Agenda type"
   2863 				(const agenda)
   2864 				(const todo)
   2865 				(const tags)
   2866 				(const search))
   2867 			(integer :tag "Max number of tagged entries")))))
   2868 
   2869 (defcustom org-agenda-max-effort nil
   2870   "Maximum cumulated effort duration for the agenda.
   2871 This can be nil (no limit) or a number of minutes (as an integer)
   2872 or an alist of agenda types with an associated number of minutes
   2873 to limit entries to in this type."
   2874   :version "24.4"
   2875   :package-version '(Org . "8.0")
   2876   :group 'org-agenda-custom-commands
   2877   :type '(choice (symbol :tag "No limit" nil)
   2878 		 (integer :tag "Max number of minutes")
   2879 		 (repeat
   2880 		  (cons (choice :tag "Agenda type"
   2881 				(const agenda)
   2882 				(const todo)
   2883 				(const tags)
   2884 				(const search))
   2885 			(integer :tag "Max number of minutes")))))
   2886 
   2887 (defvar org-agenda-keep-restricted-file-list nil)
   2888 (defvar org-keys nil)
   2889 (defvar org-match nil)
   2890 ;;;###autoload
   2891 (defun org-agenda (&optional arg keys restriction)
   2892   "Dispatch agenda commands to collect entries to the agenda buffer.
   2893 Prompts for a command to execute.  Any prefix arg will be passed
   2894 on to the selected command.  The default selections are:
   2895 
   2896 a     Call `org-agenda-list' to display the agenda for current day or week.
   2897 t     Call `org-todo-list' to display the global todo list.
   2898 T     Call `org-todo-list' to display the global todo list, select only
   2899       entries with a specific TODO keyword (the user gets a prompt).
   2900 m     Call `org-tags-view' to display headlines with tags matching
   2901       a condition  (the user is prompted for the condition).
   2902 M     Like `m', but select only TODO entries, no ordinary headlines.
   2903 e     Export views to associated files.
   2904 s     Search entries for keywords.
   2905 S     Search entries for keywords, only with TODO keywords.
   2906 /     Multi occur across all agenda files and also files listed
   2907       in `org-agenda-text-search-extra-files'.
   2908 <     Restrict agenda commands to buffer, subtree, or region.
   2909       Press several times to get the desired effect.
   2910 >     Remove a previous restriction.
   2911 #     List \"stuck\" projects.
   2912 !     Configure what \"stuck\" means.
   2913 C     Configure custom agenda commands.
   2914 
   2915 More commands can be added by configuring the variable
   2916 `org-agenda-custom-commands'.  In particular, specific tags and TODO keyword
   2917 searches can be pre-defined in this way.
   2918 
   2919 If the current buffer is in Org mode and visiting a file, you can also
   2920 first press `<' once to indicate that the agenda should be temporarily
   2921 \(until the next use of `\\[org-agenda]') restricted to the current file.
   2922 Pressing `<' twice means to restrict to the current subtree or region
   2923 \(if active)."
   2924   (interactive "P")
   2925   (catch 'exit
   2926     (let* ((org-keys keys)
   2927 	   (prefix-descriptions nil)
   2928 	   (org-agenda-buffer-name org-agenda-buffer-name)
   2929 	   (org-agenda-window-setup (if (equal (buffer-name)
   2930 					       org-agenda-buffer-name)
   2931 					'current-window
   2932 				      org-agenda-window-setup))
   2933 	   (org-agenda-custom-commands-orig org-agenda-custom-commands)
   2934 	   (org-agenda-custom-commands
   2935 	    ;; normalize different versions
   2936 	    (delq nil
   2937 		  (mapcar
   2938 		   (lambda (x)
   2939 		     (cond ((stringp (cdr x))
   2940 			    (push x prefix-descriptions)
   2941 			    nil)
   2942 			   ((stringp (nth 1 x)) x)
   2943 			   ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
   2944 			   (t (cons (car x) (cons "" (cdr x))))))
   2945 		   org-agenda-custom-commands)))
   2946 	   (org-agenda-custom-commands
   2947 	    (org-contextualize-keys
   2948 	     org-agenda-custom-commands org-agenda-custom-commands-contexts))
   2949 	   ;; (buf (current-buffer))
   2950 	   (bfn (buffer-file-name (buffer-base-buffer)))
   2951 	   entry type org-match lprops ans) ;; key
   2952       ;; Turn off restriction unless there is an overriding one,
   2953       (unless org-agenda-overriding-restriction
   2954 	(unless org-agenda-keep-restricted-file-list
   2955 	  ;; There is a request to keep the file list in place
   2956 	  (put 'org-agenda-files 'org-restrict nil))
   2957 	(setq org-agenda-restrict nil)
   2958 	(move-marker org-agenda-restrict-begin nil)
   2959 	(move-marker org-agenda-restrict-end nil))
   2960       (unless org-keys
   2961 	(setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
   2962 	      org-keys (car ans)
   2963 	      restriction (cdr ans)))
   2964       ;; If we have sticky agenda buffers, set a name for the buffer,
   2965       ;; depending on the invoking keys.  The user may still set this
   2966       ;; as a command option, which will overwrite what we do here.
   2967       (when org-agenda-sticky
   2968 	(setq org-agenda-buffer-name
   2969 	      (format "*Org Agenda(%s)*" org-keys)))
   2970       ;; Establish the restriction, if any
   2971       (when (and (not org-agenda-overriding-restriction) restriction)
   2972 	(put 'org-agenda-files 'org-restrict (list bfn))
   2973 	(cond
   2974 	 ((eq restriction 'region)
   2975 	  (setq org-agenda-restrict (current-buffer))
   2976 	  (move-marker org-agenda-restrict-begin (region-beginning))
   2977 	  (move-marker org-agenda-restrict-end (region-end)))
   2978 	 ((eq restriction 'subtree)
   2979 	  (save-excursion
   2980 	    (setq org-agenda-restrict (current-buffer))
   2981 	    (org-back-to-heading t)
   2982 	    (move-marker org-agenda-restrict-begin (point))
   2983 	    (move-marker org-agenda-restrict-end
   2984 			 (progn (org-end-of-subtree t)))))
   2985 	 ((eq restriction 'buffer)
   2986           (if (not (buffer-narrowed-p))
   2987               (setq org-agenda-restrict t)
   2988             (setq org-agenda-restrict (current-buffer))
   2989 	    (move-marker org-agenda-restrict-begin (point-min))
   2990 	    (move-marker org-agenda-restrict-end (point-max))))))
   2991 
   2992       ;; For example the todo list should not need it (but does...)
   2993       (cond
   2994        ((setq entry (assoc org-keys org-agenda-custom-commands))
   2995 	(if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
   2996 	    (progn
   2997 	      ;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars)
   2998               ;; to some of the local variables?  There's no doc about
   2999               ;; that for `org-agenda-custom-commands'.
   3000 	      (setq type (nth 2 entry) org-match (eval (nth 3 entry) t)
   3001 		    lprops (nth 4 entry))
   3002 	      (when org-agenda-sticky
   3003 		(setq org-agenda-buffer-name
   3004 		      (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
   3005 			  (format "*Org Agenda(%s)*" org-keys))))
   3006 	      (cl-progv
   3007 	          (mapcar #'car lprops)
   3008 	          (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
   3009 	        (pcase type
   3010 	          (`agenda
   3011 	           (org-agenda-list arg))
   3012 	          (`agenda*
   3013 	           (org-agenda-list arg nil nil t))
   3014 	          (`alltodo
   3015 	           (org-todo-list arg))
   3016 	          (`search
   3017 	           (org-search-view arg org-match nil))
   3018 	          (`stuck
   3019 	           (org-agenda-list-stuck-projects arg))
   3020 	          (`tags
   3021 	           (org-tags-view arg org-match))
   3022 	          (`tags-todo
   3023 	           (org-tags-view '(4) org-match))
   3024 	          (`todo
   3025 		   (org-todo-list org-match))
   3026 		  (`tags-tree
   3027 		   (org-check-for-org-mode)
   3028 		   (org-match-sparse-tree arg org-match))
   3029 		  (`todo-tree
   3030 		   (org-check-for-org-mode)
   3031 		   (org-occur (concat "^" org-outline-regexp "[ \t]*"
   3032 				      (regexp-quote org-match) "\\>")))
   3033 		  (`occur-tree
   3034 		   (org-check-for-org-mode)
   3035 		   (org-occur org-match))
   3036 		  ((pred functionp)
   3037 		   (funcall type org-match))
   3038 		  ;; FIXME: Will signal an error since it's not `functionp'!
   3039 		  ((pred fboundp) (funcall type org-match))
   3040 		  (_ (user-error "Invalid custom agenda command type %s" type))))
   3041               (let ((inhibit-read-only t))
   3042 	        (add-text-properties (point-min) (point-max)
   3043 			             `(org-lprops ,lprops))))
   3044 	  (org-agenda-run-series (nth 1 entry) (cddr entry))))
   3045        ((equal org-keys "C")
   3046 	(setq org-agenda-custom-commands org-agenda-custom-commands-orig)
   3047 	(customize-variable 'org-agenda-custom-commands))
   3048        ((equal org-keys "a") (call-interactively 'org-agenda-list))
   3049        ((equal org-keys "s") (call-interactively 'org-search-view))
   3050        ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4))))
   3051        ((equal org-keys "t") (call-interactively 'org-todo-list))
   3052        ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
   3053        ((equal org-keys "m") (call-interactively 'org-tags-view))
   3054        ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
   3055        ((equal org-keys "e") (call-interactively 'org-store-agenda-views))
   3056        ((equal org-keys "?") (org-tags-view nil "+FLAGGED")
   3057 	(add-hook
   3058 	 'post-command-hook
   3059 	 (lambda ()
   3060 	   (unless (current-message)
   3061 	     (let* ((m (org-agenda-get-any-marker))
   3062 		    (note (and m (org-entry-get m "THEFLAGGINGNOTE"))))
   3063 	       (when note
   3064 		 (message "FLAGGING-NOTE ([?] for more info): %s"
   3065 			  (org-add-props
   3066 			      (replace-regexp-in-string
   3067 			       "\\\\n" "//"
   3068 			       (copy-sequence note))
   3069 			      nil 'face 'org-warning))))))
   3070 	 t t))
   3071        ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
   3072        ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
   3073        ((equal org-keys "!") (customize-variable 'org-stuck-projects))
   3074        (t (user-error "Invalid agenda key"))))))
   3075 
   3076 (defvar org-agenda-multi)
   3077 
   3078 (defun org-agenda-append-agenda ()
   3079   "Append another agenda view to the current one.
   3080 This function allows interactive building of block agendas.
   3081 Agenda views are separated by `org-agenda-block-separator'."
   3082   (interactive)
   3083   (unless (derived-mode-p 'org-agenda-mode)
   3084     (user-error "Can only append from within agenda buffer"))
   3085   (let ((org-agenda-multi t))
   3086     (org-agenda)
   3087     (widen)
   3088     (org-agenda-finalize)
   3089     (setq buffer-read-only t)
   3090     (org-agenda-fit-window-to-buffer)))
   3091 
   3092 (defun org-agenda-normalize-custom-commands (cmds)
   3093   "Normalize custom commands CMDS."
   3094   (delq nil
   3095 	(mapcar
   3096 	 (lambda (x)
   3097 	   (cond ((stringp (cdr x)) nil)
   3098 		 ((stringp (nth 1 x)) x)
   3099 		 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
   3100 		 (t (cons (car x) (cons "" (cdr x))))))
   3101 	 cmds)))
   3102 
   3103 (defun org-agenda-get-restriction-and-command (prefix-descriptions)
   3104   "The user interface for selecting an agenda command."
   3105   (catch 'exit
   3106     (let* ((bfn (buffer-file-name (buffer-base-buffer)))
   3107 	   (restrict-ok (and bfn (derived-mode-p 'org-mode)))
   3108 	   (region-p (org-region-active-p))
   3109 	   (custom org-agenda-custom-commands)
   3110 	   (selstring "")
   3111 	   restriction second-time
   3112 	   c entry key type match prefixes rmheader header-end custom1 desc
   3113 	   line lines left right n n1)
   3114       (save-window-excursion
   3115 	(delete-other-windows)
   3116 	(org-switch-to-buffer-other-window " *Agenda Commands*")
   3117 	(erase-buffer)
   3118 	(insert (eval-when-compile
   3119 		  (let ((header
   3120 			 (copy-sequence
   3121 			  "Press key for an agenda command:
   3122 --------------------------------        <   Buffer, subtree/region restriction
   3123 a   Agenda for current week or day      >   Remove restriction
   3124 t   List of all TODO entries            e   Export agenda views
   3125 m   Match a TAGS/PROP/TODO query        T   Entries with special TODO kwd
   3126 s   Search for keywords                 M   Like m, but only TODO entries
   3127 /   Multi-occur                         S   Like s, but only TODO entries
   3128 ?   Find :FLAGGED: entries              C   Configure custom agenda commands
   3129 *   Toggle sticky agenda views          #   List stuck projects (!=configure)
   3130 "))
   3131 			(start 0))
   3132 		    (while (string-match
   3133 			    "\\(^\\|   \\|(\\)\\(\\S-\\)\\( \\|=\\)"
   3134 			    header start)
   3135 		      (setq start (match-end 0))
   3136 		      (add-text-properties (match-beginning 2) (match-end 2)
   3137 					   '(face bold) header))
   3138 		    header)))
   3139 	(setq header-end (point-marker))
   3140 	(while t
   3141 	  (setq custom1 custom)
   3142 	  (when (eq rmheader t)
   3143 	    (org-goto-line 1)
   3144 	    (re-search-forward ":" nil t)
   3145             (delete-region (match-end 0) (line-end-position))
   3146 	    (forward-char 1)
   3147 	    (looking-at "-+")
   3148             (delete-region (match-end 0) (line-end-position))
   3149 	    (move-marker header-end (match-end 0)))
   3150 	  (goto-char header-end)
   3151 	  (delete-region (point) (point-max))
   3152 
   3153 	  ;; Produce all the lines that describe custom commands and prefixes
   3154 	  (setq lines nil)
   3155 	  (while (setq entry (pop custom1))
   3156 	    (setq key (car entry) desc (nth 1 entry)
   3157 		  type (nth 2 entry)
   3158 		  match (nth 3 entry))
   3159 	    (if (> (length key) 1)
   3160 		(cl-pushnew (string-to-char key) prefixes :test #'equal)
   3161 	      (setq line
   3162 		    (format
   3163 		     "%-4s%-14s"
   3164 		     (org-add-props (copy-sequence key)
   3165 			 '(face bold))
   3166 		     (cond
   3167 		      ((string-match "\\S-" desc) desc)
   3168 		      ((eq type 'agenda) "Agenda for current week or day")
   3169 		      ((eq type 'agenda*) "Appointments for current week or day")
   3170 		      ((eq type 'alltodo) "List of all TODO entries")
   3171 		      ((eq type 'search) "Word search")
   3172 		      ((eq type 'stuck) "List of stuck projects")
   3173 		      ((eq type 'todo) "TODO keyword")
   3174 		      ((eq type 'tags) "Tags query")
   3175 		      ((eq type 'tags-todo) "Tags (TODO)")
   3176 		      ((eq type 'tags-tree) "Tags tree")
   3177 		      ((eq type 'todo-tree) "TODO kwd tree")
   3178 		      ((eq type 'occur-tree) "Occur tree")
   3179 		      ((functionp type) (if (symbolp type)
   3180 					    (symbol-name type)
   3181 					  "Lambda expression"))
   3182 		      (t "???"))))
   3183 	      (cond
   3184 	       ((not (org-string-nw-p match)) nil)
   3185 	       (org-agenda-menu-show-matcher
   3186 		(setq line
   3187 		      (concat line ": "
   3188 			      (cond
   3189 			       ((stringp match)
   3190 				(propertize match 'face 'org-warning))
   3191 			       ((listp type)
   3192 				(format "set of %d commands" (length type)))))))
   3193 	       (t
   3194 		(org-add-props line nil 'help-echo (concat "Matcher: " match))))
   3195 	      (push line lines)))
   3196 	  (setq lines (nreverse lines))
   3197 	  (when prefixes
   3198 	    (mapc (lambda (x)
   3199 		    (push
   3200 		     (format "%s   %s"
   3201 			     (org-add-props (char-to-string x)
   3202 				 nil 'face 'bold)
   3203 			     (or (cdr (assoc (concat selstring
   3204 						     (char-to-string x))
   3205 					     prefix-descriptions))
   3206 				 "Prefix key"))
   3207 		     lines))
   3208 		  prefixes))
   3209 
   3210 	  ;; Check if we should display in two columns
   3211 	  (if org-agenda-menu-two-columns
   3212 	      (progn
   3213 		(setq n (length lines)
   3214 		      n1 (+ (/ n 2) (mod n 2))
   3215 		      right (nthcdr n1 lines)
   3216 		      left (copy-sequence lines))
   3217 		(setcdr (nthcdr (1- n1) left) nil))
   3218 	    (setq left lines right nil))
   3219 	  (while left
   3220 	    (insert "\n" (pop left))
   3221 	    (when right
   3222 	      (if (< (current-column) 40)
   3223 		  (move-to-column 40 t)
   3224 		(insert "   "))
   3225 	      (insert (pop right))))
   3226 
   3227 	  ;; Make the window the right size
   3228 	  (goto-char (point-min))
   3229 	  (if second-time
   3230 	      (when (not (pos-visible-in-window-p (point-max)))
   3231 		(org-fit-window-to-buffer))
   3232 	    (setq second-time t)
   3233 	    (org-fit-window-to-buffer))
   3234 
   3235 	  ;; Hint to navigation if window too small for all information
   3236 	  (setq header-line-format
   3237 		(when (not (pos-visible-in-window-p (point-max)))
   3238 		  "Use C-v, M-v, C-n or C-p to navigate."))
   3239 
   3240 	  ;; Ask for selection
   3241 	  (cl-loop
   3242 	   do (progn
   3243 		(message "Press key for agenda command%s:"
   3244 			 (if (or restrict-ok org-agenda-overriding-restriction)
   3245 			     (if org-agenda-overriding-restriction
   3246 				 " (restriction lock active)"
   3247 			       (if restriction
   3248 				   (format " (restricted to %s)" restriction)
   3249 				 " (unrestricted)"))
   3250 			   ""))
   3251 		(setq c (read-char-exclusive)))
   3252 	   until (not (memq c '(14 16 22 134217846)))
   3253 	   do (org-scroll c))
   3254 
   3255 	  (message "")
   3256 	  (cond
   3257 	   ((assoc (char-to-string c) custom)
   3258 	    (setq selstring (concat selstring (char-to-string c)))
   3259 	    (throw 'exit (cons selstring restriction)))
   3260 	   ((memq c prefixes)
   3261 	    (setq selstring (concat selstring (char-to-string c))
   3262 		  prefixes nil
   3263 		  rmheader (or rmheader t)
   3264 		  custom (delq nil (mapcar
   3265 				    (lambda (x)
   3266 				      (if (or (= (length (car x)) 1)
   3267 					      (/= (string-to-char (car x)) c))
   3268 					  nil
   3269 					(cons (substring (car x) 1) (cdr x))))
   3270 				    custom))))
   3271 	   ((eq c ?*)
   3272 	    (call-interactively 'org-toggle-sticky-agenda)
   3273 	    (sit-for 2))
   3274 	   ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
   3275 	    (message "Restriction is only possible in Org buffers")
   3276 	    (ding) (sit-for 1))
   3277 	   ((eq c ?1)
   3278 	    (org-agenda-remove-restriction-lock 'noupdate)
   3279 	    (setq restriction 'buffer))
   3280 	   ((eq c ?0)
   3281 	    (org-agenda-remove-restriction-lock 'noupdate)
   3282 	    (setq restriction (if region-p 'region 'subtree)))
   3283 	   ((eq c ?<)
   3284 	    (org-agenda-remove-restriction-lock 'noupdate)
   3285 	    (setq restriction
   3286 		  (cond
   3287 		   ((eq restriction 'buffer)
   3288 		    (if region-p 'region 'subtree))
   3289 		   ((memq restriction '(subtree region))
   3290 		    nil)
   3291 		   (t 'buffer))))
   3292 	   ((eq c ?>)
   3293 	    (org-agenda-remove-restriction-lock 'noupdate)
   3294 	    (setq restriction nil))
   3295 	   ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
   3296 	    (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
   3297            ((and (> (length selstring) 0) (eq c ?\d))
   3298             (delete-window)
   3299             (org-agenda-get-restriction-and-command prefix-descriptions))
   3300 
   3301 	   ((equal c ?q) (user-error "Abort"))
   3302 	   (t (user-error "Invalid key %c" c))))))))
   3303 
   3304 (defun org-agenda-fit-window-to-buffer ()
   3305   "Fit the window to the buffer size."
   3306   (and (memq org-agenda-window-setup '(reorganize-frame))
   3307        (fboundp 'fit-window-to-buffer)
   3308        (if (and (= (cdr org-agenda-window-frame-fractions) 1.0)
   3309 		(= (car org-agenda-window-frame-fractions) 1.0))
   3310 	   (delete-other-windows)
   3311 	 (org-fit-window-to-buffer
   3312 	  nil
   3313 	  (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
   3314 	  (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))))
   3315 
   3316 (defvar org-cmd nil)
   3317 (defvar org-agenda-overriding-cmd nil)
   3318 (defvar org-agenda-overriding-arguments nil)
   3319 (defvar org-agenda-overriding-cmd-arguments nil)
   3320 
   3321 (defun org-agenda-run-series (name series)
   3322   "Run agenda NAME as a SERIES of agenda commands."
   3323   (let* ((gprops (nth 1 series))
   3324          (gvars (mapcar #'car gprops))
   3325          (gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops)))
   3326     (cl-progv gvars gvals (org-agenda-prepare name))
   3327     ;; We need to reset agenda markers here, because when constructing a
   3328     ;; block agenda, the individual blocks do not do that.
   3329     (org-agenda-reset-markers)
   3330     (with-no-warnings
   3331       (defvar match))          ;Used via the `eval' below.
   3332     (let* ((org-agenda-multi t)
   3333 	   ;; FIXME: Redo should contain lists of (FUNS . ARGS) rather
   3334            ;; than expressions, so you don't need to `quote' the args
   3335            ;; and you just need to `apply' instead of `eval' when using it.
   3336 	   (redo (list 'org-agenda-run-series name (list 'quote series)))
   3337 	   (cmds (car series))
   3338 	   match
   3339 	   org-cmd type lprops)
   3340       (while (setq org-cmd (pop cmds))
   3341         (setq type (car org-cmd))
   3342         (setq match (eval (nth 1 org-cmd) t))
   3343         (setq lprops (nth 2 org-cmd))
   3344         (let ((org-agenda-overriding-arguments
   3345 	       (if (eq org-agenda-overriding-cmd org-cmd)
   3346 		   (or org-agenda-overriding-arguments
   3347 		       org-agenda-overriding-cmd-arguments)))
   3348               (lvars (mapcar #'car lprops))
   3349               (lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)))
   3350           (cl-progv (append gvars lvars) (append gvals lvals)
   3351 	    (pcase type
   3352 	      (`agenda
   3353 	       (call-interactively 'org-agenda-list))
   3354 	      (`agenda*
   3355 	       (funcall 'org-agenda-list nil nil t))
   3356 	      (`alltodo
   3357 	       (call-interactively 'org-todo-list))
   3358 	      (`search
   3359 	       (org-search-view current-prefix-arg match nil))
   3360 	      (`stuck
   3361 	       (call-interactively 'org-agenda-list-stuck-projects))
   3362 	      (`tags
   3363 	       (org-tags-view current-prefix-arg match))
   3364 	      (`tags-todo
   3365 	       (org-tags-view '(4) match))
   3366 	      (`todo
   3367 	       (org-todo-list match))
   3368 	      ((pred fboundp)
   3369 	       (funcall type match))
   3370 	      (_ (error "Invalid type in command series"))))))
   3371       (widen)
   3372       (let ((inhibit-read-only t))
   3373 	(add-text-properties (point-min) (point-max)
   3374 			     `(org-series t org-series-redo-cmd ,redo)))
   3375       (setq org-agenda-redo-command redo)
   3376       (goto-char (point-min)))
   3377     (org-agenda-fit-window-to-buffer)
   3378     (cl-progv gvars gvals (org-agenda-finalize))))
   3379 
   3380 (defun org-agenda--split-plist (plist)
   3381   ;; We could/should arguably use `map-keys' and `map-values'.
   3382   (let (keys vals)
   3383     (while plist
   3384       (push (pop plist) keys)
   3385       (push (pop plist) vals))
   3386     (cons (nreverse keys) (nreverse vals))))
   3387 
   3388 ;;;###autoload
   3389 (defmacro org-batch-agenda (cmd-key &rest parameters)
   3390   "Run an agenda command in batch mode and send the result to STDOUT.
   3391 If CMD-KEY is a string of length 1, it is used as a key in
   3392 `org-agenda-custom-commands' and triggers this command.  If it is a
   3393 longer string it is used as a tags/todo match string.
   3394 Parameters are alternating variable names and values that will be bound
   3395 before running the agenda command."
   3396   (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
   3397     `(org--batch-agenda ,cmd-key ',vars (list ,@exps))))
   3398 
   3399 (defun org--batch-agenda (cmd-key vars vals)
   3400   ;; `org-batch-agenda' is a macro because every other "parameter" is
   3401   ;; a variable name rather than an expression to evaluate.  Yuck!
   3402   (cl-progv vars vals
   3403     (let (org-agenda-sticky)
   3404       (if (> (length cmd-key) 1)
   3405 	  (org-tags-view nil cmd-key)
   3406 	(org-agenda nil cmd-key))))
   3407   (set-buffer org-agenda-buffer-name)
   3408   (princ (buffer-string)))
   3409 
   3410 (defvar org-agenda-info nil)
   3411 
   3412 ;;;###autoload
   3413 (defmacro org-batch-agenda-csv (cmd-key &rest parameters)
   3414   "Run an agenda command in batch mode and send the result to STDOUT.
   3415 If CMD-KEY is a string of length 1, it is used as a key in
   3416 `org-agenda-custom-commands' and triggers this command.  If it is a
   3417 longer string it is used as a tags/todo match string.
   3418 Parameters are alternating variable names and values that will be bound
   3419 before running the agenda command.
   3420 
   3421 The output gives a line for each selected agenda item.  Each
   3422 item is a list of comma-separated values, like this:
   3423 
   3424 category,head,type,todo,tags,date,time,extra,priority-l,priority-n
   3425 
   3426 category     The category of the item
   3427 head         The headline, without TODO kwd, TAGS and PRIORITY
   3428 type         The type of the agenda entry, can be
   3429                 todo               selected in TODO match
   3430                 tagsmatch          selected in tags match
   3431                 diary              imported from diary
   3432                 deadline           a deadline on given date
   3433                 scheduled          scheduled on given date
   3434                 timestamp          entry has timestamp on given date
   3435                 closed             entry was closed on given date
   3436                 upcoming-deadline  warning about deadline
   3437                 past-scheduled     forwarded scheduled item
   3438                 block              entry has date block including g. date
   3439 todo         The todo keyword, if any
   3440 tags         All tags including inherited ones, separated by colons
   3441 date         The relevant date, like 2007-2-14
   3442 time         The time, like 15:00-16:50
   3443 extra        String with extra planning info
   3444 priority-l   The priority letter if any was given
   3445 priority-n   The computed numerical priority
   3446 agenda-day   The day in the agenda where this is listed"
   3447   (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
   3448     `(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps))))
   3449 
   3450 (defun org--batch-agenda-csv (cmd-key vars vals)
   3451   ;; `org-batch-agenda-csv' is a macro because every other "parameter" is
   3452   ;; a variable name rather than an expression to evaluate.  Yuck!
   3453   (let ((org-agenda-remove-tags t))
   3454     (cl-progv vars vals
   3455       ;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)?
   3456       (if (> (length cmd-key) 2)
   3457 	  (org-tags-view nil cmd-key)
   3458 	(org-agenda nil cmd-key))))
   3459   (set-buffer org-agenda-buffer-name)
   3460   (let ((lines (org-split-string (buffer-string) "\n")))
   3461     (dolist (line lines)
   3462       (when (get-text-property 0 'org-category line)
   3463 	(setq org-agenda-info
   3464 	      (org-fix-agenda-info (text-properties-at 0 line)))
   3465 	(princ
   3466 	 (mapconcat #'org-agenda-export-csv-mapper
   3467 		    '(org-category txt type todo tags date time extra
   3468 		                   priority-letter priority agenda-day)
   3469 		    ","))
   3470 	(princ "\n")))))
   3471 
   3472 (defun org-fix-agenda-info (props)
   3473   "Make sure all properties on an agenda item have a canonical form.
   3474 This ensures the export commands can easily use it."
   3475   (let (tmp re)
   3476     (when (setq tmp (plist-get props 'tags))
   3477       (setq props (plist-put props 'tags (mapconcat #'identity tmp ":"))))
   3478     (when (setq tmp (plist-get props 'date))
   3479       (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
   3480       (let ((calendar-date-display-form
   3481              '(year "-" (string-pad month 2 ?0 'left) "-" (string-pad day 2 ?0 'left))))
   3482 	(setq tmp (calendar-date-string tmp)))
   3483       (setq props (plist-put props 'date tmp)))
   3484     (when (setq tmp (plist-get props 'day))
   3485       (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
   3486       (let ((calendar-date-display-form
   3487              '(year "-" (string-pad month 2 ?0 'left) "-" (string-pad day 2 ?0 'left))))
   3488 	(setq tmp (calendar-date-string tmp)))
   3489       (setq props (plist-put props 'day tmp))
   3490       (setq props (plist-put props 'agenda-day tmp)))
   3491     (when (setq tmp (plist-get props 'txt))
   3492       (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp)
   3493 	(plist-put props 'priority-letter (match-string 1 tmp))
   3494 	(setq tmp (replace-match "" t t tmp)))
   3495       (when (and (setq re (plist-get props 'org-todo-regexp))
   3496 		 (setq re (concat "\\`\\.*" re " ?"))
   3497 		 (let ((case-fold-search nil)) (string-match re tmp)))
   3498 	(plist-put props 'todo (match-string 1 tmp))
   3499 	(setq tmp (replace-match "" t t tmp)))
   3500       (plist-put props 'txt tmp)))
   3501   props)
   3502 
   3503 (defun org-agenda-export-csv-mapper (prop)
   3504   (let ((res (plist-get org-agenda-info prop)))
   3505     (setq res
   3506 	  (cond
   3507 	   ((not res) "")
   3508 	   ((stringp res) res)
   3509 	   (t (prin1-to-string res))))
   3510     (org-trim (replace-regexp-in-string "," ";" res nil t))))
   3511 
   3512 ;;;###autoload
   3513 (defun org-store-agenda-views (&rest _parameters)
   3514   "Store agenda views."
   3515   (interactive)
   3516   (org--batch-store-agenda-views nil nil))
   3517 
   3518 ;;;###autoload
   3519 (defmacro org-batch-store-agenda-views (&rest parameters)
   3520   "Run all custom agenda commands that have a file argument."
   3521   (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
   3522     `(org--batch-store-agenda-views ',vars (list ,@exps))))
   3523 
   3524 (defun org--batch-store-agenda-views (vars vals)
   3525   (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
   3526         (pop-up-frames nil)
   3527         (dir default-directory)
   3528         cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
   3529     (save-window-excursion
   3530       (while cmds
   3531 	(setq cmd (pop cmds)
   3532 	      thiscmdkey (car cmd)
   3533 	      thiscmdcmd (cdr cmd)
   3534 	      match (nth 2 thiscmdcmd)
   3535 	      bufname (if org-agenda-sticky
   3536 			  (or (and (stringp match)
   3537 				   (format "*Org Agenda(%s:%s)*" thiscmdkey match))
   3538 			      (format "*Org Agenda(%s)*" thiscmdkey))
   3539 			org-agenda-buffer-name)
   3540 	      cmd-or-set (nth 2 cmd)
   3541 	      opts (nth (if (listp cmd-or-set) 3 4) cmd)
   3542 	      files (nth (if (listp cmd-or-set) 4 5) cmd))
   3543 	(if (stringp files) (setq files (list files)))
   3544 	(when files
   3545 	  (let* ((opts (append org-agenda-exporter-settings opts))
   3546 	         (vars (append (mapcar #'car opts) vars))
   3547 	         (vals (append (mapcar (lambda (binding) (eval (cadr binding) t))
   3548 	                               opts)
   3549 	                       vals)))
   3550 	    (cl-progv vars vals
   3551 	      (org-agenda nil thiscmdkey))
   3552 	    (set-buffer bufname)
   3553 	    (while files
   3554 	      (cl-progv vars vals
   3555 	        (org-agenda-write (expand-file-name (pop files) dir)
   3556 	                          nil t bufname))))
   3557 	  (and (get-buffer bufname)
   3558 	       (kill-buffer bufname)))))))
   3559 
   3560 (defvar org-agenda-current-span nil
   3561   "The current span used in the agenda view.") ; local variable in the agenda buffer
   3562 (defun org-agenda-mark-header-line (pos)
   3563   "Mark the line at POS as an agenda structure header."
   3564   (save-excursion
   3565     (goto-char pos)
   3566     (put-text-property (line-beginning-position) (line-end-position)
   3567 		       'org-agenda-structural-header t)
   3568     (when org-agenda-title-append
   3569       (put-text-property (line-beginning-position) (line-end-position)
   3570 			 'org-agenda-title-append org-agenda-title-append))))
   3571 
   3572 (defvar org-mobile-creating-agendas) ; defined in org-mobile.el
   3573 (defvar org-agenda-write-buffer-name "Agenda View")
   3574 (defun org-agenda-write (file &optional open nosettings agenda-bufname)
   3575   "Write the current buffer (an agenda view) as a file.
   3576 
   3577 Depending on the extension of the file name, plain text (.txt),
   3578 HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
   3579 If the extension is .ics, translate visible agenda into iCalendar
   3580 format.  If the extension is .org, collect all subtrees
   3581 corresponding to the agenda entries and add them in an .org file.
   3582 
   3583 With prefix argument OPEN, open the new file immediately.  If
   3584 NOSETTINGS is given, do not scope the settings of
   3585 `org-agenda-exporter-settings' into the export commands.  This is
   3586 used when the settings have already been scoped and we do not
   3587 wish to overrule other, higher priority settings.  If
   3588 AGENDA-BUFFER-NAME is provided, use this as the buffer name for
   3589 the agenda to write."
   3590   (interactive "FWrite agenda to file: \nP")
   3591   (if (or (not (file-writable-p file))
   3592 	  (and (file-exists-p file)
   3593 	       (if (called-interactively-p 'any)
   3594 		   (not (y-or-n-p (format "Overwrite existing file %s? " file))))))
   3595       (user-error "Cannot write agenda to file %s" file))
   3596   (cl-progv
   3597       (if nosettings nil (mapcar #'car org-agenda-exporter-settings))
   3598       (if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t))
   3599                                  org-agenda-exporter-settings))
   3600     (save-excursion
   3601       (save-window-excursion
   3602 	(let ((bs (copy-sequence (buffer-string)))
   3603 	      (extension (file-name-extension file))
   3604 	      (default-directory (file-name-directory file))
   3605 	      ) ;; beg content
   3606 	  (with-temp-buffer
   3607 	    (rename-buffer org-agenda-write-buffer-name t)
   3608 	    (set-buffer-modified-p nil)
   3609 	    (insert bs)
   3610 	    (org-agenda-remove-marked-text 'invisible 'org-filtered)
   3611 	    (run-hooks 'org-agenda-before-write-hook)
   3612 	    (cond
   3613 	     ((bound-and-true-p org-mobile-creating-agendas)
   3614 	      (org-mobile-write-agenda-for-mobile file))
   3615 	     ((string= "org" extension)
   3616 	      (let (content p m message-log-max)
   3617 		(goto-char (point-min))
   3618 		(while (setq p (next-single-property-change (point) 'org-hd-marker nil))
   3619 		  (goto-char p)
   3620 		  (setq m (get-text-property (point) 'org-hd-marker))
   3621 		  (when m
   3622 		    (push (with-current-buffer (marker-buffer m)
   3623 			    (goto-char m)
   3624 			    (org-copy-subtree 1 nil t t)
   3625 			    org-subtree-clip)
   3626 			  content)))
   3627 		(find-file file)
   3628 		(erase-buffer)
   3629 		(dolist (s content) (org-paste-subtree 1 s))
   3630 		(write-file file)
   3631 		(kill-buffer (current-buffer))
   3632 		(message "Org file written to %s" file)))
   3633 	     ((member extension '("html" "htm"))
   3634 	      (or (require 'htmlize nil t)
   3635 		  (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
   3636 	      (declare-function htmlize-buffer "htmlize" (&optional buffer))
   3637 	      (set-buffer (htmlize-buffer (current-buffer)))
   3638 	      (when org-agenda-export-html-style
   3639 		;; replace <style> section with org-agenda-export-html-style
   3640 		(goto-char (point-min))
   3641 		(kill-region (- (search-forward "<style") 6)
   3642 			     (search-forward "</style>"))
   3643 		(insert org-agenda-export-html-style))
   3644 	      (write-file file)
   3645 	      (kill-buffer (current-buffer))
   3646 	      (message "HTML written to %s" file))
   3647 	     ((string= "ps" extension)
   3648 	      (require 'ps-print)
   3649 	      (ps-print-buffer-with-faces file)
   3650 	      (message "Postscript written to %s" file))
   3651 	     ((string= "pdf" extension)
   3652 	      (require 'ps-print)
   3653 	      (ps-print-buffer-with-faces
   3654 	       (concat (file-name-sans-extension file) ".ps"))
   3655 	      (call-process "ps2pdf" nil nil nil
   3656 			    (expand-file-name
   3657 			     (concat (file-name-sans-extension file) ".ps"))
   3658 			    (expand-file-name file))
   3659 	      (delete-file (concat (file-name-sans-extension file) ".ps"))
   3660 	      (message "PDF written to %s" file))
   3661 	     ((string= "ics" extension)
   3662 	      (require 'ox-icalendar)
   3663 	      (declare-function org-icalendar-export-current-agenda
   3664 	                        "ox-icalendar" (file))
   3665 	      (org-icalendar-export-current-agenda (expand-file-name file)))
   3666 	     (t
   3667 	      (let ((bs (buffer-string)))
   3668 		(find-file file)
   3669 		(erase-buffer)
   3670 		(insert bs)
   3671 		(save-buffer 0)
   3672 		(kill-buffer (current-buffer))
   3673 		(message "Plain text written to %s" file))))))))
   3674     (set-buffer (or agenda-bufname
   3675 		    ;; FIXME: I'm pretty sure called-interactively-p
   3676                     ;; doesn't do what we want here!
   3677 		    (and (called-interactively-p 'any) (buffer-name))
   3678 		    org-agenda-buffer-name)))
   3679   (when open (org-open-file file)))
   3680 
   3681 (defun org-agenda-remove-marked-text (property &optional value)
   3682   "Delete all text marked with VALUE of PROPERTY.
   3683 VALUE defaults to t."
   3684   (let (beg)
   3685     (setq value (or value t))
   3686     (while (setq beg (text-property-any (point-min) (point-max)
   3687 					property value))
   3688       (delete-region
   3689        beg (or (next-single-property-change beg property)
   3690 	       (point-max))))))
   3691 
   3692 (defun org-agenda-add-entry-text ()
   3693   "Add entry text to agenda lines.
   3694 This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
   3695 entry text following headings shown in the agenda.
   3696 Drawers will be excluded, also the line with scheduling/deadline info."
   3697   (when (and (> org-agenda-add-entry-text-maxlines 0)
   3698 	     (not (bound-and-true-p org-mobile-creating-agendas)))
   3699     (let (m txt)
   3700       (goto-char (point-min))
   3701       (while (not (eobp))
   3702 	(if (not (setq m (org-get-at-bol 'org-hd-marker)))
   3703 	    (beginning-of-line 2)
   3704 	  (setq txt (org-agenda-get-some-entry-text
   3705 		     m org-agenda-add-entry-text-maxlines "    > "))
   3706 	  (end-of-line 1)
   3707 	  (if (string-match "\\S-" txt)
   3708 	      (insert "\n" txt)
   3709 	    (or (eobp) (forward-char 1))))))))
   3710 
   3711 (defun org-agenda-get-some-entry-text (marker n-lines &optional indent
   3712 					      &rest keep)
   3713   "Extract entry text from MARKER, at most N-LINES lines.
   3714 This will ignore drawers etc, just get the text.
   3715 If INDENT is given, prefix every line with this string.  If KEEP is
   3716 given, it is a list of symbols, defining stuff that should not be
   3717 removed from the entry content.  Currently only `planning' is allowed here."
   3718   (let (txt drawer-re kwd-time-re ind)
   3719     (save-excursion
   3720       (with-current-buffer (marker-buffer marker)
   3721 	(if (not (derived-mode-p 'org-mode))
   3722 	    (setq txt "")
   3723 	  (org-with-wide-buffer
   3724 	   (goto-char marker)
   3725 	   (end-of-line 1)
   3726 	   (setq txt (buffer-substring
   3727 		      (min (1+ (point)) (point-max))
   3728 		      (progn (outline-next-heading) (point)))
   3729 		 drawer-re org-drawer-regexp
   3730 		 kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
   3731 				     ".*\n?"))
   3732 	   (with-temp-buffer
   3733 	     (insert txt)
   3734 	     (when org-agenda-add-entry-text-descriptive-links
   3735 	       (goto-char (point-min))
   3736 	       (while (org-activate-links (point-max))
   3737 		 (goto-char (match-end 0))))
   3738 	     (goto-char (point-min))
   3739 	     (while (re-search-forward org-link-bracket-re (point-max) t)
   3740 	       (set-text-properties (match-beginning 0) (match-end 0)
   3741 				    nil))
   3742 	     (goto-char (point-min))
   3743 	     (while (re-search-forward drawer-re nil t)
   3744 	       (delete-region
   3745 		(match-beginning 0)
   3746 		(progn (re-search-forward
   3747 			"^[ \t]*:END:.*\n?" nil 'move)
   3748 		       (point))))
   3749 	     (unless (member 'planning keep)
   3750 	       (goto-char (point-min))
   3751 	       (while (re-search-forward kwd-time-re nil t)
   3752 		 (replace-match "")))
   3753 	     (goto-char (point-min))
   3754 	     (when org-agenda-entry-text-exclude-regexps
   3755 	       (let ((re-list org-agenda-entry-text-exclude-regexps)	re)
   3756 		 (while (setq re (pop re-list))
   3757 		   (goto-char (point-min))
   3758 		   (while (re-search-forward re nil t)
   3759 		     (replace-match "")))))
   3760 	     (goto-char (point-max))
   3761 	     (skip-chars-backward " \t\n")
   3762 	     (when (looking-at "[ \t\n]+\\'") (replace-match ""))
   3763 
   3764 	     ;; find and remove min common indentation
   3765 	     (goto-char (point-min))
   3766 	     (untabify (point-min) (point-max))
   3767 	     (setq ind (org-current-text-indentation))
   3768 	     (while (not (eobp))
   3769 	       (unless (looking-at "[ \t]*$")
   3770 		 (setq ind (min ind (org-current-text-indentation))))
   3771 	       (beginning-of-line 2))
   3772 	     (goto-char (point-min))
   3773 	     (while (not (eobp))
   3774 	       (unless (looking-at "[ \t]*$")
   3775 		 (move-to-column ind)
   3776                  (delete-region (line-beginning-position) (point)))
   3777 	       (beginning-of-line 2))
   3778 
   3779 	     (run-hooks 'org-agenda-entry-text-cleanup-hook)
   3780 
   3781 	     (goto-char (point-min))
   3782 	     (when indent
   3783 	       (while (and (not (eobp)) (re-search-forward "^" nil t))
   3784 		 (replace-match indent t t)))
   3785 	     (goto-char (point-min))
   3786 	     (while (looking-at "[ \t]*\n") (replace-match ""))
   3787 	     (goto-char (point-max))
   3788 	     (when (> (org-current-line)
   3789 		      n-lines)
   3790 	       (org-goto-line (1+ n-lines))
   3791 	       (backward-char 1))
   3792 	     (setq txt (buffer-substring (point-min) (point))))))))
   3793     txt))
   3794 
   3795 (defun org-check-for-org-mode ()
   3796   "Make sure current buffer is in Org mode.  Error if not."
   3797   (or (derived-mode-p 'org-mode)
   3798       (error "Cannot execute Org agenda command on buffer in %s"
   3799 	     major-mode)))
   3800 
   3801 ;;; Agenda prepare and finalize
   3802 
   3803 (defvar org-agenda-multi nil)  ; dynamically scoped
   3804 (defvar org-agenda-pre-window-conf nil)
   3805 (defvar org-agenda-columns-active nil)
   3806 (defvar org-agenda-name nil)
   3807 (defvar org-agenda-tag-filter nil)
   3808 (defvar org-agenda-category-filter nil)
   3809 (defvar org-agenda-regexp-filter nil)
   3810 (defvar org-agenda-effort-filter nil)
   3811 (defvar org-agenda-top-headline-filter nil)
   3812 
   3813 (defvar org-agenda-represented-categories nil
   3814   "Cache for the list of all categories in the agenda.")
   3815 (defvar org-agenda-represented-tags nil
   3816   "Cache for the list of all categories in the agenda.")
   3817 (defvar org-agenda-tag-filter-preset nil
   3818   "A preset of the tags filter used for secondary agenda filtering.
   3819 This must be a list of strings, each string must be a single tag preceded
   3820 by \"+\" or \"-\".
   3821 This variable should not be set directly, but agenda custom commands can
   3822 bind it in the options section.  The preset filter is a global property of
   3823 the entire agenda view.  In a block agenda, it will not work reliably to
   3824 define a filter for one of the individual blocks.  You need to set it in
   3825 the global options and expect it to be applied to the entire view.")
   3826 
   3827 (defvar org-agenda-filters-preset nil
   3828   "Alist of filter types and associated preset of filters.
   3829 This variable is local in `org-agenda' buffers.  See `org-agenda-local-vars'.")
   3830 
   3831 (defconst org-agenda-filter-variables
   3832   '((category . org-agenda-category-filter)
   3833     (tag . org-agenda-tag-filter)
   3834     (effort . org-agenda-effort-filter)
   3835     (regexp . org-agenda-regexp-filter))
   3836   "Alist of filter types and associated variables.")
   3837 (defun org-agenda-filter-any ()
   3838   "Is any filter active?"
   3839   (cl-some (lambda (x)
   3840 	     (or (symbol-value (cdr x))
   3841                  (assoc-default (car x) org-agenda-filters-preset)))
   3842 	   org-agenda-filter-variables))
   3843 
   3844 (defvar org-agenda-category-filter-preset nil
   3845   "A preset of the category filter used for secondary agenda filtering.
   3846 This must be a list of strings, each string must be a single category
   3847 preceded by \"+\" or \"-\".
   3848 This variable should not be set directly, but agenda custom commands can
   3849 bind it in the options section.  The preset filter is a global property of
   3850 the entire agenda view.  In a block agenda, it will not work reliably to
   3851 define a filter for one of the individual blocks.  You need to set it in
   3852 the global options and expect it to be applied to the entire view.")
   3853 
   3854 (defvar org-agenda-regexp-filter-preset nil
   3855   "A preset of the regexp filter used for secondary agenda filtering.
   3856 This must be a list of strings, each string must be a single regexp
   3857 preceded by \"+\" or \"-\".
   3858 This variable should not be set directly, but agenda custom commands can
   3859 bind it in the options section.  The preset filter is a global property of
   3860 the entire agenda view.  In a block agenda, it will not work reliably to
   3861 define a filter for one of the individual blocks.  You need to set it in
   3862 the global options and expect it to be applied to the entire view.")
   3863 
   3864 (defvar org-agenda-effort-filter-preset nil
   3865   "A preset of the effort condition used for secondary agenda filtering.
   3866 This must be a list of strings, each string must be a single regexp
   3867 preceded by \"+\" or \"-\".
   3868 This variable should not be set directly, but agenda custom commands can
   3869 bind it in the options section.  The preset filter is a global property of
   3870 the entire agenda view.  In a block agenda, it will not work reliably to
   3871 define a filter for one of the individual blocks.  You need to set it in
   3872 the global options and expect it to be applied to the entire view.")
   3873 
   3874 (defun org-agenda-use-sticky-p ()
   3875   "Return non-nil if an agenda buffer named
   3876 `org-agenda-buffer-name' exists and should be shown instead of
   3877 generating a new one."
   3878   (and
   3879    ;; turned off by user
   3880    org-agenda-sticky
   3881    ;; For multi-agenda buffer already exists
   3882    (not org-agenda-multi)
   3883    ;; buffer found
   3884    (get-buffer org-agenda-buffer-name)
   3885    ;; C-u parameter is same as last call
   3886    (with-current-buffer (get-buffer org-agenda-buffer-name)
   3887      (and
   3888       (equal current-prefix-arg
   3889 	     org-agenda-last-prefix-arg)
   3890       ;; In case user turned stickiness on, while having existing
   3891       ;; Agenda buffer active, don't reuse that buffer, because it
   3892       ;; does not have org variables local
   3893       org-agenda-this-buffer-is-sticky))))
   3894 
   3895 (defvar org-agenda-buffer-tmp-name nil)
   3896 
   3897 (defun org-agenda--get-buffer-name (sticky-name)
   3898   (or org-agenda-buffer-tmp-name
   3899       (and org-agenda-doing-sticky-redo org-agenda-buffer-name)
   3900       sticky-name
   3901       "*Org Agenda*"))
   3902 
   3903 (defun org-agenda-prepare-window (abuf filter-alist)
   3904   "Setup agenda buffer in the window.
   3905 ABUF is the buffer for the agenda window.
   3906 FILTER-ALIST is an alist of filters we need to apply when
   3907 `org-agenda-persistent-filter' is non-nil."
   3908   (let* ((awin (get-buffer-window abuf)) wconf)
   3909     (cond
   3910      ((equal (current-buffer) abuf) nil)
   3911      (awin (select-window awin))
   3912      ((not (setq wconf (current-window-configuration))))
   3913      ((eq org-agenda-window-setup 'current-window)
   3914       (pop-to-buffer-same-window abuf))
   3915      ((eq org-agenda-window-setup 'other-window)
   3916       (org-switch-to-buffer-other-window abuf))
   3917      ((eq org-agenda-window-setup 'other-frame)
   3918       (switch-to-buffer-other-frame abuf))
   3919      ((eq org-agenda-window-setup 'other-tab)
   3920       (if (fboundp 'switch-to-buffer-other-tab)
   3921 	  (switch-to-buffer-other-tab abuf)
   3922 	(user-error "Your version of Emacs does not have tab bar support")))
   3923      ((eq org-agenda-window-setup 'only-window)
   3924       (delete-other-windows)
   3925       (pop-to-buffer-same-window abuf))
   3926      ((eq org-agenda-window-setup 'reorganize-frame)
   3927       (delete-other-windows)
   3928       (org-switch-to-buffer-other-window abuf)))
   3929     (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist)))
   3930     (setq org-agenda-category-filter (cdr (assq 'cat filter-alist)))
   3931     (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist)))
   3932     (setq org-agenda-regexp-filter (cdr (assq 're filter-alist)))
   3933     ;; Additional test in case agenda is invoked from within agenda
   3934     ;; buffer via elisp link.
   3935     (unless (equal (current-buffer) abuf)
   3936       (pop-to-buffer-same-window abuf))
   3937     (setq org-agenda-pre-window-conf
   3938 	  (or wconf org-agenda-pre-window-conf))))
   3939 
   3940 (defun org-agenda-prepare (&optional name)
   3941   (let ((filter-alist (when org-agenda-persistent-filter
   3942 			(with-current-buffer
   3943 			    (get-buffer-create org-agenda-buffer-name)
   3944 			  `((tag . ,org-agenda-tag-filter)
   3945 			    (re . ,org-agenda-regexp-filter)
   3946 			    (effort . ,org-agenda-effort-filter)
   3947 			    (cat . ,org-agenda-category-filter))))))
   3948     (if (org-agenda-use-sticky-p)
   3949 	(progn
   3950 	  ;; Popup existing buffer
   3951 	  (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
   3952 				     filter-alist)
   3953 	  (message "Sticky Agenda buffer, use `r' to refresh")
   3954 	  (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   3955 	  (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
   3956       (setq org-todo-keywords-for-agenda nil)
   3957       (if org-agenda-multi
   3958 	  (progn
   3959 	    (setq buffer-read-only nil)
   3960 	    (goto-char (point-max))
   3961 	    (unless (or (bobp) org-agenda-compact-blocks
   3962 			(not org-agenda-block-separator))
   3963 	      (insert "\n"
   3964 		      (if (stringp org-agenda-block-separator)
   3965 			  org-agenda-block-separator
   3966 			(make-string (window-max-chars-per-line) org-agenda-block-separator))
   3967 		      "\n"))
   3968 	    (narrow-to-region (point) (point-max)))
   3969 	(setq org-done-keywords-for-agenda nil)
   3970 	;; Setting any org variables that are in org-agenda-local-vars
   3971 	;; list need to be done after the prepare call
   3972 	(org-agenda-prepare-window
   3973 	 (get-buffer-create org-agenda-buffer-name) filter-alist)
   3974 	(setq buffer-read-only nil)
   3975 	(org-agenda-reset-markers)
   3976 	(let ((inhibit-read-only t)) (erase-buffer))
   3977 	(org-agenda-mode)
   3978 	(setq org-agenda-buffer (current-buffer))
   3979 	(setq org-agenda-contributing-files nil)
   3980 	(setq org-agenda-columns-active nil)
   3981         (setq org-agenda-filters-preset
   3982               `((tag . ,org-agenda-tag-filter-preset)
   3983                 (category . ,org-agenda-category-filter-preset)
   3984                 (regexp . ,org-agenda-regexp-filter-preset)
   3985                 (effort . ,org-agenda-effort-filter-preset)))
   3986         (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
   3987 	(setq org-todo-keywords-for-agenda
   3988 	      (org-uniquify org-todo-keywords-for-agenda))
   3989 	(setq org-done-keywords-for-agenda
   3990 	      (org-uniquify org-done-keywords-for-agenda))
   3991 	(setq org-agenda-last-prefix-arg current-prefix-arg)
   3992 	(setq org-agenda-this-buffer-name org-agenda-buffer-name)
   3993 	(and name (not org-agenda-name)
   3994 	     (setq-local org-agenda-name name)))
   3995       (setq buffer-read-only nil))))
   3996 
   3997 (defvar org-overriding-columns-format)
   3998 (defvar org-local-columns-format)
   3999 (defun org-agenda-finalize ()
   4000   "Finishing touch for the agenda buffer.
   4001 This function is called just before displaying the agenda.  If
   4002 you want to add your own functions to the finalization of the
   4003 agenda display, configure `org-agenda-finalize-hook'."
   4004   (unless org-agenda-multi
   4005     (let ((inhibit-read-only t))
   4006       (save-excursion
   4007 	(goto-char (point-min))
   4008 	(save-excursion
   4009 	  (while (org-activate-links (point-max))
   4010 	    (goto-char (match-end 0))))
   4011 	(unless (eq org-agenda-remove-tags t)
   4012 	  (org-agenda-align-tags))
   4013 	(unless org-agenda-with-colors
   4014 	  (remove-text-properties (point-min) (point-max) '(face nil)))
   4015 	(when (bound-and-true-p org-overriding-columns-format)
   4016 	  (setq-local org-local-columns-format
   4017 		      org-overriding-columns-format))
   4018 	(when org-agenda-view-columns-initially
   4019 	  (org-agenda-columns))
   4020 	(when org-agenda-fontify-priorities
   4021 	  (org-agenda-fontify-priorities))
   4022 	(when (and org-agenda-dim-blocked-tasks org-blocker-hook)
   4023 	  (org-agenda-dim-blocked-tasks))
   4024 	(org-agenda-mark-clocking-task)
   4025 	(when org-agenda-entry-text-mode
   4026 	  (org-agenda-entry-text-hide)
   4027 	  (org-agenda-entry-text-show))
   4028 	(when (and (featurep 'org-habit)
   4029 		   (save-excursion (next-single-property-change (point-min) 'org-habit-p)))
   4030 	  (org-habit-insert-consistency-graphs))
   4031 	(setq org-agenda-type (org-get-at-bol 'org-agenda-type))
   4032 	(unless (or (eq org-agenda-show-inherited-tags 'always)
   4033 		    (and (listp org-agenda-show-inherited-tags)
   4034 			 (memq org-agenda-type org-agenda-show-inherited-tags))
   4035 		    (and (eq org-agenda-show-inherited-tags t)
   4036 			 (or (eq org-agenda-use-tag-inheritance t)
   4037 			     (and (listp org-agenda-use-tag-inheritance)
   4038 				  (not (memq org-agenda-type
   4039 					     org-agenda-use-tag-inheritance))))))
   4040 	  (let (mrk)
   4041 	    (save-excursion
   4042 	      (goto-char (point-min))
   4043 	      (while (equal (forward-line) 0)
   4044 		(when (setq mrk (get-text-property (point) 'org-hd-marker))
   4045                   (put-text-property (line-beginning-position) (line-end-position)
   4046 				     'tags
   4047 				     (org-with-point-at mrk
   4048 				       (org-get-tags))))))))
   4049 	(setq org-agenda-represented-tags nil
   4050 	      org-agenda-represented-categories nil)
   4051 	(when org-agenda-top-headline-filter
   4052 	  (org-agenda-filter-top-headline-apply
   4053 	   org-agenda-top-headline-filter))
   4054 	(when org-agenda-tag-filter
   4055 	  (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
   4056 	(when (assoc-default 'tag org-agenda-filters-preset)
   4057 	  (org-agenda-filter-apply
   4058 	   (assoc-default 'tag org-agenda-filters-preset) 'tag t))
   4059 	(when org-agenda-category-filter
   4060 	  (org-agenda-filter-apply org-agenda-category-filter 'category))
   4061 	(when (assoc-default 'category org-agenda-filters-preset)
   4062 	  (org-agenda-filter-apply
   4063 	   (assoc-default 'category org-agenda-filters-preset) 'category))
   4064 	(when org-agenda-regexp-filter
   4065 	  (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
   4066 	(when (assoc-default 'regexp org-agenda-filters-preset)
   4067 	  (org-agenda-filter-apply
   4068 	   (assoc-default 'regexp org-agenda-filters-preset) 'regexp))
   4069 	(when org-agenda-effort-filter
   4070 	  (org-agenda-filter-apply org-agenda-effort-filter 'effort))
   4071 	(when (assoc-default 'effort org-agenda-filters-preset)
   4072 	  (org-agenda-filter-apply
   4073 	   (assoc-default 'effort org-agenda-filters-preset) 'effort))
   4074 	(add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local))
   4075       (run-hooks 'org-agenda-finalize-hook))))
   4076 
   4077 (defun org-agenda-mark-clocking-task ()
   4078   "Mark the current clock entry in the agenda if it is present."
   4079   ;; We need to widen when `org-agenda-finalize' is called from
   4080   ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in').
   4081   (when (bound-and-true-p org-clock-current-task)
   4082     (save-restriction
   4083       (widen)
   4084       (org-agenda-unmark-clocking-task)
   4085       (when (marker-buffer org-clock-hd-marker)
   4086 	(save-excursion
   4087 	  (goto-char (point-min))
   4088 	  (let (s ov)
   4089 	    (while (setq s (next-single-property-change (point) 'org-hd-marker))
   4090 	      (goto-char s)
   4091 	      (when (equal (org-get-at-bol 'org-hd-marker)
   4092 			   org-clock-hd-marker)
   4093                 (setq ov (make-overlay (line-beginning-position)
   4094                                        (1+ (line-end-position))))
   4095 		(overlay-put ov 'type 'org-agenda-clocking)
   4096 		(overlay-put ov 'face 'org-agenda-clocking)
   4097 		(overlay-put ov 'help-echo
   4098 			     "The clock is running in this item")))))))))
   4099 
   4100 (defun org-agenda-unmark-clocking-task ()
   4101   "Unmark the current clocking task."
   4102   (mapc (lambda (o)
   4103 	  (when (eq (overlay-get o 'type) 'org-agenda-clocking)
   4104 	    (delete-overlay o)))
   4105 	(overlays-in (point-min) (point-max))))
   4106 
   4107 (defun org-agenda-fontify-priorities ()
   4108   "Make highest priority lines bold, and lowest italic."
   4109   (interactive)
   4110   (mapc (lambda (o) (when (eq (overlay-get o 'org-type) 'org-priority)
   4111 		      (delete-overlay o)))
   4112 	(overlays-in (point-min) (point-max)))
   4113   (save-excursion
   4114     (let (b e p ov h l)
   4115       (goto-char (point-min))
   4116       (while (re-search-forward org-priority-regexp nil t)
   4117 	(setq h (or (get-char-property (point) 'org-priority-highest)
   4118 		    org-priority-highest)
   4119 	      l (or (get-char-property (point) 'org-priority-lowest)
   4120 		    org-priority-lowest)
   4121 	      p (string-to-char (match-string 2))
   4122 	      b (match-beginning 1)
   4123 	      e (if (eq org-agenda-fontify-priorities 'cookies)
   4124 		    (1+ (match-end 2))
   4125                   (line-end-position))
   4126 	      ov (make-overlay b e))
   4127 	(overlay-put
   4128 	 ov 'face
   4129 	 (let ((special-face
   4130 		(cond ((org-face-from-face-or-color
   4131 			'priority 'org-priority
   4132 			(cdr (assoc p org-priority-faces))))
   4133 		      ((and (listp org-agenda-fontify-priorities)
   4134 			    (org-face-from-face-or-color
   4135 			     'priority 'org-priority
   4136 			     (cdr (assoc p org-agenda-fontify-priorities)))))
   4137 		      ((equal p l) 'italic)
   4138 		      ((equal p h) 'bold))))
   4139 	   (if special-face (list special-face 'org-priority) 'org-priority)))
   4140 	(overlay-put ov 'org-type 'org-priority)))))
   4141 
   4142 (defvar org-depend-tag-blocked)
   4143 
   4144 (defun org-agenda-dim-blocked-tasks (&optional _invisible)
   4145   "Dim currently blocked TODOs in the agenda display.
   4146 When INVISIBLE is non-nil, hide currently blocked TODO instead of
   4147 dimming them."                   ;FIXME: The arg isn't used, actually!
   4148   (interactive "P")
   4149   (when (called-interactively-p 'interactive)
   4150     (message "Dim or hide blocked tasks..."))
   4151   (dolist (o (overlays-in (point-min) (point-max)))
   4152     (when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face)
   4153       (delete-overlay o)))
   4154   (save-excursion
   4155     (let ((inhibit-read-only t))
   4156       (goto-char (point-min))
   4157       (while (let ((pos (text-property-not-all
   4158 			 (point) (point-max) 'org-todo-blocked nil)))
   4159 	       (when pos (goto-char pos)))
   4160 	(let* ((invisible
   4161 		(eq (org-get-at-bol 'org-todo-blocked) 'invisible))
   4162 	       (todo-blocked
   4163 		(eq (org-get-at-bol 'org-filter-type) 'todo-blocked))
   4164 	       (ov (make-overlay (if invisible
   4165 				     (line-end-position 0)
   4166 				   (line-beginning-position))
   4167 				 (line-end-position))))
   4168 	  (when todo-blocked
   4169 	    (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
   4170 	  (when invisible
   4171 	    (org-agenda-filter-hide-line 'todo-blocked)))
   4172         (if (= (point-max) (line-end-position))
   4173             (goto-char (point-max))
   4174 	  (move-beginning-of-line 2)))))
   4175   (when (called-interactively-p 'interactive)
   4176     (message "Dim or hide blocked tasks...done")))
   4177 
   4178 (defun org-agenda--mark-blocked-entry (entry)
   4179   "If ENTRY is blocked, mark it for fontification or invisibility.
   4180 
   4181 If the header at `org-hd-marker' is blocked according to
   4182 `org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is
   4183 `invisible' and the header is not blocked by checkboxes, set the
   4184 text property `org-todo-blocked' to `invisible', otherwise set it
   4185 to t."
   4186   (when (get-text-property 0 'todo-state entry)
   4187     (let ((entry-marker (get-text-property 0 'org-hd-marker entry))
   4188           (org-blocked-by-checkboxes nil)
   4189 	  ;; Necessary so that `org-entry-blocked-p' does not change
   4190 	  ;; the buffer.
   4191           (org-depend-tag-blocked nil))
   4192       (when entry-marker
   4193 	(let ((blocked
   4194 	       (with-current-buffer (marker-buffer entry-marker)
   4195 		 (save-excursion
   4196 		   (goto-char entry-marker)
   4197 		   (org-entry-blocked-p)))))
   4198 	  (when blocked
   4199 	    (let ((really-invisible
   4200 		   (and (not org-blocked-by-checkboxes)
   4201 			(eq org-agenda-dim-blocked-tasks 'invisible))))
   4202 	      (put-text-property
   4203 	       0 (length entry) 'org-todo-blocked
   4204 	       (if really-invisible 'invisible t)
   4205 	       entry)
   4206 	      (put-text-property
   4207 	       0 (length entry) 'org-filter-type 'todo-blocked entry)))))))
   4208   entry)
   4209 
   4210 (defvar org-agenda-skip-function nil
   4211   "Function to be called at each match during agenda construction.
   4212 If this function returns nil, the current match should not be skipped.
   4213 Otherwise, the function must return a position from where the search
   4214 should be continued.
   4215 
   4216 This may also be a Lisp form that will be evaluated.  Useful
   4217 forms include `org-agenda-skip-entry-if' and
   4218 `org-agenda-skip-subtree-if'.  See the Info node `(org) Special
   4219 Agenda Views' for more details and examples.
   4220 
   4221 Never set this variable using `setq' or similar, because then it
   4222 will apply to all future agenda commands.  If you want a global
   4223 skipping condition, use the option `org-agenda-skip-function-global'
   4224 instead.
   4225 
   4226 The correct way to use `org-agenda-skip-function' is to bind it with `let'
   4227 to scope it dynamically into the agenda-constructing command.
   4228 A good way to set it is through options in `org-agenda-custom-commands'.")
   4229 
   4230 (defun org-agenda-skip (&optional element)
   4231   "Throw to `:skip' in places that should be skipped.
   4232 Also moves point to the end of the skipped region, so that search can
   4233 continue from there.
   4234 
   4235 Optional argument ELEMENT contains element at point."
   4236   (when (or
   4237          (if element
   4238              (eq (org-element-type element) 'comment)
   4239 	   (save-excursion
   4240              (goto-char (line-beginning-position))
   4241              (looking-at comment-start-skip)))
   4242 	 (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
   4243 	      (or (and (save-match-data (org-in-archived-heading-p nil element))
   4244 		       (org-end-of-subtree t element))
   4245 		  (and (member org-archive-tag org-file-tags)
   4246 		       (goto-char (point-max)))))
   4247 	 (and org-agenda-skip-comment-trees
   4248               (org-in-commented-heading-p nil element)
   4249 	      (org-end-of-subtree t element))
   4250          (let ((to (or (org-agenda-skip-eval org-agenda-skip-function-global)
   4251 		       (org-agenda-skip-eval org-agenda-skip-function))))
   4252            (and to (goto-char to)))
   4253 	 (org-in-src-block-p t element))
   4254     (throw :skip t)))
   4255 
   4256 (defun org-agenda-skip-eval (form)
   4257   "If FORM is a function or a list, call (or eval) it and return the result.
   4258 `save-excursion' and `save-match-data' are wrapped around the call, so point
   4259 and match data are returned to the previous state no matter what these
   4260 functions do."
   4261   (let (fp)
   4262     (and form
   4263 	 (or (setq fp (functionp form))
   4264 	     (consp form))
   4265 	 (save-excursion
   4266 	   (save-match-data
   4267 	     (if fp
   4268 		 (funcall form)
   4269 	       (eval form t)))))))
   4270 
   4271 (defvar org-agenda-markers nil
   4272   "List of all currently active markers created by `org-agenda'.")
   4273 (defvar org-agenda-last-marker-time (float-time)
   4274   "Creation time of the last agenda marker.")
   4275 
   4276 (defun org-agenda-new-marker (&optional pos)
   4277   "Return a new agenda marker.
   4278 Marker is at point, or at POS if non-nil.  Org mode keeps a list
   4279 of these markers and resets them when they are no longer in use."
   4280   (let ((m (copy-marker (or pos (point)) t)))
   4281     (setq org-agenda-last-marker-time (float-time))
   4282     (if (and org-agenda-buffer (buffer-live-p org-agenda-buffer))
   4283         (with-current-buffer org-agenda-buffer
   4284 	  (push m org-agenda-markers))
   4285       (push m org-agenda-markers))
   4286     m))
   4287 
   4288 (defun org-agenda-reset-markers ()
   4289   "Reset markers created by `org-agenda'."
   4290   (while org-agenda-markers
   4291     (move-marker (pop org-agenda-markers) nil)))
   4292 
   4293 (defun org-agenda-save-markers-for-cut-and-paste (beg end)
   4294   "Save relative positions of markers in region.
   4295 This check for agenda markers in all agenda buffers currently active."
   4296   (dolist (buf (buffer-list))
   4297     (with-current-buffer buf
   4298       (when (eq major-mode 'org-agenda-mode)
   4299 	(mapc (lambda (m) (org-check-and-save-marker m beg end))
   4300 	      org-agenda-markers)))))
   4301 
   4302 ;;; Entry text mode
   4303 
   4304 (defun org-agenda-entry-text-show-here ()
   4305   "Add some text from the entry as context to the current line."
   4306   (let (m txt o)
   4307     (setq m (org-get-at-bol 'org-hd-marker))
   4308     (unless (marker-buffer m)
   4309       (error "No marker points to an entry here"))
   4310     (setq txt (concat "\n" (org-no-properties
   4311 			    (org-agenda-get-some-entry-text
   4312 			     m org-agenda-entry-text-maxlines
   4313 			     org-agenda-entry-text-leaders))))
   4314     (when (string-match "\\S-" txt)
   4315       (setq o (make-overlay (line-beginning-position) (line-end-position)))
   4316       (overlay-put o 'evaporate t)
   4317       (overlay-put o 'org-overlay-type 'agenda-entry-content)
   4318       (overlay-put o 'after-string txt))))
   4319 
   4320 (defun org-agenda-entry-text-show ()
   4321   "Add entry context for all agenda lines."
   4322   (interactive)
   4323   (save-excursion
   4324     (goto-char (point-max))
   4325     (beginning-of-line 1)
   4326     (while (not (bobp))
   4327       (when (org-get-at-bol 'org-hd-marker)
   4328 	(org-agenda-entry-text-show-here))
   4329       (beginning-of-line 0))))
   4330 
   4331 (defun org-agenda-entry-text-hide ()
   4332   "Remove any shown entry context."
   4333   (mapc (lambda (o)
   4334 	  (when (eq (overlay-get o 'org-overlay-type)
   4335 		    'agenda-entry-content)
   4336 	    (delete-overlay o)))
   4337 	(overlays-in (point-min) (point-max))))
   4338 
   4339 (defun org-agenda-get-day-face (date)
   4340   "Return the face DATE should be displayed with."
   4341   (cond ((and (functionp org-agenda-day-face-function)
   4342 	      (funcall org-agenda-day-face-function date)))
   4343 	((and (org-agenda-today-p date)
   4344               (memq (calendar-day-of-week date) org-agenda-weekend-days))
   4345          'org-agenda-date-weekend-today)
   4346 	((org-agenda-today-p date) 'org-agenda-date-today)
   4347 	((memq (calendar-day-of-week date) org-agenda-weekend-days)
   4348 	 'org-agenda-date-weekend)
   4349 	(t 'org-agenda-date)))
   4350 
   4351 (defvar org-agenda-show-log-scoped)
   4352 
   4353 ;;; Agenda Daily/Weekly
   4354 
   4355 (defvar org-agenda-start-day nil  ; dynamically scoped parameter
   4356   "Start day for the agenda view.
   4357 Custom commands can set this variable in the options section.
   4358 This is usually a string like \"2007-11-01\", \"+2d\" or any other
   4359 input allowed when reading a date through the Org calendar.
   4360 See the docstring of `org-read-date' for details.")
   4361 (defvar org-starting-day nil) ; local variable in the agenda buffer
   4362 (defvar org-arg-loc nil) ; local variable
   4363 
   4364 ;;;###autoload
   4365 (defun org-agenda-list (&optional arg start-day span with-hour)
   4366   "Produce a daily/weekly view from all files in variable `org-agenda-files'.
   4367 The view will be for the current day or week, but from the overview buffer
   4368 you will be able to go to other days/weeks.
   4369 
   4370 With a numeric prefix argument in an interactive call, the agenda will
   4371 span ARG days.  Lisp programs should instead specify SPAN to change
   4372 the number of days.  SPAN defaults to `org-agenda-span'.
   4373 
   4374 START-DAY defaults to TODAY, or to the most recent match for the weekday
   4375 given in `org-agenda-start-on-weekday'.
   4376 
   4377 When WITH-HOUR is non-nil, only include scheduled and deadline
   4378 items if they have an hour specification like [h]h:mm."
   4379   (interactive "P")
   4380   (when org-agenda-overriding-arguments
   4381     (setq arg (car org-agenda-overriding-arguments)
   4382 	  start-day (nth 1 org-agenda-overriding-arguments)
   4383 	  span (nth 2 org-agenda-overriding-arguments)))
   4384   (when (and (integerp arg) (> arg 0))
   4385     (setq span arg arg nil))
   4386   (when (numberp span)
   4387     (unless (< 0 span)
   4388       (user-error "Agenda creation impossible for this span(=%d days)" span)))
   4389   (catch 'exit
   4390     (setq org-agenda-buffer-name
   4391 	  (org-agenda--get-buffer-name
   4392 	   (and org-agenda-sticky
   4393 		(cond ((and org-keys (stringp org-match))
   4394 		       (format "*Org Agenda(%s:%s)*" org-keys org-match))
   4395 		      (org-keys
   4396 		       (format "*Org Agenda(%s)*" org-keys))
   4397 		      (t "*Org Agenda(a)*")))))
   4398     (org-agenda-prepare "Day/Week")
   4399     (setq start-day (or start-day org-agenda-start-day))
   4400     (when (stringp start-day)
   4401       ;; Convert to an absolute day number
   4402       (setq start-day (time-to-days (org-read-date nil t start-day))))
   4403     (org-compile-prefix-format 'agenda)
   4404     (org-set-sorting-strategy 'agenda)
   4405     (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span)))
   4406 	   (today (org-today))
   4407 	   (sd (or start-day today))
   4408 	   (ndays (org-agenda-span-to-ndays span sd))
   4409 	   (org-agenda-start-on-weekday
   4410 	    (and (or (eq ndays 7) (eq ndays 14))
   4411 		 org-agenda-start-on-weekday))
   4412 	   (thefiles (org-agenda-files nil 'ifmode))
   4413 	   (files thefiles)
   4414 	   (start (if (or (null org-agenda-start-on-weekday)
   4415 			  (< ndays 7))
   4416 		      sd
   4417 		    (let* ((nt (calendar-day-of-week
   4418 				(calendar-gregorian-from-absolute sd)))
   4419 			   (n1 org-agenda-start-on-weekday)
   4420 			   (d (- nt n1)))
   4421 		      (- sd (+ (if (< d 0) 7 0) d)))))
   4422 	   (day-numbers (list start))
   4423 	   (day-cnt 0)
   4424            ;; FIXME: This may cause confusion when users are trying to
   4425            ;; debug agenda.  The debugger will not trigger without
   4426            ;; redisplay.
   4427 	   (inhibit-redisplay (not debug-on-error))
   4428 	   (org-agenda-show-log-scoped org-agenda-show-log)
   4429 	   s rtn rtnall file date d start-pos end-pos todayp ;; e
   4430 	   clocktable-start clocktable-end) ;; filter
   4431       (setq org-agenda-redo-command
   4432 	    (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
   4433       (dotimes (_ (1- ndays))
   4434 	(push (1+ (car day-numbers)) day-numbers))
   4435       (setq day-numbers (nreverse day-numbers))
   4436       (setq clocktable-start (car day-numbers)
   4437 	    clocktable-end (1+ (or (org-last day-numbers) 0)))
   4438       (setq-local org-starting-day (car day-numbers))
   4439       (setq-local org-arg-loc arg)
   4440       (setq-local org-agenda-current-span (org-agenda-ndays-to-span span))
   4441       (unless org-agenda-compact-blocks
   4442 	(let* ((d1 (car day-numbers))
   4443 	       (d2 (org-last day-numbers))
   4444 	       (w1 (org-days-to-iso-week d1))
   4445 	       (w2 (org-days-to-iso-week d2)))
   4446 	  (setq s (point))
   4447 	  (org-agenda--insert-overriding-header
   4448 	    (concat (org-agenda-span-name span)
   4449 		    "-agenda"
   4450 		    (cond ((<= 350 (- d2 d1)) "")
   4451                           ((= w1 w2) (format " (W%02d)" w1))
   4452                           (t (format " (W%02d-W%02d)" w1 w2)))
   4453 		    ":\n")))
   4454 	;; Add properties if we actually inserted a header.
   4455 	(when (> (point) s)
   4456 	  (add-text-properties s (1- (point))
   4457 			       (list 'face 'org-agenda-structure
   4458 				     'org-date-line t))
   4459 	  (org-agenda-mark-header-line s)))
   4460       (while (setq d (pop day-numbers))
   4461 	(setq date (calendar-gregorian-from-absolute d)
   4462 	      s (point))
   4463 	(if (or (setq todayp (= d today))
   4464 		(and (not start-pos) (= d sd)))
   4465 	    (setq start-pos (point))
   4466 	  (when (and start-pos (not end-pos))
   4467 	    (setq end-pos (point))))
   4468 	(setq files thefiles
   4469 	      rtnall nil)
   4470 	(while (setq file (pop files))
   4471 	  (catch 'nextfile
   4472 	    (org-check-agenda-file file)
   4473 	    (let ((org-agenda-entry-types org-agenda-entry-types))
   4474 	      ;; Starred types override non-starred equivalents
   4475 	      (when (member :deadline* org-agenda-entry-types)
   4476 		(setq org-agenda-entry-types
   4477 		      (delq :deadline org-agenda-entry-types)))
   4478 	      (when (member :scheduled* org-agenda-entry-types)
   4479 		(setq org-agenda-entry-types
   4480 		      (delq :scheduled org-agenda-entry-types)))
   4481 	      ;; Honor with-hour
   4482 	      (when with-hour
   4483 		(when (member :deadline org-agenda-entry-types)
   4484 		  (setq org-agenda-entry-types
   4485 			(delq :deadline org-agenda-entry-types))
   4486 		  (push :deadline* org-agenda-entry-types))
   4487 		(when (member :scheduled org-agenda-entry-types)
   4488 		  (setq org-agenda-entry-types
   4489 			(delq :scheduled org-agenda-entry-types))
   4490 		  (push :scheduled* org-agenda-entry-types)))
   4491 	      (unless org-agenda-include-deadlines
   4492 		(setq org-agenda-entry-types
   4493 		      (delq :deadline* (delq :deadline org-agenda-entry-types))))
   4494 	      (cond
   4495 	       ((memq org-agenda-show-log-scoped '(only clockcheck))
   4496 		(setq rtn (org-agenda-get-day-entries
   4497 			   file date :closed)))
   4498 	       (org-agenda-show-log-scoped
   4499 		(setq rtn (apply #'org-agenda-get-day-entries
   4500 				 file date
   4501 				 (append '(:closed) org-agenda-entry-types))))
   4502 	       (t
   4503 		(setq rtn (apply #'org-agenda-get-day-entries
   4504 				 file date
   4505 				 org-agenda-entry-types)))))
   4506 	    (setq rtnall (append rtnall rtn)))) ;; all entries
   4507 	(when org-agenda-include-diary
   4508 	  (let ((org-agenda-search-headline-for-time t))
   4509 	    (require 'diary-lib)
   4510 	    (setq rtn (org-get-entries-from-diary date))
   4511 	    (setq rtnall (append rtnall rtn))))
   4512 	(when (or rtnall org-agenda-show-all-dates)
   4513 	  (setq day-cnt (1+ day-cnt))
   4514 	  (insert
   4515 	   (if (stringp org-agenda-format-date)
   4516 	       (format-time-string org-agenda-format-date
   4517 				   (org-time-from-absolute date))
   4518 	     (funcall org-agenda-format-date date))
   4519 	   "\n")
   4520 	  (put-text-property s (1- (point)) 'face
   4521 			     (org-agenda-get-day-face date))
   4522 	  (put-text-property s (1- (point)) 'org-date-line t)
   4523 	  (put-text-property s (1- (point)) 'org-agenda-date-header t)
   4524 	  (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
   4525 	  (when todayp
   4526 	    (put-text-property s (1- (point)) 'org-today t))
   4527 	  (setq rtnall
   4528 		(org-agenda-add-time-grid-maybe rtnall ndays todayp))
   4529 	  (when rtnall (insert ;; all entries
   4530 			(org-agenda-finalize-entries rtnall 'agenda)
   4531 			"\n"))
   4532 	  (put-text-property s (1- (point)) 'day d)
   4533 	  (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))
   4534       (when (and org-agenda-clockreport-mode clocktable-start)
   4535 	(let ((org-agenda-files (org-agenda-files nil 'ifmode))
   4536 	      ;; the above line is to ensure the restricted range!
   4537 	      (p (copy-sequence org-agenda-clockreport-parameter-plist))
   4538 	      tbl)
   4539 	  (setq p (org-plist-delete p :block))
   4540 	  (setq p (plist-put p :tstart clocktable-start))
   4541 	  (setq p (plist-put p :tend clocktable-end))
   4542 	  (setq p (plist-put p :scope 'agenda))
   4543 	  (setq tbl (apply #'org-clock-get-clocktable p))
   4544           (when org-agenda-clock-report-header
   4545             (insert (propertize org-agenda-clock-report-header 'face 'org-agenda-structure))
   4546             (unless (string-suffix-p "\n" org-agenda-clock-report-header)
   4547               (insert "\n")))
   4548 	  (insert tbl)))
   4549       (goto-char (point-min))
   4550       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   4551       (unless (or (not (get-buffer-window org-agenda-buffer-name))
   4552 		  (and (pos-visible-in-window-p (point-min))
   4553 		       (pos-visible-in-window-p (point-max))))
   4554 	(goto-char (1- (point-max)))
   4555 	(recenter -1)
   4556 	(when (not (pos-visible-in-window-p (or start-pos 1)))
   4557 	  (goto-char (or start-pos 1))
   4558 	  (recenter 1)))
   4559       (goto-char (or start-pos 1))
   4560       (add-text-properties (point-min) (point-max)
   4561 			   `(org-agenda-type agenda
   4562 					     org-last-args (,arg ,start-day ,span)
   4563 					     org-redo-cmd ,org-agenda-redo-command
   4564 					     org-series-cmd ,org-cmd))
   4565       (when (eq org-agenda-show-log-scoped 'clockcheck)
   4566 	(org-agenda-show-clocking-issues))
   4567       (org-agenda-finalize)
   4568       (setq buffer-read-only t)
   4569       (message ""))))
   4570 
   4571 (defun org-agenda-ndays-to-span (n)
   4572   "Return a span symbol for a span of N days, or N if none matches."
   4573   (cond ((symbolp n) n)
   4574 	((= n 1) 'day)
   4575 	((= n 7) 'week)
   4576 	((= n 14) 'fortnight)
   4577 	(t n)))
   4578 
   4579 (defun org-agenda-span-to-ndays (span &optional start-day)
   4580   "Return ndays from SPAN, possibly starting at START-DAY.
   4581 START-DAY is an absolute time value."
   4582   (cond ((numberp span) span)
   4583 	((eq span 'day) 1)
   4584 	((eq span 'week) 7)
   4585 	((eq span 'fortnight) 14)
   4586 	((eq span 'month)
   4587 	 (let ((date (calendar-gregorian-from-absolute start-day)))
   4588 	   (calendar-last-day-of-month (car date) (cl-caddr date))))
   4589 	((eq span 'year)
   4590 	 (let ((date (calendar-gregorian-from-absolute start-day)))
   4591 	   (if (calendar-leap-year-p (cl-caddr date)) 366 365)))))
   4592 
   4593 (defun org-agenda-span-name (span)
   4594   "Return a SPAN name."
   4595   (if (null span)
   4596       ""
   4597     (if (symbolp span)
   4598 	(capitalize (symbol-name span))
   4599       (format "%d days" span))))
   4600 
   4601 ;;; Agenda word search
   4602 
   4603 (defvar org-agenda-search-history nil)
   4604 
   4605 (defvar org-search-syntax-table nil
   4606   "Special syntax table for Org search.
   4607 In this table, we have single quotes not as word constituents, to
   4608 that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
   4609 
   4610 (defvar org-mode-syntax-table) ; From org.el
   4611 (defun org-search-syntax-table ()
   4612   (unless org-search-syntax-table
   4613     (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table))
   4614     (modify-syntax-entry ?' "." org-search-syntax-table)
   4615     (modify-syntax-entry ?` "." org-search-syntax-table))
   4616   org-search-syntax-table)
   4617 
   4618 (defvar org-agenda-last-search-view-search-was-boolean nil)
   4619 
   4620 ;;;###autoload
   4621 (defun org-search-view (&optional todo-only string edit-at)
   4622   "Show all entries that contain a phrase or words or regular expressions.
   4623 
   4624 With optional prefix argument TODO-ONLY, only consider entries that are
   4625 TODO entries.  The argument STRING can be used to pass a default search
   4626 string into this function.  If EDIT-AT is non-nil, it means that the
   4627 user should get a chance to edit this string, with cursor at position
   4628 EDIT-AT.
   4629 
   4630 The search string can be viewed either as a phrase that should be found as
   4631 is, or it can be broken into a number of snippets, each of which must match
   4632 in a Boolean way to select an entry.  The default depends on the variable
   4633 `org-agenda-search-view-always-boolean'.
   4634 Even if this is turned off (the default) you can always switch to
   4635 Boolean search dynamically by preceding the first word with  \"+\" or \"-\".
   4636 
   4637 The default is a direct search of the whole phrase, where each space in
   4638 the search string can expand to an arbitrary amount of whitespace,
   4639 including newlines.
   4640 
   4641 If using a Boolean search, the search string is split on whitespace and
   4642 each snippet is searched separately, with logical AND to select an entry.
   4643 Words prefixed with a minus must *not* occur in the entry.  Words without
   4644 a prefix or prefixed with a plus must occur in the entry.  Matching is
   4645 case-insensitive.  Words are enclosed by word delimiters (i.e. they must
   4646 match whole words, not parts of a word) if
   4647 `org-agenda-search-view-force-full-words' is set (default is nil).
   4648 
   4649 Boolean search snippets enclosed by curly braces are interpreted as
   4650 regular expressions that must or (when preceded with \"-\") must not
   4651 match in the entry.  Snippets enclosed into double quotes will be taken
   4652 as a whole, to include whitespace.
   4653 
   4654 - If the search string starts with an asterisk, search only in headlines.
   4655 - If (possibly after the leading star) the search string starts with an
   4656   exclamation mark, this also means to look at TODO entries only, an effect
   4657   that can also be achieved with a prefix argument.
   4658 - If (possibly after star and exclamation mark) the search string starts
   4659   with a colon, this will mean that the (non-regexp) snippets of the
   4660   Boolean search must match as full words.
   4661 
   4662 This command searches the agenda files, and in addition the files
   4663 listed in `org-agenda-text-search-extra-files' unless a restriction lock
   4664 is active."
   4665   (interactive "P")
   4666   (when org-agenda-overriding-arguments
   4667     (setq todo-only (car org-agenda-overriding-arguments)
   4668 	  string (nth 1 org-agenda-overriding-arguments)
   4669 	  edit-at (nth 2 org-agenda-overriding-arguments)))
   4670   (let* ((props (list 'face nil
   4671 		      'done-face 'org-agenda-done
   4672 		      'org-not-done-regexp org-not-done-regexp
   4673 		      'org-todo-regexp org-todo-regexp
   4674 		      'org-complex-heading-regexp org-complex-heading-regexp
   4675 		      'mouse-face 'highlight
   4676 		      'help-echo "mouse-2 or RET jump to location"))
   4677 	 (full-words org-agenda-search-view-force-full-words)
   4678 	 (org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
   4679 	 regexp rtn rtnall files file pos inherited-tags
   4680 	 marker category level tags c neg re boolean
   4681 	 ee txt beg end last-search-end words regexps+ regexps- hdl-only buffer beg1 str)
   4682     (unless (and (not edit-at)
   4683 		 (stringp string)
   4684 		 (string-match "\\S-" string))
   4685       (setq string (read-string
   4686 		    (if org-agenda-search-view-always-boolean
   4687 			"[+-]Word/{Regexp} ...: "
   4688 		      "Phrase or [+-]Word/{Regexp} ...: ")
   4689 		    (cond
   4690 		     ((integerp edit-at) (cons string edit-at))
   4691 		     (edit-at string))
   4692 		    'org-agenda-search-history)))
   4693     (catch 'exit
   4694       (setq org-agenda-buffer-name
   4695 	    (org-agenda--get-buffer-name
   4696 	     (and org-agenda-sticky
   4697 		  (if (stringp string)
   4698 		      (format "*Org Agenda(%s:%s)*"
   4699 			      (or org-keys (or (and todo-only "S") "s"))
   4700 			      string)
   4701 		    (format "*Org Agenda(%s)*"
   4702 			    (or (and todo-only "S") "s"))))))
   4703       (org-agenda-prepare "SEARCH")
   4704       (org-compile-prefix-format 'search)
   4705       (org-set-sorting-strategy 'search)
   4706       (setq org-agenda-redo-command
   4707 	    (list 'org-search-view (if todo-only t nil)
   4708 		  (list 'if 'current-prefix-arg nil string)))
   4709       (setq org-agenda-query-string string)
   4710       (if (equal (string-to-char string) ?*)
   4711 	  (setq hdl-only t
   4712 		words (substring string 1))
   4713 	(setq words string))
   4714       (when (equal (string-to-char words) ?!)
   4715 	(setq todo-only t
   4716 	      words (substring words 1)))
   4717       (when (equal (string-to-char words) ?:)
   4718 	(setq full-words t
   4719 	      words (substring words 1)))
   4720       (when (or org-agenda-search-view-always-boolean
   4721 		(member (string-to-char words) '(?- ?+ ?\{)))
   4722 	(setq boolean t))
   4723       (setq words (split-string words))
   4724       (let (www w)
   4725 	(while (setq w (pop words))
   4726 	  (while (and (string-match "\\\\\\'" w) words)
   4727 	    (setq w (concat (substring w 0 -1) " " (pop words))))
   4728 	  (push w www))
   4729 	(setq words (nreverse www) www nil)
   4730 	(while (setq w (pop words))
   4731 	  (when (and (string-match "\\`[-+]?{" w)
   4732 		     (not (string-match "}\\'" w)))
   4733 	    (while (and words (not (string-match "}\\'" (car words))))
   4734 	      (setq w (concat w " " (pop words))))
   4735 	    (setq w (concat w " " (pop words))))
   4736 	  (push w www))
   4737 	(setq words (nreverse www)))
   4738       (setq org-agenda-last-search-view-search-was-boolean boolean)
   4739       (when boolean
   4740 	(let (wds w)
   4741 	  (while (setq w (pop words))
   4742 	    (when (or (equal (substring w 0 1) "\"")
   4743 		      (and (> (length w) 1)
   4744 			   (member (substring w 0 1) '("+" "-"))
   4745 			   (equal (substring w 1 2) "\"")))
   4746 	      (while (and words (not (equal (substring w -1) "\"")))
   4747 		(setq w (concat w " " (pop words)))))
   4748 	    (and (string-match "\\`\\([-+]?\\)\"" w)
   4749 		 (setq w (replace-match "\\1" nil nil w)))
   4750 	    (and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
   4751 	    (push w wds))
   4752 	  (setq words (nreverse wds))))
   4753       (if boolean
   4754 	  (mapc (lambda (w)
   4755 		  (setq c (string-to-char w))
   4756 		  (if (equal c ?-)
   4757 		      (setq neg t w (substring w 1))
   4758 		    (if (equal c ?+)
   4759 			(setq neg nil w (substring w 1))
   4760 		      (setq neg nil)))
   4761 		  (if (string-match "\\`{.*}\\'" w)
   4762 		      (setq re (substring w 1 -1))
   4763 		    (if full-words
   4764 			(setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
   4765 		      (setq re (regexp-quote (downcase w)))))
   4766 		  (if neg (push re regexps-) (push re regexps+)))
   4767 		words)
   4768 	(push (mapconcat #'regexp-quote words "\\s-+")
   4769 	      regexps+))
   4770       (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
   4771       (if (not regexps+)
   4772 	  (setq regexp org-outline-regexp-bol)
   4773 	(setq regexp (pop regexps+))
   4774 	(when hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
   4775 					    regexp))))
   4776       (setq files (org-agenda-files nil 'ifmode))
   4777       ;; Add `org-agenda-text-search-extra-files' unless there is some
   4778       ;; restriction.
   4779       (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
   4780 	(pop org-agenda-text-search-extra-files)
   4781 	(unless (get 'org-agenda-files 'org-restrict)
   4782 	  (setq files (org-add-archive-files files))))
   4783       ;; Uniquify files.  However, let `org-check-agenda-file' handle
   4784       ;; non-existent ones.
   4785       (setq files (cl-remove-duplicates
   4786 		   (append files org-agenda-text-search-extra-files)
   4787 		   :test (lambda (a b)
   4788 			   (and (file-exists-p a)
   4789 				(file-exists-p b)
   4790 				(file-equal-p a b))))
   4791 	    rtnall nil)
   4792       (while (setq file (pop files))
   4793 	(setq ee nil)
   4794 	(catch 'nextfile
   4795 	  (org-check-agenda-file file)
   4796 	  (setq buffer (if (file-exists-p file)
   4797 			   (org-get-agenda-file-buffer file)
   4798 			 (error "No such file %s" file)))
   4799 	  (unless buffer
   4800 	    ;; If file does not exist, make sure an error message is sent
   4801 	    (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
   4802 				    file))))
   4803 	  (with-current-buffer buffer
   4804 	    (with-syntax-table (org-search-syntax-table)
   4805 	      (unless (derived-mode-p 'org-mode)
   4806 		(error "Agenda file %s is not in Org mode" file))
   4807 	      (let ((case-fold-search t))
   4808 		(save-excursion
   4809 		  (save-restriction
   4810 		    (if (eq buffer org-agenda-restrict)
   4811 			(narrow-to-region org-agenda-restrict-begin
   4812 					  org-agenda-restrict-end)
   4813 		      (widen))
   4814 		    (goto-char (point-min))
   4815 		    (unless (or (org-at-heading-p)
   4816 				(outline-next-heading))
   4817 		      (throw 'nextfile t))
   4818 		    (goto-char (max (point-min) (1- (point))))
   4819 		    (while (re-search-forward regexp nil t)
   4820                       (setq last-search-end (point))
   4821 		      (org-back-to-heading t)
   4822 		      (while (and (not (zerop org-agenda-search-view-max-outline-level))
   4823 				  (> (org-reduced-level (org-outline-level))
   4824 				     org-agenda-search-view-max-outline-level)
   4825 				  (forward-line -1)
   4826 				  (org-back-to-heading t)))
   4827 		      (skip-chars-forward "* ")
   4828                       (setq beg (line-beginning-position)
   4829 			    beg1 (point)
   4830 			    end (progn
   4831 				  (outline-next-heading)
   4832 				  (while (and (not (zerop org-agenda-search-view-max-outline-level))
   4833 					      (> (org-reduced-level (org-outline-level))
   4834 						 org-agenda-search-view-max-outline-level)
   4835 					      (forward-line 1)
   4836 					      (outline-next-heading)))
   4837 				  (point)))
   4838 
   4839 		      (catch :skip
   4840 			(goto-char beg)
   4841 			(org-agenda-skip)
   4842 			(setq str (buffer-substring-no-properties
   4843                                    (line-beginning-position)
   4844                                    (if hdl-only (line-end-position) end)))
   4845 			(mapc (lambda (wr) (when (string-match wr str)
   4846 					     (goto-char (1- end))
   4847 					     (throw :skip t)))
   4848 			      regexps-)
   4849 			(mapc (lambda (wr) (unless (string-match wr str)
   4850 					     (goto-char (1- end))
   4851 					     (throw :skip t)))
   4852 			      (if todo-only
   4853 				  (cons (concat "^\\*+[ \t]+"
   4854                                                 org-not-done-regexp)
   4855 					regexps+)
   4856 				regexps+))
   4857 			(goto-char beg)
   4858 			(setq marker (org-agenda-new-marker (point))
   4859 			      category (org-get-category)
   4860 			      level (make-string (org-reduced-level (org-outline-level)) ? )
   4861 			      inherited-tags
   4862 			      (or (eq org-agenda-show-inherited-tags 'always)
   4863 				  (and (listp org-agenda-show-inherited-tags)
   4864 				       (memq 'todo org-agenda-show-inherited-tags))
   4865 				  (and (eq org-agenda-show-inherited-tags t)
   4866 				       (or (eq org-agenda-use-tag-inheritance t)
   4867 					   (memq 'todo org-agenda-use-tag-inheritance))))
   4868 			      tags (org-get-tags nil (not inherited-tags))
   4869 			      txt (org-agenda-format-item
   4870 				   ""
   4871 				   (buffer-substring-no-properties
   4872                                     beg1 (line-end-position))
   4873 				   level category tags t))
   4874 			(org-add-props txt props
   4875 			  'org-marker marker 'org-hd-marker marker
   4876 			  'org-todo-regexp org-todo-regexp
   4877 			  'level level
   4878 			  'org-complex-heading-regexp org-complex-heading-regexp
   4879 			  'priority 1000
   4880 			  'type "search")
   4881 			(push txt ee)
   4882 			(goto-char (max (1- end) last-search-end))))))))))
   4883 	(setq rtn (nreverse ee))
   4884 	(setq rtnall (append rtnall rtn)))
   4885       (org-agenda--insert-overriding-header
   4886 	(with-temp-buffer
   4887 	  (insert "Search words: ")
   4888 	  (add-text-properties (point-min) (1- (point))
   4889 			       (list 'face 'org-agenda-structure))
   4890 	  (setq pos (point))
   4891 	  (insert string "\n")
   4892 	  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter))
   4893 	  (setq pos (point))
   4894 	  (unless org-agenda-multi
   4895 	    (insert (substitute-command-keys "\\<org-agenda-mode-map>\
   4896 Press `\\[org-agenda-manipulate-query-add]', \
   4897 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
   4898 `\\[org-agenda-manipulate-query-add-re]', \
   4899 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
   4900 `\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n"))
   4901 	    (add-text-properties pos (1- (point))
   4902 				 (list 'face 'org-agenda-structure-secondary)))
   4903 	  (buffer-string)))
   4904       (org-agenda-mark-header-line (point-min))
   4905       (when rtnall
   4906 	(insert (org-agenda-finalize-entries rtnall 'search) "\n"))
   4907       (goto-char (point-min))
   4908       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   4909       (add-text-properties (point-min) (point-max)
   4910 			   `(org-agenda-type search
   4911 					     org-last-args (,todo-only ,string ,edit-at)
   4912 					     org-redo-cmd ,org-agenda-redo-command
   4913 					     org-series-cmd ,org-cmd))
   4914       (org-agenda-finalize)
   4915       (setq buffer-read-only t))))
   4916 
   4917 ;;; Agenda TODO list
   4918 
   4919 (defun org-agenda-propertize-selected-todo-keywords (keywords)
   4920   "Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
   4921   (concat
   4922    (if (or (equal keywords "ALL") (not keywords))
   4923        (propertize "ALL" 'face 'org-agenda-structure-filter)
   4924      (mapconcat
   4925       (lambda (kw)
   4926         (propertize kw 'face (list (org-get-todo-face kw) 'org-agenda-structure)))
   4927       (org-split-string keywords "|")
   4928       "|"))
   4929    "\n"))
   4930 
   4931 (defvar org-select-this-todo-keyword nil)
   4932 (defvar org-last-arg nil)
   4933 
   4934 (defvar crm-separator)
   4935 
   4936 ;;;###autoload
   4937 (defun org-todo-list (&optional arg)
   4938   "Show all (not done) TODO entries from all agenda files in a single list.
   4939 The prefix arg can be used to select a specific TODO keyword and limit
   4940 the list to these.  When using `\\[universal-argument]', you will be prompted
   4941 for a keyword.  A numeric prefix directly selects the Nth keyword in
   4942 `org-todo-keywords-1'."
   4943   (interactive "P")
   4944   (when org-agenda-overriding-arguments
   4945     (setq arg org-agenda-overriding-arguments))
   4946   (when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
   4947   (let* ((today (org-today))
   4948 	 (date (calendar-gregorian-from-absolute today))
   4949 	 (completion-ignore-case t)
   4950          kwds org-select-this-todo-keyword rtn rtnall files file pos)
   4951     (catch 'exit
   4952       (setq org-agenda-buffer-name
   4953 	    (org-agenda--get-buffer-name
   4954 	     (and org-agenda-sticky
   4955 		  (if (stringp org-select-this-todo-keyword)
   4956 		      (format "*Org Agenda(%s:%s)*" (or org-keys "t")
   4957 			      org-select-this-todo-keyword)
   4958 		    (format "*Org Agenda(%s)*" (or org-keys "t"))))))
   4959       (org-agenda-prepare "TODO")
   4960       (setq kwds org-todo-keywords-for-agenda
   4961             org-select-this-todo-keyword (if (stringp arg) arg
   4962                                            (and (integerp arg)
   4963 						(> arg 0)
   4964                                                 (nth (1- arg) kwds))))
   4965       (when (equal arg '(4))
   4966         (setq org-select-this-todo-keyword
   4967               (mapconcat #'identity
   4968                          (let ((crm-separator "|"))
   4969                            (completing-read-multiple
   4970                             "Keyword (or KWD1|KWD2|...): "
   4971                             (mapcar #'list kwds) nil nil))
   4972                          "|")))
   4973       (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
   4974       (org-compile-prefix-format 'todo)
   4975       (org-set-sorting-strategy 'todo)
   4976       (setq org-agenda-redo-command
   4977 	    `(org-todo-list (or (and (numberp current-prefix-arg)
   4978 				     current-prefix-arg)
   4979 				,org-select-this-todo-keyword
   4980 				current-prefix-arg ,arg)))
   4981       (setq files (org-agenda-files nil 'ifmode)
   4982 	    rtnall nil)
   4983       (while (setq file (pop files))
   4984 	(catch 'nextfile
   4985 	  (org-check-agenda-file file)
   4986 	  (setq rtn (org-agenda-get-day-entries file date :todo))
   4987 	  (setq rtnall (append rtnall rtn))))
   4988       (org-agenda--insert-overriding-header
   4989         (with-temp-buffer
   4990 	  (insert "Global list of TODO items of type: ")
   4991 	  (add-text-properties (point-min) (1- (point))
   4992 			       (list 'face 'org-agenda-structure
   4993 				     'short-heading
   4994 				     (concat "ToDo: "
   4995 					     (or org-select-this-todo-keyword "ALL"))))
   4996 	  (org-agenda-mark-header-line (point-min))
   4997 	  (insert (org-agenda-propertize-selected-todo-keywords
   4998 		   org-select-this-todo-keyword))
   4999 	  (setq pos (point))
   5000 	  (unless org-agenda-multi
   5001 	    (insert (substitute-command-keys "Press \
   5002 \\<org-agenda-mode-map>`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \
   5003 to search again: (0)[ALL]"))
   5004 	    (let ((n 0))
   5005               (dolist (k kwds)
   5006                 (let ((s (format "(%d)%s" (cl-incf n) k)))
   5007                   (when (> (+ (current-column) (string-width s) 1) (window-max-chars-per-line))
   5008                     (insert "\n                     "))
   5009                   (insert " " s))))
   5010 	    (insert "\n"))
   5011 	  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary))
   5012 	  (buffer-string)))
   5013       (org-agenda-mark-header-line (point-min))
   5014       (when rtnall
   5015 	(insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
   5016       (goto-char (point-min))
   5017       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   5018       (add-text-properties (point-min) (point-max)
   5019 			   `(org-agenda-type todo
   5020 					     org-last-args ,arg
   5021 					     org-redo-cmd ,org-agenda-redo-command
   5022 					     org-series-cmd ,org-cmd))
   5023       (org-agenda-finalize)
   5024       (setq buffer-read-only t))))
   5025 
   5026 ;;; Agenda tags match
   5027 
   5028 ;;;###autoload
   5029 (defun org-tags-view (&optional todo-only match)
   5030   "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
   5031 The prefix arg TODO-ONLY limits the search to TODO entries."
   5032   (interactive "P")
   5033   (when org-agenda-overriding-arguments
   5034     (setq todo-only (car org-agenda-overriding-arguments)
   5035 	  match (nth 1 org-agenda-overriding-arguments)))
   5036   (let* ((org-tags-match-list-sublevels
   5037 	  org-tags-match-list-sublevels)
   5038 	 (completion-ignore-case t)
   5039 	 (org--matcher-tags-todo-only todo-only)
   5040 	 rtn rtnall files file pos matcher
   5041 	 buffer)
   5042     (when (and (stringp match) (not (string-match "\\S-" match)))
   5043       (setq match nil))
   5044     (catch 'exit
   5045       (setq org-agenda-buffer-name
   5046 	    (org-agenda--get-buffer-name
   5047 	     (and org-agenda-sticky
   5048 		  (if (stringp match)
   5049 		      (format "*Org Agenda(%s:%s)*"
   5050 			      (or org-keys (or (and todo-only "M") "m"))
   5051 			      match)
   5052 		    (format "*Org Agenda(%s)*"
   5053 			    (or (and todo-only "M") "m"))))))
   5054       (setq matcher (org-make-tags-matcher match))
   5055       ;; Prepare agendas (and `org-tag-alist-for-agenda') before
   5056       ;; expanding tags within `org-make-tags-matcher'
   5057       (org-agenda-prepare (concat "TAGS " match))
   5058       (setq match (car matcher)
   5059 	    matcher (cdr matcher))
   5060       (org-compile-prefix-format 'tags)
   5061       (org-set-sorting-strategy 'tags)
   5062       (setq org-agenda-query-string match)
   5063       (setq org-agenda-redo-command
   5064 	    (list 'org-tags-view
   5065 		  `(quote ,org--matcher-tags-todo-only)
   5066 		  `(if current-prefix-arg nil ,org-agenda-query-string)))
   5067       (setq files (org-agenda-files nil 'ifmode)
   5068 	    rtnall nil)
   5069       (while (setq file (pop files))
   5070 	(catch 'nextfile
   5071 	  (org-check-agenda-file file)
   5072 	  (setq buffer (if (file-exists-p file)
   5073 			   (org-get-agenda-file-buffer file)
   5074 			 (error "No such file %s" file)))
   5075 	  (if (not buffer)
   5076 	      ;; If file does not exist, error message to agenda
   5077 	      (setq rtn (list
   5078 			 (format "ORG-AGENDA-ERROR: No such org-file %s" file))
   5079 		    rtnall (append rtnall rtn))
   5080 	    (with-current-buffer buffer
   5081 	      (unless (derived-mode-p 'org-mode)
   5082 		(error "Agenda file %s is not in Org mode" file))
   5083 	      (save-excursion
   5084 		(save-restriction
   5085 		  (if (eq buffer org-agenda-restrict)
   5086 		      (narrow-to-region org-agenda-restrict-begin
   5087 					org-agenda-restrict-end)
   5088 		    (widen))
   5089 		  (setq rtn (org-scan-tags 'agenda
   5090 					   matcher
   5091 					   org--matcher-tags-todo-only))
   5092 		  (setq rtnall (append rtnall rtn))))))))
   5093       (org-agenda--insert-overriding-header
   5094         (with-temp-buffer
   5095 	  (insert "Headlines with TAGS match: ")
   5096 	  (add-text-properties (point-min) (1- (point))
   5097 			       (list 'face 'org-agenda-structure
   5098 				     'short-heading
   5099 				     (concat "Match: " match)))
   5100 	  (setq pos (point))
   5101 	  (insert match "\n")
   5102 	  (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter))
   5103 	  (setq pos (point))
   5104 	  (unless org-agenda-multi
   5105 	    (insert (substitute-command-keys
   5106 		     "Press \
   5107 \\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \
   5108 to search again\n")))
   5109 	  (add-text-properties pos (1- (point))
   5110 			       (list 'face 'org-agenda-structure-secondary))
   5111 	  (buffer-string)))
   5112       (org-agenda-mark-header-line (point-min))
   5113       (when rtnall
   5114 	(insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
   5115       (goto-char (point-min))
   5116       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
   5117       (add-text-properties
   5118        (point-min) (point-max)
   5119        `(org-agenda-type tags
   5120 			 org-last-args (,org--matcher-tags-todo-only ,match)
   5121 			 org-redo-cmd ,org-agenda-redo-command
   5122 			 org-series-cmd ,org-cmd))
   5123       (org-agenda-finalize)
   5124       (setq buffer-read-only t))))
   5125 
   5126 ;;; Agenda Finding stuck projects
   5127 
   5128 (defvar org-agenda-skip-regexp nil
   5129   "Regular expression used in skipping subtrees for the agenda.
   5130 This is basically a temporary global variable that can be set and then
   5131 used by user-defined selections using `org-agenda-skip-function'.")
   5132 
   5133 (defvar org-agenda-overriding-header nil
   5134   "When set during agenda, todo and tags searches it replaces the header.
   5135 If an empty string, no header will be inserted.  If any other
   5136 string, it will be inserted as a header.  If a function, insert
   5137 the string returned by the function as a header.  If nil, a
   5138 header will be generated automatically according to the command.
   5139 This variable should not be set directly, but custom commands can
   5140 bind it in the options section.")
   5141 
   5142 (defun org-agenda-skip-entry-if (&rest conditions)
   5143   "Skip entry if any of CONDITIONS is true.
   5144 See `org-agenda-skip-if' for details about CONDITIONS.
   5145 
   5146 This function can be put into `org-agenda-skip-function' for the
   5147 duration of a command."
   5148   (org-agenda-skip-if nil conditions))
   5149 
   5150 (defun org-agenda-skip-subtree-if (&rest conditions)
   5151   "Skip subtree if any of CONDITIONS is true.
   5152 See `org-agenda-skip-if' for details about CONDITIONS.
   5153 
   5154 This function can be put into `org-agenda-skip-function' for the
   5155 duration of a command."
   5156   (org-agenda-skip-if t conditions))
   5157 
   5158 (defun org-agenda-skip-if (subtree conditions)
   5159   "Check current entity for CONDITIONS.
   5160 If SUBTREE is non-nil, the entire subtree is checked.  Otherwise, only
   5161 the entry (i.e. the text before the next heading) is checked.
   5162 
   5163 CONDITIONS is a list of symbols, boolean OR is used to combine the results
   5164 from different tests.  Valid conditions are:
   5165 
   5166 scheduled     Check if there is a scheduled cookie
   5167 notscheduled  Check if there is no scheduled cookie
   5168 deadline      Check if there is a deadline
   5169 notdeadline   Check if there is no deadline
   5170 timestamp     Check if there is a timestamp (also deadline or scheduled)
   5171 nottimestamp  Check if there is no timestamp (also deadline or scheduled)
   5172 regexp        Check if regexp matches
   5173 notregexp     Check if regexp does not match.
   5174 todo          Check if TODO keyword matches
   5175 nottodo       Check if TODO keyword does not match
   5176 
   5177 The regexp is taken from the conditions list, and must come right
   5178 after the `regexp' or `notregexp' element.
   5179 
   5180 `todo' and `nottodo' accept as an argument a list of todo
   5181 keywords, which may include \"*\" to match any todo keyword.
   5182 
   5183     (org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\"))
   5184 
   5185 would skip all entries with \"TODO\" or \"WAITING\" keywords.
   5186 
   5187 Instead of a list, a keyword class may be given.  For example:
   5188 
   5189     (org-agenda-skip-entry-if \\='nottodo \\='done)
   5190 
   5191 would skip entries that haven't been marked with any of \"DONE\"
   5192 keywords.  Possible classes are: `todo', `done', `any'.
   5193 
   5194 If any of these conditions is met, this function returns the end point of
   5195 the entity, causing the search to continue from there.  This is a function
   5196 that can be put into `org-agenda-skip-function' for the duration of a command."
   5197   (org-back-to-heading t)
   5198   (let* (;; (beg (point))
   5199 	 (end (if subtree (save-excursion (org-end-of-subtree t) (point))
   5200 		(org-entry-end-position)))
   5201 	 (planning-end (if subtree end (line-end-position 2)))
   5202 	 m)
   5203     (and
   5204      (or (and (memq 'scheduled conditions)
   5205 	      (re-search-forward org-scheduled-time-regexp planning-end t))
   5206 	 (and (memq 'notscheduled conditions)
   5207 	      (not
   5208 	       (save-excursion
   5209 		 (re-search-forward org-scheduled-time-regexp planning-end t))))
   5210 	 (and (memq 'deadline conditions)
   5211 	      (re-search-forward org-deadline-time-regexp planning-end t))
   5212 	 (and (memq 'notdeadline conditions)
   5213 	      (not
   5214 	       (save-excursion
   5215 		 (re-search-forward org-deadline-time-regexp planning-end t))))
   5216 	 (and (memq 'timestamp conditions)
   5217 	      (re-search-forward org-ts-regexp end t))
   5218 	 (and (memq 'nottimestamp conditions)
   5219 	      (not (save-excursion (re-search-forward org-ts-regexp end t))))
   5220 	 (and (setq m (memq 'regexp conditions))
   5221 	      (stringp (nth 1 m))
   5222 	      (re-search-forward (nth 1 m) end t))
   5223 	 (and (setq m (memq 'notregexp conditions))
   5224 	      (stringp (nth 1 m))
   5225 	      (not (save-excursion (re-search-forward (nth 1 m) end t))))
   5226 	 (and (or
   5227 	       (setq m (memq 'nottodo conditions))
   5228 	       (setq m (memq 'todo-unblocked conditions))
   5229 	       (setq m (memq 'nottodo-unblocked conditions))
   5230 	       (setq m (memq 'todo conditions)))
   5231 	      (org-agenda-skip-if-todo m end)))
   5232      end)))
   5233 
   5234 (defun org-agenda-skip-if-todo (args end)
   5235   "Helper function for `org-agenda-skip-if', do not use it directly.
   5236 ARGS is a list with first element either `todo', `nottodo',
   5237 `todo-unblocked' or `nottodo-unblocked'.  The remainder is either
   5238 a list of TODO keywords, or a state symbol `todo' or `done' or
   5239 `any'."
   5240   (let ((todo-re
   5241 	 (concat "^\\*+[ \t]+"
   5242 		 (regexp-opt
   5243 		  (pcase args
   5244 		    (`(,_ todo)
   5245 		     (org-delete-all org-done-keywords
   5246 				     (copy-sequence org-todo-keywords-1)))
   5247 		    (`(,_ done) org-done-keywords)
   5248 		    (`(,_ any) org-todo-keywords-1)
   5249 		    (`(,_ ,(pred atom))
   5250 		     (error "Invalid TODO class or type: %S" args))
   5251 		    (`(,_ ,(pred (member "*"))) org-todo-keywords-1)
   5252 		    (`(,_ ,todo-list) todo-list))
   5253 		  'words))))
   5254     (pcase args
   5255       (`(todo . ,_)
   5256        (let (case-fold-search) (re-search-forward todo-re end t)))
   5257       (`(nottodo . ,_)
   5258        (not (let (case-fold-search) (re-search-forward todo-re end t))))
   5259       (`(todo-unblocked . ,_)
   5260        (catch :unblocked
   5261 	 (while (let (case-fold-search) (re-search-forward todo-re end t))
   5262 	   (when (org-entry-blocked-p) (throw :unblocked t)))
   5263 	 nil))
   5264       (`(nottodo-unblocked . ,_)
   5265        (catch :unblocked
   5266 	 (while (let (case-fold-search) (re-search-forward todo-re end t))
   5267 	   (when (org-entry-blocked-p) (throw :unblocked nil)))
   5268 	 t))
   5269       (`(,type . ,_) (error "Unknown TODO skip type: %S" type)))))
   5270 
   5271 ;;;###autoload
   5272 (defun org-agenda-list-stuck-projects (&rest _ignore)
   5273   "Create agenda view for projects that are stuck.
   5274 Stuck projects are project that have no next actions.  For the definitions
   5275 of what a project is and how to check if it stuck, customize the variable
   5276 `org-stuck-projects'."
   5277   (interactive)
   5278   (let* ((org-agenda-overriding-header
   5279 	  (or org-agenda-overriding-header "List of stuck projects: "))
   5280 	 (matcher (nth 0 org-stuck-projects))
   5281 	 (todo (nth 1 org-stuck-projects))
   5282 	 (tags (nth 2 org-stuck-projects))
   5283 	 (gen-re (org-string-nw-p (nth 3 org-stuck-projects)))
   5284 	 (todo-wds
   5285 	  (if (not (member "*" todo)) todo
   5286 	    (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
   5287 	    (org-delete-all org-done-keywords-for-agenda
   5288 			    (copy-sequence org-todo-keywords-for-agenda))))
   5289 	 (todo-re (and todo
   5290 		       (format "^\\*+[ \t]+\\(%s\\)\\>"
   5291 			       (mapconcat #'identity todo-wds "\\|"))))
   5292 	 (tags-re (cond ((null tags) nil)
   5293 			((member "*" tags) org-tag-line-re)
   5294 			(tags
   5295 			 (let ((other-tags (format "\\(?:%s:\\)*" org-tag-re)))
   5296 			   (concat org-outline-regexp-bol
   5297 				   ".*?[ \t]:"
   5298 				   other-tags
   5299 				   (regexp-opt tags t)
   5300 				   ":" other-tags "[ \t]*$")))
   5301 			(t nil)))
   5302 	 (re-list (delq nil (list todo-re tags-re gen-re)))
   5303 	 (skip-re
   5304 	  (if (null re-list)
   5305 	      (error "Missing information to identify unstuck projects")
   5306 	    (mapconcat #'identity re-list "\\|")))
   5307 	 (org-agenda-skip-function
   5308 	  ;; Skip entry if `org-agenda-skip-regexp' matches anywhere
   5309 	  ;; in the subtree.
   5310 	  (lambda ()
   5311 	    (and (save-excursion
   5312 		   (let ((case-fold-search nil))
   5313 		     (re-search-forward
   5314 		      skip-re (save-excursion (org-end-of-subtree t)) t)))
   5315 		 (progn (outline-next-heading) (point))))))
   5316     (org-tags-view nil matcher)
   5317     (setq org-agenda-buffer-name (buffer-name))
   5318     (with-current-buffer org-agenda-buffer-name
   5319       (setq org-agenda-redo-command
   5320 	    `(org-agenda-list-stuck-projects ,current-prefix-arg))
   5321       (let ((inhibit-read-only t))
   5322         (add-text-properties
   5323          (point-min) (point-max)
   5324          `(org-redo-cmd ,org-agenda-redo-command))))))
   5325 
   5326 ;;; Diary integration
   5327 
   5328 (defvar org-disable-agenda-to-diary nil)          ;Dynamically-scoped param.
   5329 (defvar diary-list-entries-hook)
   5330 (defvar diary-time-regexp)
   5331 (defvar diary-modify-entry-list-string-function)
   5332 (defvar diary-file-name-prefix)
   5333 (defvar diary-display-function)
   5334 
   5335 (defun org-get-entries-from-diary (date)
   5336   "Get the (Emacs Calendar) diary entries for DATE."
   5337   (require 'diary-lib)
   5338   (declare-function diary-fancy-display "diary-lib" ())
   5339   (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
   5340 	 (diary-display-function #'diary-fancy-display)
   5341 	 (pop-up-frames nil)
   5342 	 (diary-list-entries-hook
   5343 	  (cons 'org-diary-default-entry diary-list-entries-hook))
   5344 	 (diary-file-name-prefix nil) ; turn this feature off
   5345 	 (diary-modify-entry-list-string-function
   5346 	  #'org-modify-diary-entry-string)
   5347 	 (diary-time-regexp (concat "^" diary-time-regexp))
   5348 	 entries
   5349 	 (org-disable-agenda-to-diary t))
   5350     (save-excursion
   5351       (save-window-excursion
   5352         (diary-list-entries date 1)))
   5353     (if (not (get-buffer diary-fancy-buffer))
   5354 	(setq entries nil)
   5355       (with-current-buffer diary-fancy-buffer
   5356 	(setq buffer-read-only nil)
   5357 	(if (zerop (buffer-size))
   5358 	    ;; No entries
   5359 	    (setq entries nil)
   5360 	  ;; Omit the date and other unnecessary stuff
   5361 	  (org-agenda-cleanup-fancy-diary)
   5362 	  ;; Add prefix to each line and extend the text properties
   5363 	  (if (zerop (buffer-size))
   5364 	      (setq entries nil)
   5365 	    (setq entries (buffer-substring (point-min) (- (point-max) 1)))
   5366 	    (setq entries
   5367 		  (with-temp-buffer
   5368 		    (insert entries) (goto-char (point-min))
   5369 		    (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t)
   5370 		      (unless (save-match-data (string-match diary-time-regexp (match-string 1)))
   5371 			(replace-match (concat "; " (match-string 1)))))
   5372 		    (buffer-string)))))
   5373 	(set-buffer-modified-p nil)
   5374 	(kill-buffer diary-fancy-buffer)))
   5375     (when entries
   5376       (setq entries (org-split-string entries "\n"))
   5377       (setq entries
   5378 	    (mapcar
   5379 	     (lambda (x)
   5380 	       (setq x (org-agenda-format-item "" x nil "Diary" nil 'time))
   5381 	       ;; Extend the text properties to the beginning of the line
   5382 	       (org-add-props x (text-properties-at (1- (length x)) x)
   5383 		 'type "diary" 'date date 'face 'org-agenda-diary))
   5384 	     entries)))))
   5385 
   5386 (defvar org-agenda-cleanup-fancy-diary-hook nil
   5387   "Hook run when the fancy diary buffer is cleaned up.")
   5388 
   5389 (defun org-agenda-cleanup-fancy-diary ()
   5390   "Remove unwanted stuff in buffer created by `diary-fancy-display'.
   5391 This gets rid of the date, the underline under the date, and the
   5392 dummy entry installed by Org mode to ensure non-empty diary for
   5393 each date.  It also removes lines that contain only whitespace."
   5394   (goto-char (point-min))
   5395   (if (looking-at ".*?:[ \t]*")
   5396       (progn
   5397 	(replace-match "")
   5398 	(re-search-forward "\n=+$" nil t)
   5399 	(replace-match "")
   5400 	(while (re-search-backward "^ +\n?" nil t) (replace-match "")))
   5401     (re-search-forward "\n=+$" nil t)
   5402     (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
   5403   (goto-char (point-min))
   5404   (while (re-search-forward "^ +\n" nil t)
   5405     (replace-match ""))
   5406   (goto-char (point-min))
   5407   (when (re-search-forward "^Org mode dummy\n?" nil t)
   5408     (replace-match ""))
   5409   (run-hooks 'org-agenda-cleanup-fancy-diary-hook))
   5410 
   5411 (defun org-modify-diary-entry-string (string)
   5412   "Add text properties to string, allowing Org to act on it."
   5413   (org-add-props string nil
   5414     'mouse-face 'highlight
   5415     'help-echo (if buffer-file-name
   5416 		   (format "mouse-2 or RET jump to diary file %s"
   5417 			   (abbreviate-file-name buffer-file-name))
   5418 		 "")
   5419     'org-agenda-diary-link t
   5420     'org-marker (org-agenda-new-marker (line-beginning-position))))
   5421 
   5422 (defun org-diary-default-entry ()
   5423   "Add a dummy entry to the diary.
   5424 Needed to avoid empty dates which mess up holiday display."
   5425   ;; Catch the error if dealing with the new add-to-diary-alist
   5426   (when org-disable-agenda-to-diary
   5427     (diary-add-to-list original-date "Org mode dummy" "")))
   5428 
   5429 (defvar org-diary-last-run-time nil)
   5430 
   5431 ;;;###autoload
   5432 (defun org-diary (&rest args)
   5433   "Return diary information from org files.
   5434 This function can be used in a \"sexp\" diary entry in the Emacs calendar.
   5435 It accesses org files and extracts information from those files to be
   5436 listed in the diary.  The function accepts arguments specifying what
   5437 items should be listed.  For a list of arguments allowed here, see the
   5438 variable `org-agenda-entry-types'.
   5439 
   5440 The call in the diary file should look like this:
   5441 
   5442    &%%(org-diary) ~/path/to/some/orgfile.org
   5443 
   5444 Use a separate line for each org file to check.  Or, if you omit the file name,
   5445 all files listed in `org-agenda-files' will be checked automatically:
   5446 
   5447    &%%(org-diary)
   5448 
   5449 If you don't give any arguments (as in the example above), the default value
   5450 of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
   5451 So the example above may also be written as
   5452 
   5453    &%%(org-diary :deadline :timestamp :sexp :scheduled)
   5454 
   5455 The function expects the lisp variables `entry' and `date' to be provided
   5456 by the caller, because this is how the calendar works.  Don't use this
   5457 function from a program - use `org-agenda-get-day-entries' instead."
   5458   (with-no-warnings (defvar date) (defvar entry))
   5459   (when (> (- (float-time)
   5460 	      org-agenda-last-marker-time)
   5461 	   5)
   5462     ;; I am not sure if this works with sticky agendas, because the marker
   5463     ;; list is then no longer a global variable.
   5464     (org-agenda-reset-markers))
   5465   (org-compile-prefix-format 'agenda)
   5466   (org-set-sorting-strategy 'agenda)
   5467   (setq args (or args org-agenda-entry-types))
   5468   (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
   5469 		    (list entry)
   5470 		  (org-agenda-files t)))
   5471 	 (time (float-time))
   5472 	 file rtn results)
   5473     (when (or (not org-diary-last-run-time)
   5474 	      (> (- time
   5475 		    org-diary-last-run-time)
   5476 		 3))
   5477       (org-agenda-prepare-buffers files))
   5478     (setq org-diary-last-run-time time)
   5479     ;; If this is called during org-agenda, don't return any entries to
   5480     ;; the calendar.  Org Agenda will list these entries itself.
   5481     (when org-disable-agenda-to-diary (setq files nil))
   5482     (while (setq file (pop files))
   5483       (setq rtn (apply #'org-agenda-get-day-entries file date args))
   5484       (setq results (append results rtn)))
   5485     (when results
   5486       (setq results
   5487 	    (mapcar (lambda (i) (replace-regexp-in-string
   5488 				 org-link-bracket-re "\\2" i))
   5489 		    results))
   5490       (concat (org-agenda-finalize-entries results) "\n"))))
   5491 
   5492 ;;; Agenda entry finders
   5493 
   5494 (defun org-agenda--timestamp-to-absolute (&rest args)
   5495   "Call `org-time-string-to-absolute' with ARGS.
   5496 However, throw `:skip' whenever an error is raised."
   5497   (condition-case e
   5498       (apply #'org-time-string-to-absolute args)
   5499     (org-diary-sexp-no-match (throw :skip nil))
   5500     (error
   5501      (message "%s; Skipping entry" (error-message-string e))
   5502      (throw :skip nil))))
   5503 
   5504 (defun org-agenda-get-day-entries (file date &rest args)
   5505   "Does the work for `org-diary' and `org-agenda'.
   5506 FILE is the path to a file to be checked for entries.  DATE is date like
   5507 the one returned by `calendar-current-date'.  ARGS are symbols indicating
   5508 which kind of entries should be extracted.  For details about these, see
   5509 the documentation of `org-diary'."
   5510   (let* ((org-startup-folded nil)
   5511 	 (org-startup-align-all-tables nil)
   5512 	 (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file)
   5513 		   (error "No such file %s" file))))
   5514     (if (not buffer)
   5515 	;; If file does not exist, signal it in diary nonetheless.
   5516 	(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
   5517       (with-current-buffer buffer
   5518 	(unless (derived-mode-p 'org-mode)
   5519 	  (error "Agenda file %s is not in Org mode" file))
   5520 	(setq org-agenda-buffer (or org-agenda-buffer buffer))
   5521 	(setf org-agenda-current-date date)
   5522 	(save-excursion
   5523 	  (save-restriction
   5524 	    (if (eq buffer org-agenda-restrict)
   5525 		(narrow-to-region org-agenda-restrict-begin
   5526 				  org-agenda-restrict-end)
   5527 	      (widen))
   5528 	    ;; Rationalize ARGS.  Also make sure `:deadline' comes
   5529 	    ;; first in order to populate DEADLINES before passing it.
   5530 	    ;;
   5531 	    ;; We use `delq' since `org-uniquify' duplicates ARGS,
   5532 	    ;; guarding us from modifying `org-agenda-entry-types'.
   5533 	    (setf args (org-uniquify (or args org-agenda-entry-types)))
   5534 	    (when (and (memq :scheduled args) (memq :scheduled* args))
   5535 	      (setf args (delq :scheduled* args)))
   5536 	    (cond
   5537 	     ((memq :deadline args)
   5538 	      (setf args (cons :deadline
   5539 			       (delq :deadline (delq :deadline* args)))))
   5540 	     ((memq :deadline* args)
   5541 	      (setf args (cons :deadline* (delq :deadline* args)))))
   5542 	    ;; Collect list of headlines.  Return them flattened.
   5543 	    (let ((case-fold-search nil) results deadlines)
   5544               (org-dlet
   5545                   ((date date))
   5546 	        (dolist (arg args (apply #'nconc (nreverse results)))
   5547 		  (pcase arg
   5548 		    ((and :todo (guard (org-agenda-today-p date)))
   5549 		     (push (org-agenda-get-todos) results))
   5550 		    (:timestamp
   5551 		     (push (org-agenda-get-blocks) results)
   5552 		     (push (org-agenda-get-timestamps deadlines) results))
   5553 		    (:sexp
   5554 		     (push (org-agenda-get-sexps) results))
   5555 		    (:scheduled
   5556 		     (push (org-agenda-get-scheduled deadlines) results))
   5557 		    (:scheduled*
   5558 		     (push (org-agenda-get-scheduled deadlines t) results))
   5559 		    (:closed
   5560 		     (push (org-agenda-get-progress) results))
   5561 		    (:deadline
   5562 		     (setf deadlines (org-agenda-get-deadlines))
   5563 		     (push deadlines results))
   5564 		    (:deadline*
   5565 		     (setf deadlines (org-agenda-get-deadlines t))
   5566 		     (push deadlines results))))))))))))
   5567 
   5568 (defsubst org-em (x y list)
   5569   "Is X or Y a member of LIST?"
   5570   (or (memq x list) (memq y list)))
   5571 
   5572 (defvar org-heading-keyword-regexp-format) ; defined in org.el
   5573 (defvar org-agenda-sorting-strategy-selected nil)
   5574 
   5575 (defun org-agenda-entry-get-agenda-timestamp (pom)
   5576   "Retrieve timestamp information for sorting agenda views.
   5577 Given a point or marker POM, returns a cons cell of the timestamp
   5578 and the timestamp type relevant for the sorting strategy in
   5579 `org-agenda-sorting-strategy-selected'."
   5580   (let (ts ts-date-type)
   5581     (save-match-data
   5582       (cond ((org-em 'scheduled-up 'scheduled-down
   5583 		     org-agenda-sorting-strategy-selected)
   5584 	     (setq ts (org-entry-get pom "SCHEDULED")
   5585 		   ts-date-type " scheduled"))
   5586 	    ((org-em 'deadline-up 'deadline-down
   5587 		     org-agenda-sorting-strategy-selected)
   5588 	     (setq ts (org-entry-get pom "DEADLINE")
   5589 		   ts-date-type " deadline"))
   5590 	    ((org-em 'ts-up 'ts-down
   5591 		     org-agenda-sorting-strategy-selected)
   5592 	     (setq ts (org-entry-get pom "TIMESTAMP")
   5593 		   ts-date-type " timestamp"))
   5594 	    ((org-em 'tsia-up 'tsia-down
   5595 		     org-agenda-sorting-strategy-selected)
   5596 	     (setq ts (org-entry-get pom "TIMESTAMP_IA")
   5597 		   ts-date-type " timestamp_ia"))
   5598 	    ((org-em 'timestamp-up 'timestamp-down
   5599 		     org-agenda-sorting-strategy-selected)
   5600 	     (setq ts (or (org-entry-get pom "SCHEDULED")
   5601 			  (org-entry-get pom "DEADLINE")
   5602 			  (org-entry-get pom "TIMESTAMP")
   5603 			  (org-entry-get pom "TIMESTAMP_IA"))
   5604 		   ts-date-type ""))
   5605 	    (t (setq ts-date-type "")))
   5606       (cons (when ts (ignore-errors (org-time-string-to-absolute ts)))
   5607 	    ts-date-type))))
   5608 
   5609 (defun org-agenda-get-todos ()
   5610   "Return the TODO information for agenda display."
   5611   (let* ((props (list 'face nil
   5612 		      'done-face 'org-agenda-done
   5613 		      'org-not-done-regexp org-not-done-regexp
   5614 		      'org-todo-regexp org-todo-regexp
   5615 		      'org-complex-heading-regexp org-complex-heading-regexp
   5616 		      'mouse-face 'highlight
   5617 		      'help-echo
   5618 		      (format "mouse-2 or RET jump to org file %s"
   5619 			      (abbreviate-file-name buffer-file-name))))
   5620 	 (case-fold-search nil)
   5621 	 (regexp (format org-heading-keyword-regexp-format
   5622 			 (cond
   5623 			  ((and org-select-this-todo-keyword
   5624 				(equal org-select-this-todo-keyword "*"))
   5625 			   org-todo-regexp)
   5626 			  (org-select-this-todo-keyword
   5627 			   (concat "\\("
   5628 				   (mapconcat #'identity
   5629 					      (org-split-string
   5630 					       org-select-this-todo-keyword
   5631 					       "|")
   5632 					      "\\|")
   5633 				   "\\)"))
   5634 			  (t org-not-done-regexp))))
   5635 	 marker priority category level tags todo-state
   5636 	 ts-date ts-date-type ts-date-pair
   5637 	 ee txt beg end inherited-tags todo-state-end-pos
   5638          effort effort-minutes)
   5639     (goto-char (point-min))
   5640     (while (re-search-forward regexp nil t)
   5641       (catch :skip
   5642 	(save-match-data
   5643 	  (beginning-of-line)
   5644 	  (org-agenda-skip)
   5645 	  (setq beg (point) end (save-excursion (outline-next-heading) (point)))
   5646 	  (unless (and (setq todo-state (org-get-todo-state))
   5647 		       (setq todo-state-end-pos (match-end 2)))
   5648 	    (goto-char end)
   5649 	    (throw :skip nil))
   5650 	  (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
   5651 	    (goto-char (1+ beg))
   5652 	    (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
   5653 	    (throw :skip nil)))
   5654 	(goto-char (match-beginning 2))
   5655 	(setq marker (org-agenda-new-marker (match-beginning 0))
   5656 	      category (org-get-category)
   5657               effort (save-match-data (or (get-text-property (point) 'effort)
   5658                                           (org-entry-get (point) org-effort-property)))
   5659               effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))
   5660 	      ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
   5661 	      ts-date (car ts-date-pair)
   5662 	      ts-date-type (cdr ts-date-pair)
   5663 	      txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
   5664 	      inherited-tags
   5665 	      (or (eq org-agenda-show-inherited-tags 'always)
   5666 		  (and (listp org-agenda-show-inherited-tags)
   5667 		       (memq 'todo org-agenda-show-inherited-tags))
   5668 		  (and (eq org-agenda-show-inherited-tags t)
   5669 		       (or (eq org-agenda-use-tag-inheritance t)
   5670 			   (memq 'todo org-agenda-use-tag-inheritance))))
   5671 	      tags (org-get-tags nil (not inherited-tags))
   5672 	      level (make-string (org-reduced-level (org-outline-level)) ? )
   5673 	      txt (org-agenda-format-item ""
   5674                                 (org-add-props txt nil
   5675                                   'effort effort
   5676                                   'effort-minutes effort-minutes)
   5677                                 level category tags t)
   5678 	      priority (1+ (org-get-priority txt)))
   5679 	(org-add-props txt props
   5680 	  'org-marker marker 'org-hd-marker marker
   5681 	  'priority priority
   5682           'effort effort 'effort-minutes effort-minutes
   5683 	  'level level
   5684 	  'ts-date ts-date
   5685 	  'type (concat "todo" ts-date-type) 'todo-state todo-state)
   5686 	(push txt ee)
   5687 	(if org-agenda-todo-list-sublevels
   5688 	    (goto-char todo-state-end-pos)
   5689 	  (org-end-of-subtree 'invisible))))
   5690     (nreverse ee)))
   5691 
   5692 (defun org-agenda-todo-custom-ignore-p (time n)
   5693   "Check whether timestamp is farther away than n number of days.
   5694 This function is invoked if `org-agenda-todo-ignore-deadlines',
   5695 `org-agenda-todo-ignore-scheduled' or
   5696 `org-agenda-todo-ignore-timestamp' is set to an integer."
   5697   (let ((days (org-time-stamp-to-now
   5698 	       time org-agenda-todo-ignore-time-comparison-use-seconds)))
   5699     (if (>= n 0)
   5700 	(>= days n)
   5701       (<= days n))))
   5702 
   5703 ;;;###autoload
   5704 (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
   5705     (&optional end)
   5706   "Do we have a reason to ignore this TODO entry because it has a time stamp?"
   5707   (when (or org-agenda-todo-ignore-with-date
   5708 	    org-agenda-todo-ignore-scheduled
   5709 	    org-agenda-todo-ignore-deadlines
   5710 	    org-agenda-todo-ignore-timestamp)
   5711     (setq end (or end (save-excursion (outline-next-heading) (point))))
   5712     (save-excursion
   5713       (or (and org-agenda-todo-ignore-with-date
   5714 	       (re-search-forward org-ts-regexp end t))
   5715 	  (and org-agenda-todo-ignore-scheduled
   5716 	       (re-search-forward org-scheduled-time-regexp end t)
   5717 	       (cond
   5718 		((eq org-agenda-todo-ignore-scheduled 'future)
   5719 		 (> (org-time-stamp-to-now
   5720 		     (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5721 		    0))
   5722 		((eq org-agenda-todo-ignore-scheduled 'past)
   5723 		 (<= (org-time-stamp-to-now
   5724 		      (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5725 		     0))
   5726 		((numberp org-agenda-todo-ignore-scheduled)
   5727 		 (org-agenda-todo-custom-ignore-p
   5728 		  (match-string 1) org-agenda-todo-ignore-scheduled))
   5729 		(t)))
   5730 	  (and org-agenda-todo-ignore-deadlines
   5731 	       (re-search-forward org-deadline-time-regexp end t)
   5732 	       (cond
   5733 		((eq org-agenda-todo-ignore-deadlines 'all) t)
   5734 		((eq org-agenda-todo-ignore-deadlines 'far)
   5735 		 (not (org-deadline-close-p (match-string 1))))
   5736 		((eq org-agenda-todo-ignore-deadlines 'future)
   5737 		 (> (org-time-stamp-to-now
   5738 		     (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5739 		    0))
   5740 		((eq org-agenda-todo-ignore-deadlines 'past)
   5741 		 (<= (org-time-stamp-to-now
   5742 		      (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5743 		     0))
   5744 		((numberp org-agenda-todo-ignore-deadlines)
   5745 		 (org-agenda-todo-custom-ignore-p
   5746 		  (match-string 1) org-agenda-todo-ignore-deadlines))
   5747 		(t (org-deadline-close-p (match-string 1)))))
   5748 	  (and org-agenda-todo-ignore-timestamp
   5749 	       (let ((buffer (current-buffer))
   5750 		     (regexp
   5751 		      (concat
   5752 		       org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
   5753 		     (start (point)))
   5754 		 ;; Copy current buffer into a temporary one
   5755 		 (with-temp-buffer
   5756 		   (insert-buffer-substring buffer start end)
   5757 		   (goto-char (point-min))
   5758 		   ;; Delete SCHEDULED and DEADLINE items
   5759 		   (while (re-search-forward regexp end t)
   5760 		     (delete-region (match-beginning 0) (match-end 0)))
   5761 		   (goto-char (point-min))
   5762 		   ;; No search for timestamp left
   5763 		   (when (re-search-forward org-ts-regexp nil t)
   5764 		     (cond
   5765 		      ((eq org-agenda-todo-ignore-timestamp 'future)
   5766 		       (> (org-time-stamp-to-now
   5767 			   (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5768 			  0))
   5769 		      ((eq org-agenda-todo-ignore-timestamp 'past)
   5770 		       (<= (org-time-stamp-to-now
   5771 			    (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
   5772 			   0))
   5773 		      ((numberp org-agenda-todo-ignore-timestamp)
   5774 		       (org-agenda-todo-custom-ignore-p
   5775 			(match-string 1) org-agenda-todo-ignore-timestamp))
   5776 		      (t))))))))))
   5777 
   5778 (defun org-agenda-get-timestamps (&optional deadlines)
   5779   "Return the date stamp information for agenda display.
   5780 Optional argument DEADLINES is a list of deadline items to be
   5781 displayed in agenda view."
   5782   (with-no-warnings (defvar date))
   5783   (let* ((props (list 'face 'org-agenda-calendar-event
   5784 		      'org-not-done-regexp org-not-done-regexp
   5785 		      'org-todo-regexp org-todo-regexp
   5786 		      'org-complex-heading-regexp org-complex-heading-regexp
   5787 		      'mouse-face 'highlight
   5788 		      'help-echo
   5789 		      (format "mouse-2 or RET jump to Org file %s"
   5790 			      (abbreviate-file-name buffer-file-name))))
   5791 	 (current (calendar-absolute-from-gregorian date))
   5792 	 (today (org-today))
   5793 	 (deadline-position-alist
   5794 	  (mapcar (lambda (d)
   5795 		    (let ((m (get-text-property 0 'org-hd-marker d)))
   5796 		      (and m (marker-position m))))
   5797 		  deadlines))
   5798 	 ;; Match time-stamps set to current date, time-stamps with
   5799 	 ;; a repeater, and S-exp time-stamps.
   5800 	 (regexp
   5801 	  (concat
   5802 	   (if org-agenda-include-inactive-timestamps "[[<]" "<")
   5803 	   (regexp-quote
   5804 	    (substring
   5805 	     (format-time-string
   5806 	      (org-time-stamp-format)
   5807 	      (org-encode-time	; DATE bound by calendar
   5808 	       0 0 0 (nth 1 date) (car date) (nth 2 date)))
   5809 	     1 11))
   5810 	   "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
   5811 	   "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
   5812 	 timestamp-items)
   5813     (goto-char (point-min))
   5814     (while (re-search-forward regexp nil t)
   5815       ;; Skip date ranges, scheduled and deadlines, which are handled
   5816       ;; specially.  Also skip time-stamps before first headline as
   5817       ;; there would be no entry to add to the agenda.  Eventually,
   5818       ;; ignore clock entries.
   5819       (catch :skip
   5820 	(save-match-data
   5821 	  (when (or (org-at-date-range-p)
   5822 		    (org-at-planning-p)
   5823 		    (org-before-first-heading-p)
   5824 		    (and org-agenda-include-inactive-timestamps
   5825 			 (org-at-clock-log-p))
   5826                     (not (org-at-timestamp-p 'agenda)))
   5827 	    (throw :skip nil))
   5828 	  (org-agenda-skip (org-element-at-point)))
   5829 	(let* ((pos (match-beginning 0))
   5830 	       (repeat (match-string 1))
   5831 	       (sexp-entry (match-string 3))
   5832 	       (time-stamp (if (or repeat sexp-entry) (match-string 0)
   5833 			     (save-excursion
   5834 			       (goto-char pos)
   5835 			       (looking-at org-ts-regexp-both)
   5836 			       (match-string 0))))
   5837 	       (todo-state (org-get-todo-state))
   5838 	       (warntime (get-text-property (point) 'org-appt-warntime))
   5839 	       (done? (member todo-state org-done-keywords)))
   5840 	  ;; Possibly skip done tasks.
   5841 	  (when (and done? org-agenda-skip-timestamp-if-done)
   5842 	    (throw :skip t))
   5843 	  ;; S-exp entry doesn't match current day: skip it.
   5844 	  (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
   5845 	    (throw :skip nil))
   5846 	  (when repeat
   5847 	    (let* ((past
   5848 		    ;; A repeating time stamp is shown at its base
   5849 		    ;; date and every repeated date up to TODAY.  If
   5850 		    ;; `org-agenda-prefer-last-repeat' is non-nil,
   5851 		    ;; however, only the last repeat before today
   5852 		    ;; (inclusive) is shown.
   5853 		    (org-agenda--timestamp-to-absolute
   5854 		     repeat
   5855 		     (if (or (> current today)
   5856 			     (eq org-agenda-prefer-last-repeat t)
   5857 			     (member todo-state org-agenda-prefer-last-repeat))
   5858 			 today
   5859 		       current)
   5860 		     'past (current-buffer) pos))
   5861 		   (future
   5862 		    ;;  Display every repeated date past TODAY
   5863 		    ;;  (exclusive) unless
   5864 		    ;;  `org-agenda-show-future-repeats' is nil.  If
   5865 		    ;;  this variable is set to `next', only display
   5866 		    ;;  the first repeated date after TODAY
   5867 		    ;;  (exclusive).
   5868 		    (cond
   5869 		     ((<= current today) past)
   5870 		     ((not org-agenda-show-future-repeats) past)
   5871 		     (t
   5872 		      (let ((base (if (eq org-agenda-show-future-repeats 'next)
   5873 				      (1+ today)
   5874 				    current)))
   5875 			(org-agenda--timestamp-to-absolute
   5876 			 repeat base 'future (current-buffer) pos))))))
   5877 	      (when (and (/= current past) (/= current future))
   5878 		(throw :skip nil))))
   5879 	  (save-excursion
   5880 	    (re-search-backward org-outline-regexp-bol nil t)
   5881 	    ;; Possibly skip time-stamp when a deadline is set.
   5882 	    (when (and org-agenda-skip-timestamp-if-deadline-is-shown
   5883 		       (assq (point) deadline-position-alist))
   5884 	      (throw :skip nil))
   5885 	    (let* ((category (org-get-category pos))
   5886                    (effort (org-entry-get pos org-effort-property))
   5887                    (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
   5888 		   (inherited-tags
   5889 		    (or (eq org-agenda-show-inherited-tags 'always)
   5890 			(and (consp org-agenda-show-inherited-tags)
   5891 			     (memq 'agenda org-agenda-show-inherited-tags))
   5892 			(and (eq org-agenda-show-inherited-tags t)
   5893 			     (or (eq org-agenda-use-tag-inheritance t)
   5894 				 (memq 'agenda
   5895 				       org-agenda-use-tag-inheritance)))))
   5896 		   (tags (org-get-tags nil (not inherited-tags)))
   5897 		   (level (make-string (org-reduced-level (org-outline-level))
   5898 				       ?\s))
   5899 		   (head (and (looking-at "\\*+[ \t]+\\(.*\\)")
   5900 			      (match-string 1)))
   5901 		   (inactive? (= (char-after pos) ?\[))
   5902 		   (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
   5903 		   (item
   5904 		    (org-agenda-format-item
   5905 		     (and inactive? org-agenda-inactive-leader)
   5906                      (org-add-props head nil
   5907                        'effort effort
   5908                        'effort-minutes effort-minutes)
   5909                      level category tags time-stamp org-ts-regexp habit?)))
   5910 	      (org-add-props item props
   5911 		'priority (if habit?
   5912 			      (org-habit-get-priority (org-habit-parse-todo))
   5913 			    (org-get-priority item))
   5914 		'org-marker (org-agenda-new-marker pos)
   5915 		'org-hd-marker (org-agenda-new-marker)
   5916 		'date date
   5917 		'level level
   5918                 'effort effort 'effort-minutes effort-minutes
   5919 		'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat)
   5920 			   current)
   5921 		'todo-state todo-state
   5922 		'warntime warntime
   5923 		'type "timestamp")
   5924 	      (push item timestamp-items))))
   5925 	(when org-agenda-skip-additional-timestamps-same-entry
   5926 	  (outline-next-heading))))
   5927     (nreverse timestamp-items)))
   5928 
   5929 (defun org-agenda-get-sexps ()
   5930   "Return the sexp information for agenda display."
   5931   (require 'diary-lib)
   5932   (with-no-warnings (defvar date) (defvar entry))
   5933   (let* ((props (list 'face 'org-agenda-calendar-sexp
   5934 		      'mouse-face 'highlight
   5935 		      'help-echo
   5936 		      (format "mouse-2 or RET jump to org file %s"
   5937 			      (abbreviate-file-name buffer-file-name))))
   5938 	 (regexp "^&?%%(")
   5939 	 ;; FIXME: Is this `entry' binding intended to be dynamic,
   5940          ;; so as to "hide" any current binding for it?
   5941 	 marker category extra level ee txt tags entry
   5942 	 result beg b sexp sexp-entry todo-state warntime inherited-tags
   5943          effort effort-minutes)
   5944     (goto-char (point-min))
   5945     (while (re-search-forward regexp nil t)
   5946       (catch :skip
   5947         ;; We do not run `org-agenda-skip' right away because every single sexp
   5948         ;; in the buffer is matched here, unlike day-specific search
   5949         ;; in ordinary timestamps.  Most of the sexps will not match
   5950         ;; the agenda day and it is quicker to run `org-agenda-skip' only for
   5951         ;; matching sexps later on.
   5952 	(setq beg (match-beginning 0))
   5953 	(goto-char (1- (match-end 0)))
   5954 	(setq b (point))
   5955 	(forward-sexp 1)
   5956 	(setq sexp (buffer-substring b (point)))
   5957 	(setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
   5958                              (buffer-substring
   5959                               (match-beginning 1)
   5960                               (save-excursion
   5961                                 (goto-char (match-end 1))
   5962                                 (skip-chars-backward "[:blank:]")
   5963                                 (point)))
   5964 			   ""))
   5965 	(setq result (org-diary-sexp-entry sexp sexp-entry date))
   5966 	(when result
   5967           ;; Only check if entry should be skipped on matching sexps.
   5968           (org-agenda-skip (org-element-at-point))
   5969 	  (setq marker (org-agenda-new-marker beg)
   5970 		level (make-string (org-reduced-level (org-outline-level)) ? )
   5971 		category (org-get-category beg)
   5972                 effort (save-match-data (or (get-text-property (point) 'effort)
   5973                                             (org-entry-get (point) org-effort-property)))
   5974 		inherited-tags
   5975 		(or (eq org-agenda-show-inherited-tags 'always)
   5976 		    (and (listp org-agenda-show-inherited-tags)
   5977 			 (memq 'agenda org-agenda-show-inherited-tags))
   5978 		    (and (eq org-agenda-show-inherited-tags t)
   5979 			 (or (eq org-agenda-use-tag-inheritance t)
   5980 			     (memq 'agenda org-agenda-use-tag-inheritance))))
   5981 		tags (org-get-tags nil (not inherited-tags))
   5982 		todo-state (org-get-todo-state)
   5983 		warntime (get-text-property (point) 'org-appt-warntime)
   5984 		extra nil)
   5985           (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
   5986 
   5987 	  (dolist (r (if (stringp result)
   5988 			 (list result)
   5989 		       result)) ;; we expect a list here
   5990 	    (when (and org-agenda-diary-sexp-prefix
   5991 		       (string-match org-agenda-diary-sexp-prefix r))
   5992 	      (setq extra (match-string 0 r)
   5993 		    r (replace-match "" nil nil r)))
   5994 	    (if (string-match "\\S-" r)
   5995 		(setq txt r)
   5996 	      (setq txt "SEXP entry returned empty string"))
   5997 	    (setq txt (org-agenda-format-item extra
   5998                                     (org-add-props txt nil
   5999                                       'effort effort
   6000                                       'effort-minutes effort-minutes)
   6001                                     level category tags 'time))
   6002 	    (org-add-props txt props 'org-marker marker
   6003 			   'date date 'todo-state todo-state
   6004                            'effort effort 'effort-minutes effort-minutes
   6005 			   'level level 'type "sexp" 'warntime warntime)
   6006 	    (push txt ee)))))
   6007     (nreverse ee)))
   6008 
   6009 ;; Calendar sanity: define some functions that are independent of
   6010 ;; `calendar-date-style'.
   6011 (defun org-anniversary (year month day &optional mark)
   6012   "Like `diary-anniversary', but with fixed (ISO) order of arguments."
   6013   (with-no-warnings
   6014     (let ((calendar-date-style 'iso))
   6015       (diary-anniversary year month day mark))))
   6016 (defun org-cyclic (N year month day &optional mark)
   6017   "Like `diary-cyclic', but with fixed (ISO) order of arguments."
   6018   (with-no-warnings
   6019     (let ((calendar-date-style 'iso))
   6020       (diary-cyclic N year month day mark))))
   6021 (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
   6022   "Like `diary-block', but with fixed (ISO) order of arguments."
   6023   (with-no-warnings
   6024     (let ((calendar-date-style 'iso))
   6025       (diary-block Y1 M1 D1 Y2 M2 D2 mark))))
   6026 (defun org-date (year month day &optional mark)
   6027   "Like `diary-date', but with fixed (ISO) order of arguments."
   6028   (with-no-warnings
   6029     (let ((calendar-date-style 'iso))
   6030       (diary-date year month day mark))))
   6031 
   6032 ;; Define the `org-class' function
   6033 (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
   6034   "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
   6035 DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
   6036 SKIP-WEEKS is any number of ISO weeks in the block period for which the
   6037 item should be skipped.  If any of the SKIP-WEEKS arguments is the symbol
   6038 `holidays', then any date that is known by the Emacs calendar to be a
   6039 holiday will also be skipped.  If SKIP-WEEKS arguments are holiday strings,
   6040 then those holidays will be skipped."
   6041   (with-no-warnings (defvar date) (defvar entry))
   6042   (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
   6043 	 (date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
   6044 	 (d (calendar-absolute-from-gregorian date))
   6045 	 (h (when skip-weeks (calendar-check-holidays date))))
   6046     (and
   6047      (<= date1 d)
   6048      (<= d date2)
   6049      (= (calendar-day-of-week date) dayname)
   6050      (or (not skip-weeks)
   6051 	 (progn
   6052 	   (require 'cal-iso)
   6053 	   (not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
   6054      (not (or (and h (memq 'holidays skip-weeks))
   6055 	      (delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
   6056      entry)))
   6057 
   6058 (defalias 'org-get-closed #'org-agenda-get-progress)
   6059 (defun org-agenda-get-progress ()
   6060   "Return the logged TODO entries for agenda display."
   6061   (with-no-warnings (defvar date))
   6062   (let* ((props (list 'mouse-face 'highlight
   6063 		      'org-not-done-regexp org-not-done-regexp
   6064 		      'org-todo-regexp org-todo-regexp
   6065 		      'org-complex-heading-regexp org-complex-heading-regexp
   6066 		      'help-echo
   6067 		      (format "mouse-2 or RET jump to org file %s"
   6068 			      (abbreviate-file-name buffer-file-name))))
   6069 	 (items (if (consp org-agenda-show-log-scoped)
   6070 		    org-agenda-show-log-scoped
   6071 		  (if (eq org-agenda-show-log-scoped 'clockcheck)
   6072 		      '(clock)
   6073 		    org-agenda-log-mode-items)))
   6074 	 (parts
   6075 	  (delq nil
   6076 		(list
   6077 		 (when (memq 'closed items) (concat "\\<" org-closed-string))
   6078 		 (when (memq 'clock items) (concat "\\<" org-clock-string))
   6079 		 (when (memq 'state items)
   6080 		   (format "- +State \"%s\".*?" org-todo-regexp)))))
   6081 	 (parts-re (if parts (mapconcat #'identity parts "\\|")
   6082 		     (error "`org-agenda-log-mode-items' is empty")))
   6083 	 (regexp (concat
   6084 		  "\\(" parts-re "\\)"
   6085 		  " *\\["
   6086 		  (regexp-quote
   6087 		   (substring
   6088 		    (format-time-string
   6089 		     (org-time-stamp-format)
   6090 		     (org-encode-time  ; DATE bound by calendar
   6091 		      0 0 0 (nth 1 date) (car date) (nth 2 date)))
   6092 		    1 11))))
   6093 	 (org-agenda-search-headline-for-time nil)
   6094 	 marker hdmarker priority category level tags closedp type
   6095 	 statep clockp state ee txt extra timestr rest clocked inherited-tags
   6096          effort effort-minutes)
   6097     (goto-char (point-min))
   6098     (while (re-search-forward regexp nil t)
   6099       (catch :skip
   6100 	(org-agenda-skip)
   6101 	(setq marker (org-agenda-new-marker (match-beginning 0))
   6102 	      closedp (equal (match-string 1) org-closed-string)
   6103 	      statep (equal (string-to-char (match-string 1)) ?-)
   6104 	      clockp (not (or closedp statep))
   6105 	      state (and statep (match-string 2))
   6106 	      category (org-get-category (match-beginning 0))
   6107 	      timestr (buffer-substring (match-beginning 0) (line-end-position))
   6108               effort (save-match-data (or (get-text-property (point) 'effort)
   6109                                           (org-entry-get (point) org-effort-property))))
   6110         (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
   6111 	(when (string-match "\\]" timestr)
   6112 	  ;; substring should only run to end of time stamp
   6113 	  (setq rest (substring timestr (match-end 0))
   6114 		timestr (substring timestr 0 (match-end 0)))
   6115 	  (if (and (not closedp) (not statep)
   6116 		   (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
   6117 				 rest))
   6118 	      (progn (setq timestr (concat (substring timestr 0 -1)
   6119 					   "-" (match-string 1 rest) "]"))
   6120 		     (setq clocked (match-string 2 rest)))
   6121 	    (setq clocked "-")))
   6122 	(save-excursion
   6123 	  (setq extra
   6124 		(cond
   6125 		 ((not org-agenda-log-mode-add-notes) nil)
   6126 		 (statep
   6127 		  (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
   6128 		       (match-string 1)))
   6129 		 (clockp
   6130 		  (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
   6131 		       (match-string 1)))))
   6132 	  (if (not (re-search-backward org-outline-regexp-bol nil t))
   6133 	      (throw :skip nil)
   6134 	    (goto-char (match-beginning 0))
   6135 	    (setq hdmarker (org-agenda-new-marker)
   6136 		  inherited-tags
   6137 		  (or (eq org-agenda-show-inherited-tags 'always)
   6138 		      (and (listp org-agenda-show-inherited-tags)
   6139 			   (memq 'todo org-agenda-show-inherited-tags))
   6140 		      (and (eq org-agenda-show-inherited-tags t)
   6141 			   (or (eq org-agenda-use-tag-inheritance t)
   6142 			       (memq 'todo org-agenda-use-tag-inheritance))))
   6143 		  tags (org-get-tags nil (not inherited-tags))
   6144 		  level (make-string (org-reduced-level (org-outline-level)) ? ))
   6145 	    (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
   6146 	    (setq txt (match-string 1))
   6147 	    (when extra
   6148 	      (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
   6149 		  (setq txt (concat (substring txt 0 (match-beginning 1))
   6150 				    " - " extra " " (match-string 2 txt)))
   6151 		(setq txt (concat txt " - " extra))))
   6152 	    (setq txt (org-agenda-format-item
   6153 		       (cond
   6154 			(closedp "Closed:    ")
   6155 			(statep (concat "State:     (" state ")"))
   6156 			(t (concat "Clocked:   (" clocked  ")")))
   6157                        (org-add-props txt nil
   6158                          'effort effort
   6159                          'effort-minutes effort-minutes)
   6160 		       level category tags timestr)))
   6161 	  (setq type (cond (closedp "closed")
   6162 			   (statep "state")
   6163 			   (t "clock")))
   6164 	  (setq priority 100000)
   6165 	  (org-add-props txt props
   6166 	    'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
   6167 	    'priority priority 'level level
   6168             'effort effort 'effort-minutes effort-minutes
   6169 	    'type type 'date date
   6170 	    'undone-face 'org-warning 'done-face 'org-agenda-done)
   6171 	  (push txt ee))
   6172         (goto-char (line-end-position))))
   6173     (nreverse ee)))
   6174 
   6175 (defun org-agenda-show-clocking-issues ()
   6176   "Add overlays, showing issues with clocking.
   6177 See also the user option `org-agenda-clock-consistency-checks'."
   6178   (interactive)
   6179   (let* ((pl org-agenda-clock-consistency-checks)
   6180 	 (re (concat "^[ \t]*"
   6181 		     org-clock-string
   6182 		     "[ \t]+"
   6183 		     "\\(\\[.*?\\]\\)"	; group 1 is first stamp
   6184 		     "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
   6185 	 (tlstart 0.)
   6186 	 (tlend 0.)
   6187 	 (maxtime (org-duration-to-minutes
   6188 		   (or (plist-get pl :max-duration) "24:00")))
   6189 	 (mintime (org-duration-to-minutes
   6190 		   (or (plist-get pl :min-duration) 0)))
   6191 	 (maxgap  (org-duration-to-minutes
   6192 		   ;; default 30:00 means never complain
   6193 		   (or (plist-get pl :max-gap) "30:00")))
   6194 	 (gapok (mapcar #'org-duration-to-minutes
   6195 			(plist-get pl :gap-ok-around)))
   6196 	 (def-face (or (plist-get pl :default-face)
   6197 		       '((:background "DarkRed") (:foreground "white"))))
   6198 	 issue face m te ts dt ov)
   6199     (goto-char (point-min))
   6200     (while (re-search-forward " Clocked: +(\\(?:-\\|\\([0-9]+:[0-9]+\\)\\))" nil t)
   6201       (setq issue nil face def-face)
   6202       (catch 'next
   6203 	(setq m (org-get-at-bol 'org-marker)
   6204 	      te nil ts nil)
   6205 	(unless (and m (markerp m))
   6206 	  (setq issue "No valid clock line") (throw 'next t))
   6207 	(org-with-point-at m
   6208 	  (save-excursion
   6209             (goto-char (line-beginning-position))
   6210 	    (unless (looking-at re)
   6211 	      (error "No valid Clock line")
   6212 	      (throw 'next t))
   6213 	    (unless (match-end 3)
   6214 	      (setq issue
   6215 		    (format
   6216 		     "No end time: (%s)"
   6217 		     (org-duration-from-minutes
   6218 		      (floor
   6219 		       (- (float-time (org-current-time))
   6220 			  (float-time (org-time-string-to-time (match-string 1))))
   6221 		       60)))
   6222 		    face (or (plist-get pl :no-end-time-face) face))
   6223 	      (throw 'next t))
   6224 	    (setq ts (match-string 1)
   6225 		  te (match-string 3)
   6226 		  ts (float-time (org-time-string-to-time ts))
   6227 		  te (float-time (org-time-string-to-time te))
   6228 		  dt (- te ts))))
   6229 	(cond
   6230 	 ((> dt (* 60 maxtime))
   6231 	  ;; a very long clocking chunk
   6232 	  (setq issue (format "Clocking interval is very long: %s"
   6233 			      (org-duration-from-minutes (floor dt 60)))
   6234 		face (or (plist-get pl :long-face) face)))
   6235 	 ((< dt (* 60 mintime))
   6236 	  ;; a very short clocking chunk
   6237 	  (setq issue (format "Clocking interval is very short: %s"
   6238 			      (org-duration-from-minutes (floor dt 60)))
   6239 		face (or (plist-get pl :short-face) face)))
   6240 	 ((and (> tlend 0) (< ts tlend))
   6241 	  ;; Two clock entries are overlapping
   6242 	  (setq issue (format "Clocking overlap: %d minutes"
   6243 			      (/ (- tlend ts) 60))
   6244 		face (or (plist-get pl :overlap-face) face)))
   6245 	 ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap))))
   6246 	  ;; There is a gap, lets see if we need to report it
   6247 	  (unless (org-agenda-check-clock-gap tlend ts gapok)
   6248 	    (setq issue (format "Clocking gap: %d minutes"
   6249 				(/ (- ts tlend) 60))
   6250 		  face (or (plist-get pl :gap-face) face))))
   6251 	 (t nil)))
   6252       (setq tlend (or te tlend) tlstart (or ts tlstart))
   6253       (when issue
   6254 	;; OK, there was some issue, add an overlay to show the issue
   6255         (setq ov (make-overlay (line-beginning-position) (line-end-position)))
   6256 	(overlay-put ov 'before-string
   6257 		     (concat
   6258 		      (org-add-props
   6259 			  (format "%-43s" (concat " " issue))
   6260 			  nil
   6261 			'face face)
   6262 		      "\n"))
   6263 	(overlay-put ov 'evaporate t)))))
   6264 
   6265 (defun org-agenda-check-clock-gap (t1 t2 ok-list)
   6266   "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values."
   6267   (catch 'exit
   6268     (unless ok-list
   6269       ;; there are no OK times for gaps...
   6270       (throw 'exit nil))
   6271     (when (> (- (/ t2 36000) (/ t1 36000)) 24)
   6272       ;; This is more than 24 hours, so it is OK.
   6273       ;; because we have at least one OK time, that must be in the
   6274       ;; 24 hour interval.
   6275       (throw 'exit t))
   6276     ;; We have a shorter gap.
   6277     ;; Now we have to get the minute of the day when these times are
   6278     (let* ((t1dec (decode-time t1))
   6279 	   (t2dec (decode-time t2))
   6280 	   ;; compute the minute on the day
   6281 	   (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec))))
   6282 	   (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec)))))
   6283       (when (< min2 min1)
   6284 	;; if min2 is smaller than min1, this means it is on the next day.
   6285 	;; Wrap it to after midnight.
   6286 	(setq min2 (+ min2 1440)))
   6287       ;; Now check if any of the OK times is in the gap
   6288       (mapc (lambda (x)
   6289 	      ;; Wrap the time to after midnight if necessary
   6290 	      (when (< x min1) (setq x (+ x 1440)))
   6291 	      ;; Check if in interval
   6292 	      (and (<= min1 x) (>= min2 x) (throw 'exit t)))
   6293 	    ok-list)
   6294       ;; Nope, this gap is not OK
   6295       nil)))
   6296 
   6297 (defun org-agenda-get-deadlines (&optional with-hour)
   6298   "Return the deadline information for agenda display.
   6299 When WITH-HOUR is non-nil, only return deadlines with an hour
   6300 specification like [h]h:mm."
   6301   (with-no-warnings (defvar date))
   6302   (let* ((props (list 'mouse-face 'highlight
   6303 		      'org-not-done-regexp org-not-done-regexp
   6304 		      'org-todo-regexp org-todo-regexp
   6305 		      'org-complex-heading-regexp org-complex-heading-regexp
   6306 		      'help-echo
   6307 		      (format "mouse-2 or RET jump to org file %s"
   6308 			      (abbreviate-file-name buffer-file-name))))
   6309 	 (regexp (if with-hour
   6310 		     org-deadline-time-hour-regexp
   6311 		   org-deadline-time-regexp))
   6312 	 (today (org-today))
   6313 	 (today? (org-agenda-today-p date)) ; DATE bound by calendar.
   6314 	 (current (calendar-absolute-from-gregorian date))
   6315 	 deadline-items)
   6316     (goto-char (point-min))
   6317     (if (org-element--cache-active-p)
   6318         (org-element-cache-map
   6319          (lambda (el)
   6320            (when (and (org-element-property :deadline el)
   6321                       (or (not with-hour)
   6322                           (org-element-property
   6323                            :hour-start
   6324                            (org-element-property :deadline el))
   6325                           (org-element-property
   6326                            :hour-end
   6327                            (org-element-property :deadline el))))
   6328              (goto-char (org-element-property :contents-begin el))
   6329              (catch :skip
   6330 	       (org-agenda-skip el)
   6331 	       (let* ((s (substring (org-element-property
   6332                                      :raw-value
   6333                                      (org-element-property :deadline el))
   6334                                     1 -1))
   6335 	              (pos (save-excursion
   6336                              (goto-char (org-element-property :contents-begin el))
   6337                              ;; We intentionally leave NOERROR
   6338                              ;; argument in `re-search-forward' nil.  If
   6339                              ;; the search fails here, something went
   6340                              ;; wrong and we are looking at
   6341                              ;; non-matching headline.
   6342                              (re-search-forward regexp (line-end-position))
   6343                              (1- (match-beginning 1))))
   6344 	              (todo-state (org-element-property :todo-keyword el))
   6345 	              (done? (eq 'done (org-element-property :todo-type el)))
   6346                       (sexp? (eq 'diary
   6347                                  (org-element-property
   6348                                   :type (org-element-property :deadline el))))
   6349 	              ;; DEADLINE is the deadline date for the entry.  It is
   6350 	              ;; either the base date or the last repeat, according
   6351 	              ;; to `org-agenda-prefer-last-repeat'.
   6352 	              (deadline
   6353 		       (cond
   6354 		        (sexp? (org-agenda--timestamp-to-absolute s current))
   6355 		        ((or (eq org-agenda-prefer-last-repeat t)
   6356 		             (member todo-state org-agenda-prefer-last-repeat))
   6357 		         (org-agenda--timestamp-to-absolute
   6358 		          s today 'past (current-buffer) pos))
   6359 		        (t (org-agenda--timestamp-to-absolute s))))
   6360 	              ;; REPEAT is the future repeat closest from CURRENT,
   6361 	              ;; according to `org-agenda-show-future-repeats'. If
   6362 	              ;; the latter is nil, or if the time stamp has no
   6363 	              ;; repeat part, default to DEADLINE.
   6364 	              (repeat
   6365 		       (cond
   6366 		        (sexp? deadline)
   6367 		        ((<= current today) deadline)
   6368 		        ((not org-agenda-show-future-repeats) deadline)
   6369 		        (t
   6370 		         (let ((base (if (eq org-agenda-show-future-repeats 'next)
   6371 				         (1+ today)
   6372 				       current)))
   6373 		           (org-agenda--timestamp-to-absolute
   6374 		            s base 'future (current-buffer) pos)))))
   6375 	              (diff (- deadline current))
   6376 	              (suppress-prewarning
   6377 		       (let ((scheduled
   6378 		              (and org-agenda-skip-deadline-prewarning-if-scheduled
   6379                                    (org-element-property
   6380                                     :raw-value
   6381                                     (org-element-property :scheduled el)))))
   6382 		         (cond
   6383 		          ((not scheduled) nil)
   6384 		          ;; The current item has a scheduled date, so
   6385 		          ;; evaluate its prewarning lead time.
   6386 		          ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
   6387 		           ;; Use global prewarning-restart lead time.
   6388 		           org-agenda-skip-deadline-prewarning-if-scheduled)
   6389 		          ((eq org-agenda-skip-deadline-prewarning-if-scheduled
   6390 			       'pre-scheduled)
   6391 		           ;; Set pre-warning to no earlier than SCHEDULED.
   6392 		           (min (- deadline
   6393 			           (org-agenda--timestamp-to-absolute scheduled))
   6394 			        org-deadline-warning-days))
   6395 		          ;; Set pre-warning to deadline.
   6396 		          (t 0))))
   6397 	              (wdays (or suppress-prewarning (org-get-wdays s))))
   6398 	         (cond
   6399 	          ;; Only display deadlines at their base date, at future
   6400 	          ;; repeat occurrences or in today agenda.
   6401 	          ((= current deadline) nil)
   6402 	          ((= current repeat) nil)
   6403 	          ((not today?) (throw :skip nil))
   6404 	          ;; Upcoming deadline: display within warning period WDAYS.
   6405 	          ((> deadline current) (when (> diff wdays) (throw :skip nil)))
   6406 	          ;; Overdue deadline: warn about it for
   6407 	          ;; `org-deadline-past-days' duration.
   6408 	          (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
   6409 	         ;; Possibly skip done tasks.
   6410 	         (when (and done?
   6411 		            (or org-agenda-skip-deadline-if-done
   6412 			        (/= deadline current)))
   6413 	           (throw :skip nil))
   6414 	         (save-excursion
   6415                    (goto-char (org-element-property :begin el))
   6416 	           (let* ((category (org-get-category))
   6417                           (effort (save-match-data (or (get-text-property (point) 'effort)
   6418                                                        (org-element-property (intern (concat ":" (upcase org-effort-property))) el))))
   6419                           (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
   6420 		          (level (make-string (org-element-property :level el)
   6421 				              ?\s))
   6422 		          (head (save-excursion
   6423                                   (goto-char (org-element-property :begin el))
   6424                                   (re-search-forward org-outline-regexp-bol)
   6425                                   (buffer-substring-no-properties (point) (line-end-position))))
   6426 		          (inherited-tags
   6427 		           (or (eq org-agenda-show-inherited-tags 'always)
   6428 			       (and (listp org-agenda-show-inherited-tags)
   6429 			            (memq 'agenda org-agenda-show-inherited-tags))
   6430 			       (and (eq org-agenda-show-inherited-tags t)
   6431 			            (or (eq org-agenda-use-tag-inheritance t)
   6432 				        (memq 'agenda
   6433 				              org-agenda-use-tag-inheritance)))))
   6434 		          (tags (org-get-tags el (not inherited-tags)))
   6435 		          (time
   6436 		           (cond
   6437 		            ;; No time of day designation if it is only
   6438 		            ;; a reminder.
   6439 		            ((and (/= current deadline) (/= current repeat)) nil)
   6440 		            ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
   6441 		             (concat (substring s (match-beginning 1)) " "))
   6442 		            (t 'time)))
   6443 		          (item
   6444 		           (org-agenda-format-item
   6445 		            ;; Insert appropriate suffixes before deadlines.
   6446 		            ;; Those only apply to today agenda.
   6447 		            (pcase-let ((`(,now ,future ,past)
   6448 				         org-agenda-deadline-leaders))
   6449 		              (cond
   6450 			       ((and today? (< deadline today)) (format past (- diff)))
   6451 			       ((and today? (> deadline today)) (format future diff))
   6452 			       (t now)))
   6453 		            (org-add-props head nil
   6454                               'effort effort
   6455                               'effort-minutes effort-minutes)
   6456                             level category tags time))
   6457 		          (face (org-agenda-deadline-face
   6458 			         (- 1 (/ (float diff) (max wdays 1)))))
   6459 		          (upcoming? (and today? (> deadline today)))
   6460 		          (warntime (get-text-property (point) 'org-appt-warntime)))
   6461 	             (org-add-props item props
   6462 		       'org-marker (org-agenda-new-marker pos)
   6463 		       'org-hd-marker (org-agenda-new-marker (line-beginning-position))
   6464 		       'warntime warntime
   6465 		       'level level
   6466                        'effort effort 'effort-minutes effort-minutes
   6467 		       'ts-date deadline
   6468 		       'priority
   6469 		       ;; Adjust priority to today reminders about deadlines.
   6470 		       ;; Overdue deadlines get the highest priority
   6471 		       ;; increase, then imminent deadlines and eventually
   6472 		       ;; more distant deadlines.
   6473 		       (let ((adjust (if today? (- diff) 0)))
   6474 		         (+ adjust (org-get-priority item)))
   6475 		       'todo-state todo-state
   6476 		       'type (if upcoming? "upcoming-deadline" "deadline")
   6477 		       'date (if upcoming? date deadline)
   6478 		       'face (if done? 'org-agenda-done face)
   6479 		       'undone-face face
   6480 		       'done-face 'org-agenda-done)
   6481 	             (push item deadline-items)))))))
   6482          :next-re regexp
   6483          :fail-re regexp
   6484          :narrow t)
   6485       (while (re-search-forward regexp nil t)
   6486         (catch :skip
   6487 	  (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
   6488 	  (org-agenda-skip)
   6489 	  (let* ((s (match-string 1))
   6490 	         (pos (1- (match-beginning 1)))
   6491 	         (todo-state (save-match-data (org-get-todo-state)))
   6492 	         (done? (member todo-state org-done-keywords))
   6493                  (sexp? (string-prefix-p "%%" s))
   6494 	         ;; DEADLINE is the deadline date for the entry.  It is
   6495 	         ;; either the base date or the last repeat, according
   6496 	         ;; to `org-agenda-prefer-last-repeat'.
   6497 	         (deadline
   6498 		  (cond
   6499 		   (sexp? (org-agenda--timestamp-to-absolute s current))
   6500 		   ((or (eq org-agenda-prefer-last-repeat t)
   6501 		        (member todo-state org-agenda-prefer-last-repeat))
   6502 		    (org-agenda--timestamp-to-absolute
   6503 		     s today 'past (current-buffer) pos))
   6504 		   (t (org-agenda--timestamp-to-absolute s))))
   6505 	         ;; REPEAT is the future repeat closest from CURRENT,
   6506 	         ;; according to `org-agenda-show-future-repeats'. If
   6507 	         ;; the latter is nil, or if the time stamp has no
   6508 	         ;; repeat part, default to DEADLINE.
   6509 	         (repeat
   6510 		  (cond
   6511 		   (sexp? deadline)
   6512 		   ((<= current today) deadline)
   6513 		   ((not org-agenda-show-future-repeats) deadline)
   6514 		   (t
   6515 		    (let ((base (if (eq org-agenda-show-future-repeats 'next)
   6516 				    (1+ today)
   6517 				  current)))
   6518 		      (org-agenda--timestamp-to-absolute
   6519 		       s base 'future (current-buffer) pos)))))
   6520 	         (diff (- deadline current))
   6521 	         (suppress-prewarning
   6522 		  (let ((scheduled
   6523 		         (and org-agenda-skip-deadline-prewarning-if-scheduled
   6524 			      (org-entry-get nil "SCHEDULED"))))
   6525 		    (cond
   6526 		     ((not scheduled) nil)
   6527 		     ;; The current item has a scheduled date, so
   6528 		     ;; evaluate its prewarning lead time.
   6529 		     ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
   6530 		      ;; Use global prewarning-restart lead time.
   6531 		      org-agenda-skip-deadline-prewarning-if-scheduled)
   6532 		     ((eq org-agenda-skip-deadline-prewarning-if-scheduled
   6533 			  'pre-scheduled)
   6534 		      ;; Set pre-warning to no earlier than SCHEDULED.
   6535 		      (min (- deadline
   6536 			      (org-agenda--timestamp-to-absolute scheduled))
   6537 			   org-deadline-warning-days))
   6538 		     ;; Set pre-warning to deadline.
   6539 		     (t 0))))
   6540 	         (wdays (or suppress-prewarning (org-get-wdays s))))
   6541 	    (cond
   6542 	     ;; Only display deadlines at their base date, at future
   6543 	     ;; repeat occurrences or in today agenda.
   6544 	     ((= current deadline) nil)
   6545 	     ((= current repeat) nil)
   6546 	     ((not today?) (throw :skip nil))
   6547 	     ;; Upcoming deadline: display within warning period WDAYS.
   6548 	     ((> deadline current) (when (> diff wdays) (throw :skip nil)))
   6549 	     ;; Overdue deadline: warn about it for
   6550 	     ;; `org-deadline-past-days' duration.
   6551 	     (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
   6552 	    ;; Possibly skip done tasks.
   6553 	    (when (and done?
   6554 		       (or org-agenda-skip-deadline-if-done
   6555 			   (/= deadline current)))
   6556 	      (throw :skip nil))
   6557 	    (save-excursion
   6558 	      (re-search-backward "^\\*+[ \t]+" nil t)
   6559 	      (goto-char (match-end 0))
   6560 	      (let* ((category (org-get-category))
   6561                      (effort (save-match-data (or (get-text-property (point) 'effort)
   6562                                                   (org-entry-get (point) org-effort-property))))
   6563                      (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
   6564 		     (level (make-string (org-reduced-level (org-outline-level))
   6565 				         ?\s))
   6566 		     (head (buffer-substring-no-properties
   6567                             (point) (line-end-position)))
   6568 		     (inherited-tags
   6569 		      (or (eq org-agenda-show-inherited-tags 'always)
   6570 			  (and (listp org-agenda-show-inherited-tags)
   6571 			       (memq 'agenda org-agenda-show-inherited-tags))
   6572 			  (and (eq org-agenda-show-inherited-tags t)
   6573 			       (or (eq org-agenda-use-tag-inheritance t)
   6574 				   (memq 'agenda
   6575 				         org-agenda-use-tag-inheritance)))))
   6576 		     (tags (org-get-tags nil (not inherited-tags)))
   6577 		     (time
   6578 		      (cond
   6579 		       ;; No time of day designation if it is only
   6580 		       ;; a reminder.
   6581 		       ((and (/= current deadline) (/= current repeat)) nil)
   6582 		       ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
   6583 		        (concat (substring s (match-beginning 1)) " "))
   6584 		       (t 'time)))
   6585 		     (item
   6586 		      (org-agenda-format-item
   6587 		       ;; Insert appropriate suffixes before deadlines.
   6588 		       ;; Those only apply to today agenda.
   6589 		       (pcase-let ((`(,now ,future ,past)
   6590 				    org-agenda-deadline-leaders))
   6591 		         (cond
   6592 			  ((and today? (< deadline today)) (format past (- diff)))
   6593 			  ((and today? (> deadline today)) (format future diff))
   6594 			  (t now)))
   6595 		       (org-add-props head nil
   6596                          'effort effort
   6597                          'effort-minutes effort-minutes)
   6598                        level category tags time))
   6599 		     (face (org-agenda-deadline-face
   6600 			    (- 1 (/ (float diff) (max wdays 1)))))
   6601 		     (upcoming? (and today? (> deadline today)))
   6602 		     (warntime (get-text-property (point) 'org-appt-warntime)))
   6603 	        (org-add-props item props
   6604 		  'org-marker (org-agenda-new-marker pos)
   6605 		  'org-hd-marker (org-agenda-new-marker (line-beginning-position))
   6606 		  'warntime warntime
   6607 		  'level level
   6608                   'effort effort 'effort-minutes effort-minutes
   6609 		  'ts-date deadline
   6610 		  'priority
   6611 		  ;; Adjust priority to today reminders about deadlines.
   6612 		  ;; Overdue deadlines get the highest priority
   6613 		  ;; increase, then imminent deadlines and eventually
   6614 		  ;; more distant deadlines.
   6615 		  (let ((adjust (if today? (- diff) 0)))
   6616 		    (+ adjust (org-get-priority item)))
   6617 		  'todo-state todo-state
   6618 		  'type (if upcoming? "upcoming-deadline" "deadline")
   6619 		  'date (if upcoming? date deadline)
   6620 		  'face (if done? 'org-agenda-done face)
   6621 		  'undone-face face
   6622 		  'done-face 'org-agenda-done)
   6623 	        (push item deadline-items)))))))
   6624     (nreverse deadline-items)))
   6625 
   6626 (defun org-agenda-deadline-face (fraction)
   6627   "Return the face to displaying a deadline item.
   6628 FRACTION is what fraction of the head-warning time has passed."
   6629   (assoc-default fraction org-agenda-deadline-faces #'<=))
   6630 
   6631 (defun org-agenda-get-scheduled (&optional deadlines with-hour)
   6632   "Return the scheduled information for agenda display.
   6633 Optional argument DEADLINES is a list of deadline items to be
   6634 displayed in agenda view.  When WITH-HOUR is non-nil, only return
   6635 scheduled items with an hour specification like [h]h:mm."
   6636   (with-no-warnings (defvar date))
   6637   (let* ((props (list 'org-not-done-regexp org-not-done-regexp
   6638 		      'org-todo-regexp org-todo-regexp
   6639 		      'org-complex-heading-regexp org-complex-heading-regexp
   6640 		      'done-face 'org-agenda-done
   6641 		      'mouse-face 'highlight
   6642 		      'help-echo
   6643 		      (format "mouse-2 or RET jump to Org file %s"
   6644 			      (abbreviate-file-name buffer-file-name))))
   6645 	 (regexp (if with-hour
   6646 		     org-scheduled-time-hour-regexp
   6647 		   org-scheduled-time-regexp))
   6648 	 (today (org-today))
   6649 	 (todayp (org-agenda-today-p date)) ; DATE bound by calendar.
   6650 	 (current (calendar-absolute-from-gregorian date))
   6651 	 (deadline-pos
   6652 	  (mapcar (lambda (d)
   6653 		    (let ((m (get-text-property 0 'org-hd-marker d)))
   6654 		      (and m (marker-position m))))
   6655 		  deadlines))
   6656 	 scheduled-items)
   6657     (goto-char (point-min))
   6658     (if (org-element--cache-active-p)
   6659         (org-element-cache-map
   6660          (lambda (el)
   6661            (when (and (org-element-property :scheduled el)
   6662                       (or (not with-hour)
   6663                           (org-element-property
   6664                            :hour-start
   6665                            (org-element-property :scheduled el))
   6666                           (org-element-property
   6667                            :hour-end
   6668                            (org-element-property :scheduled el))))
   6669              (goto-char (org-element-property :contents-begin el))
   6670              (catch :skip
   6671                (org-agenda-skip el)
   6672                (let* ((s (substring (org-element-property
   6673                                      :raw-value
   6674                                      (org-element-property :scheduled el))
   6675                                     1 -1))
   6676                       (pos (save-excursion
   6677                              (goto-char (org-element-property :contents-begin el))
   6678                              ;; We intentionally leave NOERROR
   6679                              ;; argument in `re-search-forward' nil.  If
   6680                              ;; the search fails here, something went
   6681                              ;; wrong and we are looking at
   6682                              ;; non-matching headline.
   6683                              (re-search-forward regexp (line-end-position))
   6684                              (1- (match-beginning 1))))
   6685                       (todo-state (org-element-property :todo-keyword el))
   6686 	              (donep (eq 'done (org-element-property :todo-type el)))
   6687 	              (sexp? (eq 'diary
   6688                                  (org-element-property
   6689                                   :type (org-element-property :scheduled el))))
   6690 	              ;; SCHEDULE is the scheduled date for the entry.  It is
   6691 	              ;; either the bare date or the last repeat, according
   6692 	              ;; to `org-agenda-prefer-last-repeat'.
   6693 	              (schedule
   6694 		       (cond
   6695 		        (sexp? (org-agenda--timestamp-to-absolute s current))
   6696 		        ((or (eq org-agenda-prefer-last-repeat t)
   6697 		             (member todo-state org-agenda-prefer-last-repeat))
   6698 		         (org-agenda--timestamp-to-absolute
   6699 		          s today 'past (current-buffer) pos))
   6700 		        (t (org-agenda--timestamp-to-absolute s))))
   6701 	              ;; REPEAT is the future repeat closest from CURRENT,
   6702 	              ;; according to `org-agenda-show-future-repeats'. If
   6703 	              ;; the latter is nil, or if the time stamp has no
   6704 	              ;; repeat part, default to SCHEDULE.
   6705 	              (repeat
   6706 		       (cond
   6707 		        (sexp? schedule)
   6708 		        ((<= current today) schedule)
   6709 		        ((not org-agenda-show-future-repeats) schedule)
   6710 		        (t
   6711 		         (let ((base (if (eq org-agenda-show-future-repeats 'next)
   6712 				         (1+ today)
   6713 				       current)))
   6714 		           (org-agenda--timestamp-to-absolute
   6715 		            s base 'future (current-buffer) pos)))))
   6716 	              (diff (- current schedule))
   6717 	              (warntime (get-text-property (point) 'org-appt-warntime))
   6718 	              (pastschedp (< schedule today))
   6719 	              (futureschedp (> schedule today))
   6720 	              (habitp (and (fboundp 'org-is-habit-p)
   6721                                    (string= "habit" (org-element-property :STYLE el))))
   6722 	              (suppress-delay
   6723 		       (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
   6724                                             (org-element-property
   6725                                              :raw-value
   6726                                              (org-element-property :deadline el)))))
   6727 		         (cond
   6728 		          ((not deadline) nil)
   6729 		          ;; The current item has a deadline date, so
   6730 		          ;; evaluate its delay time.
   6731 		          ((integerp org-agenda-skip-scheduled-delay-if-deadline)
   6732 		           ;; Use global delay time.
   6733 		           (- org-agenda-skip-scheduled-delay-if-deadline))
   6734 		          ((eq org-agenda-skip-scheduled-delay-if-deadline
   6735 			       'post-deadline)
   6736 		           ;; Set delay to no later than DEADLINE.
   6737 		           (min (- schedule
   6738 			           (org-agenda--timestamp-to-absolute deadline))
   6739 			        org-scheduled-delay-days))
   6740 		          (t 0))))
   6741 	              (ddays
   6742 		       (cond
   6743 		        ;; Nullify delay when a repeater triggered already
   6744 		        ;; and the delay is of the form --Xd.
   6745 		        ((and (string-match-p "--[0-9]+[hdwmy]" s)
   6746 		              (> schedule (org-agenda--timestamp-to-absolute s)))
   6747 		         0)
   6748 		        (suppress-delay
   6749 		         (let ((org-scheduled-delay-days suppress-delay))
   6750 		           (org-get-wdays s t t)))
   6751 		        (t (org-get-wdays s t)))))
   6752 	         ;; Display scheduled items at base date (SCHEDULE), today if
   6753 	         ;; scheduled before the current date, and at any repeat past
   6754 	         ;; today.  However, skip delayed items and items that have
   6755 	         ;; been displayed for more than `org-scheduled-past-days'.
   6756 	         (unless (and todayp
   6757 		              habitp
   6758 		              (bound-and-true-p org-habit-show-all-today))
   6759 	           (when (or (and (> ddays 0) (< diff ddays))
   6760 		             (> diff (or (and habitp org-habit-scheduled-past-days)
   6761 				         org-scheduled-past-days))
   6762 		             (> schedule current)
   6763 		             (and (/= current schedule)
   6764 			          (/= current today)
   6765 			          (/= current repeat)))
   6766 	             (throw :skip nil)))
   6767 	         ;; Possibly skip done tasks.
   6768 	         (when (and donep
   6769 		            (or org-agenda-skip-scheduled-if-done
   6770 			        (/= schedule current)))
   6771 	           (throw :skip nil))
   6772 	         ;; Skip entry if it already appears as a deadline, per
   6773 	         ;; `org-agenda-skip-scheduled-if-deadline-is-shown'.  This
   6774 	         ;; doesn't apply to habits.
   6775 	         (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
   6776 		         ((guard
   6777 		           (or (not (memq (line-beginning-position 0) deadline-pos))
   6778 			       habitp))
   6779 		          nil)
   6780 		         (`repeated-after-deadline
   6781 		          (let ((deadline (time-to-days
   6782                                            (when (org-element-property :deadline el)
   6783                                              (org-time-string-to-time
   6784                                               (org-element-property :deadline el))))))
   6785 		            (and (<= schedule deadline) (> current deadline))))
   6786 		         (`not-today pastschedp)
   6787 		         (`t t)
   6788 		         (_ nil))
   6789 	           (throw :skip nil))
   6790 	         ;; Skip habits if `org-habit-show-habits' is nil, or if we
   6791 	         ;; only show them for today.  Also skip done habits.
   6792 	         (when (and habitp
   6793 		            (or donep
   6794 			        (not (bound-and-true-p org-habit-show-habits))
   6795 			        (and (not todayp)
   6796 			             (bound-and-true-p
   6797 			              org-habit-show-habits-only-for-today))))
   6798 	           (throw :skip nil))
   6799 	         (save-excursion
   6800                    (goto-char (org-element-property :begin el))
   6801 	           (let* ((category (org-get-category))
   6802                           (effort (save-match-data
   6803                                     (or (get-text-property (point) 'effort)
   6804                                         (org-element-property (intern (concat ":" (upcase org-effort-property))) el))))
   6805                           (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
   6806 		          (inherited-tags
   6807 		           (or (eq org-agenda-show-inherited-tags 'always)
   6808 			       (and (listp org-agenda-show-inherited-tags)
   6809 			            (memq 'agenda org-agenda-show-inherited-tags))
   6810 			       (and (eq org-agenda-show-inherited-tags t)
   6811 			            (or (eq org-agenda-use-tag-inheritance t)
   6812 				        (memq 'agenda
   6813 				              org-agenda-use-tag-inheritance)))))
   6814 		          (tags (org-get-tags el (not inherited-tags)))
   6815 		          (level (make-string (org-element-property :level el)
   6816 				              ?\s))
   6817 		          (head (save-excursion
   6818                                   (goto-char (org-element-property :begin el))
   6819                                   (re-search-forward org-outline-regexp-bol)
   6820                                   (buffer-substring (point) (line-end-position))))
   6821 		          (time
   6822 		           (cond
   6823 		            ;; No time of day designation if it is only a
   6824 		            ;; reminder, except for habits, which always show
   6825 		            ;; the time of day.  Habits are an exception
   6826 		            ;; because if there is a time of day, that is
   6827 		            ;; interpreted to mean they should usually happen
   6828 		            ;; then, even if doing the habit was missed.
   6829 		            ((and
   6830 		              (not habitp)
   6831 		              (/= current schedule)
   6832 		              (/= current repeat))
   6833 		             nil)
   6834 		            ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
   6835 		             (concat (substring s (match-beginning 1)) " "))
   6836 		            (t 'time)))
   6837 		          (item
   6838 		           (org-agenda-format-item
   6839 		            (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
   6840 		              ;; Show a reminder of a past scheduled today.
   6841 		              (if (and todayp pastschedp)
   6842 			          (format past diff)
   6843 			        first))
   6844 		            (org-add-props head nil
   6845                               'effort effort
   6846                               'effort-minutes effort-minutes)
   6847                             level category tags time nil habitp))
   6848 		          (face (cond ((and (not habitp) pastschedp)
   6849 				       'org-scheduled-previously)
   6850 			              ((and habitp futureschedp)
   6851 				       'org-agenda-done)
   6852 			              (todayp 'org-scheduled-today)
   6853 			              (t 'org-scheduled)))
   6854 		          (habitp (and habitp (org-habit-parse-todo (org-element-property :begin el)))))
   6855 	             (org-add-props item props
   6856 		       'undone-face face
   6857 		       'face (if donep 'org-agenda-done face)
   6858 		       'org-marker (org-agenda-new-marker pos)
   6859 		       'org-hd-marker (org-agenda-new-marker (line-beginning-position))
   6860 		       'type (if pastschedp "past-scheduled" "scheduled")
   6861 		       'date (if pastschedp schedule date)
   6862 		       'ts-date schedule
   6863 		       'warntime warntime
   6864 		       'level level
   6865                        'effort effort 'effort-minutes effort-minutes
   6866 		       'priority (if habitp (org-habit-get-priority habitp)
   6867 			           (+ 99 diff (org-get-priority item)))
   6868 		       'org-habit-p habitp
   6869 		       'todo-state todo-state)
   6870 	             (push item scheduled-items)))))))
   6871          :next-re regexp
   6872          :fail-re regexp
   6873          :narrow t)
   6874       (while (re-search-forward regexp nil t)
   6875         (catch :skip
   6876 	  (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
   6877 	  (org-agenda-skip)
   6878 	  (let* ((s (match-string 1))
   6879 	         (pos (1- (match-beginning 1)))
   6880 	         (todo-state (save-match-data (org-get-todo-state)))
   6881 	         (donep (member todo-state org-done-keywords))
   6882 	         (sexp? (string-prefix-p "%%" s))
   6883 	         ;; SCHEDULE is the scheduled date for the entry.  It is
   6884 	         ;; either the bare date or the last repeat, according
   6885 	         ;; to `org-agenda-prefer-last-repeat'.
   6886 	         (schedule
   6887 		  (cond
   6888 		   (sexp? (org-agenda--timestamp-to-absolute s current))
   6889 		   ((or (eq org-agenda-prefer-last-repeat t)
   6890 		        (member todo-state org-agenda-prefer-last-repeat))
   6891 		    (org-agenda--timestamp-to-absolute
   6892 		     s today 'past (current-buffer) pos))
   6893 		   (t (org-agenda--timestamp-to-absolute s))))
   6894 	         ;; REPEAT is the future repeat closest from CURRENT,
   6895 	         ;; according to `org-agenda-show-future-repeats'. If
   6896 	         ;; the latter is nil, or if the time stamp has no
   6897 	         ;; repeat part, default to SCHEDULE.
   6898 	         (repeat
   6899 		  (cond
   6900 		   (sexp? schedule)
   6901 		   ((<= current today) schedule)
   6902 		   ((not org-agenda-show-future-repeats) schedule)
   6903 		   (t
   6904 		    (let ((base (if (eq org-agenda-show-future-repeats 'next)
   6905 				    (1+ today)
   6906 				  current)))
   6907 		      (org-agenda--timestamp-to-absolute
   6908 		       s base 'future (current-buffer) pos)))))
   6909 	         (diff (- current schedule))
   6910 	         (warntime (get-text-property (point) 'org-appt-warntime))
   6911 	         (pastschedp (< schedule today))
   6912 	         (futureschedp (> schedule today))
   6913 	         (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
   6914 	         (suppress-delay
   6915 		  (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
   6916 				       (org-entry-get nil "DEADLINE"))))
   6917 		    (cond
   6918 		     ((not deadline) nil)
   6919 		     ;; The current item has a deadline date, so
   6920 		     ;; evaluate its delay time.
   6921 		     ((integerp org-agenda-skip-scheduled-delay-if-deadline)
   6922 		      ;; Use global delay time.
   6923 		      (- org-agenda-skip-scheduled-delay-if-deadline))
   6924 		     ((eq org-agenda-skip-scheduled-delay-if-deadline
   6925 			  'post-deadline)
   6926 		      ;; Set delay to no later than DEADLINE.
   6927 		      (min (- schedule
   6928 			      (org-agenda--timestamp-to-absolute deadline))
   6929 			   org-scheduled-delay-days))
   6930 		     (t 0))))
   6931 	         (ddays
   6932 		  (cond
   6933 		   ;; Nullify delay when a repeater triggered already
   6934 		   ;; and the delay is of the form --Xd.
   6935 		   ((and (string-match-p "--[0-9]+[hdwmy]" s)
   6936 		         (> schedule (org-agenda--timestamp-to-absolute s)))
   6937 		    0)
   6938 		   (suppress-delay
   6939 		    (let ((org-scheduled-delay-days suppress-delay))
   6940 		      (org-get-wdays s t t)))
   6941 		   (t (org-get-wdays s t)))))
   6942 	    ;; Display scheduled items at base date (SCHEDULE), today if
   6943 	    ;; scheduled before the current date, and at any repeat past
   6944 	    ;; today.  However, skip delayed items and items that have
   6945 	    ;; been displayed for more than `org-scheduled-past-days'.
   6946 	    (unless (and todayp
   6947 		         habitp
   6948 		         (bound-and-true-p org-habit-show-all-today))
   6949 	      (when (or (and (> ddays 0) (< diff ddays))
   6950 		        (> diff (or (and habitp org-habit-scheduled-past-days)
   6951 				    org-scheduled-past-days))
   6952 		        (> schedule current)
   6953 		        (and (/= current schedule)
   6954 			     (/= current today)
   6955 			     (/= current repeat)))
   6956 	        (throw :skip nil)))
   6957 	    ;; Possibly skip done tasks.
   6958 	    (when (and donep
   6959 		       (or org-agenda-skip-scheduled-if-done
   6960 			   (/= schedule current)))
   6961 	      (throw :skip nil))
   6962 	    ;; Skip entry if it already appears as a deadline, per
   6963 	    ;; `org-agenda-skip-scheduled-if-deadline-is-shown'.  This
   6964 	    ;; doesn't apply to habits.
   6965 	    (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
   6966 		    ((guard
   6967 		      (or (not (memq (line-beginning-position 0) deadline-pos))
   6968 			  habitp))
   6969 		     nil)
   6970 		    (`repeated-after-deadline
   6971 		     (let ((deadline (time-to-days
   6972 				      (org-get-deadline-time (point)))))
   6973 		       (and (<= schedule deadline) (> current deadline))))
   6974 		    (`not-today pastschedp)
   6975 		    (`t t)
   6976 		    (_ nil))
   6977 	      (throw :skip nil))
   6978 	    ;; Skip habits if `org-habit-show-habits' is nil, or if we
   6979 	    ;; only show them for today.  Also skip done habits.
   6980 	    (when (and habitp
   6981 		       (or donep
   6982 			   (not (bound-and-true-p org-habit-show-habits))
   6983 			   (and (not todayp)
   6984 			        (bound-and-true-p
   6985 			         org-habit-show-habits-only-for-today))))
   6986 	      (throw :skip nil))
   6987 	    (save-excursion
   6988 	      (re-search-backward "^\\*+[ \t]+" nil t)
   6989 	      (goto-char (match-end 0))
   6990 	      (let* ((category (org-get-category))
   6991                      (effort (save-match-data (or (get-text-property (point) 'effort)
   6992                                                   (org-entry-get (point) org-effort-property))))
   6993                      (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
   6994 		     (inherited-tags
   6995 		      (or (eq org-agenda-show-inherited-tags 'always)
   6996 			  (and (listp org-agenda-show-inherited-tags)
   6997 			       (memq 'agenda org-agenda-show-inherited-tags))
   6998 			  (and (eq org-agenda-show-inherited-tags t)
   6999 			       (or (eq org-agenda-use-tag-inheritance t)
   7000 				   (memq 'agenda
   7001 				         org-agenda-use-tag-inheritance)))))
   7002 		     (tags (org-get-tags nil (not inherited-tags)))
   7003 		     (level (make-string (org-reduced-level (org-outline-level))
   7004 				         ?\s))
   7005 		     (head (buffer-substring (point) (line-end-position)))
   7006 		     (time
   7007 		      (cond
   7008 		       ;; No time of day designation if it is only a
   7009 		       ;; reminder, except for habits, which always show
   7010 		       ;; the time of day.  Habits are an exception
   7011 		       ;; because if there is a time of day, that is
   7012 		       ;; interpreted to mean they should usually happen
   7013 		       ;; then, even if doing the habit was missed.
   7014 		       ((and
   7015 		         (not habitp)
   7016 		         (/= current schedule)
   7017 		         (/= current repeat))
   7018 		        nil)
   7019 		       ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
   7020 		        (concat (substring s (match-beginning 1)) " "))
   7021 		       (t 'time)))
   7022 		     (item
   7023 		      (org-agenda-format-item
   7024 		       (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
   7025 		         ;; Show a reminder of a past scheduled today.
   7026 		         (if (and todayp pastschedp)
   7027 			     (format past diff)
   7028 			   first))
   7029 		       (org-add-props head nil
   7030                          'effort effort
   7031                          'effort-minutes effort-minutes)
   7032                        level category tags time nil habitp))
   7033 		     (face (cond ((and (not habitp) pastschedp)
   7034 				  'org-scheduled-previously)
   7035 			         ((and habitp futureschedp)
   7036 				  'org-agenda-done)
   7037 			         (todayp 'org-scheduled-today)
   7038 			         (t 'org-scheduled)))
   7039 		     (habitp (and habitp (org-habit-parse-todo))))
   7040 	        (org-add-props item props
   7041 		  'undone-face face
   7042 		  'face (if donep 'org-agenda-done face)
   7043 		  'org-marker (org-agenda-new-marker pos)
   7044 		  'org-hd-marker (org-agenda-new-marker (line-beginning-position))
   7045 		  'type (if pastschedp "past-scheduled" "scheduled")
   7046 		  'date (if pastschedp schedule date)
   7047 		  'ts-date schedule
   7048 		  'warntime warntime
   7049 		  'level level
   7050                   'effort effort 'effort-minutes effort-minutes
   7051 		  'priority (if habitp (org-habit-get-priority habitp)
   7052 			      (+ 99 diff (org-get-priority item)))
   7053 		  'org-habit-p habitp
   7054 		  'todo-state todo-state)
   7055 	        (push item scheduled-items)))))))
   7056     (nreverse scheduled-items)))
   7057 
   7058 (defun org-agenda-get-blocks ()
   7059   "Return the date-range information for agenda display."
   7060   (with-no-warnings (defvar date))
   7061   (let* ((props (list 'face nil
   7062 		      'org-not-done-regexp org-not-done-regexp
   7063 		      'org-todo-regexp org-todo-regexp
   7064 		      'org-complex-heading-regexp org-complex-heading-regexp
   7065 		      'mouse-face 'highlight
   7066 		      'help-echo
   7067 		      (format "mouse-2 or RET jump to org file %s"
   7068 			      (abbreviate-file-name buffer-file-name))))
   7069 	 (regexp org-tr-regexp)
   7070 	 (d0 (calendar-absolute-from-gregorian date))
   7071 	 marker hdmarker ee txt d1 d2 s1 s2 category
   7072 	 level todo-state tags pos head donep inherited-tags
   7073          effort effort-minutes)
   7074     (goto-char (point-min))
   7075     (while (re-search-forward regexp nil t)
   7076       (catch :skip
   7077 	(org-agenda-skip)
   7078 	(setq pos (point))
   7079 	(let ((start-time (match-string 1))
   7080 	      (end-time (match-string 2)))
   7081 	  (setq s1 (match-string 1)
   7082 		s2 (match-string 2)
   7083 		d1 (time-to-days
   7084 		    (condition-case err
   7085 			(org-time-string-to-time s1)
   7086 		      (error
   7087 		       (error
   7088 			"Bad timestamp %S at %d in buffer %S\nError was: %s"
   7089 			s1
   7090 			pos
   7091 			(current-buffer)
   7092 			(error-message-string err)))))
   7093 		d2 (time-to-days
   7094 		    (condition-case err
   7095 			(org-time-string-to-time s2)
   7096 		      (error
   7097 		       (error
   7098 			"Bad timestamp %S at %d in buffer %S\nError was: %s"
   7099 			s2
   7100 			pos
   7101 			(current-buffer)
   7102 			(error-message-string err))))))
   7103 	  (when (and (> (- d0 d1) -1) (> (- d2 d0) -1))
   7104 	    ;; Only allow days between the limits, because the normal
   7105 	    ;; date stamps will catch the limits.
   7106 	    (save-excursion
   7107 	      (setq todo-state (org-get-todo-state))
   7108 	      (setq donep (member todo-state org-done-keywords))
   7109 	      (when (and donep org-agenda-skip-timestamp-if-done)
   7110 		(throw :skip t))
   7111 	      (setq marker (org-agenda-new-marker (point))
   7112 		    category (org-get-category))
   7113               (setq effort (save-match-data (or (get-text-property (point) 'effort)
   7114                                                 (org-entry-get (point) org-effort-property))))
   7115               (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
   7116 	      (if (not (re-search-backward org-outline-regexp-bol nil t))
   7117 		  (throw :skip nil)
   7118 		(goto-char (match-beginning 0))
   7119 		(setq hdmarker (org-agenda-new-marker (point))
   7120 		      inherited-tags
   7121 		      (or (eq org-agenda-show-inherited-tags 'always)
   7122 			  (and (listp org-agenda-show-inherited-tags)
   7123 			       (memq 'agenda org-agenda-show-inherited-tags))
   7124 			  (and (eq org-agenda-show-inherited-tags t)
   7125 			       (or (eq org-agenda-use-tag-inheritance t)
   7126 				   (memq 'agenda org-agenda-use-tag-inheritance))))
   7127 		      tags (org-get-tags nil (not inherited-tags)))
   7128 		(setq level (make-string (org-reduced-level (org-outline-level)) ? ))
   7129 		(looking-at "\\*+[ \t]+\\(.*\\)")
   7130 		(setq head (match-string 1))
   7131 		(let ((remove-re
   7132 		       (if org-agenda-remove-timeranges-from-blocks
   7133 			   (concat
   7134 			    "<" (regexp-quote s1) ".*?>"
   7135 			    "--"
   7136 			    "<" (regexp-quote s2) ".*?>")
   7137 			 nil)))
   7138 		  (setq txt (org-agenda-format-item
   7139 			     (format
   7140 			      (nth (if (= d1 d2) 0 1)
   7141 				   org-agenda-timerange-leaders)
   7142 			      (1+ (- d0 d1)) (1+ (- d2 d1)))
   7143 			     (org-add-props head nil
   7144                                'effort effort
   7145                                'effort-minutes effort-minutes)
   7146                              level category tags
   7147 			     (save-match-data
   7148 			       (let ((hhmm1 (and (string-match org-ts-regexp1 s1)
   7149 						 (match-string 6 s1)))
   7150 				     (hhmm2 (and (string-match org-ts-regexp1 s2)
   7151 						 (match-string 6 s2))))
   7152 				 (cond ((string= hhmm1 hhmm2)
   7153 					(concat "<" start-time ">--<" end-time ">"))
   7154 				       ((and (= d1 d0) (= d2 d0))
   7155 					(concat "<" start-time ">--<" end-time ">"))
   7156                                        ((= d1 d0)
   7157 					(concat "<" start-time ">"))
   7158 				       ((= d2 d0)
   7159 					(concat "<" end-time ">")))))
   7160 			     remove-re))))
   7161 	      (org-add-props txt props
   7162 		'org-marker marker 'org-hd-marker hdmarker
   7163 		'type "block" 'date date
   7164 		'level level
   7165                 'effort effort 'effort-minutes effort-minutes
   7166 		'todo-state todo-state
   7167 		'priority (org-get-priority txt))
   7168 	      (push txt ee))))
   7169 	(goto-char pos)))
   7170     ;; Sort the entries by expiration date.
   7171     (nreverse ee)))
   7172 
   7173 ;;; Agenda presentation and sorting
   7174 
   7175 (defvar org-prefix-has-time nil
   7176   "A flag, set by `org-compile-prefix-format'.
   7177 The flag is set if the currently compiled format contains a `%t'.")
   7178 (defvar org-prefix-has-tag nil
   7179   "A flag, set by `org-compile-prefix-format'.
   7180 The flag is set if the currently compiled format contains a `%T'.")
   7181 (defvar org-prefix-has-effort nil
   7182   "A flag, set by `org-compile-prefix-format'.
   7183 The flag is set if the currently compiled format contains a `%e'.")
   7184 (defvar org-prefix-has-breadcrumbs nil
   7185   "A flag, set by `org-compile-prefix-format'.
   7186 The flag is set if the currently compiled format contains a `%b'.")
   7187 (defvar org-prefix-category-length nil
   7188   "Used by `org-compile-prefix-format' to remember the category field width.")
   7189 (defvar org-prefix-category-max-length nil
   7190   "Used by `org-compile-prefix-format' to remember the category field width.")
   7191 
   7192 (defun org-agenda-get-category-icon (category)
   7193   "Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
   7194   (cl-dolist (entry org-agenda-category-icon-alist)
   7195     (when (string-match-p (car entry) category)
   7196       (if (listp (cadr entry))
   7197 	  (cl-return (cadr entry))
   7198 	(cl-return (apply #'create-image (cdr entry)))))))
   7199 
   7200 (defun org-agenda-format-item (extra txt &optional with-level with-category tags dotime
   7201 				     remove-re habitp)
   7202   "Format TXT to be inserted into the agenda buffer.
   7203 In particular, add the prefix and corresponding text properties.
   7204 
   7205 EXTRA must be a string to replace the `%s' specifier in the prefix format.
   7206 WITH-LEVEL may be a string to replace the `%l' specifier.
   7207 WITH-CATEGORY (a string, a symbol or nil) may be used to overrule the default
   7208 category taken from local variable or file name.  It will replace the `%c'
   7209 specifier in the format.
   7210 DOTIME, when non-nil, indicates that a time-of-day should be extracted from
   7211 TXT for sorting of this entry, and for the `%t' specifier in the format.
   7212 When DOTIME is a string, this string is searched for a time before TXT is.
   7213 TAGS can be the tags of the headline.
   7214 Any match of REMOVE-RE will be removed from TXT."
   7215   ;; We keep the org-prefix-* variable values along with a compiled
   7216   ;; formatter, so that multiple agendas existing at the same time do
   7217   ;; not step on each other toes.
   7218   ;;
   7219   ;; It was inconvenient to make these variables buffer local in
   7220   ;; Agenda buffers, because this function expects to be called with
   7221   ;; the buffer where item comes from being current, and not agenda
   7222   ;; buffer
   7223   (let* ((bindings (car org-prefix-format-compiled))
   7224 	 (formatter (cadr org-prefix-format-compiled)))
   7225     (cl-loop for (var value) in bindings
   7226 	     do (set var value))
   7227     (save-match-data
   7228       ;; Diary entries sometimes have extra whitespace at the beginning
   7229       (setq txt (org-trim txt))
   7230 
   7231       ;; Fix the tags part in txt
   7232       (setq txt (org-agenda-fix-displayed-tags
   7233 		 txt tags
   7234 		 org-agenda-show-inherited-tags
   7235 		 org-agenda-hide-tags-regexp))
   7236 
   7237       (with-no-warnings
   7238 	;; `time', `tag', `effort' are needed for the eval of the prefix format.
   7239 	;; Based on what I see in `org-compile-prefix-format', I added
   7240 	;; a few more.
   7241         (defvar breadcrumbs) (defvar category) (defvar category-icon)
   7242         (defvar effort) (defvar extra)
   7243         (defvar level) (defvar tag) (defvar time))
   7244       (let* ((category (or with-category
   7245 			   (if buffer-file-name
   7246 			       (file-name-sans-extension
   7247 				(file-name-nondirectory buffer-file-name))
   7248 			     "")))
   7249 	     (category-icon (org-agenda-get-category-icon category))
   7250 	     (category-icon (if category-icon
   7251 				(propertize " " 'display category-icon)
   7252 			      ""))
   7253 	     (effort (and (not (string= txt ""))
   7254 			  (get-text-property 1 'effort txt)))
   7255 	     (tag (if tags (nth (1- (length tags)) tags) ""))
   7256 	     (time-grid-trailing-characters (nth 2 org-agenda-time-grid))
   7257 	     (extra (or (and (not habitp) extra) ""))
   7258 	     time
   7259 	     (ts (when dotime (concat
   7260 			       (if (stringp dotime) dotime "")
   7261 			       (and org-agenda-search-headline-for-time txt))))
   7262 	     (time-of-day (and dotime (org-get-time-of-day ts)))
   7263 	     stamp plain s0 s1 s2 rtn srp l
   7264 	     duration breadcrumbs)
   7265 	(and (derived-mode-p 'org-mode) buffer-file-name
   7266 	     (add-to-list 'org-agenda-contributing-files buffer-file-name))
   7267 	(when (and dotime time-of-day)
   7268 	  ;; Extract starting and ending time and move them to prefix
   7269 	  (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
   7270 		    (setq plain (string-match org-plain-time-of-day-regexp ts)))
   7271 	    (setq s0 (match-string 0 ts)
   7272 		  srp (and stamp (match-end 3))
   7273 		  s1 (match-string (if plain 1 2) ts)
   7274 		  s2 (match-string (if plain 8 (if srp 4 6)) ts))
   7275 
   7276 	    ;; If the times are in TXT (not in DOTIMES), and the prefix will list
   7277 	    ;; them, we might want to remove them there to avoid duplication.
   7278 	    ;; The user can turn this off with a variable.
   7279 	    (when (and org-prefix-has-time
   7280 		       org-agenda-remove-times-when-in-prefix (or stamp plain)
   7281 		       (string-match (concat (regexp-quote s0) " *") txt)
   7282 		       (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
   7283 		       (if (eq org-agenda-remove-times-when-in-prefix 'beg)
   7284 			   (= (match-beginning 0) 0)
   7285 			 t))
   7286 	      (setq txt (replace-match "" nil nil txt))))
   7287           ;; Normalize the time(s) to 24 hour.
   7288 	  (when s1 (setq s1 (org-get-time-of-day s1 t)))
   7289 	  (when s2 (setq s2 (org-get-time-of-day s2 t)))
   7290 	  ;; Try to set s2 if s1 and
   7291 	  ;; `org-agenda-default-appointment-duration' are set
   7292 	  (when (and s1 (not s2) org-agenda-default-appointment-duration)
   7293 	    (setq s2
   7294 		  (org-duration-from-minutes
   7295 		   (+ (org-duration-to-minutes s1 t)
   7296 		      org-agenda-default-appointment-duration)
   7297 		   nil t)))
   7298 	  ;; Compute the duration
   7299 	  (when s2
   7300 	    (setq duration (- (org-duration-to-minutes s2)
   7301 			      (org-duration-to-minutes s1))))
   7302           ;; Format S1 and S2 for display.
   7303 	  (when s1 (setq s1 (format "%5s" (org-get-time-of-day s1 'overtime))))
   7304 	  (when s2 (setq s2 (org-get-time-of-day s2 'overtime))))
   7305 	(when (string-match org-tag-group-re txt)
   7306 	  ;; Tags are in the string
   7307 	  (if (or (eq org-agenda-remove-tags t)
   7308 		  (and org-agenda-remove-tags
   7309 		       org-prefix-has-tag))
   7310 	      (setq txt (replace-match "" t t txt))
   7311 	    (setq txt (replace-match
   7312 		       (concat (make-string (max (- 50 (length txt)) 1) ?\ )
   7313 			       (match-string 1 txt))
   7314 		       t t txt))))
   7315 
   7316 	(when remove-re
   7317 	  (while (string-match remove-re txt)
   7318 	    (setq txt (replace-match "" t t txt))))
   7319 
   7320 	;; Set org-heading property on `txt' to mark the start of the
   7321 	;; heading.
   7322 	(add-text-properties 0 (length txt) '(org-heading t) txt)
   7323 
   7324 	;; Prepare the variables needed in the eval of the compiled format
   7325 	(when org-prefix-has-breadcrumbs
   7326 	  (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker)
   7327 			      (let ((s (org-format-outline-path (org-get-outline-path)
   7328 								(1- (frame-width))
   7329 								nil org-agenda-breadcrumbs-separator)))
   7330 				(if (eq "" s) "" (concat s org-agenda-breadcrumbs-separator))))))
   7331 	(setq time (cond (s2 (concat
   7332 			      (org-agenda-time-of-day-to-ampm-maybe s1)
   7333 			      "-" (org-agenda-time-of-day-to-ampm-maybe s2)
   7334 			      (when org-agenda-timegrid-use-ampm " ")))
   7335 			 (s1 (concat
   7336 			      (org-agenda-time-of-day-to-ampm-maybe s1)
   7337 			      (if org-agenda-timegrid-use-ampm
   7338                                   (concat time-grid-trailing-characters " ")
   7339                                 time-grid-trailing-characters)))
   7340 			 (t ""))
   7341 	      category (if (symbolp category) (symbol-name category) category)
   7342 	      level (or with-level ""))
   7343 	(if (string-match org-link-bracket-re category)
   7344 	    (progn
   7345 	      (setq l (string-width (or (match-string 2) (match-string 1))))
   7346 	      (when (< l (or org-prefix-category-length 0))
   7347 		(setq category (copy-sequence category))
   7348 		(org-add-props category nil
   7349 		  'extra-space (make-string
   7350 				(- org-prefix-category-length l 1) ?\ ))))
   7351 	  (when (and org-prefix-category-max-length
   7352 		     (>= (length category) org-prefix-category-max-length))
   7353 	    (setq category (substring category 0 (1- org-prefix-category-max-length)))))
   7354 	;; Evaluate the compiled format
   7355 	(setq rtn (concat (eval formatter t) txt))
   7356 
   7357 	;; And finally add the text properties
   7358 	(remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
   7359 	(org-add-props rtn nil
   7360 	  'org-category category
   7361           'tags tags
   7362           'org-priority-highest org-priority-highest
   7363 	  'org-priority-lowest org-priority-lowest
   7364 	  'time-of-day time-of-day
   7365 	  'duration duration
   7366 	  'breadcrumbs breadcrumbs
   7367 	  'txt txt
   7368 	  'level level
   7369 	  'time time
   7370 	  'extra extra
   7371 	  'format org-prefix-format-compiled
   7372 	  'dotime dotime)))))
   7373 
   7374 (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
   7375   "Remove tags string from TXT, and add a modified list of tags.
   7376 The modified list may contain inherited tags, and tags matched by
   7377 `org-agenda-hide-tags-regexp' will be removed."
   7378   (when (or add-inherited hide-re)
   7379     (when (string-match org-tag-group-re txt)
   7380       (setq txt (substring txt 0 (match-beginning 0))))
   7381     (setq tags
   7382 	  (delq nil
   7383 		(mapcar (lambda (tg)
   7384 			  (if (or (and hide-re (string-match hide-re tg))
   7385 				  (and (not add-inherited)
   7386 				       (get-text-property 0 'inherited tg)))
   7387 			      nil
   7388 			    tg))
   7389 			tags)))
   7390     (when tags
   7391       (let ((have-i (get-text-property 0 'inherited (car tags)))
   7392 	    i)
   7393 	(setq txt (concat txt " :"
   7394 			  (mapconcat
   7395 			   (lambda (x)
   7396 			     (setq i (get-text-property 0 'inherited x))
   7397 			     (if (and have-i (not i))
   7398 				 (progn
   7399 				   (setq have-i nil)
   7400 				   (concat ":" x))
   7401 			       x))
   7402 			   tags ":")
   7403 			  (if have-i "::" ":"))))))
   7404   txt)
   7405 
   7406 (defvar org-agenda-sorting-strategy) ;; because the def is in a let form
   7407 
   7408 (defun org-agenda-add-time-grid-maybe (list ndays todayp)
   7409   "Add a time-grid for agenda items which need it.
   7410 
   7411 LIST is the list of agenda items formatted by `org-agenda-list'.
   7412 NDAYS is the span of the current agenda view.
   7413 TODAYP is t when the current agenda view is on today."
   7414   (catch 'exit
   7415     (cond ((not org-agenda-use-time-grid) (throw 'exit list))
   7416 	  ((and todayp (member 'today (car org-agenda-time-grid))))
   7417 	  ((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
   7418 	  ((member 'weekly (car org-agenda-time-grid)))
   7419 	  (t (throw 'exit list)))
   7420     (let* ((have (delq nil (mapcar
   7421 			    (lambda (x) (get-text-property 1 'time-of-day x))
   7422 			    list)))
   7423 	   (string (nth 3 org-agenda-time-grid))
   7424 	   (gridtimes (nth 1 org-agenda-time-grid))
   7425 	   (req (car org-agenda-time-grid))
   7426 	   (remove (member 'remove-match req))
   7427 	   new time)
   7428       (when (and (member 'require-timed req) (not have))
   7429 	;; don't show empty grid
   7430 	(throw 'exit list))
   7431       (while (setq time (pop gridtimes))
   7432 	(unless (and remove (member time have))
   7433 	  (setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
   7434 	  (push (org-agenda-format-item
   7435 		 nil string nil "" nil
   7436 		 (concat (substring time 0 -2) ":" (substring time -2)))
   7437 		new)
   7438 	  (put-text-property
   7439 	   2 (length (car new)) 'face 'org-time-grid (car new))))
   7440       (when (and todayp org-agenda-show-current-time-in-grid)
   7441 	(push (org-agenda-format-item
   7442 	       nil org-agenda-current-time-string nil "" nil
   7443 	       (format-time-string "%H:%M "))
   7444 	      new)
   7445 	(put-text-property
   7446 	 2 (length (car new)) 'face 'org-agenda-current-time (car new)))
   7447 
   7448       (if (member 'time-up org-agenda-sorting-strategy-selected)
   7449 	  (append new list)
   7450 	(append list new)))))
   7451 
   7452 (defun org-compile-prefix-format (key)
   7453   "Compile the prefix format into a Lisp form that can be evaluated.
   7454 KEY is the agenda type (see `org-agenda-prefix-format').
   7455 The resulting form and associated variable bindings is returned
   7456 and stored in the variable `org-prefix-format-compiled'."
   7457   (setq org-prefix-has-time nil
   7458 	org-prefix-has-tag nil
   7459 	org-prefix-category-length nil
   7460 	org-prefix-has-effort nil
   7461 	org-prefix-has-breadcrumbs nil)
   7462   (let ((s (cond
   7463 	    ((stringp org-agenda-prefix-format)
   7464 	     org-agenda-prefix-format)
   7465 	    ((assq key org-agenda-prefix-format)
   7466 	     (cdr (assq key org-agenda-prefix-format)))
   7467 	    (t "  %-12:c%?-12t% s")))
   7468 	(start 0)
   7469 	varform vars var c f opt) ;; e
   7470     (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)"
   7471 			 s start)
   7472       (setq var (or (cdr (assoc (match-string 4 s)
   7473 				'(("c" . category) ("t" . time) ("l" . level) ("s" . extra)
   7474 				  ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs))))
   7475 		    'eval)
   7476 	    c (or (match-string 3 s) "")
   7477 	    opt (match-beginning 1)
   7478 	    start (1+ (match-beginning 0)))
   7479       (cl-case var
   7480 	(time        (setq org-prefix-has-time        t))
   7481 	(tag         (setq org-prefix-has-tag         t))
   7482 	(effort      (setq org-prefix-has-effort      t))
   7483 	(breadcrumbs (setq org-prefix-has-breadcrumbs t)))
   7484       (setq f (concat "%" (match-string 2 s) "s"))
   7485       (when (eq var 'category)
   7486 	(setq org-prefix-category-length
   7487 	      (floor (abs (string-to-number (match-string 2 s)))))
   7488 	(setq org-prefix-category-max-length
   7489 	      (let ((x (match-string 2 s)))
   7490 		(save-match-data
   7491 		  (and (string-match "\\.[0-9]+" x)
   7492 		       (string-to-number (substring (match-string 0 x) 1)))))))
   7493       (if (eq var 'eval)
   7494 	  (setq varform `(format ,f (org-eval ,(read (substring s (match-beginning 4))))))
   7495 	(if opt
   7496 	    (setq varform
   7497 		  `(if (member ,var '("" nil))
   7498 		       ""
   7499 		     (format ,f (concat ,var ,c))))
   7500 	  (setq varform
   7501 		`(format ,f (if (member ,var '("" nil)) ""
   7502 			      (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
   7503       (if (eq var 'eval)
   7504           (setf (substring s (match-beginning 0)
   7505                            (+ (match-beginning 4)
   7506                               (length (format "%S" (read (substring s (match-beginning 4)))))))
   7507                 "%s")
   7508         (setq s (replace-match "%s" t nil s)))
   7509       (push varform vars))
   7510     (setq vars (nreverse vars))
   7511     (with-current-buffer (or org-agenda-buffer (current-buffer))
   7512       (setq org-prefix-format-compiled
   7513 	    (list
   7514 	     `((org-prefix-has-time ,org-prefix-has-time)
   7515 	       (org-prefix-has-tag ,org-prefix-has-tag)
   7516 	       (org-prefix-category-length ,org-prefix-category-length)
   7517 	       (org-prefix-has-effort ,org-prefix-has-effort)
   7518 	       (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs))
   7519 	     `(format ,s ,@vars))))))
   7520 
   7521 (defun org-set-sorting-strategy (key)
   7522   (setq org-agenda-sorting-strategy-selected
   7523         (if (symbolp (car org-agenda-sorting-strategy))
   7524             ;; the old format
   7525             org-agenda-sorting-strategy
   7526 	  (or (cdr (assq key org-agenda-sorting-strategy))
   7527 	      (cdr (assq 'agenda org-agenda-sorting-strategy))
   7528 	      '(time-up category-keep priority-down)))))
   7529 
   7530 (defun org-get-time-of-day (s &optional string)
   7531   "Check string S for a time of day.
   7532 
   7533 If found, return it as a military time number between 0 and 2400.
   7534 If not found, return nil.
   7535 
   7536 The optional STRING argument forces conversion into a 5 character wide string
   7537 HH:MM.  When it is `overtime', any time above 24:00 is turned into \"+H:MM\"
   7538 where H:MM is the duration above midnight."
   7539   (let ((case-fold-search t)
   7540         (time-regexp
   7541          (rx word-start
   7542              (group (opt (any "012")) digit)           ;group 1: hours
   7543              (or (and ":" (group (any "012345") digit) ;group 2: minutes
   7544                       (opt (group (or "am" "pm"))))    ;group 3: am/pm
   7545                  ;; Special "HHam/pm" case.
   7546                  (group-n 3 (or "am" "pm")))
   7547              word-end)))
   7548     (save-match-data
   7549       (when (and (string-match time-regexp s)
   7550                  (not (eq 'org-link (get-text-property 1 'face s))))
   7551         (let ((hours
   7552                (let* ((ampm (and (match-end 3) (downcase (match-string 3 s))))
   7553                       (am-p (equal ampm "am")))
   7554                  (pcase (string-to-number (match-string 1 s))
   7555                    ((and (guard (not ampm)) h) h)
   7556                    (12 (if am-p 0 12))
   7557                    (h (+ h (if am-p 0 12))))))
   7558               (minutes
   7559                (if (match-end 2)
   7560                    (string-to-number (match-string 2 s))
   7561                  0)))
   7562           (pcase string
   7563             (`nil (+ minutes (* hours 100)))
   7564             ((and `overtime
   7565                   (guard (or (> hours 24)
   7566                              (and (= hours 24)
   7567                                   (> minutes 0)))))
   7568              (format "+%d:%02d" (- hours 24) minutes))
   7569             ((guard org-agenda-time-leading-zero)
   7570              (format "%02d:%02d" hours minutes))
   7571             (_
   7572              (format "%d:%02d" hours minutes))))))))
   7573 
   7574 (defvar org-agenda-before-sorting-filter-function nil
   7575   "Function to be applied to agenda items prior to sorting.
   7576 Prior to sorting also means just before they are inserted into the agenda.
   7577 
   7578 To aid sorting, you may revisit the original entries and add more text
   7579 properties which will later be used by the sorting functions.
   7580 
   7581 The function should take a string argument, an agenda line.
   7582 It has access to the text properties in that line, which contain among
   7583 other things, the property `org-hd-marker' that points to the entry
   7584 where the line comes from.  Note that not all lines going into the agenda
   7585 have this property, only most.
   7586 
   7587 The function should return the modified string.  It is probably best
   7588 to ONLY change text properties.
   7589 
   7590 You can also use this function as a filter, by returning nil for lines
   7591 you don't want to have in the agenda at all.  For this application, you
   7592 could bind the variable in the options section of a custom command.")
   7593 
   7594 (defun org-agenda-finalize-entries (list &optional type)
   7595   "Sort, limit and concatenate the LIST of agenda items.
   7596 The optional argument TYPE tells the agenda type."
   7597   (let ((max-effort (cond ((listp org-agenda-max-effort)
   7598 			   (cdr (assoc type org-agenda-max-effort)))
   7599 			  (t org-agenda-max-effort)))
   7600 	(max-todo (cond ((listp org-agenda-max-todos)
   7601 			 (cdr (assoc type org-agenda-max-todos)))
   7602 			(t org-agenda-max-todos)))
   7603 	(max-tags (cond ((listp org-agenda-max-tags)
   7604 			 (cdr (assoc type org-agenda-max-tags)))
   7605 			(t org-agenda-max-tags)))
   7606 	(max-entries (cond ((listp org-agenda-max-entries)
   7607 			    (cdr (assoc type org-agenda-max-entries)))
   7608 			   (t org-agenda-max-entries))))
   7609     (when org-agenda-before-sorting-filter-function
   7610       (setq list
   7611 	    (delq nil
   7612 		  (mapcar
   7613 		   org-agenda-before-sorting-filter-function list))))
   7614     (setq list (mapcar #'org-agenda-highlight-todo list)
   7615 	  list (mapcar #'identity (sort list #'org-entries-lessp)))
   7616     (when max-effort
   7617       (setq list (org-agenda-limit-entries
   7618 		  list 'effort-minutes max-effort
   7619 		  (lambda (e) (or e (if org-agenda-sort-noeffort-is-high
   7620 					32767 -1))))))
   7621     (when max-todo
   7622       (setq list (org-agenda-limit-entries list 'todo-state max-todo)))
   7623     (when max-tags
   7624       (setq list (org-agenda-limit-entries list 'tags max-tags)))
   7625     (when max-entries
   7626       (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
   7627     (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
   7628       (setq list (mapcar #'org-agenda--mark-blocked-entry list)))
   7629     (mapconcat #'identity list "\n")))
   7630 
   7631 (defun org-agenda-limit-entries (list prop limit &optional fn)
   7632   "Limit the number of agenda entries."
   7633   (let ((include (and limit (< limit 0))))
   7634     (if limit
   7635 	(let ((fun (or fn (lambda (p) (when p 1))))
   7636 	      (lim 0))
   7637 	  (delq nil
   7638 		(mapcar
   7639 		 (lambda (e)
   7640 		   (let ((pval (funcall
   7641 				fun (get-text-property (1- (length e))
   7642 						       prop e))))
   7643 		     (when pval (setq lim (+ lim pval)))
   7644 		     (cond ((and pval (<= lim (abs limit))) e)
   7645 			   ((and include (not pval)) e))))
   7646 		 list)))
   7647       list)))
   7648 
   7649 (defun org-agenda-limit-interactively (remove)
   7650   "In agenda, interactively limit entries to various maximums."
   7651   (interactive "P")
   7652   (if remove
   7653       (progn (setq org-agenda-max-entries nil
   7654 		   org-agenda-max-todos nil
   7655 		   org-agenda-max-tags nil
   7656 		   org-agenda-max-effort nil)
   7657 	     (org-agenda-redo))
   7658     (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
   7659 	   (msg (cond ((= max ?E) "How many minutes? ")
   7660 		      ((= max ?e) "How many entries? ")
   7661 		      ((= max ?t) "How many TODO entries? ")
   7662 		      ((= max ?T) "How many tagged entries? ")
   7663 		      (t (user-error "Wrong input"))))
   7664 	   (num (string-to-number (read-from-minibuffer msg))))
   7665       (cond ((equal max ?e)
   7666 	     (let ((org-agenda-max-entries num)) (org-agenda-redo)))
   7667 	    ((equal max ?t)
   7668 	     (let ((org-agenda-max-todos num)) (org-agenda-redo)))
   7669 	    ((equal max ?T)
   7670 	     (let ((org-agenda-max-tags num)) (org-agenda-redo)))
   7671 	    ((equal max ?E)
   7672 	     (let ((org-agenda-max-effort num)) (org-agenda-redo))))))
   7673   (org-agenda-fit-window-to-buffer))
   7674 
   7675 (defun org-agenda-highlight-todo (x)
   7676   (let ((org-done-keywords org-done-keywords-for-agenda)
   7677 	(case-fold-search nil)
   7678 	re)
   7679     (if (eq x 'line)
   7680 	(save-excursion
   7681 	  (beginning-of-line 1)
   7682 	  (setq re (org-get-at-bol 'org-todo-regexp))
   7683           (goto-char (or (text-property-any (line-beginning-position)
   7684                                             (line-end-position)
   7685                                             'org-heading t)
   7686                          (point)))
   7687 	  (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
   7688 	    (add-text-properties (match-beginning 0) (match-end 1)
   7689 				 (list 'face (org-get-todo-face 1)))
   7690 	    (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
   7691 	      (delete-region (match-beginning 1) (1- (match-end 0)))
   7692 	      (goto-char (match-beginning 1))
   7693 	      (insert (format org-agenda-todo-keyword-format s)))))
   7694       (let ((pl (text-property-any 0 (length x) 'org-heading t x)))
   7695 	(setq re (get-text-property 0 'org-todo-regexp x))
   7696 	(when (and re
   7697 		   ;; Test `pl' because if there's no heading content,
   7698 		   ;; there's no point matching to highlight.  Note
   7699 		   ;; that if we didn't test `pl' first, and there
   7700 		   ;; happened to be no keyword from `org-todo-regexp'
   7701 		   ;; on this heading line, then the `equal' comparison
   7702 		   ;; afterwards would spuriously succeed in the case
   7703 		   ;; where `pl' is nil -- causing an args-out-of-range
   7704 		   ;; error when we try to add text properties to text
   7705 		   ;; that isn't there.
   7706 		   pl
   7707 		   (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
   7708 					x pl)
   7709 			  pl))
   7710 	  (add-text-properties
   7711 	   (or (match-end 1) (match-end 0)) (match-end 0)
   7712 	   (list 'face (org-get-todo-face (match-string 2 x)))
   7713 	   x)
   7714 	  (when (match-end 1)
   7715 	    (setq x
   7716 		  (concat
   7717 		   (substring x 0 (match-end 1))
   7718                    (unless (string= org-agenda-todo-keyword-format "")
   7719                      (format org-agenda-todo-keyword-format
   7720                              (match-string 2 x)))
   7721                    (unless (string= org-agenda-todo-keyword-format "")
   7722                      ;; Remove `display' property as the icon could leak
   7723                      ;; on the white space.
   7724                      (org-add-props " " (org-plist-delete (text-properties-at 0 x)
   7725                                                           'display)))
   7726                    (substring x (match-end 3)))))))
   7727       x)))
   7728 
   7729 (defsubst org-cmp-values (a b property)
   7730   "Compare the numeric value of text PROPERTY for string A and B."
   7731   (let ((pa (or (get-text-property (1- (length a)) property a) 0))
   7732 	(pb (or (get-text-property (1- (length b)) property b) 0)))
   7733     (cond ((> pa pb) +1)
   7734 	  ((< pa pb) -1))))
   7735 
   7736 (defsubst org-cmp-effort (a b)
   7737   "Compare the effort values of string A and B."
   7738   (let* ((def (if org-agenda-sort-noeffort-is-high 32767 -1))
   7739 	 ;; `effort-minutes' property is not directly accessible from
   7740 	 ;; the strings, but is stored as a property in `txt'.
   7741 	 (ea (or (get-text-property
   7742 		  0 'effort-minutes (get-text-property 0 'txt a))
   7743 		 def))
   7744 	 (eb (or (get-text-property
   7745 		  0 'effort-minutes (get-text-property 0 'txt b))
   7746 		 def)))
   7747     (cond ((> ea eb) +1)
   7748 	  ((< ea eb) -1))))
   7749 
   7750 (defsubst org-cmp-category (a b)
   7751   "Compare the string values of categories of strings A and B."
   7752   (let ((ca (or (get-text-property (1- (length a)) 'org-category a) ""))
   7753 	(cb (or (get-text-property (1- (length b)) 'org-category b) "")))
   7754     (cond ((string-lessp ca cb) -1)
   7755 	  ((string-lessp cb ca) +1))))
   7756 
   7757 (defsubst org-cmp-todo-state (a b)
   7758   "Compare the todo states of strings A and B."
   7759   (let* ((ma (or (get-text-property 1 'org-marker a)
   7760 		 (get-text-property 1 'org-hd-marker a)))
   7761 	 (mb (or (get-text-property 1 'org-marker b)
   7762 		 (get-text-property 1 'org-hd-marker b)))
   7763 	 (fa (and ma (marker-buffer ma)))
   7764 	 (fb (and mb (marker-buffer mb)))
   7765 	 (todo-kwds
   7766 	  (or (and fa (with-current-buffer fa org-todo-keywords-1))
   7767 	      (and fb (with-current-buffer fb org-todo-keywords-1))))
   7768 	 (ta (or (get-text-property 1 'todo-state a) ""))
   7769 	 (tb (or (get-text-property 1 'todo-state b) ""))
   7770 	 (la (- (length (member ta todo-kwds))))
   7771 	 (lb (- (length (member tb todo-kwds))))
   7772 	 (donepa (member ta org-done-keywords-for-agenda))
   7773 	 (donepb (member tb org-done-keywords-for-agenda)))
   7774     (cond ((and donepa (not donepb)) -1)
   7775 	  ((and (not donepa) donepb) +1)
   7776 	  ((< la lb) -1)
   7777 	  ((< lb la) +1))))
   7778 
   7779 (defsubst org-cmp-alpha (a b)
   7780   "Compare the headlines, alphabetically."
   7781   (let* ((pla (text-property-any 0 (length a) 'org-heading t a))
   7782 	 (plb (text-property-any 0 (length b) 'org-heading t b))
   7783 	 (ta (and pla (substring a pla)))
   7784 	 (tb (and plb (substring b plb)))
   7785 	 (case-fold-search nil))
   7786     (when pla
   7787       (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
   7788 				  "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *")
   7789 			  ta)
   7790 	(setq ta (substring ta (match-end 0))))
   7791       (setq ta (downcase ta)))
   7792     (when plb
   7793       (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "")
   7794 				  "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *")
   7795 			  tb)
   7796 	(setq tb (substring tb (match-end 0))))
   7797       (setq tb (downcase tb)))
   7798     (cond ((not (or ta tb)) nil)
   7799 	  ((not ta) +1)
   7800 	  ((not tb) -1)
   7801 	  ((string-lessp ta tb) -1)
   7802 	  ((string-lessp tb ta) +1))))
   7803 
   7804 (defsubst org-cmp-tag (a b)
   7805   "Compare the string values of the first tags of A and B."
   7806   (let ((ta (car (last (get-text-property 1 'tags a))))
   7807 	(tb (car (last (get-text-property 1 'tags b)))))
   7808     (cond ((not (or ta tb)) nil)
   7809 	  ((not ta) +1)
   7810 	  ((not tb) -1)
   7811 	  ((string-lessp ta tb) -1)
   7812 	  ((string-lessp tb ta) +1))))
   7813 
   7814 (defsubst org-cmp-time (a b)
   7815   "Compare the time-of-day values of strings A and B."
   7816   (let* ((def (if org-agenda-sort-notime-is-late 9901 -1))
   7817 	 (ta (or (get-text-property 1 'time-of-day a) def))
   7818 	 (tb (or (get-text-property 1 'time-of-day b) def)))
   7819     (cond ((< ta tb) -1)
   7820 	  ((< tb ta) +1))))
   7821 
   7822 (defsubst org-cmp-ts (a b type)
   7823   "Compare the timestamps values of entries A and B.
   7824 When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
   7825 \"timestamp_ia\", compare within each of these type.  When TYPE
   7826 is the empty string, compare all timestamps without respect of
   7827 their type."
   7828   (let* ((def (if org-agenda-sort-notime-is-late 99999999 -1))
   7829 	 (ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
   7830 		      (get-text-property 1 'ts-date a))
   7831 		 def))
   7832 	 (tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
   7833 		      (get-text-property 1 'ts-date b))
   7834 		 def)))
   7835     (cond ((if ta (and tb (< ta tb)) tb) -1)
   7836 	  ((if tb (and ta (< tb ta)) ta) +1))))
   7837 
   7838 (defsubst org-cmp-habit-p (a b)
   7839   "Compare the todo states of strings A and B."
   7840   (let ((ha (get-text-property 1 'org-habit-p a))
   7841 	(hb (get-text-property 1 'org-habit-p b)))
   7842     (cond ((and ha (not hb)) -1)
   7843 	  ((and (not ha) hb) +1))))
   7844 
   7845 (defun org-entries-lessp (a b)
   7846   "Predicate for sorting agenda entries."
   7847   ;; The following variables will be used when the form is evaluated.
   7848   ;; So even though the compiler complains, keep them.
   7849   (let ((ss org-agenda-sorting-strategy-selected))
   7850     (org-dlet
   7851 	((timestamp-up    (and (org-em 'timestamp-up 'timestamp-down ss)
   7852 			       (org-cmp-ts a b "")))
   7853 	 (timestamp-down  (if timestamp-up (- timestamp-up) nil))
   7854 	 (scheduled-up    (and (org-em 'scheduled-up 'scheduled-down ss)
   7855 			       (org-cmp-ts a b "scheduled")))
   7856 	 (scheduled-down  (if scheduled-up (- scheduled-up) nil))
   7857 	 (deadline-up     (and (org-em 'deadline-up 'deadline-down ss)
   7858 			       (org-cmp-ts a b "deadline")))
   7859 	 (deadline-down   (if deadline-up (- deadline-up) nil))
   7860 	 (tsia-up         (and (org-em 'tsia-up 'tsia-down ss)
   7861 			       (org-cmp-ts a b "timestamp_ia")))
   7862 	 (tsia-down       (if tsia-up (- tsia-up) nil))
   7863 	 (ts-up           (and (org-em 'ts-up 'ts-down ss)
   7864 			       (org-cmp-ts a b "timestamp")))
   7865 	 (ts-down         (if ts-up (- ts-up) nil))
   7866 	 (time-up         (and (org-em 'time-up 'time-down ss)
   7867 			       (org-cmp-time a b)))
   7868 	 (time-down       (if time-up (- time-up) nil))
   7869 	 (stats-up        (and (org-em 'stats-up 'stats-down ss)
   7870 			       (org-cmp-values a b 'org-stats)))
   7871 	 (stats-down      (if stats-up (- stats-up) nil))
   7872 	 (priority-up     (and (org-em 'priority-up 'priority-down ss)
   7873 			       (org-cmp-values a b 'priority)))
   7874 	 (priority-down   (if priority-up (- priority-up) nil))
   7875 	 (effort-up       (and (org-em 'effort-up 'effort-down ss)
   7876 			       (org-cmp-effort a b)))
   7877 	 (effort-down     (if effort-up (- effort-up) nil))
   7878 	 (category-up     (and (or (org-em 'category-up 'category-down ss)
   7879 				   (memq 'category-keep ss))
   7880 			       (org-cmp-category a b)))
   7881 	 (category-down   (if category-up (- category-up) nil))
   7882 	 (category-keep   (if category-up +1 nil))
   7883 	 (tag-up          (and (org-em 'tag-up 'tag-down ss)
   7884 			       (org-cmp-tag a b)))
   7885 	 (tag-down        (if tag-up (- tag-up) nil))
   7886 	 (todo-state-up   (and (org-em 'todo-state-up 'todo-state-down ss)
   7887 			       (org-cmp-todo-state a b)))
   7888 	 (todo-state-down (if todo-state-up (- todo-state-up) nil))
   7889 	 (habit-up        (and (org-em 'habit-up 'habit-down ss)
   7890 			       (org-cmp-habit-p a b)))
   7891 	 (habit-down      (if habit-up (- habit-up) nil))
   7892 	 (alpha-up        (and (org-em 'alpha-up 'alpha-down ss)
   7893 			       (org-cmp-alpha a b)))
   7894 	 (alpha-down      (if alpha-up (- alpha-up) nil))
   7895 	 (need-user-cmp   (org-em 'user-defined-up 'user-defined-down ss))
   7896 	 user-defined-up user-defined-down)
   7897       (when (and need-user-cmp org-agenda-cmp-user-defined
   7898 	         (functionp org-agenda-cmp-user-defined))
   7899 	(setq user-defined-up
   7900 	      (funcall org-agenda-cmp-user-defined a b)
   7901 	      user-defined-down (if user-defined-up (- user-defined-up) nil)))
   7902       (cdr (assoc
   7903 	    (eval (cons 'or org-agenda-sorting-strategy-selected) t)
   7904 	    '((-1 . t) (1 . nil) (nil . nil)))))))
   7905 
   7906 ;;; Agenda restriction lock
   7907 
   7908 (defvar org-agenda-restriction-lock-overlay (make-overlay 1 1)
   7909   "Overlay to mark the headline to which agenda commands are restricted.")
   7910 (overlay-put org-agenda-restriction-lock-overlay
   7911 	     'face 'org-agenda-restriction-lock)
   7912 (overlay-put org-agenda-restriction-lock-overlay
   7913 	     'help-echo "Agendas are currently limited to this subtree.")
   7914 (delete-overlay org-agenda-restriction-lock-overlay)
   7915 
   7916 (defun org-agenda-set-restriction-lock-from-agenda (arg)
   7917   "Set the restriction lock to the agenda item at point from within the agenda.
   7918 When called with a `\\[universal-argument]' prefix, restrict to
   7919 the file which contains the item.
   7920 Argument ARG is the prefix argument."
   7921   (interactive "P")
   7922   (unless  (derived-mode-p 'org-agenda-mode)
   7923     (user-error "Not in an Org agenda buffer"))
   7924   (let* ((marker (or (org-get-at-bol 'org-marker)
   7925                      (org-agenda-error)))
   7926          (buffer (marker-buffer marker))
   7927          (pos (marker-position marker)))
   7928     (with-current-buffer buffer
   7929       (goto-char pos)
   7930       (org-agenda-set-restriction-lock arg))))
   7931 
   7932 ;;;###autoload
   7933 (defun org-agenda-set-restriction-lock (&optional type)
   7934   "Set restriction lock for agenda to current subtree or file.
   7935 When in a restricted subtree, remove it.
   7936 
   7937 The restriction will span over the entire file if TYPE is `file',
   7938 or if TYPE is (4), or if the cursor is before the first headline
   7939 in the file.  Otherwise, only apply the restriction to the current
   7940 subtree."
   7941   (interactive "P")
   7942   (if (and org-agenda-overriding-restriction
   7943 	   (member org-agenda-restriction-lock-overlay
   7944 		   (overlays-at (point)))
   7945 	   (equal (overlay-start org-agenda-restriction-lock-overlay)
   7946 		  (point)))
   7947       (org-agenda-remove-restriction-lock 'noupdate)
   7948     (org-agenda-remove-restriction-lock 'noupdate)
   7949     (and (equal type '(4)) (setq type 'file))
   7950     (setq type (cond
   7951 		(type type)
   7952 		((org-at-heading-p) 'subtree)
   7953 		((condition-case nil (org-back-to-heading t) (error nil))
   7954 		 'subtree)
   7955 		(t 'file)))
   7956     (if (eq type 'subtree)
   7957 	(progn
   7958 	  (setq org-agenda-restrict (current-buffer))
   7959 	  (setq org-agenda-overriding-restriction 'subtree)
   7960 	  (put 'org-agenda-files 'org-restrict
   7961 	       (list (buffer-file-name (buffer-base-buffer))))
   7962 	  (org-back-to-heading t)
   7963 	  (move-overlay org-agenda-restriction-lock-overlay
   7964 			(point)
   7965 			(if org-agenda-restriction-lock-highlight-subtree
   7966 			    (save-excursion (org-end-of-subtree t t) (point))
   7967                           (line-end-position)))
   7968 	  (move-marker org-agenda-restrict-begin (point))
   7969 	  (move-marker org-agenda-restrict-end
   7970 		       (save-excursion (org-end-of-subtree t t)))
   7971 	  (message "Locking agenda restriction to subtree"))
   7972       (put 'org-agenda-files 'org-restrict
   7973 	   (list (buffer-file-name (buffer-base-buffer))))
   7974       (setq org-agenda-restrict t)
   7975       (setq org-agenda-overriding-restriction 'file)
   7976       (move-marker org-agenda-restrict-begin nil)
   7977       (move-marker org-agenda-restrict-end nil)
   7978       (message "Locking agenda restriction to file"))
   7979     (setq current-prefix-arg nil))
   7980   (org-agenda-maybe-redo))
   7981 
   7982 (defun org-agenda-remove-restriction-lock (&optional noupdate)
   7983   "Remove agenda restriction lock."
   7984   (interactive "P")
   7985   (if (not org-agenda-restrict)
   7986       (message "No agenda restriction to remove.")
   7987     (delete-overlay org-agenda-restriction-lock-overlay)
   7988     (delete-overlay org-speedbar-restriction-lock-overlay)
   7989     (setq org-agenda-overriding-restriction nil)
   7990     (setq org-agenda-restrict nil)
   7991     (put 'org-agenda-files 'org-restrict nil)
   7992     (move-marker org-agenda-restrict-begin nil)
   7993     (move-marker org-agenda-restrict-end nil)
   7994     (setq current-prefix-arg nil)
   7995     (message "Agenda restriction lock removed")
   7996     (or noupdate (org-agenda-maybe-redo))))
   7997 
   7998 (defun org-agenda-maybe-redo ()
   7999   "If there is any window showing the agenda view, update it."
   8000   (let ((w (get-buffer-window (or org-agenda-this-buffer-name
   8001 				  org-agenda-buffer-name)
   8002 			      t))
   8003 	(w0 (selected-window)))
   8004     (when w
   8005       (select-window w)
   8006       (org-agenda-redo)
   8007       (select-window w0)
   8008       (if org-agenda-overriding-restriction
   8009 	  (message "Agenda view shifted to new %s restriction"
   8010 		   org-agenda-overriding-restriction)
   8011 	(message "Agenda restriction lock removed")))))
   8012 
   8013 ;;; Agenda commands
   8014 
   8015 (defun org-agenda-check-type (error &rest types)
   8016   "Check if agenda buffer or component is of allowed type.
   8017 If ERROR is non-nil, throw an error, otherwise just return nil.
   8018 Allowed types are `agenda' `todo' `tags' `search'."
   8019   (cond ((not org-agenda-type)
   8020 	 (error "No Org agenda currently displayed"))
   8021 	((memq org-agenda-type types) t)
   8022 	(error
   8023 	 (error "Not allowed in '%s'-type agenda buffer or component" org-agenda-type))
   8024 	(t nil)))
   8025 
   8026 (defun org-agenda-Quit ()
   8027   "Exit the agenda, killing the agenda buffer.
   8028 Like `org-agenda-quit', but kill the buffer even when
   8029 `org-agenda-sticky' is non-nil."
   8030   (interactive)
   8031   (org-agenda--quit))
   8032 
   8033 (defun org-agenda-quit ()
   8034   "Exit the agenda.
   8035 
   8036 When `org-agenda-sticky' is non-nil, bury the agenda buffer
   8037 instead of killing it.
   8038 
   8039 When `org-agenda-restore-windows-after-quit' is non-nil, restore
   8040 the pre-agenda window configuration.
   8041 
   8042 When column view is active, exit column view instead of the
   8043 agenda."
   8044   (interactive)
   8045   (org-agenda--quit org-agenda-sticky))
   8046 
   8047 (defun org-agenda--quit (&optional bury)
   8048   (if org-agenda-columns-active
   8049       (org-columns-quit)
   8050     (let ((wconf org-agenda-pre-window-conf)
   8051 	  (buf (current-buffer))
   8052 	  (org-agenda-last-indirect-window
   8053 	   (and (eq org-indirect-buffer-display 'other-window)
   8054 		org-agenda-last-indirect-buffer
   8055 		(get-buffer-window org-agenda-last-indirect-buffer))))
   8056       (cond
   8057        ((eq org-agenda-window-setup 'other-frame)
   8058 	(delete-frame))
   8059        ((eq org-agenda-window-setup 'other-tab)
   8060 	(if (fboundp 'tab-bar-close-tab)
   8061 	    (tab-bar-close-tab)
   8062 	  (user-error "Your version of Emacs does not have tab bar mode support")))
   8063        ((and org-agenda-restore-windows-after-quit
   8064 	     wconf)
   8065 	;; Maybe restore the pre-agenda window configuration.  Reset
   8066 	;; `org-agenda-pre-window-conf' before running
   8067 	;; `set-window-configuration', which loses the current buffer.
   8068 	(setq org-agenda-pre-window-conf nil)
   8069 	(set-window-configuration wconf))
   8070        (t
   8071 	(when org-agenda-last-indirect-window
   8072 	  (delete-window org-agenda-last-indirect-window))
   8073 	(and (not (eq org-agenda-window-setup 'current-window))
   8074 	     (not (one-window-p))
   8075 	     (delete-window))))
   8076       (if bury
   8077 	  ;; Set the agenda buffer as the current buffer instead of
   8078 	  ;; passing it as an argument to `bury-buffer' so that
   8079 	  ;; `bury-buffer' removes it from the window.
   8080 	  (with-current-buffer buf
   8081 	    (bury-buffer))
   8082 	(kill-buffer buf)
   8083 	(setq org-agenda-archives-mode nil
   8084 	      org-agenda-buffer nil)))))
   8085 
   8086 (defun org-agenda-exit ()
   8087   "Exit the agenda, killing Org buffers loaded by the agenda.
   8088 Like `org-agenda-Quit', but kill any buffers that were created by
   8089 the agenda.  Org buffers visited directly by the user will not be
   8090 touched.  Also, exit the agenda even if it is in column view."
   8091   (interactive)
   8092   (when org-agenda-columns-active
   8093     (org-columns-quit))
   8094   (org-release-buffers org-agenda-new-buffers)
   8095   (setq org-agenda-new-buffers nil)
   8096   (org-agenda-Quit))
   8097 
   8098 (defun org-agenda-kill-all-agenda-buffers ()
   8099   "Kill all buffers in `org-agenda-mode'.
   8100 This is used when toggling sticky agendas."
   8101   (interactive)
   8102   (let (blist)
   8103     (dolist (buf (buffer-list))
   8104       (when (with-current-buffer buf (eq major-mode 'org-agenda-mode))
   8105 	(push buf blist)))
   8106     (mapc #'kill-buffer blist)))
   8107 
   8108 (defun org-agenda-execute (arg)
   8109   "Execute another agenda command, keeping same window.
   8110 So this is just a shortcut for \\<global-map>`\\[org-agenda]', available
   8111 in the agenda."
   8112   (interactive "P")
   8113   (let ((org-agenda-window-setup 'current-window))
   8114     (org-agenda arg)))
   8115 
   8116 (defun org-agenda-redo (&optional all)
   8117   "Rebuild possibly ALL agenda view(s) in the current buffer."
   8118   (interactive "P")
   8119   (defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used?
   8120   (let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
   8121 	 (cpa (unless (eq all t) current-prefix-arg))
   8122 	 (org-agenda-doing-sticky-redo org-agenda-sticky)
   8123 	 (org-agenda-sticky nil)
   8124 	 (org-agenda-buffer-name (or org-agenda-this-buffer-name
   8125 				     org-agenda-buffer-name))
   8126 	 (org-agenda-keep-modes t)
   8127 	 (tag-filter org-agenda-tag-filter)
   8128 	 (tag-preset (assoc-default 'tag org-agenda-filters-preset))
   8129 	 (top-hl-filter org-agenda-top-headline-filter)
   8130 	 (cat-filter org-agenda-category-filter)
   8131 	 (cat-preset (assoc-default 'category org-agenda-filters-preset))
   8132 	 (re-filter org-agenda-regexp-filter)
   8133 	 (re-preset (assoc-default 'regexp org-agenda-filters-preset))
   8134 	 (effort-filter org-agenda-effort-filter)
   8135 	 (effort-preset (assoc-default 'effort org-agenda-filters-preset))
   8136 	 (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
   8137 	 (cols org-agenda-columns-active)
   8138 	 (line (org-current-line))
   8139 	 (window-line (- line (org-current-line (window-start))))
   8140 	 (lprops (get-text-property p 'org-lprops))
   8141 	 (redo-cmd (get-text-property p 'org-redo-cmd))
   8142 	 (last-args (get-text-property p 'org-last-args))
   8143 	 (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd))
   8144 	 (org-agenda-overriding-cmd-arguments
   8145 	  (unless (eq all t)
   8146 	    (cond ((listp last-args)
   8147 		   (cons (or cpa (car last-args)) (cdr last-args)))
   8148 		  ((stringp last-args)
   8149 		   last-args))))
   8150 	 (series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
   8151     (and cols (org-columns-quit))
   8152     (message "Rebuilding agenda buffer...")
   8153     (if series-redo-cmd
   8154 	(eval series-redo-cmd t)
   8155       (cl-progv
   8156 	  (mapcar #'car lprops)
   8157 	  (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
   8158 	(eval redo-cmd t))
   8159       (let ((inhibit-read-only t))
   8160 	(add-text-properties (point-min) (point-max) `(org-lprops ,lprops))))
   8161     (setq org-agenda-undo-list nil
   8162 	  org-agenda-pending-undo-list nil
   8163 	  org-agenda-tag-filter tag-filter
   8164 	  org-agenda-category-filter cat-filter
   8165 	  org-agenda-regexp-filter re-filter
   8166 	  org-agenda-effort-filter effort-filter
   8167 	  org-agenda-top-headline-filter top-hl-filter)
   8168     (message "Rebuilding agenda buffer...done")
   8169     (let ((tag (or tag-filter tag-preset))
   8170 	  (cat (or cat-filter cat-preset))
   8171 	  (effort (or effort-filter effort-preset))
   8172 	  (re (or re-filter re-preset)))
   8173       (when tag (org-agenda-filter-apply tag 'tag t))
   8174       (when cat (org-agenda-filter-apply cat 'category))
   8175       (when effort (org-agenda-filter-apply effort 'effort))
   8176       (when re  (org-agenda-filter-apply re 'regexp)))
   8177     (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
   8178     (and cols (called-interactively-p 'any) (org-agenda-columns))
   8179     (org-goto-line line)
   8180     (when (called-interactively-p 'any) (recenter window-line))))
   8181 
   8182 (defun org-agenda-redo-all (&optional exhaustive)
   8183   "Rebuild all agenda views in the current buffer.
   8184 With a prefix argument, do so in all agenda buffers."
   8185   (interactive "P")
   8186   (if exhaustive
   8187       (dolist (buffer (buffer-list))
   8188         (with-current-buffer buffer
   8189           (when (derived-mode-p 'org-agenda-mode)
   8190             (org-agenda-redo t))))
   8191     (org-agenda-redo t)))
   8192 
   8193 (defvar org-global-tags-completion-table nil)
   8194 (defvar org-agenda-filter-form nil)
   8195 (defvar org-agenda-filtered-by-category nil)
   8196 
   8197 (defsubst org-agenda-get-category ()
   8198   "Return the category of the agenda line."
   8199   (org-get-at-bol 'org-category))
   8200 
   8201 (defun org-agenda-filter-by-category (strip)
   8202   "Filter lines in the agenda buffer that have a specific category.
   8203 The category is that of the current line.
   8204 With a `\\[universal-argument]' prefix argument, exclude the lines of that category.
   8205 When there is already a category filter in place, this command removes the
   8206 filter."
   8207   (interactive "P")
   8208   (if (and org-agenda-filtered-by-category
   8209 	   org-agenda-category-filter)
   8210       (org-agenda-filter-show-all-cat)
   8211     (let ((cat (org-no-properties (org-get-at-eol 'org-category 1))))
   8212       (cond
   8213        ((and cat strip)
   8214         (org-agenda-filter-apply
   8215          (push (concat "-" cat) org-agenda-category-filter) 'category))
   8216        (cat
   8217         (org-agenda-filter-apply
   8218          (setq org-agenda-category-filter
   8219 	       (list (concat "+" cat)))
   8220 	 'category))
   8221        (t (error "No category at point"))))))
   8222 
   8223 (defun org-find-top-headline (&optional pos)
   8224   "Find the topmost parent headline and return it.
   8225 POS when non-nil is the marker or buffer position to start the
   8226 search from."
   8227   (save-excursion
   8228     (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
   8229       (when pos (goto-char pos))
   8230       ;; Skip up to the topmost parent.
   8231       (while (org-up-heading-safe))
   8232       (ignore-errors
   8233 	(replace-regexp-in-string
   8234 	 "^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" ""
   8235 	 (nth 4 (org-heading-components)))))))
   8236 
   8237 (defvar org-agenda-filtered-by-top-headline nil)
   8238 (defun org-agenda-filter-by-top-headline (strip)
   8239   "Keep only those lines that are descendants from the same top headline.
   8240 The top headline is that of the current line.  With prefix arg STRIP, hide
   8241 all lines of the category at point."
   8242   (interactive "P")
   8243   (if org-agenda-filtered-by-top-headline
   8244       (progn
   8245         (setq org-agenda-filtered-by-top-headline nil
   8246 	      org-agenda-top-headline-filter nil)
   8247         (org-agenda-filter-show-all-top-filter))
   8248     (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
   8249       (if toph (org-agenda-filter-top-headline-apply toph strip)
   8250         (error "No top-level headline at point")))))
   8251 
   8252 (defvar org-agenda-regexp-filter nil)
   8253 (defun org-agenda-filter-by-regexp (strip-or-accumulate)
   8254   "Filter agenda entries by a regular expressions.
   8255 You will be prompted for the regular expression, and the agenda
   8256 view will only show entries that are matched by that expression.
   8257 
   8258 With one `\\[universal-argument]' prefix argument, hide entries matching the regexp.
   8259 When there is already a regexp filter active, this command removed the
   8260 filter.  However, with two `\\[universal-argument]' prefix arguments, add a new condition to
   8261 an already existing regexp filter."
   8262   (interactive "P")
   8263   (let* ((strip (equal strip-or-accumulate '(4)))
   8264 	 (accumulate (equal strip-or-accumulate '(16))))
   8265     (cond
   8266      ((and org-agenda-regexp-filter (not accumulate))
   8267       (org-agenda-filter-show-all-re)
   8268       (message "Regexp filter removed"))
   8269      (t (let ((flt (concat (if strip "-" "+")
   8270 			   (read-from-minibuffer
   8271 			    (if strip
   8272 				"Hide entries matching regexp: "
   8273 			      "Narrow to entries matching regexp: ")))))
   8274 	  (push flt org-agenda-regexp-filter)
   8275 	  (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))))))
   8276 
   8277 (defvar org-agenda-effort-filter nil)
   8278 (defun org-agenda-filter-by-effort (strip-or-accumulate)
   8279   "Filter agenda entries by effort.
   8280 With no `\\[universal-argument]' prefix argument, keep entries matching the effort condition.
   8281 With one `\\[universal-argument]' prefix argument, filter out entries matching the condition.
   8282 With two `\\[universal-argument]' prefix arguments, add a second condition to the existing filter.
   8283 This last option is in practice not very useful, but it is available for
   8284 consistency with the other filter commands."
   8285   (interactive "P")
   8286   (let* ((efforts (split-string
   8287 		   (or (cdr (assoc-string (concat org-effort-property "_ALL")
   8288 					  org-global-properties
   8289 					  t))
   8290 		       "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")))
   8291 	 ;; XXX: the following handles only up to 10 different
   8292 	 ;; effort values.
   8293 	 (allowed-keys (if (null efforts) nil
   8294 			 (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0
   8295 				 (number-sequence 1 (length efforts)))))
   8296 	 (keep (equal strip-or-accumulate '(16)))
   8297 	 (negative (equal strip-or-accumulate '(4)))
   8298 	 (current org-agenda-effort-filter)
   8299 	 (op nil))
   8300     (while (not (memq op '(?< ?> ?= ?_)))
   8301       (setq op (read-char-exclusive
   8302 		"Effort operator? (> = or <)     or press `_' again to remove filter")))
   8303     ;; Select appropriate duration.  Ignore non-digit characters.
   8304     (if (eq op ?_)
   8305 	(progn
   8306 	  (org-agenda-filter-show-all-effort)
   8307 	  (message "Effort filter removed"))
   8308       (let ((prompt
   8309 	     (apply #'format
   8310 		    (concat "Effort %c "
   8311 			    (mapconcat (lambda (s) (concat "[%d]" s))
   8312 				       efforts
   8313 				       " "))
   8314 		    op allowed-keys))
   8315 	    (eff -1))
   8316 	(while (not (memq eff allowed-keys))
   8317 	  (message prompt)
   8318 	  (setq eff (- (read-char-exclusive) 48)))
   8319 	(org-agenda-filter-show-all-effort)
   8320 	(setq org-agenda-effort-filter
   8321 	      (append
   8322 	       (list (concat (if negative "-" "+")
   8323 			     (char-to-string op)
   8324 			     ;; Numbering is 1 2 3 ... 9 0, but we want
   8325 			     ;; 0 1 2 ... 8 9.
   8326 			     (nth (mod (1- eff) 10) efforts)))
   8327 	       (if keep current nil)))
   8328 	(org-agenda-filter-apply org-agenda-effort-filter 'effort)))))
   8329 
   8330 (defun org-agenda-filter (&optional strip-or-accumulate)
   8331   "Prompt for a general filter string and apply it to the agenda.
   8332 
   8333 The string may contain filter elements like
   8334 
   8335 +category
   8336 +tag
   8337 +<effort        > and = are also allowed as effort operators
   8338 +/regexp/
   8339 
   8340 Instead of `+', `-' is allowed to strip the agenda of matching entries.
   8341 `+' is optional if it is not required to separate two string parts.
   8342 Multiple filter elements can be concatenated without spaces, for example
   8343 
   8344      +work-John<0:10-/plot/
   8345 
   8346 selects entries with category `work' and effort estimates below 10 minutes,
   8347 and deselects entries with tag `John' or matching the regexp `plot'.
   8348 
   8349 During entry of the filter, completion for tags, categories and effort
   8350 values is offered.  Since the syntax for categories and tags is identical
   8351 there should be no overlap between categories and tags.  If there is, tags
   8352 get priority.
   8353 
   8354 A single `\\[universal-argument]' prefix arg STRIP-OR-ACCUMULATE will negate the
   8355 entire filter, which can be useful in connection with the prompt history.
   8356 
   8357 A double `\\[universal-argument] \\[universal-argument]' prefix arg will add the new filter elements to the
   8358 existing ones.  A shortcut for this is to add an additional `+' at the
   8359 beginning of the string, like `+-John'.
   8360 
   8361 With a triple prefix argument, execute the computed filtering defined in
   8362 the variable `org-agenda-auto-exclude-function'."
   8363   (interactive "P")
   8364   (if (equal strip-or-accumulate '(64))
   8365       ;; Execute the auto-exclude action
   8366       (if (not org-agenda-auto-exclude-function)
   8367 	  (user-error "`org-agenda-auto-exclude-function' is undefined")
   8368 	(org-agenda-filter-show-all-tag)
   8369 	(setq org-agenda-tag-filter nil)
   8370 	(dolist (tag (org-agenda-get-represented-tags))
   8371 	  (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
   8372 	    (when modifier
   8373 	      (push modifier org-agenda-tag-filter))))
   8374 	(unless (null org-agenda-tag-filter)
   8375 	  (org-agenda-filter-apply org-agenda-tag-filter 'tag 'expand)))
   8376     ;; Prompt for a filter and act
   8377     (let* ((tag-list (org-agenda-get-represented-tags))
   8378 	   (category-list (org-agenda-get-represented-categories))
   8379 	   (negate (equal strip-or-accumulate '(4)))
   8380 	   (cf (mapconcat #'identity org-agenda-category-filter ""))
   8381 	   (tf (mapconcat #'identity org-agenda-tag-filter ""))
   8382 	   ;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) ""))))
   8383 	   (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) "")))
   8384 	   (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) "")))
   8385 	   (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/"))))
   8386 	   (f-string (completing-read
   8387 		      (concat
   8388 		       (if negate "Negative filter" "Filter")
   8389 		       " [+cat-tag<0:10-/regexp/]: ")
   8390 		      #'org-agenda-filter-completion-function
   8391 		      nil nil ff))
   8392 	   (keep (or (if (string-match "^\\+[+-]" f-string)
   8393 			 (progn (setq f-string (substring f-string 1)) t))
   8394 		     (equal strip-or-accumulate '(16))))
   8395 	   (fc (if keep org-agenda-category-filter))
   8396 	   (ft (if keep org-agenda-tag-filter))
   8397 	   (fe (if keep org-agenda-effort-filter))
   8398 	   (fr (if keep org-agenda-regexp-filter))
   8399 	   pm s)
   8400       ;; If the filter contains a double-quoted string, replace a
   8401       ;; single hyphen by the arbitrary and temporary string "~~~"
   8402       ;; to disambiguate such hyphens from syntactic ones.
   8403       (setq f-string (replace-regexp-in-string
   8404 		      "\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string))
   8405       (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string)
   8406 	(setq pm (if (match-beginning 1) (match-string 1 f-string) "+"))
   8407 	(when negate
   8408 	  (setq pm (if (equal pm "+") "-" "+")))
   8409 	(cond
   8410 	 ((match-beginning 3)
   8411 	  ;; category or tag
   8412 	  (setq s (replace-regexp-in-string ; Remove the temporary special string.
   8413 		   "~~~" "-" (match-string 3 f-string)))
   8414 	  (cond
   8415 	   ((member s tag-list)
   8416 	    (org-pushnew-to-end (concat pm s) ft))
   8417 	   ((member s category-list)
   8418 	    (org-pushnew-to-end (concat pm ; Remove temporary double quotes.
   8419 				        (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s))
   8420 				fc))
   8421 	   (t (message
   8422 	       "`%s%s' filter ignored because tag/category is not represented"
   8423 	       pm s))))
   8424 	 ((match-beginning 4)
   8425 	  ;; effort
   8426 	  (org-pushnew-to-end (concat pm (match-string 4 f-string)) fe))
   8427 	 ((match-beginning 5)
   8428 	  ;; regexp
   8429 	  (org-pushnew-to-end (concat pm (match-string 6 f-string)) fr)))
   8430 	(setq f-string (substring f-string (match-end 0))))
   8431       (org-agenda-filter-remove-all)
   8432       (and fc (org-agenda-filter-apply
   8433 	       (setq org-agenda-category-filter fc) 'category))
   8434       (and ft (org-agenda-filter-apply
   8435 	       (setq org-agenda-tag-filter ft) 'tag 'expand))
   8436       (and fe (org-agenda-filter-apply
   8437 	       (setq org-agenda-effort-filter fe) 'effort))
   8438       (and fr (org-agenda-filter-apply
   8439 	       (setq org-agenda-regexp-filter fr) 'regexp))
   8440       (run-hooks 'org-agenda-filter-hook))))
   8441 
   8442 (defun org-agenda-filter-completion-function (string _predicate &optional flag)
   8443   "Complete a complex filter string.
   8444 FLAG specifies the type of completion operation to perform.  This
   8445 function is passed as a collection function to `completing-read',
   8446 which see."
   8447   (let ((completion-ignore-case t)	;tags are case-sensitive
   8448 	(confirm (lambda (x) (stringp x)))
   8449 	(prefix "")
   8450 	(operator "")
   8451 	table)
   8452     (when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string)
   8453       (setq prefix (match-string 1 string)
   8454 	    operator (match-string 2 string)
   8455 	    string (match-string 3 string)))
   8456     (cond
   8457      ((member operator '("+" "-" "" nil))
   8458       (setq table (append (org-agenda-get-represented-categories)
   8459 			  (org-agenda-get-represented-tags))))
   8460      ((member operator '("<" ">" "="))
   8461       (setq table (split-string
   8462 		   (or (cdr (assoc-string (concat org-effort-property "_ALL")
   8463 					  org-global-properties
   8464 					  t))
   8465 		       "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")
   8466 		   " +")))
   8467      (t (setq table nil)))
   8468     (pcase flag
   8469       (`t (all-completions string table confirm))
   8470       (`lambda (assoc string table)) ;exact match?
   8471       (`nil
   8472        (pcase (try-completion string table confirm)
   8473 	 ((and completion (pred stringp))
   8474 	  (concat prefix completion))
   8475 	 (completion completion)))
   8476       (_ nil))))
   8477 
   8478 (defun org-agenda-filter-remove-all ()
   8479   "Remove all filters from the current agenda buffer."
   8480   (interactive)
   8481   (when org-agenda-tag-filter
   8482     (org-agenda-filter-show-all-tag))
   8483   (when org-agenda-category-filter
   8484     (org-agenda-filter-show-all-cat))
   8485   (when org-agenda-regexp-filter
   8486     (org-agenda-filter-show-all-re))
   8487   (when org-agenda-top-headline-filter
   8488     (org-agenda-filter-show-all-top-filter))
   8489   (when org-agenda-effort-filter
   8490     (org-agenda-filter-show-all-effort))
   8491   (org-agenda-finalize)
   8492   (when (called-interactively-p 'interactive)
   8493     (message "All agenda filters removed")))
   8494 
   8495 (defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude)
   8496   "Keep only those lines in the agenda buffer that have a specific tag.
   8497 
   8498 The tag is selected with its fast selection letter, as configured.
   8499 
   8500 With a `\\[universal-argument]' prefix, apply the filter negatively, stripping all matches.
   8501 
   8502 With a `\\[universal-argument] \\[universal-argument]' prefix, add the new tag to the existing filter
   8503 instead of replacing it.
   8504 
   8505 With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \
   8506 i.e. don't
   8507 filter on all its group members.
   8508 
   8509 A Lisp caller can specify CHAR.  EXCLUDE means that the new tag
   8510 should be used to exclude the search - the interactive user can
   8511 also press `-' or `+' to switch between filtering and excluding."
   8512   (interactive "P")
   8513   (let* ((alist org-tag-alist-for-agenda)
   8514 	 (seen-chars nil)
   8515 	 (tag-chars (mapconcat
   8516 		     (lambda (x) (if (and (not (symbolp (car x)))
   8517 					  (cdr x)
   8518 					  (not (member (cdr x) seen-chars)))
   8519 				     (progn
   8520 				       (push (cdr x) seen-chars)
   8521 				       (char-to-string (cdr x)))
   8522 				   ""))
   8523 		     org-tag-alist-for-agenda ""))
   8524 	 (valid-char-list (append '(?\t ?\r ?\\ ?. ?\s ?q)
   8525 				  (string-to-list tag-chars)))
   8526 	 (exclude (or exclude (equal strip-or-accumulate '(4))))
   8527 	 (accumulate (equal strip-or-accumulate '(16)))
   8528 	 (expand (not (equal strip-or-accumulate '(64))))
   8529 	 (inhibit-read-only t)
   8530 	 (current org-agenda-tag-filter)
   8531 	 a tag) ;; n
   8532     (unless char
   8533       (while (not (memq char valid-char-list))
   8534 	(org-unlogged-message
   8535 	 "%s by tag%s: [%s ]tag-char [TAB]tag %s[\\]off [q]uit"
   8536 	 (if exclude "Exclude[+]" "Filter[-]")
   8537 	 (if expand "" " (no grouptag expand)")
   8538 	 tag-chars
   8539 	 (if org-agenda-auto-exclude-function "[RET] " ""))
   8540 	(setq char (read-char-exclusive))
   8541 	;; Excluding or filtering down
   8542 	(cond ((eq char ?-) (setq exclude t))
   8543 	      ((eq char ?+) (setq exclude nil)))))
   8544     (when (eq char ?\t)
   8545       (unless (local-variable-p 'org-global-tags-completion-table)
   8546 	(setq-local org-global-tags-completion-table
   8547 		    (org-global-tags-completion-table)))
   8548       (let ((completion-ignore-case t))
   8549 	(setq tag (completing-read
   8550 		   "Tag: " org-global-tags-completion-table nil t))))
   8551     (cond
   8552      ((eq char ?\r)
   8553       (org-agenda-filter-show-all-tag)
   8554       (when org-agenda-auto-exclude-function
   8555 	(setq org-agenda-tag-filter nil)
   8556 	(dolist (tag (org-agenda-get-represented-tags))
   8557 	  (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
   8558 	    (when modifier
   8559 	      (push modifier org-agenda-tag-filter))))
   8560 	(unless (null org-agenda-tag-filter)
   8561 	  (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
   8562      ((eq char ?\\)
   8563       (org-agenda-filter-show-all-tag)
   8564       (when (assoc-default 'tag org-agenda-filters-preset)
   8565 	(org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
   8566      ((eq char ?.)
   8567       (setq org-agenda-tag-filter
   8568 	    (mapcar (lambda(tag) (concat "+" tag))
   8569 		    (org-get-at-bol 'tags)))
   8570       (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
   8571      ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
   8572      ((or (eq char ?\s)
   8573 	  (setq a (rassoc char alist))
   8574 	  (and tag (setq a (cons tag nil))))
   8575       (org-agenda-filter-show-all-tag)
   8576       (setq tag (car a))
   8577       (setq org-agenda-tag-filter
   8578 	    (cons (concat (if exclude "-" "+") tag)
   8579 		  (if accumulate current nil)))
   8580       (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
   8581      (t (error "Invalid tag selection character %c" char)))))
   8582 
   8583 (defun org-agenda-get-represented-categories ()
   8584   "Return a list of all categories used in this agenda buffer."
   8585   (or org-agenda-represented-categories
   8586       (when (derived-mode-p 'org-agenda-mode)
   8587 	(let ((pos (point-min)) categories)
   8588 	  (while (and (< pos (point-max))
   8589 		      (setq pos (next-single-property-change
   8590 				 pos 'org-category nil (point-max))))
   8591 	    (push (get-text-property pos 'org-category) categories))
   8592 	  (setq org-agenda-represented-categories
   8593 		;; Enclose category names with a hyphen in double
   8594 		;; quotes to process them specially in `org-agenda-filter'.
   8595 		(mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s))
   8596 			(nreverse (org-uniquify (delq nil categories)))))))))
   8597 
   8598 (defvar org-tag-groups-alist-for-agenda)
   8599 (defun org-agenda-get-represented-tags ()
   8600   "Return a list of all tags used in this agenda buffer.
   8601 These will be lower-case, for filtering."
   8602   (or org-agenda-represented-tags
   8603       (when (derived-mode-p 'org-agenda-mode)
   8604 	(let ((pos (point-min)) tags-lists tt)
   8605 	  (while (and (< pos (point-max))
   8606 		      (setq pos (next-single-property-change
   8607 				 pos 'tags nil (point-max))))
   8608 	    (setq tt (get-text-property pos 'tags))
   8609 	    (if tt (push tt tags-lists)))
   8610 	  (setq tags-lists
   8611 		(nreverse (org-uniquify
   8612 			   (delq nil (apply #'append tags-lists)))))
   8613 	  (dolist (tag tags-lists)
   8614 	    (mapc
   8615 	     (lambda (group)
   8616 	       (when (member tag group)
   8617 		 (push (car group) tags-lists)))
   8618 	     org-tag-groups-alist-for-agenda))
   8619 	  (setq org-agenda-represented-tags tags-lists)))))
   8620 
   8621 (defun org-agenda-filter-make-matcher (filter type &optional expand)
   8622   "Create the form that tests a line for agenda filter.
   8623 Optional argument EXPAND can be used for the TYPE tag and will
   8624 expand the tags in the FILTER if any of the tags in FILTER are
   8625 grouptags."
   8626   (let ((multi-pos-cats
   8627 	 (and (eq type 'category)
   8628 	      (string-match-p "\\+.*\\+"
   8629 			      (mapconcat (lambda (cat) (substring cat 0 1))
   8630 					 filter ""))))
   8631 	f f1)
   8632     (cond
   8633      ;; Tag filter
   8634      ((eq type 'tag)
   8635       (setq filter
   8636 	    (delete-dups
   8637 	     (append (assoc-default 'tag org-agenda-filters-preset)
   8638 		     filter)))
   8639       (dolist (x filter)
   8640 	(let ((op (string-to-char x)))
   8641 	  (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
   8642 	    (setq x (list x)))
   8643 	  (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
   8644 	  (push f1 f))))
   8645      ;; Category filter
   8646      ((eq type 'category)
   8647       (setq filter
   8648 	    (delete-dups
   8649 	     (append (assoc-default 'category org-agenda-filters-preset)
   8650 		     filter)))
   8651       (dolist (x filter)
   8652 	(if (equal "-" (substring x 0 1))
   8653 	    (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
   8654 	  (setq f1 (list 'equal (substring x 1) 'cat)))
   8655 	(push f1 f)))
   8656      ;; Regexp filter
   8657      ((eq type 'regexp)
   8658       (setq filter
   8659 	    (delete-dups
   8660 	     (append (assoc-default 'regexp org-agenda-filters-preset)
   8661 		     filter)))
   8662       (dolist (x filter)
   8663 	(if (equal "-" (substring x 0 1))
   8664 	    (setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
   8665 	  (setq f1 (list 'string-match (substring x 1) 'txt)))
   8666 	(push f1 f)))
   8667      ;; Effort filter
   8668      ((eq type 'effort)
   8669       (setq filter
   8670 	    (delete-dups
   8671 	     (append (assoc-default 'effort org-agenda-filters-preset)
   8672 		     filter)))
   8673       (dolist (x filter)
   8674 	(push (org-agenda-filter-effort-form x) f))))
   8675     (cons (if multi-pos-cats 'or 'and) (nreverse f))))
   8676 
   8677 (defun org-agenda-filter-make-matcher-tag-exp (tags op)
   8678   "Return a form associated to tag-expression TAGS.
   8679 Build a form testing a line for agenda filter for
   8680 tag-expressions.  OP is an operator of type CHAR that allows the
   8681 function to set the right switches in the returned form."
   8682   (let (form)
   8683     ;; Any of the expressions can match if OP is +, all must match if
   8684     ;; the operator is -.
   8685     (dolist (x tags (cons (if (eq op ?-) 'and 'or) form))
   8686       (let* ((tag (substring x 1))
   8687 	     (f (cond
   8688 		 ((string= "" tag) 'tags)
   8689 		 ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag))
   8690 		  ;; TAG is a regexp.
   8691 		  (list 'org-match-any-p (substring tag 1 -1) 'tags))
   8692 		 (t (list 'member tag 'tags)))))
   8693 	(push (if (eq op ?-) (list 'not f) f) form)))))
   8694 
   8695 (defun org-agenda-filter-effort-form (e)
   8696   "Return the form to compare the effort of the current line with what E says.
   8697 E looks like \"+<2:25\"."
   8698   (let (op)
   8699     (setq e (substring e 1))
   8700     (setq op (string-to-char e) e (substring e 1))
   8701     (setq op (cond ((equal op ?<) '<=)
   8702 		   ((equal op ?>) '>=)
   8703 		   ((equal op ??) op)
   8704 		   (t '=)))
   8705     (list 'org-agenda-compare-effort (list 'quote op)
   8706 	  (org-duration-to-minutes e))))
   8707 
   8708 (defun org-agenda-compare-effort (op value)
   8709   "Compare the effort of the current line with VALUE, using OP.
   8710 If the line does not have an effort defined, return nil."
   8711   ;; `effort-minutes' property cannot be extracted directly from
   8712   ;; current line but is stored as a property in `txt'.
   8713   (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt))))
   8714     (funcall op
   8715 	     (or effort (if org-agenda-sort-noeffort-is-high 32767 -1))
   8716 	     value)))
   8717 
   8718 (defun org-agenda-filter-expand-tags (filter &optional no-operator)
   8719   "Expand group tags in FILTER for the agenda.
   8720 When NO-OPERATOR is non-nil, do not add the + operator to
   8721 returned tags."
   8722   (if org-group-tags
   8723       (let (case-fold-search rtn)
   8724 	(mapc
   8725 	 (lambda (f)
   8726 	   (let (f0 dir)
   8727 	     (if (string-match "^\\([+-]\\)\\(.+\\)" f)
   8728 		 (setq dir (match-string 1 f) f0 (match-string 2 f))
   8729 	       (setq dir (if no-operator "" "+") f0 f))
   8730 	     (setq rtn (append (mapcar (lambda(f1) (concat dir f1))
   8731 				       (org-tags-expand f0 t))
   8732 			       rtn))))
   8733 	 filter)
   8734 	(reverse rtn))
   8735     filter))
   8736 
   8737 (defun org-agenda-filter-apply (filter type &optional expand)
   8738   "Set FILTER as the new agenda filter and apply it.
   8739 Optional argument EXPAND can be used for the TYPE tag and will
   8740 expand the tags in the FILTER if any of the tags in FILTER are
   8741 grouptags."
   8742   ;; Deactivate `org-agenda-entry-text-mode' when filtering
   8743   (when org-agenda-entry-text-mode (org-agenda-entry-text-mode))
   8744   (setq org-agenda-filter-form (org-agenda-filter-make-matcher
   8745 				filter type expand))
   8746   ;; Only set `org-agenda-filtered-by-category' to t when a unique
   8747   ;; category is used as the filter:
   8748   (setq org-agenda-filtered-by-category
   8749 	(and (eq type 'category)
   8750 	     (not (equal (substring (car filter) 0 1) "-"))))
   8751   (org-agenda-set-mode-name)
   8752   (save-excursion
   8753     (goto-char (point-min))
   8754     (while (not (eobp))
   8755       (when (or (org-get-at-bol 'org-hd-marker)
   8756 		(org-get-at-bol 'org-marker))
   8757 	(org-dlet
   8758 	    ((tags (org-get-at-bol 'tags))
   8759 	     (cat (org-agenda-get-category))
   8760 	     (txt (or (org-get-at-bol 'txt) "")))
   8761 	  (unless (eval org-agenda-filter-form t)
   8762 	    (org-agenda-filter-hide-line type))))
   8763       (beginning-of-line 2)))
   8764   (when (get-char-property (point) 'invisible)
   8765     (ignore-errors (org-agenda-previous-line))))
   8766 
   8767 (defun org-agenda-filter-top-headline-apply (hl &optional negative)
   8768   "Filter by top headline HL."
   8769   (org-agenda-set-mode-name)
   8770   (save-excursion
   8771     (goto-char (point-min))
   8772     (while (not (eobp))
   8773       (let* ((pos (org-get-at-bol 'org-hd-marker))
   8774              (tophl (and pos (org-find-top-headline pos))))
   8775         (when (and tophl (funcall (if negative 'identity 'not)
   8776 				  (string= hl tophl)))
   8777           (org-agenda-filter-hide-line 'top-headline)))
   8778       (beginning-of-line 2)))
   8779   (when (get-char-property (point) 'invisible)
   8780     (org-agenda-previous-line))
   8781   (setq org-agenda-top-headline-filter hl
   8782 	org-agenda-filtered-by-top-headline t))
   8783 
   8784 (defun org-agenda-filter-hide-line (type)
   8785   "If current line is TYPE, hide it in the agenda buffer."
   8786   (let* (buffer-invisibility-spec
   8787          (beg (max (point-min) (1- (line-beginning-position))))
   8788          (end (line-end-position)))
   8789     (let ((inhibit-read-only t))
   8790       (add-text-properties
   8791        beg end `(invisible org-filtered org-filter-type ,type)))))
   8792 
   8793 (defun org-agenda-remove-filter (type)
   8794   "Remove filter of type TYPE from the agenda buffer."
   8795   (interactive)
   8796   (save-excursion
   8797     (goto-char (point-min))
   8798     (let ((inhibit-read-only t) pos)
   8799       (while (setq pos (text-property-any (point) (point-max)
   8800 					  'org-filter-type type))
   8801 	(goto-char pos)
   8802 	(remove-text-properties
   8803 	 (point) (next-single-property-change (point) 'org-filter-type)
   8804 	 `(invisible org-filtered org-filter-type ,type))))
   8805     (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil)
   8806     (setq org-agenda-filter-form nil)
   8807     (org-agenda-set-mode-name)
   8808     (org-agenda-finalize)))
   8809 
   8810 (defun org-agenda-filter-show-all-tag nil
   8811   (org-agenda-remove-filter 'tag))
   8812 (defun org-agenda-filter-show-all-re nil
   8813   (org-agenda-remove-filter 'regexp))
   8814 (defun org-agenda-filter-show-all-effort nil
   8815   (org-agenda-remove-filter 'effort))
   8816 (defun org-agenda-filter-show-all-cat nil
   8817   (org-agenda-remove-filter 'category))
   8818 (defun org-agenda-filter-show-all-top-filter nil
   8819   (org-agenda-remove-filter 'top-headline))
   8820 
   8821 (defun org-agenda-manipulate-query-add ()
   8822   "Manipulate the query by adding a search term with positive selection.
   8823 Positive selection means the term must be matched for selection of an entry."
   8824   (interactive)
   8825   (org-agenda-manipulate-query ?\[))
   8826 (defun org-agenda-manipulate-query-subtract ()
   8827   "Manipulate the query by adding a search term with negative selection.
   8828 Negative selection means term must not be matched for selection of an entry."
   8829   (interactive)
   8830   (org-agenda-manipulate-query ?\]))
   8831 (defun org-agenda-manipulate-query-add-re ()
   8832   "Manipulate the query by adding a search regexp with positive selection.
   8833 Positive selection means the regexp must match for selection of an entry."
   8834   (interactive)
   8835   (org-agenda-manipulate-query ?\{))
   8836 (defun org-agenda-manipulate-query-subtract-re ()
   8837   "Manipulate the query by adding a search regexp with negative selection.
   8838 Negative selection means regexp must not match for selection of an entry."
   8839   (interactive)
   8840   (org-agenda-manipulate-query ?\}))
   8841 (defun org-agenda-manipulate-query (char)
   8842   (cond
   8843    ((eq org-agenda-type 'agenda)
   8844     (let ((org-agenda-include-inactive-timestamps t))
   8845       (org-agenda-redo))
   8846     (message "Display now includes inactive timestamps as well"))
   8847    ((eq org-agenda-type 'search)
   8848     (org-add-to-string
   8849      'org-agenda-query-string
   8850      (if org-agenda-last-search-view-search-was-boolean
   8851 	 (cdr (assoc char '((?\[ . " +") (?\] . " -")
   8852 			    (?\{ . " +{}") (?\} . " -{}"))))
   8853        " "))
   8854     (setq org-agenda-redo-command
   8855 	  (list 'org-search-view
   8856 		(car (get-text-property (min (1- (point-max)) (point))
   8857 					'org-last-args))
   8858 		org-agenda-query-string
   8859 		(+ (length org-agenda-query-string)
   8860 		   (if (member char '(?\{ ?\})) 0 1))))
   8861     (set-register org-agenda-query-register org-agenda-query-string)
   8862     (let ((org-agenda-overriding-arguments
   8863 	   (cdr org-agenda-redo-command)))
   8864       (org-agenda-redo)))
   8865    (t (error "Cannot manipulate query for %s-type agenda buffers"
   8866 	     org-agenda-type))))
   8867 
   8868 (defun org-add-to-string (var string)
   8869   (set var (concat (symbol-value var) string)))
   8870 
   8871 (defun org-agenda-goto-date (date)
   8872   "Jump to DATE in the agenda buffer.
   8873 
   8874 When called interactively, prompt for the date.
   8875 When called from Lisp, DATE should be a date as returned by
   8876 `org-read-date'.
   8877 
   8878 See also:
   8879  `org-agenda-earlier'    (\\[org-agenda-earlier])
   8880  `org-agenda-later'      (\\[org-agenda-later])
   8881  `org-agenda-goto-today' (\\[org-agenda-goto-today])"
   8882   (interactive
   8883    (list
   8884     (let ((org-read-date-prefer-future org-agenda-jump-prefer-future))
   8885       (org-read-date))))
   8886   (let* ((day (time-to-days (org-time-string-to-time date)))
   8887 	 (org-agenda-sticky-orig org-agenda-sticky)
   8888 	 (org-agenda-buffer-tmp-name (buffer-name))
   8889 	 (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
   8890 	 (0-arg (or current-prefix-arg (car args)))
   8891 	 (2-arg (nth 2 args))
   8892 	 (with-hour-p (nth 4 org-agenda-redo-command))
   8893 	 (newcmd (list 'org-agenda-list 0-arg date
   8894 		       (org-agenda-span-to-ndays
   8895 			2-arg (org-time-string-to-absolute date))
   8896 		       with-hour-p))
   8897 	 (newargs (cdr newcmd))
   8898 	 (inhibit-read-only t)
   8899 	 org-agenda-sticky)
   8900     (if (not (org-agenda-check-type t 'agenda))
   8901 	(error "Not available in non-agenda views")
   8902       (add-text-properties (point-min) (point-max)
   8903 			   `(org-redo-cmd ,newcmd org-last-args ,newargs))
   8904       (org-agenda-redo)
   8905       (goto-char (point-min))
   8906       (while (not (or (= (or (get-text-property (point) 'day) 0) day)
   8907 		      (save-excursion (move-beginning-of-line 2) (eobp))))
   8908 	(move-beginning-of-line 2))
   8909       (setq org-agenda-sticky org-agenda-sticky-orig
   8910 	    org-agenda-this-buffer-is-sticky org-agenda-sticky))))
   8911 
   8912 (defun org-agenda-goto-today ()
   8913   "Go to today's date in the agenda buffer.
   8914 
   8915 See also:
   8916  `org-agenda-later'     (\\[org-agenda-later])
   8917  `org-agenda-earlier'   (\\[org-agenda-earlier])
   8918  `org-agenda-goto-date' (\\[org-agenda-goto-date])"
   8919   (interactive)
   8920   (org-agenda-check-type t 'agenda)
   8921   (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
   8922 	 (curspan (nth 2 args))
   8923 	 (tdpos (text-property-any (point-min) (point-max) 'org-today t)))
   8924     (cond
   8925      (tdpos (goto-char tdpos))
   8926      ((eq org-agenda-type 'agenda)
   8927       (let* ((sd (org-agenda-compute-starting-span
   8928 		  (org-today) (or curspan org-agenda-span)))
   8929 	     (org-agenda-overriding-arguments args))
   8930 	(setf (nth 1 org-agenda-overriding-arguments) sd)
   8931 	(org-agenda-redo)
   8932 	(org-agenda-find-same-or-today-or-agenda)))
   8933      (t (error "Cannot find today")))))
   8934 
   8935 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
   8936   (goto-char
   8937    (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
   8938        (text-property-any (point-min) (point-max) 'org-today t)
   8939        (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
   8940        (and (get-text-property (min (1- (point-max)) (point)) 'org-series)
   8941 	    (org-agenda-backward-block))
   8942        (point-min))))
   8943 
   8944 (defun org-agenda-backward-block ()
   8945   "Move backward by one agenda block."
   8946   (interactive)
   8947   (org-agenda-forward-block 'backward))
   8948 
   8949 (defun org-agenda-forward-block (&optional backward)
   8950   "Move forward by one agenda block.
   8951 When optional argument BACKWARD is set, go backward."
   8952   (interactive)
   8953   (cond ((not (derived-mode-p 'org-agenda-mode))
   8954 	 (user-error
   8955 	  "Cannot execute this command outside of org-agenda-mode buffers"))
   8956 	((looking-at (if backward "\\`" "\\'"))
   8957 	 (message "Already at the %s block" (if backward "first" "last")))
   8958 	(t (let ((_pos (prog1 (point)
   8959 			 (ignore-errors (if backward (backward-char 1)
   8960 					  (move-end-of-line 1)))))
   8961 		 (f (if backward
   8962 			#'previous-single-property-change
   8963 		      #'next-single-property-change))
   8964 		 moved dest)
   8965 	     (while (and (setq dest (funcall
   8966 				     f (point) 'org-agenda-structural-header))
   8967 			 (not (get-text-property
   8968 			       (point) 'org-agenda-structural-header)))
   8969 	       (setq moved t)
   8970 	       (goto-char dest))
   8971 	     (if moved (move-beginning-of-line 1)
   8972 	       (goto-char (if backward (point-min) (point-max)))
   8973 	       (move-beginning-of-line 1)
   8974 	       (message "No %s block" (if backward "previous" "further")))))))
   8975 
   8976 (defun org-agenda-later (arg)
   8977   "Go forward in time by the current span in the agenda buffer.
   8978 With prefix ARG, go forward that many times the current span.
   8979 
   8980 See also:
   8981  `org-agenda-earlier'    (\\[org-agenda-earlier])
   8982  `org-agenda-goto-today' (\\[org-agenda-goto-today])
   8983  `org-agenda-goto-date'  (\\[org-agenda-goto-date])"
   8984   (interactive "p")
   8985   (org-agenda-check-type t 'agenda)
   8986   (let* ((wstart (window-start))
   8987          (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
   8988 	 (span (or (nth 2 args) org-agenda-current-span))
   8989 	 (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day))
   8990 	 (greg (calendar-gregorian-from-absolute sd))
   8991 	 (cnt (org-get-at-bol 'org-day-cnt))
   8992 	 greg2)
   8993     (cond
   8994      ((numberp span)
   8995       (setq sd (+ (* span arg) sd)))
   8996      ((eq span 'day)
   8997       (setq sd (+ arg sd)))
   8998      ((eq span 'week)
   8999       (setq sd (+ (* 7 arg) sd)))
   9000      ((eq span 'fortnight)
   9001       (setq sd (+ (* 14 arg) sd)))
   9002      ((eq span 'month)
   9003       (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
   9004 	    sd (calendar-absolute-from-gregorian greg2))
   9005       (setcar greg2 (1+ (car greg2))))
   9006      ((eq span 'year)
   9007       (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
   9008 	    sd (calendar-absolute-from-gregorian greg2))
   9009       (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
   9010      (t
   9011       (setq sd (+ (* span arg) sd))))
   9012     (let ((org-agenda-overriding-cmd
   9013 	   ;; `cmd' may have been set by `org-agenda-run-series' which
   9014 	   ;; uses `org-agenda-overriding-cmd' to decide whether
   9015 	   ;; overriding is allowed for `cmd'
   9016 	   (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
   9017 	  (org-agenda-overriding-arguments
   9018 	   (list (car args) sd span)))
   9019       (org-agenda-redo)
   9020       (org-agenda-find-same-or-today-or-agenda cnt))
   9021     (set-window-start nil wstart)))
   9022 
   9023 (defun org-agenda-earlier (arg)
   9024   "Go backward in time by the current span in the agenda buffer.
   9025 With prefix ARG, go backward that many times the current span.
   9026 
   9027 See also:
   9028  `org-agenda-later'      (\\[org-agenda-later])
   9029  `org-agenda-goto-today' (\\[org-agenda-goto-today])
   9030  `org-agenda-goto-date'  (\\[org-agenda-goto-date])"
   9031   (interactive "p")
   9032   (org-agenda-later (- arg)))
   9033 
   9034 (defun org-agenda-view-mode-dispatch ()
   9035   "Call one of the view mode commands."
   9036   (interactive)
   9037   (org-unlogged-message
   9038    "View: [d]ay  [w]eek  for[t]night  [m]onth  [y]ear  [SPC]reset  [q]uit/abort
   9039        time[G]rid   [[]inactive  [f]ollow      [l]og    [L]og-all   [c]lockcheck
   9040        [a]rch-trees [A]rch-files clock[R]eport include[D]iary       [E]ntryText")
   9041   (pcase (read-char-exclusive)
   9042     (?\ (call-interactively 'org-agenda-reset-view))
   9043     (?d (call-interactively 'org-agenda-day-view))
   9044     (?w (call-interactively 'org-agenda-week-view))
   9045     (?t (call-interactively 'org-agenda-fortnight-view))
   9046     (?m (call-interactively 'org-agenda-month-view))
   9047     (?y (call-interactively 'org-agenda-year-view))
   9048     (?l (call-interactively 'org-agenda-log-mode))
   9049     (?L (org-agenda-log-mode '(4)))
   9050     (?c (org-agenda-log-mode 'clockcheck))
   9051     ((or ?F ?f) (call-interactively 'org-agenda-follow-mode))
   9052     (?a (call-interactively 'org-agenda-archives-mode))
   9053     (?A (org-agenda-archives-mode 'files))
   9054     ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode))
   9055     ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode))
   9056     (?G (call-interactively 'org-agenda-toggle-time-grid))
   9057     (?D (call-interactively 'org-agenda-toggle-diary))
   9058     (?\! (call-interactively 'org-agenda-toggle-deadlines))
   9059     (?\[ (let ((org-agenda-include-inactive-timestamps t))
   9060 	   (org-agenda-check-type t 'agenda)
   9061 	   (org-agenda-redo))
   9062 	 (message "Display now includes inactive timestamps as well"))
   9063     (?q (message "Abort"))
   9064     (key (user-error "Invalid key: %s" key))))
   9065 
   9066 (defun org-agenda-reset-view ()
   9067   "Switch to default view for agenda."
   9068   (interactive)
   9069   (org-agenda-change-time-span org-agenda-span))
   9070 
   9071 (defun org-agenda-day-view (&optional day-of-month)
   9072   "Switch to daily view for agenda.
   9073 With argument DAY-OF-MONTH, switch to that day of the month."
   9074   (interactive "P")
   9075   (org-agenda-change-time-span 'day day-of-month))
   9076 
   9077 (defun org-agenda-week-view (&optional iso-week)
   9078   "Switch to weekly view for agenda.
   9079 With argument ISO-WEEK, switch to the corresponding ISO week.
   9080 If ISO-WEEK has more then 2 digits, only the last two encode
   9081 the week.  Any digits before this encode a year.  So 200712
   9082 means week 12 of year 2007.  Years ranging from 70 years ago
   9083 to 30 years in the future can also be written as 2-digit years."
   9084   (interactive "P")
   9085   (org-agenda-change-time-span 'week iso-week))
   9086 
   9087 (defun org-agenda-fortnight-view (&optional iso-week)
   9088   "Switch to fortnightly view for agenda.
   9089 With argument ISO-WEEK, switch to the corresponding ISO week.
   9090 If ISO-WEEK has more then 2 digits, only the last two encode
   9091 the week.  Any digits before this encode a year.  So 200712
   9092 means week 12 of year 2007.  Years ranging from 70 years ago
   9093 to 30 years in the future can also be written as 2-digit years."
   9094   (interactive "P")
   9095   (org-agenda-change-time-span 'fortnight iso-week))
   9096 
   9097 (defun org-agenda-month-view (&optional month)
   9098   "Switch to monthly view for agenda.
   9099 With argument MONTH, switch to that month.  If MONTH has more
   9100 then 2 digits, only the last two encode the month.  Any digits
   9101 before this encode a year.  So 200712 means December year 2007.
   9102 Years ranging from 70 years ago to 30 years in the future can
   9103 also be written as 2-digit years."
   9104   (interactive "P")
   9105   (org-agenda-change-time-span 'month month))
   9106 
   9107 (defun org-agenda-year-view (&optional year)
   9108   "Switch to yearly view for agenda.
   9109 With argument YEAR, switch to that year.  Years ranging from 70
   9110 years ago to 30 years in the future can also be written as
   9111 2-digit years."
   9112   (interactive "P")
   9113   (when year
   9114     (setq year (org-small-year-to-year year)))
   9115   (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ")
   9116       (org-agenda-change-time-span 'year year)
   9117     (error "Abort")))
   9118 
   9119 (defun org-agenda-change-time-span (span &optional n)
   9120   "Change the agenda view to SPAN.
   9121 SPAN may be `day', `week', `fortnight', `month', `year'."
   9122   (org-agenda-check-type t 'agenda)
   9123   (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
   9124 	 (curspan (nth 2 args)))
   9125     (when (and (not n) (equal curspan span))
   9126       (error "Viewing span is already \"%s\"" span))
   9127     (let* ((sd (or (org-get-at-bol 'day)
   9128 		   (nth 1 args)
   9129 		   org-starting-day))
   9130 	   (sd (org-agenda-compute-starting-span sd span n))
   9131 	   (org-agenda-overriding-cmd
   9132 	    (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
   9133 	   (org-agenda-overriding-arguments
   9134 	    (list (car args) sd span)))
   9135       (org-agenda-redo)
   9136       (org-agenda-find-same-or-today-or-agenda))
   9137     (org-agenda-set-mode-name)
   9138     (message "Switched to %s view" span)))
   9139 
   9140 (defun org-agenda-compute-starting-span (sd span &optional n)
   9141   "Compute starting date for agenda.
   9142 SPAN may be `day', `week', `fortnight', `month', `year'.  The return value
   9143 is a cons cell with the starting date and the number of days,
   9144 so that the date SD will be in that range."
   9145   (let* ((greg (calendar-gregorian-from-absolute sd))
   9146 	 ;; (dg (nth 1 greg))
   9147 	 (mg (car greg))
   9148 	 (yg (nth 2 greg)))
   9149     (cond
   9150      ((eq span 'day)
   9151       (when n
   9152 	(setq sd (+ (calendar-absolute-from-gregorian
   9153 		     (list mg 1 yg))
   9154 		    n -1))))
   9155      ((or (eq span 'week) (eq span 'fortnight))
   9156       (let* ((nt (calendar-day-of-week
   9157 		  (calendar-gregorian-from-absolute sd)))
   9158 	     (d (if org-agenda-start-on-weekday
   9159 		    (- nt org-agenda-start-on-weekday)
   9160 		  0))
   9161 	     y1)
   9162 	(setq sd (- sd (+ (if (< d 0) 7 0) d)))
   9163 	(when n
   9164 	  (require 'cal-iso)
   9165 	  (when (> n 99)
   9166 	    (setq y1 (org-small-year-to-year (/ n 100))
   9167 		  n (mod n 100)))
   9168 	  (setq sd
   9169 		(calendar-iso-to-absolute
   9170 		 (list n 1
   9171 		       (or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
   9172      ((eq span 'month)
   9173       (let (y1)
   9174 	(when (and n (> n 99))
   9175 	  (setq y1 (org-small-year-to-year (/ n 100))
   9176 		n (mod n 100)))
   9177 	(setq sd (calendar-absolute-from-gregorian
   9178 		  (list (or n mg) 1 (or y1 yg))))))
   9179      ((eq span 'year)
   9180       (setq sd (calendar-absolute-from-gregorian
   9181 		(list 1 1 (or n yg))))))
   9182     sd))
   9183 
   9184 (defun org-agenda-next-date-line (&optional arg)
   9185   "Jump to the next line indicating a date in agenda buffer."
   9186   (interactive "p")
   9187   (org-agenda-check-type t 'agenda)
   9188   (beginning-of-line 1)
   9189   ;; This does not work if user makes date format that starts with a blank
   9190   (when (looking-at-p "^\\S-") (forward-char 1))
   9191   (unless (re-search-forward "^\\S-" nil t arg)
   9192     (backward-char 1)
   9193     (error "No next date after this line in this buffer"))
   9194   (goto-char (match-beginning 0)))
   9195 
   9196 (defun org-agenda-previous-date-line (&optional arg)
   9197   "Jump to the previous line indicating a date in agenda buffer."
   9198   (interactive "p")
   9199   (org-agenda-check-type t 'agenda)
   9200   (beginning-of-line 1)
   9201   (unless (re-search-backward "^\\S-" nil t arg)
   9202     (error "No previous date before this line in this buffer")))
   9203 
   9204 ;; Initialize the highlight
   9205 (defvar org-hl (make-overlay 1 1))
   9206 (overlay-put org-hl 'face 'highlight)
   9207 
   9208 (defun org-highlight (begin end &optional buffer)
   9209   "Highlight a region with overlay."
   9210   (move-overlay org-hl begin end (or buffer (current-buffer))))
   9211 
   9212 (defun org-unhighlight ()
   9213   "Detach overlay INDEX."
   9214   (delete-overlay org-hl))
   9215 
   9216 (defun org-unhighlight-once ()
   9217   "Remove the highlight from its position, and this function from the hook."
   9218   (remove-hook 'pre-command-hook #'org-unhighlight-once)
   9219   (org-unhighlight))
   9220 
   9221 (defvar org-agenda-pre-follow-window-conf nil)
   9222 (defun org-agenda-follow-mode ()
   9223   "Toggle follow mode in an agenda buffer."
   9224   (interactive)
   9225   (unless org-agenda-follow-mode
   9226     (setq org-agenda-pre-follow-window-conf
   9227 	  (current-window-configuration)))
   9228   (setq org-agenda-follow-mode (not org-agenda-follow-mode))
   9229   (unless org-agenda-follow-mode
   9230     (set-window-configuration org-agenda-pre-follow-window-conf))
   9231   (org-agenda-set-mode-name)
   9232   (org-agenda-do-context-action)
   9233   (message "Follow mode is %s"
   9234 	   (if org-agenda-follow-mode "on" "off")))
   9235 
   9236 (defun org-agenda-entry-text-mode (&optional arg)
   9237   "Toggle entry text mode in an agenda buffer."
   9238   (interactive "P")
   9239   (if (or org-agenda-tag-filter
   9240 	  org-agenda-category-filter
   9241 	  org-agenda-regexp-filter
   9242 	  org-agenda-top-headline-filter)
   9243       (user-error "Can't show entry text in filtered views")
   9244     (setq org-agenda-entry-text-mode (or (integerp arg)
   9245 					 (not org-agenda-entry-text-mode)))
   9246     (org-agenda-entry-text-hide)
   9247     (and org-agenda-entry-text-mode
   9248 	 (let ((org-agenda-entry-text-maxlines
   9249 		(if (integerp arg) arg org-agenda-entry-text-maxlines)))
   9250 	   (org-agenda-entry-text-show)))
   9251     (org-agenda-set-mode-name)
   9252     (message "Entry text mode is %s%s"
   9253 	     (if org-agenda-entry-text-mode "on" "off")
   9254 	     (if (not org-agenda-entry-text-mode) ""
   9255 	       (format " (maximum number of lines is %d)"
   9256 		       (if (integerp arg) arg org-agenda-entry-text-maxlines))))))
   9257 
   9258 (defun org-agenda-clockreport-mode ()
   9259   "Toggle clocktable mode in an agenda buffer."
   9260   (interactive)
   9261   (org-agenda-check-type t 'agenda)
   9262   (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))
   9263   (org-agenda-set-mode-name)
   9264   (org-agenda-redo)
   9265   (message "Clocktable mode is %s"
   9266 	   (if org-agenda-clockreport-mode "on" "off")))
   9267 
   9268 (defun org-agenda-log-mode (&optional special)
   9269   "Toggle log mode in an agenda buffer.
   9270 
   9271 With argument SPECIAL, show all possible log items, not only the ones
   9272 configured in `org-agenda-log-mode-items'.
   9273 
   9274 With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
   9275 log items, nothing else."
   9276   (interactive "P")
   9277   (org-agenda-check-type t 'agenda)
   9278   (setq org-agenda-show-log
   9279 	(cond
   9280 	 ((equal special '(16)) 'only)
   9281 	 ((eq special 'clockcheck)
   9282 	  (if (eq org-agenda-show-log 'clockcheck)
   9283 	      nil 'clockcheck))
   9284 	 (special '(closed clock state))
   9285 	 (t (not org-agenda-show-log))))
   9286   (org-agenda-set-mode-name)
   9287   (org-agenda-redo)
   9288   (message "Log mode is %s" (if org-agenda-show-log "on" "off")))
   9289 
   9290 (defun org-agenda-archives-mode (&optional with-files)
   9291   "Toggle inclusion of items in trees marked with :ARCHIVE:.
   9292 When called with a prefix argument, include all archive files as well."
   9293   (interactive "P")
   9294   (setq org-agenda-archives-mode
   9295 	(cond ((and with-files (eq org-agenda-archives-mode t)) nil)
   9296 	      (with-files t)
   9297 	      (org-agenda-archives-mode nil)
   9298 	      (t 'trees)))
   9299   (org-agenda-set-mode-name)
   9300   (org-agenda-redo)
   9301   (message
   9302    "%s"
   9303    (cond
   9304     ((eq org-agenda-archives-mode nil)
   9305      "No archives are included")
   9306     ((eq org-agenda-archives-mode 'trees)
   9307      (format "Trees with :%s: tag are included" org-archive-tag))
   9308     ((eq org-agenda-archives-mode t)
   9309      (format "Trees with :%s: tag and all active archive files are included"
   9310 	     org-archive-tag)))))
   9311 
   9312 (defun org-agenda-toggle-diary ()
   9313   "Toggle diary inclusion in an agenda buffer."
   9314   (interactive)
   9315   (org-agenda-check-type t 'agenda)
   9316   (setq org-agenda-include-diary (not org-agenda-include-diary))
   9317   (org-agenda-redo)
   9318   (org-agenda-set-mode-name)
   9319   (message "Diary inclusion turned %s"
   9320 	   (if org-agenda-include-diary "on" "off")))
   9321 
   9322 (defun org-agenda-toggle-deadlines ()
   9323   "Toggle inclusion of entries with a deadline in an agenda buffer."
   9324   (interactive)
   9325   (org-agenda-check-type t 'agenda)
   9326   (setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
   9327   (org-agenda-redo)
   9328   (org-agenda-set-mode-name)
   9329   (message "Deadlines inclusion turned %s"
   9330 	   (if org-agenda-include-deadlines "on" "off")))
   9331 
   9332 (defun org-agenda-toggle-time-grid ()
   9333   "Toggle time grid in an agenda buffer."
   9334   (interactive)
   9335   (org-agenda-check-type t 'agenda)
   9336   (setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
   9337   (org-agenda-redo)
   9338   (org-agenda-set-mode-name)
   9339   (message "Time-grid turned %s"
   9340 	   (if org-agenda-use-time-grid "on" "off")))
   9341 
   9342 (defun org-agenda-set-mode-name ()
   9343   "Set the mode name to indicate all the small mode settings."
   9344   (setq mode-name
   9345 	(list "Org-Agenda"
   9346 	      (if (get 'org-agenda-files 'org-restrict) " []" "")
   9347 	      " "
   9348 	      '(:eval (org-agenda-span-name org-agenda-current-span))
   9349 	      (if org-agenda-follow-mode     " Follow" "")
   9350 	      (if org-agenda-entry-text-mode " ETxt"   "")
   9351 	      (if org-agenda-include-diary   " Diary"  "")
   9352 	      (if org-agenda-include-deadlines " Ddl"  "")
   9353 	      (if org-agenda-use-time-grid   " Grid"   "")
   9354 	      (if (and (boundp 'org-habit-show-habits)
   9355 		       org-habit-show-habits)
   9356 		  " Habit"   "")
   9357 	      (cond
   9358 	       ((consp org-agenda-show-log) " LogAll")
   9359 	       ((eq org-agenda-show-log 'clockcheck) " ClkCk")
   9360 	       (org-agenda-show-log " Log")
   9361 	       (t ""))
   9362 	      (if (org-agenda-filter-any) " " "")
   9363 	      (if (or org-agenda-category-filter
   9364 		      (assoc-default 'category org-agenda-filters-preset))
   9365 		  '(:eval (propertize
   9366 			   (concat "["
   9367 	      			   (mapconcat
   9368                                     #'identity
   9369 	      			    (append
   9370                                      (assoc-default 'category org-agenda-filters-preset)
   9371 	      			     org-agenda-category-filter)
   9372 	      			    "")
   9373 				   "]")
   9374 	      		   'face 'org-agenda-filter-category
   9375                            'help-echo "Category used in filtering"))
   9376                 "")
   9377 	      (if (or org-agenda-tag-filter
   9378 		      (assoc-default 'tag org-agenda-filters-preset))
   9379 		  '(:eval (propertize
   9380 			   (concat (mapconcat
   9381 				    #'identity
   9382 				    (append
   9383 				     (assoc-default 'tag org-agenda-filters-preset)
   9384 				     org-agenda-tag-filter)
   9385 				    ""))
   9386 			   'face 'org-agenda-filter-tags
   9387 			   'help-echo "Tags used in filtering"))
   9388 		"")
   9389 	      (if (or org-agenda-effort-filter
   9390 		      (assoc-default 'effort org-agenda-filters-preset))
   9391 		  '(:eval (propertize
   9392 			   (concat (mapconcat
   9393 				    #'identity
   9394 				    (append
   9395 				     (assoc-default 'effort org-agenda-filters-preset)
   9396 				     org-agenda-effort-filter)
   9397 				    ""))
   9398 			   'face 'org-agenda-filter-effort
   9399 			   'help-echo "Effort conditions used in filtering"))
   9400 		"")
   9401 	      (if (or org-agenda-regexp-filter
   9402 		      (assoc-default 'regexp org-agenda-filters-preset))
   9403 		  '(:eval (propertize
   9404 			   (concat (mapconcat
   9405 				    (lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/"))
   9406 				    (append
   9407 				     (assoc-default 'regexp org-agenda-filters-preset)
   9408 				     org-agenda-regexp-filter)
   9409 				    ""))
   9410 			   'face 'org-agenda-filter-regexp
   9411 			   'help-echo "Regexp used in filtering"))
   9412 		"")
   9413 	      (if org-agenda-archives-mode
   9414 		  (if (eq org-agenda-archives-mode t)
   9415 		      " Archives"
   9416 		    (format " :%s:" org-archive-tag))
   9417 		"")
   9418 	      (if org-agenda-clockreport-mode " Clock" "")))
   9419   (force-mode-line-update))
   9420 
   9421 (defun org-agenda-update-agenda-type ()
   9422   "Update the agenda type after each command."
   9423   (setq org-agenda-type
   9424 	(or (get-text-property (point) 'org-agenda-type)
   9425 	    (get-text-property (max (point-min) (1- (point))) 'org-agenda-type))))
   9426 
   9427 (defun org-agenda-next-line ()
   9428   "Move cursor to the next line, and show if follow mode is active."
   9429   (interactive)
   9430   (call-interactively 'next-line)
   9431   (org-agenda-do-context-action))
   9432 
   9433 (defun org-agenda-previous-line ()
   9434   "Move cursor to the previous line, and show if follow-mode is active."
   9435   (interactive)
   9436   (call-interactively 'previous-line)
   9437   (org-agenda-do-context-action))
   9438 
   9439 (defun org-agenda-next-item (n)
   9440   "Move cursor to next agenda item."
   9441   (interactive "p")
   9442   (let ((col (current-column)))
   9443     (dotimes (_ n)
   9444       (when (next-single-property-change (line-end-position) 'org-marker)
   9445 	(move-end-of-line 1)
   9446 	(goto-char (next-single-property-change (point) 'org-marker))))
   9447     (org-move-to-column col))
   9448   (org-agenda-do-context-action))
   9449 
   9450 (defun org-agenda-previous-item (n)
   9451   "Move cursor to next agenda item."
   9452   (interactive "p")
   9453   (dotimes (_ n)
   9454     (let ((col (current-column))
   9455 	  (goto (save-excursion
   9456 		  (move-end-of-line 0)
   9457 		  (previous-single-property-change (point) 'org-marker))))
   9458       (when goto (goto-char goto))
   9459       (org-move-to-column col)))
   9460   (org-agenda-do-context-action))
   9461 
   9462 (defun org-agenda-do-context-action ()
   9463   "Show outline path and, maybe, follow mode window."
   9464   (let ((m (org-get-at-bol 'org-marker)))
   9465     (when (and (markerp m) (marker-buffer m))
   9466       (and org-agenda-follow-mode
   9467 	   (if org-agenda-follow-indirect
   9468 	       (org-agenda-tree-to-indirect-buffer nil)
   9469 	     (org-agenda-show)))
   9470       (and org-agenda-show-outline-path
   9471 	   (org-with-point-at m (org-display-outline-path org-agenda-show-outline-path))))))
   9472 
   9473 (defun org-agenda-show-tags ()
   9474   "Show the tags applicable to the current item."
   9475   (interactive)
   9476   (let* ((tags (org-get-at-bol 'tags)))
   9477     (if tags
   9478 	(message "Tags are :%s:"
   9479 		 (org-no-properties (mapconcat #'identity tags ":")))
   9480       (message "No tags associated with this line"))))
   9481 
   9482 (defun org-agenda-goto (&optional highlight)
   9483   "Go to the entry at point in the corresponding Org file."
   9484   (interactive)
   9485   (let* ((marker (or (org-get-at-bol 'org-marker)
   9486 		     (org-agenda-error)))
   9487 	 (buffer (marker-buffer marker))
   9488 	 (pos (marker-position marker)))
   9489     ;; FIXME: use `org-switch-to-buffer-other-window'?
   9490     (switch-to-buffer-other-window buffer)
   9491     (widen)
   9492     (push-mark)
   9493     (goto-char pos)
   9494     (when (derived-mode-p 'org-mode)
   9495       (org-fold-show-context 'agenda)
   9496       (recenter (/ (window-height) 2))
   9497       (org-back-to-heading t)
   9498       (let ((case-fold-search nil))
   9499 	(when (re-search-forward org-complex-heading-regexp nil t)
   9500 	  (goto-char (match-beginning 4)))))
   9501     (run-hooks 'org-agenda-after-show-hook)
   9502     (and highlight (org-highlight (line-beginning-position)
   9503                                   (line-end-position)))))
   9504 
   9505 (defvar org-agenda-after-show-hook nil
   9506   "Normal hook run after an item has been shown from the agenda.
   9507 Point is in the buffer where the item originated.")
   9508 
   9509 ;; Defined later in org-agenda.el
   9510 (defvar org-agenda-loop-over-headlines-in-active-region nil)
   9511 
   9512 (defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete)
   9513   "Between region BEG and END, call agenda command CMD.
   9514 When optional argument ARG is non-nil or FORCE-ARG is t, pass
   9515 ARG to CMD.  When optional argument DELETE is non-nil, assume CMD
   9516 deletes the agenda entry and don't move to the next entry."
   9517   (save-excursion
   9518     (goto-char beg)
   9519     (let ((mend (move-marker (make-marker) end))
   9520 	  (all (eq org-agenda-loop-over-headlines-in-active-region t))
   9521 	  (match (and (stringp org-agenda-loop-over-headlines-in-active-region)
   9522 		      org-agenda-loop-over-headlines-in-active-region))
   9523 	  (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level)
   9524 		      (org-get-at-bol 'level))))
   9525       (while (< (point) mend)
   9526         (let ((ov (make-overlay (point) (line-end-position))))
   9527 	  (if (not (or all
   9528 		     (and match (looking-at-p match))
   9529 		     (eq level (org-get-at-bol 'level))))
   9530 	      (org-agenda-next-item 1)
   9531 	    (overlay-put ov 'face 'region)
   9532 	    (if (or arg force-arg) (funcall cmd arg) (funcall cmd))
   9533 	    (when (not delete) (org-agenda-next-item 1))
   9534 	    (delete-overlay ov)))))))
   9535 
   9536 ;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*,
   9537 ;; kill,set-property,set-effort] commands may loop over agenda
   9538 ;; entries.  Commands `org-agenda-set-tags' and `org-agenda-bulk-mark'
   9539 ;; use their own mechanisms on active regions.
   9540 (defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body)
   9541   "Maybe loop over agenda entries and perform CMD.
   9542 Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'."
   9543   (declare (debug t))
   9544   `(if (and (called-interactively-p 'any)
   9545 	    org-agenda-loop-over-headlines-in-active-region
   9546 	    (org-region-active-p))
   9547        (org-agenda-do-in-region
   9548 	(region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete)
   9549      ,@body))
   9550 
   9551 (defun org-agenda-kill ()
   9552   "Kill the entry or subtree belonging to the current agenda entry."
   9553   (interactive)
   9554   (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
   9555   (org-agenda-maybe-loop
   9556    #'org-agenda-kill nil nil t
   9557    (let* ((bufname-orig (buffer-name))
   9558 	  (marker (or (org-get-at-bol 'org-marker)
   9559 		      (org-agenda-error)))
   9560 	  (buffer (marker-buffer marker))
   9561 	  (pos (marker-position marker))
   9562 	  (type (org-get-at-bol 'type))
   9563 	  dbeg dend (n 0))
   9564      (org-with-remote-undo buffer
   9565        (with-current-buffer buffer
   9566 	 (save-excursion
   9567 	   (goto-char pos)
   9568 	   (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
   9569 	       (setq dbeg (progn (org-back-to-heading t) (point))
   9570 		     dend (org-end-of-subtree t t))
   9571              (setq dbeg (line-beginning-position)
   9572                    dend (min (point-max) (1+ (line-end-position)))))
   9573 	   (goto-char dbeg)
   9574 	   (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
   9575        (when (or (eq t org-agenda-confirm-kill)
   9576 		 (and (numberp org-agenda-confirm-kill)
   9577 		      (> n org-agenda-confirm-kill)))
   9578 	 (let ((win-conf (current-window-configuration)))
   9579 	   (unwind-protect
   9580 	       (and
   9581 		(prog2
   9582 		    (org-agenda-tree-to-indirect-buffer nil)
   9583 		    (not (y-or-n-p
   9584 			(format "Delete entry with %d lines in buffer \"%s\"? "
   9585 				n (buffer-name buffer))))
   9586 		  (kill-buffer org-last-indirect-buffer))
   9587 		(error "Abort"))
   9588 	     (set-window-configuration win-conf))))
   9589        (let ((org-agenda-buffer-name bufname-orig))
   9590 	 (org-remove-subtree-entries-from-agenda buffer dbeg dend))
   9591        (with-current-buffer buffer (delete-region dbeg dend))
   9592        (message "Agenda item and source killed")))))
   9593 
   9594 (defvar org-archive-default-command) ; defined in org-archive.el
   9595 (defun org-agenda-archive-default ()
   9596   "Archive the entry or subtree belonging to the current agenda entry."
   9597   (interactive)
   9598   (require 'org-archive)
   9599   (funcall-interactively
   9600    #'org-agenda-archive-with org-archive-default-command))
   9601 
   9602 (defun org-agenda-archive-default-with-confirmation ()
   9603   "Archive the entry or subtree belonging to the current agenda entry."
   9604   (interactive)
   9605   (require 'org-archive)
   9606   (funcall-interactively
   9607    #'org-agenda-archive-with org-archive-default-command 'confirm))
   9608 
   9609 (defun org-agenda-archive ()
   9610   "Archive the entry or subtree belonging to the current agenda entry."
   9611   (interactive)
   9612   (funcall-interactively
   9613    #'org-agenda-archive-with 'org-archive-subtree))
   9614 
   9615 (defun org-agenda-archive-to-archive-sibling ()
   9616   "Move the entry to the archive sibling."
   9617   (interactive)
   9618   (funcall-interactively
   9619    #'org-agenda-archive-with 'org-archive-to-archive-sibling))
   9620 
   9621 (defvar org-archive-from-agenda)
   9622 
   9623 (defun org-agenda-archive-with (cmd &optional confirm)
   9624   "Move the entry to the archive sibling."
   9625   (interactive)
   9626   (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
   9627   (org-agenda-maybe-loop
   9628    #'org-agenda-archive-with cmd nil t
   9629    (let* ((bufname-orig (buffer-name))
   9630 	  (marker (or (org-get-at-bol 'org-marker)
   9631 		      (org-agenda-error)))
   9632 	  (buffer (marker-buffer marker))
   9633 	  (pos (marker-position marker)))
   9634      (org-with-remote-undo buffer
   9635        (with-current-buffer buffer
   9636 	 (if (derived-mode-p 'org-mode)
   9637 	     (if (and confirm
   9638 		      (not (y-or-n-p "Archive this subtree or entry? ")))
   9639 		 (error "Abort")
   9640 	       (save-window-excursion
   9641 		 (goto-char pos)
   9642 		 (let ((org-agenda-buffer-name bufname-orig))
   9643 		   (org-remove-subtree-entries-from-agenda))
   9644 		 (org-back-to-heading t)
   9645 		 (let ((org-archive-from-agenda t))
   9646 		   (funcall cmd))))
   9647 	   (error "Archiving works only in Org files")))))))
   9648 
   9649 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
   9650   "Remove all lines in the agenda that correspond to a given subtree.
   9651 The subtree is the one in buffer BUF, starting at BEG and ending at END.
   9652 If this information is not given, the function uses the tree at point."
   9653   (let ((buf (or buf (current-buffer))) m p)
   9654     (save-excursion
   9655       (unless (and beg end)
   9656 	(org-back-to-heading t)
   9657 	(setq beg (point))
   9658 	(org-end-of-subtree t)
   9659 	(setq end (point)))
   9660       (set-buffer (get-buffer org-agenda-buffer-name))
   9661       (save-excursion
   9662 	(goto-char (point-max))
   9663 	(beginning-of-line 1)
   9664 	(while (not (bobp))
   9665 	  (when (and (setq m (org-get-at-bol 'org-marker))
   9666 		     (equal buf (marker-buffer m))
   9667 		     (setq p (marker-position m))
   9668 		     (>= p beg)
   9669 		     (< p end))
   9670 	    (let ((inhibit-read-only t))
   9671               (delete-region (line-beginning-position)
   9672                              (1+ (line-end-position)))))
   9673 	  (beginning-of-line 0))))))
   9674 
   9675 (defun org-agenda-refile (&optional goto rfloc no-update)
   9676   "Refile the item at point.
   9677 
   9678 When called with `\\[universal-argument] \\[universal-argument]', \
   9679 go to the location of the last
   9680 refiled item.
   9681 
   9682 When called with `\\[universal-argument] \\[universal-argument] \
   9683 \\[universal-argument]' prefix or when GOTO is 0, clear
   9684 the refile cache.
   9685 
   9686 RFLOC can be a refile location obtained in a different way.
   9687 
   9688 When NO-UPDATE is non-nil, don't redo the agenda buffer."
   9689   (interactive "P")
   9690   (cond
   9691    ((member goto '(0 (64)))
   9692     (org-refile-cache-clear))
   9693    ((equal goto '(16))
   9694     (org-refile-goto-last-stored))
   9695    (t
   9696     (let* ((buffer-orig (buffer-name))
   9697 	   (marker (or (org-get-at-bol 'org-hd-marker)
   9698 		       (org-agenda-error)))
   9699 	   (buffer (marker-buffer marker))
   9700 	   ;; (pos (marker-position marker))
   9701 	   (rfloc (or rfloc
   9702 		      (org-refile-get-location
   9703 		       (if goto "Goto" "Refile to") buffer
   9704 		       org-refile-allow-creating-parent-nodes))))
   9705       (with-current-buffer buffer
   9706 	(org-with-wide-buffer
   9707 	 (goto-char marker)
   9708 	 (let ((org-agenda-buffer-name buffer-orig))
   9709 	   (org-remove-subtree-entries-from-agenda))
   9710 	 (org-refile goto buffer rfloc))))
   9711     (unless no-update (org-agenda-redo)))))
   9712 
   9713 (defun org-agenda-open-link (&optional arg)
   9714   "Open the link(s) in the current entry, if any.
   9715 This looks for a link in the displayed line in the agenda.
   9716 It also looks at the text of the entry itself."
   9717   (interactive "P")
   9718   (let* ((marker (or (org-get-at-bol 'org-hd-marker)
   9719 		     (org-get-at-bol 'org-marker)))
   9720 	 (buffer (and marker (marker-buffer marker)))
   9721          (prefix (buffer-substring (line-beginning-position)
   9722                                    (line-end-position)))
   9723 	 (lkall (and buffer (org-offer-links-in-entry
   9724 			     buffer marker arg prefix)))
   9725 	 (lk0 (car lkall))
   9726 	 (lk (if (stringp lk0) (list lk0) lk0))
   9727 	 (lkend (cdr lkall))
   9728 	 trg)
   9729     (cond
   9730      ((and buffer lk)
   9731       (mapcar (lambda(l)
   9732 		(with-current-buffer buffer
   9733 		  (setq trg (and (string-match org-link-bracket-re l)
   9734 				 (match-string 1 l)))
   9735 		  (if (or (not trg) (string-match org-link-any-re trg))
   9736 		      ;; Don't use `org-with-wide-buffer' here as
   9737 		      ;; opening the link may result in moving the point
   9738 		      (save-restriction
   9739 			(widen)
   9740 			(goto-char marker)
   9741 			(when (search-forward l nil lkend)
   9742 			  (goto-char (match-beginning 0))
   9743 			  (org-open-at-point)))
   9744 		    ;; This is an internal link, widen the buffer
   9745 		    ;; FIXME: use `org-switch-to-buffer-other-window'?
   9746 		    (switch-to-buffer-other-window buffer)
   9747 		    (widen)
   9748 		    (goto-char marker)
   9749 		    (when (search-forward l nil lkend)
   9750 		      (goto-char (match-beginning 0))
   9751 		      (org-open-at-point)))))
   9752 	      lk))
   9753      ((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)"))
   9754 	  (save-excursion
   9755 	    (beginning-of-line 1)
   9756 	    (looking-at (concat ".*?\\(" org-link-bracket-re "\\)"))))
   9757       (org-link-open-from-string (match-string 1)))
   9758      (t (message "No link to open here")))))
   9759 
   9760 (defun org-agenda-copy-local-variable (var)
   9761   "Get a variable from a referenced buffer and install it here."
   9762   (let ((m (org-get-at-bol 'org-marker)))
   9763     (when (and m (buffer-live-p (marker-buffer m)))
   9764       (set (make-local-variable var)
   9765 	   (with-current-buffer (marker-buffer m)
   9766 	     (symbol-value var))))))
   9767 
   9768 (defun org-agenda-switch-to (&optional delete-other-windows)
   9769   "Go to the Org mode file which contains the item at point.
   9770 When optional argument DELETE-OTHER-WINDOWS is non-nil, the
   9771 displayed Org file fills the frame."
   9772   (interactive)
   9773   (if (and org-return-follows-link
   9774 	   (not (org-get-at-bol 'org-marker))
   9775 	   (org-in-regexp org-link-bracket-re))
   9776       (org-link-open-from-string (match-string 0))
   9777     (let* ((marker (or (org-get-at-bol 'org-marker)
   9778 		       (org-agenda-error)))
   9779 	   (buffer (marker-buffer marker))
   9780 	   (pos (marker-position marker)))
   9781       (unless buffer (user-error "Trying to switch to non-existent buffer"))
   9782       (pop-to-buffer-same-window buffer)
   9783       (when delete-other-windows (delete-other-windows))
   9784       (widen)
   9785       (goto-char pos)
   9786       (when (derived-mode-p 'org-mode)
   9787 	(org-fold-show-context 'agenda)
   9788 	(run-hooks 'org-agenda-after-show-hook)))))
   9789 
   9790 (defun org-agenda-goto-mouse (ev)
   9791   "Go to the Org file which contains the item at the mouse click."
   9792   (interactive "e")
   9793   (mouse-set-point ev)
   9794   (org-agenda-goto))
   9795 
   9796 (defun org-agenda-show (&optional full-entry)
   9797   "Display the Org file which contains the item at point.
   9798 With prefix argument FULL-ENTRY, make the entire entry visible
   9799 if it was hidden in the outline."
   9800   (interactive "P")
   9801   (let ((win (selected-window)))
   9802     (org-agenda-goto t)
   9803     (when full-entry (org-fold-show-entry 'hide-drawers))
   9804     (select-window win)))
   9805 
   9806 (defvar org-agenda-show-window nil)
   9807 (defun org-agenda-show-and-scroll-up (&optional arg)
   9808   "Display the Org file which contains the item at point.
   9809 
   9810 When called repeatedly, scroll the window that is displaying the buffer.
   9811 
   9812 With a `\\[universal-argument]' prefix argument, display the item, but \
   9813 fold drawers."
   9814   (interactive "P")
   9815   (let ((win (selected-window)))
   9816     (if (and (window-live-p org-agenda-show-window)
   9817 	     (eq this-command last-command))
   9818 	(progn
   9819 	  (select-window org-agenda-show-window)
   9820 	  (ignore-errors (scroll-up)))
   9821       (org-agenda-goto t)
   9822       (org-fold-show-entry 'hide-drawers)
   9823       (if arg (org-cycle-hide-drawers 'children)
   9824 	(org-with-wide-buffer
   9825 	 (narrow-to-region (org-entry-beginning-position)
   9826 			   (org-entry-end-position))
   9827 	 (org-fold-show-all '(drawers))))
   9828       (setq org-agenda-show-window (selected-window)))
   9829     (select-window win)))
   9830 
   9831 (defun org-agenda-show-scroll-down ()
   9832   "Scroll down the window showing the agenda."
   9833   (interactive)
   9834   (let ((win (selected-window)))
   9835     (when (window-live-p org-agenda-show-window)
   9836       (select-window org-agenda-show-window)
   9837       (ignore-errors (scroll-down))
   9838       (select-window win))))
   9839 
   9840 (defun org-agenda-show-1 (&optional more)
   9841   "Display the Org file which contains the item at point.
   9842 The prefix arg selects the amount of information to display:
   9843 
   9844 0   hide the subtree
   9845 1   just show the entry according to defaults.
   9846 2   show the children view
   9847 3   show the subtree view
   9848 4   show the entire subtree and any drawers
   9849 With prefix argument FULL-ENTRY, make the entire entry visible
   9850 if it was hidden in the outline."
   9851   (interactive "p")
   9852   (let ((win (selected-window)))
   9853     (org-agenda-goto t)
   9854     (org-back-to-heading)
   9855     (set-window-start (selected-window) (line-beginning-position))
   9856     (cond
   9857      ((= more 0)
   9858       (org-fold-subtree t)
   9859       (save-excursion
   9860 	(org-back-to-heading)
   9861 	(run-hook-with-args 'org-cycle-hook 'folded))
   9862       (message "Remote: FOLDED"))
   9863      ((and (called-interactively-p 'any) (= more 1))
   9864       (message "Remote: show with default settings"))
   9865      ((= more 2)
   9866       (org-fold-show-entry 'hide-drawers)
   9867       (org-fold-show-children)
   9868       (save-excursion
   9869 	(org-back-to-heading)
   9870 	(run-hook-with-args 'org-cycle-hook 'children))
   9871       (message "Remote: CHILDREN"))
   9872      ((= more 3)
   9873       (org-fold-show-subtree)
   9874       (save-excursion
   9875 	(org-back-to-heading)
   9876 	(run-hook-with-args 'org-cycle-hook 'subtree))
   9877       (message "Remote: SUBTREE"))
   9878      ((> more 3)
   9879       (org-fold-show-subtree)
   9880       (message "Remote: SUBTREE AND ALL DRAWERS")))
   9881     (select-window win)))
   9882 
   9883 (defvar org-agenda-cycle-counter nil)
   9884 (defun org-agenda-cycle-show (&optional n)
   9885   "Show the current entry in another window, with default settings.
   9886 
   9887 Default settings are taken from `org-show-context-detail'.  When
   9888 use repeatedly in immediate succession, the remote entry will
   9889 cycle through visibility
   9890 
   9891   children -> subtree -> folded
   9892 
   9893 When called with a numeric prefix arg, that arg will be passed through to
   9894 `org-agenda-show-1'.  For the interpretation of that argument, see the
   9895 docstring of `org-agenda-show-1'."
   9896   (interactive "P")
   9897   (if (integerp n)
   9898       (setq org-agenda-cycle-counter n)
   9899     (if (not (eq last-command this-command))
   9900 	(setq org-agenda-cycle-counter 1)
   9901       (if (equal org-agenda-cycle-counter 0)
   9902 	  (setq org-agenda-cycle-counter 2)
   9903 	(setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter))
   9904 	(when (> org-agenda-cycle-counter 3)
   9905 	  (setq org-agenda-cycle-counter 0)))))
   9906   (org-agenda-show-1 org-agenda-cycle-counter))
   9907 
   9908 (defun org-agenda-recenter (arg)
   9909   "Display the Org file which contains the item at point and recenter."
   9910   (interactive "P")
   9911   (let ((win (selected-window)))
   9912     (org-agenda-goto t)
   9913     (recenter arg)
   9914     (select-window win)))
   9915 
   9916 (defun org-agenda-show-mouse (ev)
   9917   "Display the Org file which contains the item at the mouse click."
   9918   (interactive "e")
   9919   (mouse-set-point ev)
   9920   (org-agenda-show))
   9921 
   9922 (defun org-agenda-check-no-diary ()
   9923   "Check if the entry is a diary link and abort if yes."
   9924   (when (org-get-at-bol 'org-agenda-diary-link)
   9925     (org-agenda-error)))
   9926 
   9927 (defun org-agenda-error ()
   9928   "Throw an error when a command is not allowed in the agenda."
   9929   (user-error "Command not allowed in this line"))
   9930 
   9931 (defun org-agenda-tree-to-indirect-buffer (arg)
   9932   "Show the subtree corresponding to the current entry in an indirect buffer.
   9933 This calls the command `org-tree-to-indirect-buffer' from the original buffer.
   9934 
   9935 With a numerical prefix ARG, go up to this level and then take that tree.
   9936 With a negative numeric ARG, go up by this number of levels.
   9937 
   9938 With a `\\[universal-argument]' prefix, make a separate frame for this tree, \
   9939 i.e. don't use
   9940 the dedicated frame."
   9941   (interactive "P")
   9942   (if current-prefix-arg
   9943       (org-agenda-do-tree-to-indirect-buffer arg)
   9944     (let ((agenda-buffer (buffer-name))
   9945 	  (agenda-window (selected-window))
   9946           (indirect-window
   9947 	   (and org-last-indirect-buffer
   9948 		(get-buffer-window org-last-indirect-buffer))))
   9949       (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg))
   9950       (unless (or (eq org-indirect-buffer-display 'new-frame)
   9951 		  (eq org-indirect-buffer-display 'dedicated-frame))
   9952 	(unwind-protect
   9953 	    (unless (and indirect-window (window-live-p indirect-window))
   9954 	      (setq indirect-window (split-window agenda-window)))
   9955 	  (and indirect-window (select-window indirect-window))
   9956 	  (switch-to-buffer org-last-indirect-buffer :norecord)
   9957 	  (fit-window-to-buffer indirect-window)))
   9958       (select-window (get-buffer-window agenda-buffer))
   9959       (setq org-agenda-last-indirect-buffer org-last-indirect-buffer))))
   9960 
   9961 (defun org-agenda-do-tree-to-indirect-buffer (arg)
   9962   "Same as `org-agenda-tree-to-indirect-buffer' without saving window."
   9963   (org-agenda-check-no-diary)
   9964   (let* ((marker (or (org-get-at-bol 'org-marker)
   9965 		     (org-agenda-error)))
   9966 	 (buffer (marker-buffer marker))
   9967 	 (pos (marker-position marker)))
   9968     (with-current-buffer buffer
   9969       (save-excursion
   9970 	(goto-char pos)
   9971 	(org-tree-to-indirect-buffer arg)))))
   9972 
   9973 (defvar org-last-heading-marker (make-marker)
   9974   "Marker pointing to the headline that last changed its TODO state
   9975 by a remote command from the agenda.")
   9976 
   9977 (defun org-agenda-todo-nextset ()
   9978   "Switch TODO entry to next sequence."
   9979   (interactive)
   9980   (org-agenda-todo 'nextset))
   9981 
   9982 (defun org-agenda-todo-previousset ()
   9983   "Switch TODO entry to previous sequence."
   9984   (interactive)
   9985   (org-agenda-todo 'previousset))
   9986 
   9987 (defvar org-agenda-headline-snapshot-before-repeat)
   9988 
   9989 (defun org-agenda-todo (&optional arg)
   9990   "Cycle TODO state of line at point, also in Org file.
   9991 This changes the line at point, all other lines in the agenda referring to
   9992 the same tree node, and the headline of the tree node in the Org file."
   9993   (interactive "P")
   9994   (org-agenda-check-no-diary)
   9995   (org-agenda-maybe-loop
   9996    #'org-agenda-todo arg nil nil
   9997    (let* ((col (current-column))
   9998 	  (marker (or (org-get-at-bol 'org-marker)
   9999 		      (org-agenda-error)))
  10000 	  (buffer (marker-buffer marker))
  10001 	  (pos (marker-position marker))
  10002 	  (hdmarker (org-get-at-bol 'org-hd-marker))
  10003 	  (todayp (org-agenda-today-p (org-get-at-bol 'day)))
  10004 	  (inhibit-read-only t)
  10005 	  org-loop-over-headlines-in-active-region
  10006 	  org-agenda-headline-snapshot-before-repeat newhead just-one)
  10007      (org-with-remote-undo buffer
  10008        (with-current-buffer buffer
  10009 	 (widen)
  10010 	 (goto-char pos)
  10011 	 (org-fold-show-context 'agenda)
  10012 	 (let ((current-prefix-arg arg))
  10013 	   (call-interactively 'org-todo)
  10014            ;; Make sure that log is recorded in current undo.
  10015            (when (and org-log-setup
  10016                       (not (eq org-log-note-how 'note)))
  10017              (org-add-log-note)))
  10018 	 (and (bolp) (forward-char 1))
  10019 	 (setq newhead (org-get-heading))
  10020 	 (when (and org-agenda-headline-snapshot-before-repeat
  10021 		    (not (equal org-agenda-headline-snapshot-before-repeat
  10022 				newhead))
  10023 		    todayp)
  10024 	   (setq newhead org-agenda-headline-snapshot-before-repeat
  10025 		 just-one t))
  10026 	 (save-excursion
  10027 	   (org-back-to-heading)
  10028 	   (move-marker org-last-heading-marker (point))))
  10029        (beginning-of-line 1)
  10030        (save-window-excursion
  10031 	 (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
  10032        (when (bound-and-true-p org-clock-out-when-done)
  10033 	 (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
  10034 		       newhead)
  10035 	 (org-agenda-unmark-clocking-task))
  10036        (org-move-to-column col)
  10037        (org-agenda-mark-clocking-task)))))
  10038 
  10039 (defun org-agenda-add-note (&optional _arg)
  10040   "Add a time-stamped note to the entry at point."
  10041   (interactive) ;; "P"
  10042   (org-agenda-check-no-diary)
  10043   (let* ((marker (or (org-get-at-bol 'org-marker)
  10044 		     (org-agenda-error)))
  10045 	 (buffer (marker-buffer marker))
  10046 	 (pos (marker-position marker))
  10047 	 (_hdmarker (org-get-at-bol 'org-hd-marker))
  10048 	 (inhibit-read-only t))
  10049     (with-current-buffer buffer
  10050       (widen)
  10051       (goto-char pos)
  10052       (org-fold-show-context 'agenda)
  10053       (org-add-note))))
  10054 
  10055 (defun org-agenda-change-all-lines (newhead hdmarker
  10056 				            &optional fixface just-this)
  10057   "Change all lines in the agenda buffer which match HDMARKER.
  10058 The new content of the line will be NEWHEAD (as modified by
  10059 `org-agenda-format-item').  HDMARKER is checked with
  10060 `equal' against all `org-hd-marker' text properties in the file.
  10061 If FIXFACE is non-nil, the face of each item is modified according to
  10062 the new TODO state.
  10063 If JUST-THIS is non-nil, change just the current line, not all.
  10064 If FORCE-TAGS is non-nil, the car of it returns the new tags."
  10065   (let* ((inhibit-read-only t)
  10066 	 (line (org-current-line))
  10067 	 (org-agenda-buffer (current-buffer))
  10068 	 (thetags (with-current-buffer (marker-buffer hdmarker)
  10069 		    (org-get-tags hdmarker)))
  10070 	 props m undone-face done-face finish new dotime level cat tags
  10071          effort effort-minutes) ;; pl
  10072     (save-excursion
  10073       (goto-char (point-max))
  10074       (beginning-of-line 1)
  10075       (while (not finish)
  10076 	(setq finish (bobp))
  10077 	(when (and (setq m (org-get-at-bol 'org-hd-marker))
  10078 		   (or (not just-this) (= (org-current-line) line))
  10079 		   (equal m hdmarker))
  10080 	  (setq props (text-properties-at (point))
  10081 		dotime (org-get-at-bol 'dotime)
  10082 		cat (org-agenda-get-category)
  10083 		level (org-get-at-bol 'level)
  10084 		tags thetags
  10085                 effort (org-get-at-bol 'effort)
  10086                 effort-minutes (org-get-at-bol 'effort-minutes)
  10087 		new
  10088 		(let ((org-prefix-format-compiled
  10089 		       (or (get-text-property (min (1- (point-max)) (point)) 'format)
  10090 			   org-prefix-format-compiled))
  10091 		      (extra (org-get-at-bol 'extra)))
  10092 		  (with-current-buffer (marker-buffer hdmarker)
  10093 		    (org-with-wide-buffer
  10094 		     (org-agenda-format-item extra
  10095                                    (org-add-props newhead nil
  10096                                      'effort effort
  10097                                      'effort-minutes effort-minutes)
  10098                                    level cat tags dotime))))
  10099                 ;; pl (text-property-any (line-beginning-position)
  10100                 ;;                       (line-end-position) 'org-heading t)
  10101 		undone-face (org-get-at-bol 'undone-face)
  10102 		done-face (org-get-at-bol 'done-face))
  10103 	  (beginning-of-line 1)
  10104 	  (cond
  10105 	   ((equal new "") (delete-region (point) (line-beginning-position 2)))
  10106 	   ((looking-at ".*")
  10107 	    ;; When replacing the whole line, preserve bulk mark
  10108 	    ;; overlay, if any.
  10109 	    (let ((mark (catch :overlay
  10110 			  (dolist (o (overlays-in (point) (+ 2 (point))))
  10111 			    (when (eq (overlay-get o 'type)
  10112 				      'org-marked-entry-overlay)
  10113 			      (throw :overlay o))))))
  10114 	      (replace-match new t t)
  10115 	      (beginning-of-line)
  10116 	      (when mark (move-overlay mark (point) (+ 2 (point)))))
  10117             (add-text-properties (line-beginning-position)
  10118                                  (line-end-position) props)
  10119 	    (when fixface
  10120 	      (add-text-properties
  10121                (line-beginning-position) (line-end-position)
  10122 	       (list 'face
  10123 		     (if org-last-todo-state-is-todo
  10124 			 undone-face done-face))))
  10125 	    (org-agenda-highlight-todo 'line)
  10126 	    (beginning-of-line 1))
  10127 	   (t (error "Line update did not work")))
  10128 	  (save-restriction
  10129             (narrow-to-region (line-beginning-position) (line-end-position))
  10130 	    (org-agenda-finalize)))
  10131 	(beginning-of-line 0)))))
  10132 
  10133 (defun org-agenda-align-tags (&optional line)
  10134   "Align all tags in agenda items to `org-agenda-tags-column'.
  10135 When optional argument LINE is non-nil, align tags only on the
  10136 current line."
  10137   (let ((inhibit-read-only t)
  10138 	(org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
  10139 			  (- (window-max-chars-per-line))
  10140 			org-agenda-tags-column))
  10141 	(end (and line (line-end-position)))
  10142 	l c)
  10143     (org-fold-core-ignore-modifications
  10144       (save-excursion
  10145         (goto-char (if line (line-beginning-position) (point-min)))
  10146         (while (re-search-forward org-tag-group-re end t)
  10147 	  (add-text-properties
  10148 	   (match-beginning 1) (match-end 1)
  10149 	   (list 'face (delq nil (let ((prop (get-text-property
  10150 					    (match-beginning 1) 'face)))
  10151 			         (or (listp prop) (setq prop (list prop)))
  10152 			         (if (memq 'org-tag prop)
  10153 				     prop
  10154 				   (cons 'org-tag prop))))))
  10155 	  (setq l (string-width (match-string 1))
  10156 	        c (if (< org-agenda-tags-column 0)
  10157 		      (- (abs org-agenda-tags-column) l)
  10158 		    org-agenda-tags-column))
  10159 	  (goto-char (match-beginning 1))
  10160 	  (delete-region (save-excursion (skip-chars-backward " \t") (point))
  10161 		         (point))
  10162 	  (insert (org-add-props
  10163 		      (make-string (max 1 (- c (current-column))) ?\s)
  10164 		      (plist-put (copy-sequence (text-properties-at (point)))
  10165 			         'face nil))))
  10166         (goto-char (point-min))
  10167         (org-font-lock-add-tag-faces (point-max))))))
  10168 
  10169 (defun org-agenda-priority-up ()
  10170   "Increase the priority of line at point, also in Org file."
  10171   (interactive)
  10172   (org-agenda-priority 'up))
  10173 
  10174 (defun org-agenda-priority-down ()
  10175   "Decrease the priority of line at point, also in Org file."
  10176   (interactive)
  10177   (org-agenda-priority 'down))
  10178 
  10179 (defun org-agenda-priority (&optional force-direction)
  10180   "Set the priority of line at point, also in Org file.
  10181 This changes the line at point, all other lines in the agenda
  10182 referring to the same tree node, and the headline of the tree
  10183 node in the Org file.
  10184 
  10185 Called with one universal prefix arg, show the priority instead
  10186 of setting it.
  10187 
  10188 When called programmatically, FORCE-DIRECTION can be `set', `up',
  10189 `down', or a character."
  10190   (interactive "P")
  10191   (unless org-priority-enable-commands
  10192     (user-error "Priority commands are disabled"))
  10193   (org-agenda-check-no-diary)
  10194   (let* ((col (current-column))
  10195 	 (hdmarker (org-get-at-bol 'org-hd-marker))
  10196 	 (buffer (marker-buffer hdmarker))
  10197 	 (pos (marker-position hdmarker))
  10198 	 (inhibit-read-only t)
  10199 	 newhead)
  10200     (org-with-remote-undo buffer
  10201       (with-current-buffer buffer
  10202 	(widen)
  10203 	(goto-char pos)
  10204 	(org-fold-show-context 'agenda)
  10205 	(org-priority force-direction)
  10206 	(end-of-line 1)
  10207 	(setq newhead (org-get-heading)))
  10208       (org-agenda-change-all-lines newhead hdmarker)
  10209       (org-move-to-column col))))
  10210 
  10211 ;; FIXME: should fix the tags property of the agenda line.
  10212 (defun org-agenda-set-tags (&optional tag onoff)
  10213   "Set tags for the current headline."
  10214   (interactive)
  10215   (org-agenda-check-no-diary)
  10216   (if (and (org-region-active-p) (called-interactively-p 'any))
  10217       (call-interactively 'org-change-tag-in-region)
  10218     (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
  10219 			 (org-agenda-error)))
  10220 	   (buffer (marker-buffer hdmarker))
  10221 	   (pos (marker-position hdmarker))
  10222 	   (inhibit-read-only t)
  10223 	   newhead)
  10224       (org-with-remote-undo buffer
  10225 	(with-current-buffer buffer
  10226 	  (widen)
  10227 	  (goto-char pos)
  10228 	  (org-fold-show-context 'agenda)
  10229 	  (if tag
  10230 	      (org-toggle-tag tag onoff)
  10231 	    (call-interactively #'org-set-tags-command))
  10232 	  (end-of-line 1)
  10233 	  (setq newhead (org-get-heading)))
  10234 	(org-agenda-change-all-lines newhead hdmarker)
  10235 	(beginning-of-line 1)))))
  10236 
  10237 (defun org-agenda-set-property ()
  10238   "Set a property for the current headline."
  10239   (interactive)
  10240   (org-agenda-check-no-diary)
  10241   (org-agenda-maybe-loop
  10242    #'org-agenda-set-property nil nil nil
  10243    (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
  10244 			(org-agenda-error)))
  10245 	  (buffer (marker-buffer hdmarker))
  10246 	  (pos (marker-position hdmarker))
  10247 	  (inhibit-read-only t)
  10248 	  ) ;; newhead
  10249      (org-with-remote-undo buffer
  10250        (with-current-buffer buffer
  10251 	 (widen)
  10252 	 (goto-char pos)
  10253 	 (org-fold-show-context 'agenda)
  10254 	 (call-interactively 'org-set-property))))))
  10255 
  10256 (defun org-agenda-set-effort ()
  10257   "Set the effort property for the current headline."
  10258   (interactive)
  10259   (org-agenda-check-no-diary)
  10260   (org-agenda-maybe-loop
  10261    #'org-agenda-set-effort nil nil nil
  10262    (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
  10263 			(org-agenda-error)))
  10264 	  (buffer (marker-buffer hdmarker))
  10265 	  (pos (marker-position hdmarker))
  10266 	  (inhibit-read-only t)
  10267 	  newhead)
  10268      (org-with-remote-undo buffer
  10269        (with-current-buffer buffer
  10270 	 (widen)
  10271 	 (goto-char pos)
  10272 	 (org-fold-show-context 'agenda)
  10273 	 (call-interactively 'org-set-effort)
  10274 	 (end-of-line 1)
  10275 	 (setq newhead (org-get-heading)))
  10276        (org-agenda-change-all-lines newhead hdmarker)))))
  10277 
  10278 (defun org-agenda-toggle-archive-tag ()
  10279   "Toggle the archive tag for the current entry."
  10280   (interactive)
  10281   (org-agenda-check-no-diary)
  10282   (org-agenda-maybe-loop
  10283    #'org-agenda-toggle-archive-tag nil nil nil
  10284    (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
  10285 			(org-agenda-error)))
  10286 	  (buffer (marker-buffer hdmarker))
  10287 	  (pos (marker-position hdmarker))
  10288 	  (inhibit-read-only t)
  10289 	  newhead)
  10290      (org-with-remote-undo buffer
  10291        (with-current-buffer buffer
  10292 	 (widen)
  10293 	 (goto-char pos)
  10294 	 (org-fold-show-context 'agenda)
  10295 	 (call-interactively 'org-toggle-archive-tag)
  10296 	 (end-of-line 1)
  10297 	 (setq newhead (org-get-heading)))
  10298        (org-agenda-change-all-lines newhead hdmarker)
  10299        (beginning-of-line 1)))))
  10300 
  10301 (defun org-agenda-do-date-later (arg)
  10302   (interactive "P")
  10303   (cond
  10304    ((or (equal arg '(16))
  10305 	(memq last-command
  10306 	      '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
  10307     (setq this-command 'org-agenda-date-later-minutes)
  10308     (org-agenda-date-later-minutes 1))
  10309    ((or (equal arg '(4))
  10310 	(memq last-command
  10311 	      '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
  10312     (setq this-command 'org-agenda-date-later-hours)
  10313     (org-agenda-date-later-hours 1))
  10314    (t
  10315     (org-agenda-date-later (prefix-numeric-value arg)))))
  10316 
  10317 (defun org-agenda-do-date-earlier (arg)
  10318   (interactive "P")
  10319   (cond
  10320    ((or (equal arg '(16))
  10321 	(memq last-command
  10322 	      '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
  10323     (setq this-command 'org-agenda-date-earlier-minutes)
  10324     (org-agenda-date-earlier-minutes 1))
  10325    ((or (equal arg '(4))
  10326 	(memq last-command
  10327 	      '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
  10328     (setq this-command 'org-agenda-date-earlier-hours)
  10329     (org-agenda-date-earlier-hours 1))
  10330    (t
  10331     (org-agenda-date-earlier (prefix-numeric-value arg)))))
  10332 
  10333 (defun org-agenda-date-later (arg &optional what)
  10334   "Change the date of this item to ARG day(s) later."
  10335   (interactive "p")
  10336   (org-agenda-check-type t 'agenda)
  10337   (org-agenda-check-no-diary)
  10338   (let* ((marker (or (org-get-at-bol 'org-marker)
  10339 		     (org-agenda-error)))
  10340 	 (buffer (marker-buffer marker))
  10341 	 (pos (marker-position marker))
  10342 	 cdate today)
  10343     (org-with-remote-undo buffer
  10344       (with-current-buffer buffer
  10345 	(widen)
  10346 	(goto-char pos)
  10347 	(unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
  10348 	(when (and org-agenda-move-date-from-past-immediately-to-today
  10349 		   (equal arg 1)
  10350 		   (or (not what) (eq what 'day))
  10351 		   (not (save-match-data (org-at-date-range-p))))
  10352 	  (setq cdate (org-parse-time-string (match-string 0) 'nodefault)
  10353 		cdate (calendar-absolute-from-gregorian
  10354 		       (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
  10355 		today (org-today))
  10356 	  (when (> today cdate)
  10357 	    ;; immediately shift to today
  10358 	    (setq arg (- today cdate))))
  10359 	(org-timestamp-change arg (or what 'day))
  10360 	(when (and (org-at-date-range-p)
  10361                    (re-search-backward org-tr-regexp-both
  10362                                        (line-beginning-position)))
  10363 	  (let ((end org-last-changed-timestamp))
  10364 	    (org-timestamp-change arg (or what 'day))
  10365 	    (setq org-last-changed-timestamp
  10366 		  (concat org-last-changed-timestamp "--" end)))))
  10367       (org-agenda-show-new-time marker org-last-changed-timestamp))
  10368     (message "Time stamp changed to %s" org-last-changed-timestamp)))
  10369 
  10370 (defun org-agenda-date-earlier (arg &optional what)
  10371   "Change the date of this item to ARG day(s) earlier."
  10372   (interactive "p")
  10373   (org-agenda-date-later (- arg) what))
  10374 
  10375 (defun org-agenda-date-later-minutes (arg)
  10376   "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
  10377   (interactive "p")
  10378   (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
  10379   (org-agenda-date-later arg 'minute))
  10380 
  10381 (defun org-agenda-date-earlier-minutes (arg)
  10382   "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
  10383   (interactive "p")
  10384   (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
  10385   (org-agenda-date-earlier arg 'minute))
  10386 
  10387 (defun org-agenda-date-later-hours (arg)
  10388   "Change the time of this item, in hour steps."
  10389   (interactive "p")
  10390   (org-agenda-date-later arg 'hour))
  10391 
  10392 (defun org-agenda-date-earlier-hours (arg)
  10393   "Change the time of this item, in hour steps."
  10394   (interactive "p")
  10395   (org-agenda-date-earlier arg 'hour))
  10396 
  10397 (defun org-agenda-show-new-time (marker stamp &optional prefix)
  10398   "Show new date stamp via text properties."
  10399   ;; We use text properties to make this undoable
  10400   (let ((inhibit-read-only t))
  10401     (setq stamp (concat prefix " => " stamp " "))
  10402     (save-excursion
  10403       (goto-char (point-max))
  10404       (while (not (bobp))
  10405 	(when (equal marker (org-get-at-bol 'org-marker))
  10406           (remove-text-properties (line-beginning-position)
  10407 				  (line-end-position)
  10408 				  '(display nil))
  10409 	  (org-move-to-column
  10410            (- (window-max-chars-per-line)
  10411               (length stamp))
  10412            t)
  10413           (add-text-properties
  10414            (1- (point)) (line-end-position)
  10415 	   (list 'display (org-add-props stamp nil
  10416 			    'face '(secondary-selection default))))
  10417 	  (beginning-of-line 1))
  10418 	(beginning-of-line 0)))))
  10419 
  10420 (defun org-agenda-date-prompt (arg)
  10421   "Change the date of this item.  Date is prompted for, with default today.
  10422 The prefix ARG is passed to the `org-time-stamp' command and can therefore
  10423 be used to request time specification in the time stamp."
  10424   (interactive "P")
  10425   (org-agenda-check-type t 'agenda)
  10426   (org-agenda-check-no-diary)
  10427   (org-agenda-maybe-loop
  10428    #'org-agenda-date-prompt arg t nil
  10429    (let* ((marker (or (org-get-at-bol 'org-marker)
  10430 		      (org-agenda-error)))
  10431 	  (buffer (marker-buffer marker))
  10432 	  (pos (marker-position marker)))
  10433      (org-with-remote-undo buffer
  10434        (with-current-buffer buffer
  10435 	 (widen)
  10436 	 (goto-char pos)
  10437 	 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
  10438 	 (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
  10439        (org-agenda-show-new-time marker org-last-changed-timestamp))
  10440      (message "Time stamp changed to %s" org-last-changed-timestamp))))
  10441 
  10442 (defun org-agenda-schedule (arg &optional time)
  10443   "Schedule the item at point.
  10444 ARG is passed through to `org-schedule'."
  10445   (interactive "P")
  10446   (org-agenda-check-type t 'agenda 'todo 'tags 'search)
  10447   (org-agenda-check-no-diary)
  10448   (org-agenda-maybe-loop
  10449    #'org-agenda-schedule arg t nil
  10450    (let* ((marker (or (org-get-at-bol 'org-marker)
  10451 		      (org-agenda-error)))
  10452 	  ;; (type (marker-insertion-type marker))
  10453 	  (buffer (marker-buffer marker))
  10454 	  (pos (marker-position marker))
  10455 	  ts)
  10456      (set-marker-insertion-type marker t)
  10457      (org-with-remote-undo buffer
  10458        (with-current-buffer buffer
  10459 	 (widen)
  10460 	 (goto-char pos)
  10461 	 (setq ts (org-schedule arg time)))
  10462        (org-agenda-show-new-time marker ts " S"))
  10463      (message "%s" ts))))
  10464 
  10465 (defun org-agenda-deadline (arg &optional time)
  10466   "Schedule the item at point.
  10467 ARG is passed through to `org-deadline'."
  10468   (interactive "P")
  10469   (org-agenda-check-type t 'agenda 'todo 'tags 'search)
  10470   (org-agenda-check-no-diary)
  10471   (org-agenda-maybe-loop
  10472    #'org-agenda-deadline arg t nil
  10473    (let* ((marker (or (org-get-at-bol 'org-marker)
  10474 		      (org-agenda-error)))
  10475 	  (buffer (marker-buffer marker))
  10476 	  (pos (marker-position marker))
  10477 	  ts)
  10478      (org-with-remote-undo buffer
  10479        (with-current-buffer buffer
  10480 	 (widen)
  10481 	 (goto-char pos)
  10482 	 (setq ts (org-deadline arg time)))
  10483        (org-agenda-show-new-time marker ts " D"))
  10484      (message "%s" ts))))
  10485 
  10486 (defun org-agenda-clock-in (&optional arg)
  10487   "Start the clock on the currently selected item."
  10488   (interactive "P")
  10489   (org-agenda-check-no-diary)
  10490   (if (equal arg '(4))
  10491       (org-clock-in arg)
  10492     (let* ((marker (or (org-get-at-bol 'org-marker)
  10493 		       (org-agenda-error)))
  10494 	   (hdmarker (or (org-get-at-bol 'org-hd-marker) marker))
  10495 	   (pos (marker-position marker))
  10496 	   (col (current-column))
  10497 	   newhead)
  10498       (org-with-remote-undo (marker-buffer marker)
  10499         (with-current-buffer (marker-buffer marker)
  10500 	  (widen)
  10501 	  (goto-char pos)
  10502 	  (org-fold-show-context 'agenda)
  10503 	  (org-clock-in arg)
  10504 	  (setq newhead (org-get-heading)))
  10505 	(org-agenda-change-all-lines newhead hdmarker))
  10506       (org-move-to-column col))))
  10507 
  10508 (defun org-agenda-clock-out ()
  10509   "Stop the currently running clock."
  10510   (interactive)
  10511   (unless (marker-buffer org-clock-marker)
  10512     (user-error "No running clock"))
  10513   (let ((marker (make-marker)) (col (current-column)) newhead)
  10514     (org-with-remote-undo (marker-buffer org-clock-marker)
  10515       (with-current-buffer (marker-buffer org-clock-marker)
  10516 	(org-with-wide-buffer
  10517 	 (goto-char org-clock-marker)
  10518 	 (org-back-to-heading t)
  10519 	 (move-marker marker (point))
  10520 	 (org-clock-out)
  10521 	 (setq newhead (org-get-heading)))))
  10522     (org-agenda-change-all-lines newhead marker)
  10523     (move-marker marker nil)
  10524     (org-move-to-column col)
  10525     (org-agenda-unmark-clocking-task)))
  10526 
  10527 (defun org-agenda-clock-cancel (&optional _arg)
  10528   "Cancel the currently running clock."
  10529   (interactive) ;; "P"
  10530   (unless (marker-buffer org-clock-marker)
  10531     (user-error "No running clock"))
  10532   (org-with-remote-undo (marker-buffer org-clock-marker)
  10533     (org-clock-cancel)))
  10534 
  10535 (defun org-agenda-clock-goto ()
  10536   "Jump to the currently clocked in task within the agenda.
  10537 If the currently clocked in task is not listed in the agenda
  10538 buffer, display it in another window."
  10539   (interactive)
  10540   (let (pos)
  10541     (mapc (lambda (o)
  10542 	    (when (eq (overlay-get o 'type) 'org-agenda-clocking)
  10543 	      (setq pos (overlay-start o))))
  10544 	  (overlays-in (point-min) (point-max)))
  10545     (cond (pos (goto-char pos))
  10546 	  ;; If the currently clocked entry is not in the agenda
  10547 	  ;; buffer, we visit it in another window:
  10548 	  ((bound-and-true-p org-clock-current-task)
  10549 	   (org-switch-to-buffer-other-window (org-clock-goto)))
  10550 	  (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
  10551 
  10552 (defun org-agenda-diary-entry-in-org-file ()
  10553   "Make a diary entry in the file `org-agenda-diary-file'."
  10554   (let (d1 d2 char (text "") dp1 dp2)
  10555     (if (equal (buffer-name) "*Calendar*")
  10556 	(setq d1 (calendar-cursor-to-date t)
  10557 	      d2 (car calendar-mark-ring))
  10558       (setq dp1 (get-text-property (line-beginning-position) 'day))
  10559       (unless dp1 (user-error "No date defined in current line"))
  10560       (setq d1 (calendar-gregorian-from-absolute dp1)
  10561 	    d2 (and (ignore-errors (mark))
  10562 		    (save-excursion
  10563 		      (goto-char (mark))
  10564                       (setq dp2 (get-text-property (line-beginning-position) 'day)))
  10565 		    (calendar-gregorian-from-absolute dp2))))
  10566     (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree")
  10567     (setq char (read-char-exclusive))
  10568     (cond
  10569      ((equal char ?d)
  10570       (setq text (read-string "Day entry: "))
  10571       (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1)
  10572       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
  10573      ((equal char ?a)
  10574       (setq d1 (list (car d1) (nth 1 d1)
  10575 		     (read-number (format "Reference year [%d]: " (nth 2 d1))
  10576 				  (nth 2 d1))))
  10577       (setq text (read-string "Anniversary (use %d to show years): "))
  10578       (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1)
  10579       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
  10580      ((equal char ?b)
  10581       (setq text (read-string "Block entry: "))
  10582       (unless (and d1 d2 (not (equal d1 d2)))
  10583 	(user-error "No block of days selected"))
  10584       (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2)
  10585       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
  10586      ((equal char ?j)
  10587       (org-switch-to-buffer-other-window
  10588        (find-file-noselect org-agenda-diary-file))
  10589       (require 'org-datetree)
  10590       (org-datetree-find-date-create d1)
  10591       (org-fold-reveal t))
  10592      (t (user-error "Invalid selection character `%c'" char)))))
  10593 
  10594 (defcustom org-agenda-insert-diary-strategy 'date-tree
  10595   "Where in `org-agenda-diary-file' should new entries be added?
  10596 Valid values:
  10597 
  10598 date-tree         in the date tree, as first child of the date
  10599 date-tree-last    in the date tree, as last child of the date
  10600 top-level         as top-level entries at the end of the file."
  10601   :group 'org-agenda
  10602   :type '(choice
  10603 	  (const :tag "first in a date tree" date-tree)
  10604 	  (const :tag "last in a date tree" date-tree-last)
  10605 	  (const :tag "as top level at end of file" top-level)))
  10606 
  10607 (defcustom org-agenda-insert-diary-extract-time nil
  10608   "Non-nil means extract any time specification from the diary entry."
  10609   :group 'org-agenda
  10610   :version "24.1"
  10611   :type 'boolean)
  10612 
  10613 (defcustom org-agenda-bulk-mark-char ">"
  10614   "A single-character string to be used as the bulk mark."
  10615   :group 'org-agenda
  10616   :version "24.1"
  10617   :type 'string)
  10618 
  10619 (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
  10620   "Add a diary entry with TYPE to `org-agenda-diary-file'.
  10621 If TEXT is not empty, it will become the headline of the new entry, and
  10622 the resulting entry will not be shown.  When TEXT is empty, switch to
  10623 `org-agenda-diary-file' and let the user finish the entry there."
  10624   (let ((cw (current-window-configuration)))
  10625     (org-switch-to-buffer-other-window
  10626      (find-file-noselect org-agenda-diary-file))
  10627     (widen)
  10628     (goto-char (point-min))
  10629     (cl-case type
  10630       (anniversary
  10631        (or (re-search-forward "^\\*[ \t]+Anniversaries" nil t)
  10632 	   (progn
  10633 	     (or (org-at-heading-p)
  10634 		 (progn
  10635 		   (outline-next-heading)
  10636 		   (insert "* Anniversaries\n\n")
  10637 		   (beginning-of-line -1)))))
  10638        (outline-next-heading)
  10639        (org-back-over-empty-lines)
  10640        (backward-char 1)
  10641        (insert "\n")
  10642        (insert (format "%%%%(org-anniversary %d %2d %2d) %s"
  10643 		       (nth 2 d1) (car d1) (nth 1 d1) text)))
  10644       (day
  10645        (let ((org-prefix-has-time t)
  10646 	     (org-agenda-time-leading-zero t)
  10647 	     fmt time time2)
  10648 	 (when org-agenda-insert-diary-extract-time
  10649 	   ;; Use org-agenda-format-item to parse text for a time-range and
  10650 	   ;; remove it.  FIXME: This is a hack, we should refactor
  10651 	   ;; that function to make time extraction available separately
  10652 	   (setq fmt (org-agenda-format-item nil text nil nil nil t)
  10653 		 time (get-text-property 0 'time fmt)
  10654 		 time2 (if (> (length time) 0)
  10655 			   ;; split-string removes trailing ...... if
  10656 			   ;; no end time given.  First space
  10657 			   ;; separates time from date.
  10658 			   (concat " " (car (split-string time "\\.")))
  10659 			 nil)
  10660 		 text (get-text-property 0 'txt fmt)))
  10661 	 (if (eq org-agenda-insert-diary-strategy 'top-level)
  10662 	     (org-agenda-insert-diary-as-top-level text)
  10663 	   (require 'org-datetree)
  10664 	   (org-datetree-find-date-create d1)
  10665 	   (org-agenda-insert-diary-make-new-entry text))
  10666 	 (org-insert-time-stamp (org-time-from-absolute
  10667 				 (calendar-absolute-from-gregorian d1))
  10668 				nil nil nil nil time2))
  10669        (end-of-line 0))
  10670       ((block) ;; Wrap this in (strictly unnecessary) parens because
  10671        ;; otherwise the indentation gets confused by the
  10672        ;; special meaning of 'block
  10673        (when (> (calendar-absolute-from-gregorian d1)
  10674 		(calendar-absolute-from-gregorian d2))
  10675 	 (setq d1 (prog1 d2 (setq d2 d1))))
  10676        (if (eq org-agenda-insert-diary-strategy 'top-level)
  10677 	   (org-agenda-insert-diary-as-top-level text)
  10678 	 (require 'org-datetree)
  10679 	 (org-datetree-find-date-create d1)
  10680 	 (org-agenda-insert-diary-make-new-entry text))
  10681        (org-insert-time-stamp (org-time-from-absolute
  10682 			       (calendar-absolute-from-gregorian d1)))
  10683        (insert "--")
  10684        (org-insert-time-stamp (org-time-from-absolute
  10685 			       (calendar-absolute-from-gregorian d2)))
  10686        (end-of-line 0)))
  10687     (if (string-match "\\S-" text)
  10688 	(progn
  10689 	  (set-window-configuration cw)
  10690 	  (message "%s entry added to %s"
  10691 		   (capitalize (symbol-name type))
  10692 		   (abbreviate-file-name org-agenda-diary-file)))
  10693       (org-fold-reveal t)
  10694       (message "Please finish entry here"))))
  10695 
  10696 (defun org-agenda-insert-diary-as-top-level (text)
  10697   "Make new entry as a top-level entry at the end of the file.
  10698 Add TEXT as headline, and position the cursor in the second line so that
  10699 a timestamp can be added there."
  10700   (widen)
  10701   (goto-char (point-max))
  10702   (unless (bolp) (insert "\n"))
  10703   (org-insert-heading nil t t)
  10704   (insert text)
  10705   (org-end-of-meta-data)
  10706   (unless (bolp) (insert "\n"))
  10707   (when org-adapt-indentation (indent-to-column 2)))
  10708 
  10709 (defun org-agenda-insert-diary-make-new-entry (text)
  10710   "Make a new entry with TEXT as a child of the current subtree.
  10711 Position the point in the heading's first body line so that
  10712 a timestamp can be added there."
  10713   (cond
  10714    ((eq org-agenda-insert-diary-strategy 'date-tree-last)
  10715     (end-of-line)
  10716     (org-insert-heading '(4) t)
  10717     (org-do-demote))
  10718    (t
  10719     (outline-next-heading)
  10720     (org-back-over-empty-lines)
  10721     (unless (looking-at "[ \t]*$") (save-excursion (insert "\n")))
  10722     (org-insert-heading nil t)
  10723     (org-do-demote)))
  10724   (let ((col (current-column)))
  10725     (insert text)
  10726     (org-end-of-meta-data)
  10727     ;; Ensure point is left on a blank line, at proper indentation.
  10728     (unless (bolp) (insert "\n"))
  10729     (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
  10730     (when org-adapt-indentation (indent-to-column col)))
  10731   (org-fold-show-set-visibility 'lineage))
  10732 
  10733 (defun org-agenda-diary-entry ()
  10734   "Make a diary entry, like the `i' command from the calendar.
  10735 All the standard commands work: block, weekly etc.
  10736 When `org-agenda-diary-file' points to a file,
  10737 `org-agenda-diary-entry-in-org-file' is called instead to create
  10738 entries in that Org file."
  10739   (interactive)
  10740   (if (not (eq org-agenda-diary-file 'diary-file))
  10741       (org-agenda-diary-entry-in-org-file)
  10742     (require 'diary-lib)
  10743     (let* ((char (read-char-exclusive
  10744 		  "Diary entry: [d]ay [w]eekly [m]onthly [y]early\
  10745  [a]nniversary [b]lock [c]yclic"))
  10746 	   (cmd (cdr (assoc char
  10747 			    '((?d . diary-insert-entry)
  10748 			      (?w . diary-insert-weekly-entry)
  10749 			      (?m . diary-insert-monthly-entry)
  10750 			      (?y . diary-insert-yearly-entry)
  10751 			      (?a . diary-insert-anniversary-entry)
  10752 			      (?b . diary-insert-block-entry)
  10753 			      (?c . diary-insert-cyclic-entry)))))
  10754 	   (oldf (symbol-function 'calendar-cursor-to-date))
  10755 	   ;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
  10756 	   (point (point))
  10757 	   (mark (or (mark t) (point))))
  10758       (unless cmd
  10759 	(user-error "No command associated with <%c>" char))
  10760       (unless (and (get-text-property point 'day)
  10761 		   (or (not (equal ?b char))
  10762 		       (get-text-property mark 'day)))
  10763 	(user-error "Don't know which date to use for diary entry"))
  10764       ;; We implement this by hacking the `calendar-cursor-to-date' function
  10765       ;; and the `calendar-mark-ring' variable.  Saves a lot of code.
  10766       (let ((calendar-mark-ring
  10767 	     (list (calendar-gregorian-from-absolute
  10768 		    (or (get-text-property mark 'day)
  10769 			(get-text-property point 'day))))))
  10770 	(unwind-protect
  10771 	    (progn
  10772 	      (fset 'calendar-cursor-to-date
  10773 		    (lambda (&optional _error _dummy)
  10774 		      (calendar-gregorian-from-absolute
  10775 		       (get-text-property point 'day))))
  10776 	      (call-interactively cmd))
  10777 	  (fset 'calendar-cursor-to-date oldf))))))
  10778 
  10779 (defun org-agenda-execute-calendar-command (cmd)
  10780   "Execute a calendar command from the agenda with date from cursor."
  10781   (org-agenda-check-type t 'agenda)
  10782   (require 'diary-lib)
  10783   (unless (get-text-property (min (1- (point-max)) (point)) 'day)
  10784     (user-error "Don't know which date to use for the calendar command"))
  10785   (let* ((oldf (symbol-function 'calendar-cursor-to-date))
  10786 	 (point (point))
  10787 	 (date (calendar-gregorian-from-absolute
  10788 		(get-text-property point 'day))))
  10789     ;; the following 2 vars are needed in the calendar
  10790     (org-dlet
  10791 	((displayed-month (car date))
  10792 	 (displayed-year (nth 2 date)))
  10793       (unwind-protect
  10794 	  (progn
  10795 	    (fset 'calendar-cursor-to-date
  10796 		  (lambda (&optional _error _dummy)
  10797 		    (calendar-gregorian-from-absolute
  10798 		     (get-text-property point 'day))))
  10799 	    (call-interactively cmd))
  10800 	(fset 'calendar-cursor-to-date oldf)))))
  10801 
  10802 (defun org-agenda-phases-of-moon ()
  10803   "Display the phases of the moon for the 3 months around the cursor date."
  10804   (interactive)
  10805   (org-agenda-execute-calendar-command 'calendar-lunar-phases))
  10806 
  10807 (defun org-agenda-holidays ()
  10808   "Display the holidays for the 3 months around the cursor date."
  10809   (interactive)
  10810   (org-agenda-execute-calendar-command 'calendar-list-holidays))
  10811 
  10812 (defvar calendar-longitude)      ; defined in calendar.el
  10813 (defvar calendar-latitude)       ; defined in calendar.el
  10814 (defvar calendar-location-name)  ; defined in calendar.el
  10815 
  10816 (defun org-agenda-sunrise-sunset (arg)
  10817   "Display sunrise and sunset for the cursor date.
  10818 Latitude and longitude can be specified with the variables
  10819 `calendar-latitude' and `calendar-longitude'.  When called with prefix
  10820 argument, latitude and longitude will be prompted for."
  10821   (interactive "P")
  10822   (require 'solar)
  10823   (let ((calendar-longitude (if arg nil calendar-longitude))
  10824 	(calendar-latitude  (if arg nil calendar-latitude))
  10825 	(calendar-location-name
  10826 	 (if arg "the given coordinates" calendar-location-name)))
  10827     (org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
  10828 
  10829 (defun org-agenda-goto-calendar ()
  10830   "Open the Emacs calendar with the date at the cursor."
  10831   (interactive)
  10832   (org-agenda-check-type t 'agenda)
  10833   (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
  10834 		  (user-error "Don't know which date to open in calendar")))
  10835 	 (date (calendar-gregorian-from-absolute day))
  10836 	 (calendar-move-hook nil)
  10837 	 (calendar-view-holidays-initially-flag nil)
  10838 	 (calendar-view-diary-initially-flag nil))
  10839     (calendar)
  10840     (calendar-goto-date date)))
  10841 
  10842 ;;;###autoload
  10843 (defun org-calendar-goto-agenda ()
  10844   "Compute the Org agenda for the calendar date displayed at the cursor.
  10845 This is a command that has to be installed in `calendar-mode-map'."
  10846   (interactive)
  10847   ;; Temporarily disable sticky agenda since user clearly wants to
  10848   ;; refresh view anyway.
  10849   (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*")
  10850 	(org-agenda-sticky nil))
  10851     (org-agenda-list nil (calendar-absolute-from-gregorian
  10852 			  (calendar-cursor-to-date))
  10853 		     nil)))
  10854 
  10855 (defun org-agenda-convert-date ()
  10856   (interactive)
  10857   (org-agenda-check-type t 'agenda)
  10858   (let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
  10859 	date s)
  10860     (unless day
  10861       (user-error "Don't know which date to convert"))
  10862     (setq date (calendar-gregorian-from-absolute day))
  10863     (setq s (concat
  10864 	     "Gregorian:  " (calendar-date-string date) "\n"
  10865 	     "ISO:        " (calendar-iso-date-string date) "\n"
  10866 	     "Day of Yr:  " (calendar-day-of-year-string date) "\n"
  10867 	     "Julian:     " (calendar-julian-date-string date) "\n"
  10868 	     "Astron. JD: " (calendar-astro-date-string date)
  10869 	     " (Julian date number at noon UTC)\n"
  10870 	     "Hebrew:     " (calendar-hebrew-date-string date) " (until sunset)\n"
  10871 	     "Islamic:    " (calendar-islamic-date-string date) " (until sunset)\n"
  10872 	     "French:     " (calendar-french-date-string date) "\n"
  10873 	     "Bahá’í:     " (calendar-bahai-date-string date) " (until sunset)\n"
  10874 	     "Mayan:      " (calendar-mayan-date-string date) "\n"
  10875 	     "Coptic:     " (calendar-coptic-date-string date) "\n"
  10876 	     "Ethiopic:   " (calendar-ethiopic-date-string date) "\n"
  10877 	     "Persian:    " (calendar-persian-date-string date) "\n"
  10878 	     "Chinese:    " (calendar-chinese-date-string date) "\n"))
  10879     (with-output-to-temp-buffer "*Dates*"
  10880       (princ s))
  10881     (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
  10882 
  10883 ;;; Bulk commands
  10884 
  10885 (defun org-agenda-bulk-marked-p ()
  10886   "Non-nil when current entry is marked for bulk action."
  10887   (eq (get-char-property (line-beginning-position) 'type)
  10888       'org-marked-entry-overlay))
  10889 
  10890 (defun org-agenda-bulk-mark (&optional arg)
  10891   "Mark entries for future bulk action.
  10892 
  10893 When ARG is nil or one and region is not active then mark the
  10894 entry at point.
  10895 
  10896 When ARG is nil or one and region is active then mark the entries
  10897 in the region.
  10898 
  10899 When ARG is greater than one mark ARG lines."
  10900   (interactive "p")
  10901   (when (and (or (not arg) (= arg 1)) (use-region-p))
  10902     (setq arg (count-lines (region-beginning) (region-end)))
  10903     (goto-char (region-beginning))
  10904     (deactivate-mark))
  10905   (dotimes (_ (or arg 1))
  10906     (unless (org-get-at-bol 'org-agenda-diary-link)
  10907       (let* ((m (org-get-at-bol 'org-hd-marker))
  10908 	     ov)
  10909 	(unless (org-agenda-bulk-marked-p)
  10910 	  (unless m (user-error "Nothing to mark at point"))
  10911 	  (push m org-agenda-bulk-marked-entries)
  10912           (setq ov (make-overlay (line-beginning-position)
  10913                                  (+ 2 (line-beginning-position))))
  10914 	  (org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
  10915 			       (org-get-todo-face "TODO")
  10916 			       'evaporate)
  10917 	  (overlay-put ov 'type 'org-marked-entry-overlay))
  10918 	(end-of-line 1)
  10919 	(or (ignore-errors
  10920 	      (goto-char (next-single-property-change (point) 'org-hd-marker)))
  10921 	    (beginning-of-line 2))
  10922 	(while (and (get-char-property (point) 'invisible) (not (eobp)))
  10923 	  (beginning-of-line 2)))))
  10924   (message "%d entries marked for bulk action"
  10925 	   (length org-agenda-bulk-marked-entries)))
  10926 
  10927 (defun org-agenda-bulk-mark-all ()
  10928   "Mark all entries for future agenda bulk action."
  10929   (interactive)
  10930   (org-agenda-bulk-mark-regexp "."))
  10931 
  10932 (defun org-agenda-bulk-mark-regexp (regexp)
  10933   "Mark entries matching REGEXP for future agenda bulk action."
  10934   (interactive "sMark entries matching regexp: ")
  10935   (let ((entries-marked 0) txt-at-point)
  10936     (save-excursion
  10937       (goto-char (point-min))
  10938       (goto-char (next-single-property-change (point) 'org-hd-marker))
  10939       (while (and (re-search-forward regexp nil t)
  10940 		  (setq txt-at-point
  10941 			(get-text-property (match-beginning 0) 'txt)))
  10942 	(if (get-char-property (point) 'invisible)
  10943 	    (beginning-of-line 2)
  10944 	  (when (string-match-p regexp txt-at-point)
  10945 	    (setq entries-marked (1+ entries-marked))
  10946 	    (call-interactively 'org-agenda-bulk-mark)))))
  10947     (unless entries-marked
  10948       (message "No entry matching this regexp."))))
  10949 
  10950 (defun org-agenda-bulk-unmark (&optional arg)
  10951   "Unmark the entry at point for future bulk action."
  10952   (interactive "P")
  10953   (if arg
  10954       (org-agenda-bulk-unmark-all)
  10955     (cond ((org-agenda-bulk-marked-p)
  10956 	   (org-agenda-bulk-remove-overlays
  10957             (line-beginning-position) (+ 2 (line-beginning-position)))
  10958 	   (setq org-agenda-bulk-marked-entries
  10959 		 (delete (org-get-at-bol 'org-hd-marker)
  10960 			 org-agenda-bulk-marked-entries))
  10961 	   (end-of-line 1)
  10962 	   (or (ignore-errors
  10963 		 (goto-char (next-single-property-change (point) 'txt)))
  10964 	       (beginning-of-line 2))
  10965 	   (while (and (get-char-property (point) 'invisible) (not (eobp)))
  10966 	     (beginning-of-line 2))
  10967 	   (message "%d entries left marked for bulk action"
  10968 		    (length org-agenda-bulk-marked-entries)))
  10969 	  (t (message "No entry to unmark here")))))
  10970 
  10971 (defun org-agenda-bulk-toggle-all ()
  10972   "Toggle all marks for bulk action."
  10973   (interactive)
  10974   (save-excursion
  10975     (goto-char (point-min))
  10976     (while (ignore-errors
  10977 	     (goto-char (next-single-property-change (point) 'org-hd-marker)))
  10978       (org-agenda-bulk-toggle))))
  10979 
  10980 (defun org-agenda-bulk-toggle ()
  10981   "Toggle the mark at point for bulk action."
  10982   (interactive)
  10983   (if (org-agenda-bulk-marked-p)
  10984       (org-agenda-bulk-unmark)
  10985     (org-agenda-bulk-mark)))
  10986 
  10987 (defun org-agenda-bulk-remove-overlays (&optional beg end)
  10988   "Remove the mark overlays between BEG and END in the agenda buffer.
  10989 BEG and END default to the buffer limits.
  10990 
  10991 This only removes the overlays, it does not remove the markers
  10992 from the list in `org-agenda-bulk-marked-entries'."
  10993   (interactive)
  10994   (mapc (lambda (ov)
  10995 	  (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay)
  10996 	       (delete-overlay ov)))
  10997 	(overlays-in (or beg (point-min)) (or end (point-max)))))
  10998 
  10999 (defun org-agenda-bulk-unmark-all ()
  11000   "Remove all marks in the agenda buffer.
  11001 This will remove the markers and the overlays."
  11002   (interactive)
  11003   (if (null org-agenda-bulk-marked-entries)
  11004       (message "No entry to unmark")
  11005     (setq org-agenda-bulk-marked-entries nil)
  11006     (org-agenda-bulk-remove-overlays (point-min) (point-max))))
  11007 
  11008 (defcustom org-agenda-persistent-marks nil
  11009   "Non-nil means marked items will stay marked after a bulk action.
  11010 You can toggle this interactively by typing `p' when prompted for a
  11011 bulk action."
  11012   :group 'org-agenda
  11013   :version "24.1"
  11014   :type 'boolean)
  11015 
  11016 (defcustom org-agenda-loop-over-headlines-in-active-region t
  11017   "Shall some commands act upon headlines in the active region?
  11018 
  11019 When set to t, some commands will be performed in all headlines
  11020 within the active region.
  11021 
  11022 When set to `start-level', some commands will be performed in all
  11023 headlines within the active region, provided that these headlines
  11024 are of the same level than the first one.
  11025 
  11026 When set to a regular expression, those commands will be
  11027 performed on the matching headlines within the active region.
  11028 
  11029 The list of commands is: `org-agenda-schedule',
  11030 `org-agenda-deadline', `org-agenda-date-prompt',
  11031 `org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'.
  11032 
  11033 See `org-loop-over-headlines-in-active-region' for the equivalent
  11034 option for Org buffers."
  11035   :type '(choice (const :tag "Don't loop" nil)
  11036 		 (const :tag "All headlines in active region" t)
  11037 		 (const :tag "In active region, headlines at the same level than the first one" start-level)
  11038 		 (regexp :tag "Regular expression matcher"))
  11039   :version "27.1"
  11040   :package-version '(Org . "9.4")
  11041   :group 'org-agenda)
  11042 
  11043 (defun org-agenda-bulk-action (&optional arg)
  11044   "Execute an remote-editing action on all marked entries.
  11045 The prefix arg is passed through to the command if possible."
  11046   (interactive "P")
  11047   ;; When there is no mark, act on the agenda entry at point.
  11048   (if (not org-agenda-bulk-marked-entries)
  11049       (save-excursion (org-agenda-bulk-mark)))
  11050   (dolist (m org-agenda-bulk-marked-entries)
  11051     (unless (and (markerp m)
  11052 		 (marker-buffer m)
  11053 		 (buffer-live-p (marker-buffer m))
  11054 		 (marker-position m))
  11055       (user-error "Marker %s for bulk command is invalid" m)))
  11056 
  11057   ;; Prompt for the bulk command.
  11058   (org-unlogged-message
  11059    (concat "Bulk (" (if org-agenda-persistent-marks "" "don't ") "[p]ersist marks): "
  11060 	   "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
  11061 	   "[S]catter [f]unction    "
  11062 	   (and org-agenda-bulk-custom-functions
  11063 		(format " Custom: [%s]"
  11064 			(mapconcat (lambda (f) (char-to-string (car f)))
  11065 				   org-agenda-bulk-custom-functions
  11066 				   "")))))
  11067   (catch 'exit
  11068     (let* ((org-log-refile (if org-log-refile 'time nil))
  11069 	   (entries (reverse org-agenda-bulk-marked-entries))
  11070 	   (org-overriding-default-time
  11071 	    (and (get-text-property (point) 'org-agenda-date-header)
  11072 		 (org-get-cursor-date)))
  11073 	   redo-at-end
  11074 	   cmd)
  11075       (pcase (read-char-exclusive)
  11076 	(?p
  11077 	 (let ((org-agenda-persistent-marks
  11078 		(not org-agenda-persistent-marks)))
  11079 	   (org-agenda-bulk-action)
  11080 	   (throw 'exit nil)))
  11081 
  11082 	(?$
  11083 	 (setq cmd #'org-agenda-archive))
  11084 
  11085 	(?A
  11086 	 (setq cmd #'org-agenda-archive-to-archive-sibling))
  11087 
  11088 	((or ?r ?w)
  11089 	 (let ((refile-location
  11090 		(org-refile-get-location
  11091 		 "Refile to"
  11092 		 (marker-buffer (car entries))
  11093 		 org-refile-allow-creating-parent-nodes)))
  11094 	   (when (nth 3 refile-location)
  11095 	     (setcar (nthcdr 3 refile-location)
  11096 		     (move-marker
  11097 		      (make-marker)
  11098 		      (nth 3 refile-location)
  11099 		      (or (get-file-buffer (nth 1 refile-location))
  11100 			  (find-buffer-visiting (nth 1 refile-location))
  11101 			  (error "This should not happen")))))
  11102 
  11103 	   (setq cmd (lambda () (org-agenda-refile nil refile-location t)))
  11104 	   (setq redo-at-end t)))
  11105 
  11106 	(?t
  11107 	 (let ((state (completing-read
  11108 		       "Todo state: "
  11109 		       (with-current-buffer (marker-buffer (car entries))
  11110 			 (mapcar #'list org-todo-keywords-1)))))
  11111 	   (setq cmd (lambda ()
  11112 		       (let ((org-inhibit-blocking t)
  11113 			     (org-inhibit-logging 'note))
  11114 			 (org-agenda-todo state))))))
  11115 
  11116 	((and (or ?- ?+) action)
  11117 	 (let ((tag (completing-read
  11118 		     (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
  11119 		     (with-current-buffer (marker-buffer (car entries))
  11120 		       (delq nil
  11121 			     (mapcar (lambda (x) (and (stringp (car x)) x))
  11122 				     org-current-tag-alist))))))
  11123 	   (setq cmd
  11124 		 (lambda ()
  11125 		   (org-agenda-set-tags tag
  11126 					(if (eq action ?+) 'on 'off))))))
  11127 
  11128 	((and (or ?s ?d) c)
  11129 	 (let* ((schedule? (eq c ?s))
  11130 		(prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to"))
  11131 		(time
  11132 		 (and (not arg)
  11133 		      (let ((new (org-read-date
  11134 				  nil nil nil prompt org-overriding-default-time)))
  11135 			;; A "double plus" answer applies to every
  11136 			;; scheduled time.  Do not turn it into
  11137 			;; a fixed date yet.
  11138 			(if (string-match-p "\\`[ \t]*\\+\\+"
  11139 					    org-read-date-final-answer)
  11140 			    org-read-date-final-answer
  11141 			  new)))))
  11142 	   ;; Make sure to not prompt for a note when bulk
  11143 	   ;; rescheduling/resetting deadline as Org cannot cope with
  11144 	   ;; simultaneous notes.  Besides, it could be annoying
  11145 	   ;; depending on the number of marked items.
  11146 	   (setq cmd
  11147 		 (if schedule?
  11148 		     (lambda ()
  11149 		       (let ((org-log-reschedule
  11150 			      (and org-log-reschedule 'time)))
  11151 			 (org-agenda-schedule arg time)))
  11152 		   (lambda ()
  11153 		     (let ((org-log-redeadline (and org-log-redeadline 'time)))
  11154 		       (org-agenda-deadline arg time)))))))
  11155 
  11156 	(?S
  11157 	 (unless (org-agenda-check-type nil 'agenda 'todo)
  11158 	   (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type))
  11159 	 (let ((days (read-number
  11160 		      (format "Scatter tasks across how many %sdays: "
  11161 			      (if arg "week" ""))
  11162 		      7)))
  11163 	   (setq cmd
  11164 		 (lambda ()
  11165 		   (let ((distance (1+ (random days))))
  11166 		     (when arg
  11167 		       (let ((dist distance)
  11168 			     (day-of-week
  11169 			      (calendar-day-of-week
  11170 			       (calendar-gregorian-from-absolute (org-today)))))
  11171 			 (dotimes (_ (1+ dist))
  11172 			   (while (member day-of-week org-agenda-weekend-days)
  11173 			     (cl-incf distance)
  11174 			     (cl-incf day-of-week)
  11175 			     (when (= day-of-week 7)
  11176 			       (setq day-of-week 0)))
  11177 			   (cl-incf day-of-week)
  11178 			   (when (= day-of-week 7)
  11179 			     (setq day-of-week 0)))))
  11180 		     ;; Silently fail when try to replan a sexp entry.
  11181 		     (ignore-errors
  11182 		       (let* ((date (calendar-gregorian-from-absolute
  11183 				     (+ (org-today) distance)))
  11184 			      (time (org-encode-time
  11185                                      0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
  11186 			 (org-agenda-schedule nil time))))))))
  11187 
  11188 	(?f
  11189 	 (setq cmd
  11190 	       (intern
  11191 		(completing-read "Function: " obarray #'fboundp t nil nil))))
  11192 
  11193 	(action
  11194          (setq cmd
  11195                (pcase (assoc action org-agenda-bulk-custom-functions)
  11196                  (`(,_ ,fn)
  11197                   fn)
  11198                  (`(,_ ,fn ,arg-fn)
  11199                   (apply #'apply-partially fn (funcall arg-fn)))
  11200                  (_
  11201                   (user-error "Invalid bulk action: %c" action))))
  11202          (setq redo-at-end t)))
  11203       ;; Sort the markers, to make sure that parents are handled
  11204       ;; before children.
  11205       (setq entries (sort entries
  11206 			  (lambda (a b)
  11207 			    (cond
  11208 			     ((eq (marker-buffer a) (marker-buffer b))
  11209 			      (< (marker-position a) (marker-position b)))
  11210 			     (t
  11211 			      (string< (buffer-name (marker-buffer a))
  11212 				       (buffer-name (marker-buffer b))))))))
  11213 
  11214       ;; Now loop over all markers and apply CMD.
  11215       (let ((processed 0)
  11216 	    (skipped 0))
  11217 	(dolist (e entries)
  11218 	  (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
  11219 	    (if (not pos)
  11220 		(progn (message "Skipping removed entry at %s" e)
  11221 		       (cl-incf skipped))
  11222 	      (goto-char pos)
  11223 	      (let (org-loop-over-headlines-in-active-region) (funcall cmd))
  11224 	      ;; `post-command-hook' is not run yet.  We make sure any
  11225 	      ;; pending log note is processed.
  11226 	      (when org-log-setup (org-add-log-note))
  11227 	      (cl-incf processed))))
  11228 	(when redo-at-end (org-agenda-redo))
  11229 	(unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
  11230 	(message "Acted on %d entries%s%s"
  11231 		 processed
  11232 		 (if (= skipped 0)
  11233 		     ""
  11234 		   (format ", skipped %d (disappeared before their turn)"
  11235 			   skipped))
  11236 		 (if (not org-agenda-persistent-marks) "" " (kept marked)"))))))
  11237 
  11238 (defun org-agenda-capture (&optional with-time)
  11239   "Call `org-capture' with the date at point.
  11240 With a `C-1' prefix, use the HH:MM value at point (if any) or the
  11241 current HH:MM time."
  11242   (interactive "P")
  11243   (if (not (eq major-mode 'org-agenda-mode))
  11244       (user-error "You cannot do this outside of agenda buffers")
  11245     (let ((org-overriding-default-time
  11246 	   (org-get-cursor-date (equal with-time 1))))
  11247       (call-interactively 'org-capture))))
  11248 
  11249 ;;; Dragging agenda lines forward/backward
  11250 
  11251 (defun org-agenda-reapply-filters ()
  11252   "Re-apply all agenda filters."
  11253   (mapcar
  11254    (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
  11255    `((,org-agenda-tag-filter tag)
  11256      (,org-agenda-category-filter category)
  11257      (,org-agenda-regexp-filter regexp)
  11258      (,org-agenda-effort-filter effort)
  11259      (,(assoc-default 'tag org-agenda-filters-preset) tag)
  11260      (,(assoc-default 'category org-agenda-filters-preset) category)
  11261      (,(assoc-default 'effort org-agenda-filters-preset) effort)
  11262      (,(assoc-default 'regexp org-agenda-filters-preset) regexp))))
  11263 
  11264 (defun org-agenda-drag-line-forward (arg &optional backward)
  11265   "Drag an agenda line forward by ARG lines.
  11266 When the optional argument `backward' is non-nil, move backward."
  11267   (interactive "p")
  11268   (let ((inhibit-read-only t) lst line)
  11269     (if (or (not (get-text-property (point) 'txt))
  11270 	    (save-excursion
  11271 	      (dotimes (_ arg)
  11272 		(move-beginning-of-line (if backward 0 2))
  11273 		(push (not (get-text-property (point) 'txt)) lst))
  11274 	      (delq nil lst)))
  11275 	(message "Cannot move line forward")
  11276       (let ((end (save-excursion (move-beginning-of-line 2) (point))))
  11277 	(move-beginning-of-line 1)
  11278 	(setq line (buffer-substring (point) end))
  11279 	(delete-region (point) end)
  11280 	(move-beginning-of-line (funcall (if backward '1- '1+) arg))
  11281 	(insert line)
  11282 	(org-agenda-reapply-filters)
  11283 	(org-agenda-mark-clocking-task)
  11284 	(move-beginning-of-line 0)))))
  11285 
  11286 (defun org-agenda-drag-line-backward (arg)
  11287   "Drag an agenda line backward by ARG lines."
  11288   (interactive "p")
  11289   (org-agenda-drag-line-forward arg t))
  11290 
  11291 ;;; Flagging notes
  11292 
  11293 (defun org-agenda-show-the-flagging-note ()
  11294   "Display the flagging note in the other window.
  11295 When called a second time in direct sequence, offer to remove the FLAGGING
  11296 tag and (if present) the flagging note."
  11297   (interactive)
  11298   (let ((hdmarker (org-get-at-bol 'org-hd-marker))
  11299 	(win (selected-window))
  11300 	note) ;; heading newhead
  11301     (unless hdmarker
  11302       (user-error "No linked entry at point"))
  11303     (if (and (eq this-command last-command)
  11304 	     (y-or-n-p "Unflag and remove any flagging note? "))
  11305 	(progn
  11306 	  (org-agenda-remove-flag hdmarker)
  11307 	  (let ((win (get-buffer-window "*Flagging Note*")))
  11308 	    (and win (delete-window win)))
  11309 	  (message "Entry unflagged"))
  11310       (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
  11311       (unless note
  11312 	(user-error "No flagging note"))
  11313       (org-kill-new note)
  11314       (org-switch-to-buffer-other-window "*Flagging Note*")
  11315       (erase-buffer)
  11316       (insert note)
  11317       (goto-char (point-min))
  11318       (while (re-search-forward "\\\\n" nil t)
  11319 	(replace-match "\n" t t))
  11320       (goto-char (point-min))
  11321       (select-window win)
  11322       (message "%s" (substitute-command-keys "Flagging note pushed to \
  11323 kill ring.  Press `\\[org-agenda-show-the-flagging-note]' again to remove \
  11324 tag and note")))))
  11325 
  11326 (defun org-agenda-remove-flag (marker)
  11327   "Remove the FLAGGED tag and any flagging note in the entry."
  11328   (let ((newhead
  11329          (org-with-point-at marker
  11330            (org-toggle-tag "FLAGGED" 'off)
  11331            (org-entry-delete nil "THEFLAGGINGNOTE")
  11332            (org-get-heading))))
  11333     (org-agenda-change-all-lines newhead marker)
  11334     (message "Entry unflagged")))
  11335 
  11336 (defun org-agenda-get-any-marker (&optional pos)
  11337   (or (get-text-property (or pos (line-beginning-position)) 'org-hd-marker)
  11338       (get-text-property (or pos (line-beginning-position)) 'org-marker)))
  11339 
  11340 ;;; Appointment reminders
  11341 
  11342 (defvar appt-time-msg-list) ; defined in appt.el
  11343 
  11344 ;;;###autoload
  11345 (defun org-agenda-to-appt (&optional refresh filter &rest args)
  11346   "Activate appointments found in `org-agenda-files'.
  11347 
  11348 With a `\\[universal-argument]' prefix, refresh the list of \
  11349 appointments.
  11350 
  11351 If FILTER is t, interactively prompt the user for a regular
  11352 expression, and filter out entries that don't match it.
  11353 
  11354 If FILTER is a string, use this string as a regular expression
  11355 for filtering entries out.
  11356 
  11357 If FILTER is a function, filter out entries against which
  11358 calling the function returns nil.  This function takes one
  11359 argument: an entry from `org-agenda-get-day-entries'.
  11360 
  11361 FILTER can also be an alist with the car of each cell being
  11362 either `headline' or `category'.  For example:
  11363 
  11364    ((headline \"IMPORTANT\")
  11365     (category \"Work\"))
  11366 
  11367 will only add headlines containing IMPORTANT or headlines
  11368 belonging to the \"Work\" category.
  11369 
  11370 ARGS are symbols indicating what kind of entries to consider.
  11371 By default `org-agenda-to-appt' will use :deadline*, :scheduled*
  11372 \(i.e., deadlines and scheduled items with a hh:mm specification)
  11373 and :timestamp entries.  See the docstring of `org-diary' for
  11374 details and examples.
  11375 
  11376 If an entry has a APPT_WARNTIME property, its value will be used
  11377 to override `appt-message-warning-time'."
  11378   (interactive "P")
  11379   (when refresh (setq appt-time-msg-list nil))
  11380   (when (eq filter t)
  11381     (setq filter (read-from-minibuffer "Regexp filter: ")))
  11382   (let* ((cnt 0)                        ; count added events
  11383          (scope (or args '(:deadline* :scheduled* :timestamp)))
  11384          (org-agenda-new-buffers nil)
  11385          (org-deadline-warning-days 0)
  11386          ;; Do not use `org-today' here because appt only takes
  11387          ;; time and without date as argument, so it may pass wrong
  11388          ;; information otherwise
  11389          (today (org-date-to-gregorian
  11390                  (time-to-days nil)))
  11391          (org-agenda-restrict nil)
  11392          (files (org-agenda-files 'unrestricted)) entries file
  11393          (org-agenda-buffer nil))
  11394     ;; Get all entries which may contain an appt
  11395     (org-agenda-prepare-buffers files)
  11396     (while (setq file (pop files))
  11397       (setq entries
  11398             (delq nil
  11399                   (append entries
  11400                           (apply #'org-agenda-get-day-entries
  11401                                  file today scope)))))
  11402     ;; Map through entries and find if we should filter them out
  11403     (mapc
  11404      (lambda (x)
  11405        (let* ((evt (org-trim
  11406                     (replace-regexp-in-string
  11407                      org-link-bracket-re "\\2"
  11408                      (or (get-text-property 1 'txt x) ""))))
  11409               (cat (get-text-property (1- (length x)) 'org-category x))
  11410               (tod (get-text-property 1 'time-of-day x))
  11411               (ok (or (null filter)
  11412                       (and (stringp filter) (string-match filter evt))
  11413                       (and (functionp filter) (funcall filter x))
  11414                       (and (listp filter)
  11415                            (let ((cat-filter (cadr (assq 'category filter)))
  11416                                  (evt-filter (cadr (assq 'headline filter))))
  11417                              (or (and (stringp cat-filter)
  11418                                       (string-match cat-filter cat))
  11419                                  (and (stringp evt-filter)
  11420                                       (string-match evt-filter evt)))))))
  11421               (wrn (get-text-property 1 'warntime x)))
  11422          ;; FIXME: Shall we remove text-properties for the appt text?
  11423          ;; (setq evt (set-text-properties 0 (length evt) nil evt))
  11424          (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt)))
  11425            (setq tod (concat "00" (number-to-string tod)))
  11426            (setq tod (when (string-match
  11427                             "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
  11428                        (concat (match-string 1 tod) ":"
  11429                                (match-string 2 tod))))
  11430            (when (appt-add tod evt wrn)
  11431              (setq cnt (1+ cnt))))))
  11432      entries)
  11433     (org-release-buffers org-agenda-new-buffers)
  11434     (if (eq cnt 0)
  11435         (message "No event to add")
  11436       (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
  11437 
  11438 (defun org-agenda-today-p (date)
  11439   "Non-nil when DATE means today.
  11440 DATE is either a list of the form (month day year) or a number of
  11441 days as returned by `calendar-absolute-from-gregorian' or
  11442 `org-today'.  This function considers `org-extend-today-until'
  11443 when defining today."
  11444   (eq (org-today)
  11445       (if (consp date) (calendar-absolute-from-gregorian date) date)))
  11446 
  11447 (defun org-agenda-todo-yesterday (&optional arg)
  11448   "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
  11449   (interactive "P")
  11450   (let* ((org-use-effective-time t)
  11451 	 (hour (nth 2 (decode-time (org-current-time))))
  11452          (org-extend-today-until (1+ hour)))
  11453     (org-agenda-todo arg)))
  11454 
  11455 (defun org-agenda-ctrl-c-ctrl-c ()
  11456   "Set tags in agenda buffer."
  11457   (interactive)
  11458   (org-agenda-set-tags))
  11459 
  11460 (provide 'org-agenda)
  11461 
  11462 ;;; org-agenda.el ends here