mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 76bbd07de7add0f9d13c6914f158d19630fe2f62
commit | author | age
76bbd0 1 ;;; org-agenda.el --- Dynamic task and appointment lists for Org
C 2
3 ;; Copyright (C) 2004-2018 Free Software Foundation, Inc.
4
5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
6 ;; Keywords: outlines, hypermedia, calendar, wp
7 ;; Homepage: https://orgmode.org
8 ;;
9 ;; This file is part of GNU Emacs.
10 ;;
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 ;;
25 ;;; Commentary:
26
27 ;; This file contains the code for creating and using the Agenda for Org.
28 ;;
29 ;; The functions `org-batch-agenda', `org-batch-agenda-csv', and
30 ;; `org-batch-store-agenda-views' are implemented as macros to provide
31 ;; a convenient way for extracting agenda information from the command
32 ;; line.  The Lisp does not evaluate parameters of a macro call; thus
33 ;; it is not necessary to quote the parameters passed to one of those
34 ;; functions.  E.g. you can write:
35 ;;
36 ;;   emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)'
37 ;;
38 ;; To export an agenda spanning 7 days.  If `org-batch-agenda' would
39 ;; have been implemented as a regular function you'd have to quote the
40 ;; symbol org-agenda-span.  Moreover: To use a symbol as parameter
41 ;; value you would have to double quote the symbol.
42 ;;
43 ;; This is a hack, but it works even when running Org byte-compiled.
44 ;;
45
46 ;;; Code:
47
48 (require 'cl-lib)
49 (require 'org)
50 (require 'org-macs)
51
52 (declare-function diary-add-to-list "diary-lib"
53                   (date string specifier &optional marker globcolor literal))
54 (declare-function calendar-iso-to-absolute      "cal-iso"    (date))
55 (declare-function calendar-astro-date-string    "cal-julian" (&optional date))
56 (declare-function calendar-bahai-date-string    "cal-bahai"  (&optional date))
57 (declare-function calendar-chinese-date-string  "cal-china"  (&optional date))
58 (declare-function calendar-coptic-date-string   "cal-coptic" (&optional date))
59 (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date))
60 (declare-function calendar-french-date-string   "cal-french" (&optional date))
61 (declare-function calendar-goto-date            "cal-move"   (date))
62 (declare-function calendar-hebrew-date-string   "cal-hebrew" (&optional date))
63 (declare-function calendar-islamic-date-string  "cal-islam"  (&optional date))
64 (declare-function calendar-iso-date-string      "cal-iso"    (&optional date))
65 (declare-function calendar-iso-from-absolute    "cal-iso"    (date))
66 (declare-function calendar-julian-date-string   "cal-julian" (&optional date))
67 (declare-function calendar-mayan-date-string    "cal-mayan"  (&optional date))
68 (declare-function calendar-persian-date-string  "cal-persia" (&optional date))
69 (declare-function calendar-check-holidays       "holidays" (date))
70
71 (declare-function org-columns-remove-overlays "org-colview" ())
72 (declare-function org-datetree-find-date-create "org-datetree"
73           (date &optional keep-restriction))
74 (declare-function org-columns-quit              "org-colview" ())
75 (declare-function diary-date-display-form       "diary-lib"  (&optional type))
76 (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
77 (declare-function org-habit-insert-consistency-graphs
78           "org-habit" (&optional line))
79 (declare-function org-is-habit-p "org-habit" (&optional pom))
80 (declare-function org-habit-parse-todo "org-habit" (&optional pom))
81 (declare-function org-habit-get-priority "org-habit" (habit &optional moment))
82 (declare-function org-agenda-columns "org-colview" ())
83 (declare-function org-add-archive-files "org-archive" (files))
84 (declare-function org-capture "org-capture" (&optional goto keys))
85
86 (defvar calendar-mode-map)
87 (defvar org-clock-current-task)
88 (defvar org-current-tag-alist)
89 (defvar org-mobile-force-id-on-agenda-items)
90 (defvar org-habit-show-habits)
91 (defvar org-habit-show-habits-only-for-today)
92 (defvar org-habit-show-all-today)
93
94 ;; Defined somewhere in this file, but used before definition.
95 (defvar org-agenda-buffer-name "*Org Agenda*")
96 (defvar org-agenda-overriding-header nil)
97 (defvar org-agenda-title-append nil)
98 (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
99 (with-no-warnings (defvar date))  ;; unprefixed, from calendar.el
100 (defvar original-date) ; dynamically scoped, calendar.el does scope this
101
102 (defvar org-agenda-undo-list nil
103   "List of undoable operations in the agenda since last refresh.")
104 (defvar org-agenda-pending-undo-list nil
105   "In a series of undo commands, this is the list of remaining undo items.")
106
107 (defcustom org-agenda-confirm-kill 1
108   "When set, remote killing from the agenda buffer needs confirmation.
109 When t, a confirmation is always needed.  When a number N, confirmation is
110 only needed when the text to be killed contains more than N non-white lines."
111   :group 'org-agenda
112   :type '(choice
113       (const :tag "Never" nil)
114       (const :tag "Always" t)
115       (integer :tag "When more than N lines")))
116
117 (defcustom org-agenda-compact-blocks nil
118   "Non-nil means make the block agenda more compact.
119 This is done globally by leaving out lines like the agenda span
120 name and week number or the separator lines."
121   :group 'org-agenda
122   :type 'boolean)
123
124 (defcustom org-agenda-block-separator ?=
125   "The separator between blocks in the agenda.
126 If this is a string, it will be used as the separator, with a newline added.
127 If it is a character, it will be repeated to fill the window width.
128 If nil the separator is disabled.  In `org-agenda-custom-commands' this
129 addresses the separator between the current and the previous block."
130   :group 'org-agenda
131   :type '(choice
132       (const :tag "Disabled" nil)
133       (character)
134       (string)))
135
136 (defgroup org-agenda-export nil
137   "Options concerning exporting agenda views in Org mode."
138   :tag "Org Agenda Export"
139   :group 'org-agenda)
140
141 (defcustom org-agenda-with-colors t
142   "Non-nil means use colors in agenda views."
143   :group 'org-agenda-export
144   :type 'boolean)
145
146 (defcustom org-agenda-exporter-settings nil
147   "Alist of variable/value pairs that should be active during agenda export.
148 This is a good place to set options for ps-print and for htmlize.
149 Note that the way this is implemented, the values will be evaluated
150 before assigned to the variables.  So make sure to quote values you do
151 *not* want evaluated, for example
152
153    (setq org-agenda-exporter-settings
154          \\='((ps-print-color-p \\='black-white)))"
155   :group 'org-agenda-export
156   :type '(repeat
157       (list
158        (variable)
159        (sexp :tag "Value"))))
160
161 (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text)
162   "Hook run in a temporary buffer before writing the agenda to an export file.
163 A useful function for this hook is `org-agenda-add-entry-text'."
164   :group 'org-agenda-export
165   :type 'hook
166   :options '(org-agenda-add-entry-text))
167
168 (defcustom org-agenda-add-entry-text-maxlines 0
169   "Maximum number of entry text lines to be added to agenda.
170 This is only relevant when `org-agenda-add-entry-text' is part of
171 `org-agenda-before-write-hook', which is the default.
172 When this is 0, nothing will happen.  When it is greater than 0, it
173 specifies the maximum number of lines that will be added for each entry
174 that is listed in the agenda view.
175
176 Note that this variable is not used during display, only when exporting
177 the agenda.  For agenda display, see the variables `org-agenda-entry-text-mode'
178 and `org-agenda-entry-text-maxlines'."
179   :group 'org-agenda
180   :type 'integer)
181
182 (defcustom org-agenda-add-entry-text-descriptive-links t
183   "Non-nil means export org-links as descriptive links in agenda added text.
184 This variable applies to the text added to the agenda when
185 `org-agenda-add-entry-text-maxlines' is larger than 0.
186 When this variable nil, the URL will (also) be shown."
187   :group 'org-agenda
188   :type 'boolean)
189
190 (defcustom org-agenda-export-html-style nil
191   "The style specification for exported HTML Agenda files.
192 If this variable contains a string, it will replace the default <style>
193 section as produced by `htmlize'.
194 Since there are different ways of setting style information, this variable
195 needs to contain the full HTML structure to provide a style, including the
196 surrounding HTML tags.  The style specifications should include definitions
197 the fonts used by the agenda, here is an example:
198
199    <style type=\"text/css\">
200        p { font-weight: normal; color: gray; }
201        .org-agenda-structure {
202           font-size: 110%;
203           color: #003399;
204           font-weight: 600;
205        }
206        .org-todo {
207           color: #cc6666;
208           font-weight: bold;
209        }
210        .org-agenda-done {
211           color: #339933;
212        }
213        .org-done {
214           color: #339933;
215        }
216        .title { text-align: center; }
217        .todo, .deadline { color: red; }
218        .done { color: green; }
219     </style>
220
221 or, if you want to keep the style in a file,
222
223    <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
224
225 As the value of this option simply gets inserted into the HTML <head> header,
226 you can \"misuse\" it to also add other text to the header."
227   :group 'org-agenda-export
228   :group 'org-export-html
229   :type '(choice
230       (const nil)
231       (string)))
232
233 (defcustom org-agenda-persistent-filter nil
234   "When set, keep filters from one agenda view to the next."
235   :group 'org-agenda
236   :type 'boolean)
237
238 (defgroup org-agenda-custom-commands nil
239   "Options concerning agenda views in Org mode."
240   :tag "Org Agenda Custom Commands"
241   :group 'org-agenda)
242
243 (defconst org-sorting-choice
244   '(choice
245     (const time-up) (const time-down)
246     (const timestamp-up) (const timestamp-down)
247     (const scheduled-up) (const scheduled-down)
248     (const deadline-up)  (const deadline-down)
249     (const ts-up) (const ts-down)
250     (const tsia-up) (const tsia-down)
251     (const category-keep) (const category-up) (const category-down)
252     (const tag-down) (const tag-up)
253     (const priority-up) (const priority-down)
254     (const todo-state-up) (const todo-state-down)
255     (const effort-up) (const effort-down)
256     (const habit-up) (const habit-down)
257     (const alpha-up) (const alpha-down)
258     (const user-defined-up) (const user-defined-down))
259   "Sorting choices.")
260
261 ;; Keep custom values for `org-agenda-filter-preset' compatible with
262 ;; the new variable `org-agenda-tag-filter-preset'.
263 (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
264 (defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
265
266 (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
267   "List of types searched for when creating the daily/weekly agenda.
268 This variable is a list of symbols that controls the types of
269 items that appear in the daily/weekly agenda.  Allowed symbols in this
270 list are are
271
272   :timestamp   List items containing a date stamp or date range matching
273                the selected date.  This includes sexp entries in angular
274                brackets.
275
276   :sexp        List entries resulting from plain diary-like sexps.
277
278   :deadline    List deadline due on that date.  When the date is today,
279                also list any deadlines past due, or due within
280            `org-deadline-warning-days'.
281
282   :deadline*   Same as above, but only include the deadline if it has an
283                hour specification as [h]h:mm.
284
285   :scheduled   List all items which are scheduled for the given date.
286            The diary for *today* also contains items which were
287            scheduled earlier and are not yet marked DONE.
288
289   :scheduled*  Same as above, but only include the scheduled item if it
290                has an hour specification as [h]h:mm.
291
292 By default, all four non-starred types are turned on.
293
294 When :scheduled* or :deadline* are included, :schedule or :deadline
295 will be ignored.
296
297 Never set this variable globally using `setq', because then it
298 will apply to all future agenda commands.  Instead, bind it with
299 `let' to scope it dynamically into the agenda-constructing
300 command.  A good way to set it is through options in
301 `org-agenda-custom-commands'.  For a more flexible (though
302 somewhat less efficient) way of determining what is included in
303 the daily/weekly agenda, see `org-agenda-skip-function'.")
304
305 (defconst org-agenda-custom-commands-local-options
306   `(repeat :tag "Local settings for this command.  Remember to quote values"
307        (choice :tag "Setting"
308            (list :tag "Heading for this block"
309              (const org-agenda-overriding-header)
310              (string :tag "Headline"))
311            (list :tag "Files to be searched"
312              (const org-agenda-files)
313              (list
314               (const :format "" quote)
315               (repeat (file))))
316            (list :tag "Sorting strategy"
317              (const org-agenda-sorting-strategy)
318              (list
319               (const :format "" quote)
320               (repeat
321                ,org-sorting-choice)))
322            (list :tag "Prefix format"
323              (const org-agenda-prefix-format :value "  %-12:c%?-12t% s")
324              (string))
325            (list :tag "Number of days in agenda"
326              (const org-agenda-span)
327              (list
328               (const :format "" quote)
329               (choice (const :tag "Day" day)
330                   (const :tag "Week" week)
331                   (const :tag "Fortnight" fortnight)
332                   (const :tag "Month" month)
333                   (const :tag "Year" year)
334                   (integer :tag "Custom"))))
335            (list :tag "Fixed starting date"
336              (const org-agenda-start-day)
337              (string :value "2007-11-01"))
338            (list :tag "Start on day of week"
339              (const org-agenda-start-on-weekday)
340              (choice :value 1
341                  (const :tag "Today" nil)
342                  (integer :tag "Weekday No.")))
343            (list :tag "Include data from diary"
344              (const org-agenda-include-diary)
345              (boolean))
346            (list :tag "Deadline Warning days"
347              (const org-deadline-warning-days)
348              (integer :value 1))
349            (list :tag "Category filter preset"
350              (const org-agenda-category-filter-preset)
351              (list
352               (const :format "" quote)
353               (repeat
354                (string :tag "+category or -category"))))
355            (list :tag "Tags filter preset"
356              (const org-agenda-tag-filter-preset)
357              (list
358               (const :format "" quote)
359               (repeat
360                (string :tag "+tag or -tag"))))
361            (list :tag "Effort filter preset"
362              (const org-agenda-effort-filter-preset)
363              (list
364               (const :format "" quote)
365               (repeat
366                (string :tag "+=10 or -=10 or +<10 or ->10"))))
367            (list :tag "Regexp filter preset"
368              (const org-agenda-regexp-filter-preset)
369              (list
370               (const :format "" quote)
371               (repeat
372                (string :tag "+regexp or -regexp"))))
373            (list :tag "Set daily/weekly entry types"
374              (const org-agenda-entry-types)
375              (list
376               (const :format "" quote)
377               (set :greedy t :value ,org-agenda-entry-types
378                    (const :deadline)
379                    (const :scheduled)
380                    (const :deadline*)
381                    (const :scheduled*)
382                    (const :timestamp)
383                    (const :sexp))))
384            (list :tag "Standard skipping condition"
385              :value (org-agenda-skip-function '(org-agenda-skip-entry-if))
386              (const org-agenda-skip-function)
387              (list
388               (const :format "" quote)
389               (list
390                (choice
391                 :tag "Skipping range"
392                 (const :tag "Skip entry" org-agenda-skip-entry-if)
393                 (const :tag "Skip subtree" org-agenda-skip-subtree-if))
394                (repeat :inline t :tag "Conditions for skipping"
395                    (choice
396                     :tag "Condition type"
397                     (list :tag "Regexp matches" :inline t
398                       (const :format "" regexp)
399                       (regexp))
400                     (list :tag "Regexp does not match" :inline t
401                       (const :format "" notregexp)
402                       (regexp))
403                     (list :tag "TODO state is" :inline t
404                       (const todo)
405                       (choice
406                        (const :tag "Any not-done state" todo)
407                        (const :tag "Any done state" done)
408                        (const :tag "Any state" any)
409                        (list :tag "Keyword list"
410                          (const :format "" quote)
411                          (repeat (string :tag "Keyword")))))
412                     (list :tag "TODO state is not" :inline t
413                       (const nottodo)
414                       (choice
415                        (const :tag "Any not-done state" todo)
416                        (const :tag "Any done state" done)
417                        (const :tag "Any state" any)
418                        (list :tag "Keyword list"
419                          (const :format "" quote)
420                          (repeat (string :tag "Keyword")))))
421                     (const :tag "scheduled" scheduled)
422                     (const :tag "not scheduled" notscheduled)
423                     (const :tag "deadline" deadline)
424                     (const :tag "no deadline" notdeadline)
425                     (const :tag "timestamp" timestamp)
426                     (const :tag "no timestamp" nottimestamp))))))
427            (list :tag "Non-standard skipping condition"
428              :value (org-agenda-skip-function)
429              (const org-agenda-skip-function)
430              (sexp :tag "Function or form (quoted!)"))
431            (list :tag "Any variable"
432              (variable :tag "Variable")
433              (sexp :tag "Value (sexp)"))))
434   "Selection of examples for agenda command settings.
435 This will be spliced into the custom type of
436 `org-agenda-custom-commands'.")
437
438
439 (defcustom org-agenda-custom-commands
440   '(("n" "Agenda and all TODOs" ((agenda "") (alltodo ""))))
441   "Custom commands for the agenda.
442 \\<org-mode-map>
443 These commands will be offered on the splash screen displayed by the
444 agenda dispatcher `\\[org-agenda]'.  Each entry is a list like this:
445
446    (key desc type match settings files)
447
448 key      The key (one or more characters as a string) to be associated
449          with the command.
450 desc     A description of the command, when omitted or nil, a default
451          description is built using MATCH.
452 type     The command type, any of the following symbols:
453           agenda      The daily/weekly agenda.
454           todo        Entries with a specific TODO keyword, in all agenda files.
455           search      Entries containing search words entry or headline.
456           tags        Tags/Property/TODO match in all agenda files.
457           tags-todo   Tags/P/T match in all agenda files, TODO entries only.
458           todo-tree   Sparse tree of specific TODO keyword in *current* file.
459           tags-tree   Sparse tree with all tags matches in *current* file.
460           occur-tree  Occur sparse tree for *current* file.
461           ...         A user-defined function.
462 match    What to search for:
463           - a single keyword for TODO keyword searches
464           - a tags match expression for tags searches
465           - a word search expression for text searches.
466           - a regular expression for occur searches
467           For all other commands, this should be the empty string.
468 settings  A list of option settings, similar to that in a let form, so like
469           this: ((opt1 val1) (opt2 val2) ...).   The values will be
470           evaluated at the moment of execution, so quote them when needed.
471 files     A list of files to write the produced agenda buffer to with
472           the command `org-store-agenda-views'.
473           If a file name ends in \".html\", an HTML version of the buffer
474           is written out.  If it ends in \".ps\", a postscript version is
475           produced.  Otherwise, only the plain text is written to the file.
476
477 You can also define a set of commands, to create a composite agenda buffer.
478 In this case, an entry looks like this:
479
480   (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files)
481
482 where
483
484 desc   A description string to be displayed in the dispatcher menu.
485 cmd    An agenda command, similar to the above.  However, tree commands
486        are not allowed, but instead you can get agenda and global todo list.
487        So valid commands for a set are:
488        (agenda \"\" settings)
489        (alltodo \"\" settings)
490        (stuck \"\" settings)
491        (todo \"match\" settings files)
492        (search \"match\" settings files)
493        (tags \"match\" settings files)
494        (tags-todo \"match\" settings files)
495
496 Each command can carry a list of options, and another set of options can be
497 given for the whole set of commands.  Individual command options take
498 precedence over the general options.
499
500 When using several characters as key to a command, the first characters
501 are prefix commands.  For the dispatcher to display useful information, you
502 should provide a description for the prefix, like
503
504  (setq org-agenda-custom-commands
505    \\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
506      (\"hl\" tags \"+HOME+Lisa\")
507      (\"hp\" tags \"+HOME+Peter\")
508      (\"hk\" tags \"+HOME+Kim\")))"
509   :group 'org-agenda-custom-commands
510   :type `(repeat
511       (choice :value ("x" "Describe command here" tags "" nil)
512           (list :tag "Single command"
513             (string :tag "Access Key(s) ")
514             (option (string :tag "Description"))
515             (choice
516              (const :tag "Agenda" agenda)
517              (const :tag "TODO list" alltodo)
518              (const :tag "Search words" search)
519              (const :tag "Stuck projects" stuck)
520              (const :tag "Tags/Property match (all agenda files)" tags)
521              (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
522              (const :tag "TODO keyword search (all agenda files)" todo)
523              (const :tag "Tags sparse tree (current buffer)" tags-tree)
524              (const :tag "TODO keyword tree (current buffer)" todo-tree)
525              (const :tag "Occur tree (current buffer)" occur-tree)
526              (sexp :tag "Other, user-defined function"))
527             (string :tag "Match (only for some commands)")
528             ,org-agenda-custom-commands-local-options
529             (option (repeat :tag "Export" (file :tag "Export to"))))
530           (list :tag "Command series, all agenda files"
531             (string :tag "Access Key(s)")
532             (string :tag "Description  ")
533             (repeat :tag "Component"
534                 (choice
535                  (list :tag "Agenda"
536                        (const :format "" agenda)
537                        (const :tag "" :format "" "")
538                        ,org-agenda-custom-commands-local-options)
539                  (list :tag "TODO list (all keywords)"
540                        (const :format "" alltodo)
541                        (const :tag "" :format "" "")
542                        ,org-agenda-custom-commands-local-options)
543                  (list :tag "Search words"
544                        (const :format "" search)
545                        (string :tag "Match")
546                        ,org-agenda-custom-commands-local-options)
547                  (list :tag "Stuck projects"
548                        (const :format "" stuck)
549                        (const :tag "" :format "" "")
550                        ,org-agenda-custom-commands-local-options)
551                  (list :tag "Tags search"
552                        (const :format "" tags)
553                        (string :tag "Match")
554                        ,org-agenda-custom-commands-local-options)
555                  (list :tag "Tags search, TODO entries only"
556                        (const :format "" tags-todo)
557                        (string :tag "Match")
558                        ,org-agenda-custom-commands-local-options)
559                  (list :tag "TODO keyword search"
560                        (const :format "" todo)
561                        (string :tag "Match")
562                        ,org-agenda-custom-commands-local-options)
563                  (list :tag "Other, user-defined function"
564                        (symbol :tag "function")
565                        (string :tag "Match")
566                        ,org-agenda-custom-commands-local-options)))
567
568             (repeat :tag "Settings for entire command set"
569                 (list (variable :tag "Any variable")
570                       (sexp :tag "Value")))
571             (option (repeat :tag "Export" (file :tag "Export to"))))
572           (cons :tag "Prefix key documentation"
573             (string :tag "Access Key(s)")
574             (string :tag "Description  ")))))
575
576 (defcustom org-agenda-query-register ?o
577   "The register holding the current query string.
578 The purpose of this is that if you construct a query string interactively,
579 you can then use it to define a custom command."
580   :group 'org-agenda-custom-commands
581   :type 'character)
582
583 (defcustom org-stuck-projects
584   '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
585   "How to identify stuck projects.
586 This is a list of four items:
587 1. A tags/todo/property matcher string that is used to identify a project.
588    See the manual for a description of tag and property searches.
589    The entire tree below a headline matched by this is considered one project.
590 2. A list of TODO keywords identifying non-stuck projects.
591    If the project subtree contains any headline with one of these todo
592    keywords, the project is considered to be not stuck.  If you specify
593    \"*\" as a keyword, any TODO keyword will mark the project unstuck.
594 3. A list of tags identifying non-stuck projects.
595    If the project subtree contains any headline with one of these tags,
596    the project is considered to be not stuck.  If you specify \"*\" as
597    a tag, any tag will mark the project unstuck.  Note that this is about
598    the explicit presence of a tag somewhere in the subtree, inherited
599    tags do not count here.  If inherited tags make a project not stuck,
600    use \"-TAG\" in the tags part of the matcher under (1.) above.
601 4. An arbitrary regular expression matching non-stuck projects.
602
603 If the project turns out to be not stuck, search continues also in the
604 subtree to see if any of the subtasks have project status.
605
606 See also the variable `org-tags-match-list-sublevels' which applies
607 to projects matched by this search as well.
608
609 After defining this variable, you may use `org-agenda-list-stuck-projects'
610 \(bound to `\\[org-agenda] #') to produce the list."
611   :group 'org-agenda-custom-commands
612   :type '(list
613       (string :tag "Tags/TODO match to identify a project")
614       (repeat :tag "Projects are *not* stuck if they have an entry with \
615 TODO keyword any of" (string))
616       (repeat :tag "Projects are *not* stuck if they have an entry with \
617 TAG being any of" (string))
618       (regexp :tag "Projects are *not* stuck if this regexp matches inside \
619 the subtree")))
620
621 (defgroup org-agenda-skip nil
622   "Options concerning skipping parts of agenda files."
623   :tag "Org Agenda Skip"
624   :group 'org-agenda)
625
626 (defcustom org-agenda-skip-function-global nil
627   "Function to be called at each match during agenda construction.
628 If this function returns nil, the current match should not be skipped.
629 If the function decided to skip an agenda match, is must return the
630 buffer position from which the search should be continued.
631 This may also be a Lisp form, which will be evaluated.
632
633 This variable will be applied to every agenda match, including
634 tags/property searches and TODO lists.  So try to make the test function
635 do its checking as efficiently as possible.  To implement a skipping
636 condition just for specific agenda commands, use the variable
637 `org-agenda-skip-function' which can be set in the options section
638 of custom agenda commands."
639   :group 'org-agenda-skip
640   :type 'sexp)
641
642 (defgroup org-agenda-daily/weekly nil
643   "Options concerning the daily/weekly agenda."
644   :tag "Org Agenda Daily/Weekly"
645   :group 'org-agenda)
646 (defgroup org-agenda-todo-list nil
647   "Options concerning the global todo list agenda view."
648   :tag "Org Agenda Todo List"
649   :group 'org-agenda)
650 (defgroup org-agenda-match-view nil
651   "Options concerning the general tags/property/todo match agenda view."
652   :tag "Org Agenda Match View"
653   :group 'org-agenda)
654 (defgroup org-agenda-search-view nil
655   "Options concerning the search agenda view."
656   :tag "Org Agenda Search View"
657   :group 'org-agenda)
658
659 (defvar org-agenda-archives-mode nil
660   "Non-nil means the agenda will include archived items.
661 If this is the symbol `trees', trees in the selected agenda scope
662 that are marked with the ARCHIVE tag will be included anyway.  When this is
663 t, also all archive files associated with the current selection of agenda
664 files will be included.")
665
666 (defcustom org-agenda-restriction-lock-highlight-subtree t
667   "Non-nil means highlight the whole subtree when restriction is active.
668 Otherwise only highlight the headline.  Highlighting the whole subtree is
669 useful to ensure no edits happen beyond the restricted region."
670   :group 'org-agenda
671   :type 'boolean)
672
673 (defcustom org-agenda-skip-comment-trees t
674   "Non-nil means skip trees that start with the COMMENT keyword.
675 When nil, these trees are also scanned by agenda commands."
676   :group 'org-agenda-skip
677   :type 'boolean)
678
679 (defcustom org-agenda-todo-list-sublevels t
680   "Non-nil means check also the sublevels of a TODO entry for TODO entries.
681 When nil, the sublevels of a TODO entry are not checked, resulting in
682 potentially much shorter TODO lists."
683   :group 'org-agenda-skip
684   :group 'org-agenda-todo-list
685   :type 'boolean)
686
687 (defcustom org-agenda-todo-ignore-with-date nil
688   "Non-nil means don't show entries with a date in the global todo list.
689 You can use this if you prefer to mark mere appointments with a TODO keyword,
690 but don't want them to show up in the TODO list.
691 When this is set, it also covers deadlines and scheduled items, the settings
692 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
693 will be ignored.
694 See also the variable `org-agenda-tags-todo-honor-ignore-options'."
695   :group 'org-agenda-skip
696   :group 'org-agenda-todo-list
697   :type 'boolean)
698
699 (defcustom org-agenda-todo-ignore-timestamp nil
700   "Non-nil means don't show entries with a timestamp.
701 This applies when creating the global todo list.
702 Valid values are:
703
704 past     Don't show entries for today or in the past.
705
706 future   Don't show entries with a timestamp in the future.
707          The idea behind this is that if it has a future
708          timestamp, you don't want to think about it until the
709          date.
710
711 all      Don't show any entries with a timestamp in the global todo list.
712          The idea behind this is that by setting a timestamp, you
713          have already \"taken care\" of this item.
714
715 This variable can also have an integer as a value.  If positive (N),
716 todos with a timestamp N or more days in the future will be ignored.  If
717 negative (-N), todos with a timestamp N or more days in the past will be
718 ignored.  If 0, todos with a timestamp either today or in the future will
719 be ignored.  For example, a value of -1 will exclude todos with a
720 timestamp in the past (yesterday or earlier), while a value of 7 will
721 exclude todos with a timestamp a week or more in the future.
722
723 See also `org-agenda-todo-ignore-with-date'.
724 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
725 to make his option also apply to the tags-todo list."
726   :group 'org-agenda-skip
727   :group 'org-agenda-todo-list
728   :version "24.1"
729   :type '(choice
730       (const :tag "Ignore future timestamp todos" future)
731       (const :tag "Ignore past or present timestamp todos" past)
732       (const :tag "Ignore all timestamp todos" all)
733       (const :tag "Show timestamp todos" nil)
734       (integer :tag "Ignore if N or more days in past(-) or future(+).")))
735
736 (defcustom org-agenda-todo-ignore-scheduled nil
737   "Non-nil means, ignore some scheduled TODO items when making TODO list.
738 This applies when creating the global todo list.
739 Valid values are:
740
741 past     Don't show entries scheduled today or in the past.
742
743 future   Don't show entries scheduled in the future.
744          The idea behind this is that by scheduling it, you don't want to
745          think about it until the scheduled date.
746
747 all      Don't show any scheduled entries in the global todo list.
748          The idea behind this is that by scheduling it, you have already
749          \"taken care\" of this item.
750
751 t        Same as `all', for backward compatibility.
752
753 This variable can also have an integer as a value.  See
754 `org-agenda-todo-ignore-timestamp' for more details.
755
756 See also `org-agenda-todo-ignore-with-date'.
757 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
758 to make his option also apply to the tags-todo list."
759   :group 'org-agenda-skip
760   :group 'org-agenda-todo-list
761   :type '(choice
762       (const :tag "Ignore future-scheduled todos" future)
763       (const :tag "Ignore past- or present-scheduled todos" past)
764       (const :tag "Ignore all scheduled todos" all)
765       (const :tag "Ignore all scheduled todos (compatibility)" t)
766       (const :tag "Show scheduled todos" nil)
767       (integer :tag "Ignore if N or more days in past(-) or future(+).")))
768
769 (defcustom org-agenda-todo-ignore-deadlines nil
770   "Non-nil means ignore some deadline TODO items when making TODO list.
771
772 There are different motivations for using different values, please think
773 carefully when configuring this variable.
774
775 This applies when creating the global TODO list.
776
777 Valid values are:
778
779 near    Don't show near deadline entries.  A deadline is near when it is
780         closer than `org-deadline-warning-days' days.  The idea behind this
781         is that such items will appear in the agenda anyway.
782
783 far     Don't show TODO entries where a deadline has been defined, but
784         is not going to happen anytime soon.  This is useful if you want to use
785         the TODO list to figure out what to do now.
786
787 past    Don't show entries with a deadline timestamp for today or in the past.
788
789 future  Don't show entries with a deadline timestamp in the future, not even
790         when they become `near' ones.  Use it with caution.
791
792 all     Ignore all TODO entries that do have a deadline.
793
794 t       Same as `near', for backward compatibility.
795
796 This variable can also have an integer as a value.  See
797 `org-agenda-todo-ignore-timestamp' for more details.
798
799 See also `org-agenda-todo-ignore-with-date'.
800 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
801 to make his option also apply to the tags-todo list."
802   :group 'org-agenda-skip
803   :group 'org-agenda-todo-list
804   :type '(choice
805       (const :tag "Ignore near deadlines" near)
806       (const :tag "Ignore near deadlines (compatibility)" t)
807       (const :tag "Ignore far deadlines" far)
808       (const :tag "Ignore all TODOs with a deadlines" all)
809       (const :tag "Show all TODOs, even if they have a deadline" nil)
810       (integer :tag "Ignore if N or more days in past(-) or future(+).")))
811
812 (defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil
813   "Time unit to use when possibly ignoring an agenda item.
814
815 See the docstring of various `org-agenda-todo-ignore-*' options.
816 The default is to compare time stamps using days.  An item is thus
817 considered to be in the future if it is at least one day after today.
818 Non-nil means to compare time stamps using seconds.  An item is then
819 considered future if it has a time value later than current time."
820   :group 'org-agenda-skip
821   :group 'org-agenda-todo-list
822   :version "24.4"
823   :package-version '(Org . "8.0")
824   :type '(choice
825       (const :tag "Compare time with days" nil)
826       (const :tag "Compare time with seconds" t)))
827
828 (defcustom org-agenda-tags-todo-honor-ignore-options nil
829   "Non-nil means honor todo-list ignores options also in tags-todo search.
830 The variables
831    `org-agenda-todo-ignore-with-date',
832    `org-agenda-todo-ignore-timestamp',
833    `org-agenda-todo-ignore-scheduled',
834    `org-agenda-todo-ignore-deadlines'
835 make the global TODO list skip entries that have time stamps of certain
836 kinds.  If this option is set, the same options will also apply for the
837 tags-todo search, which is the general tags/property matcher
838 restricted to unfinished TODO entries only."
839   :group 'org-agenda-skip
840   :group 'org-agenda-todo-list
841   :group 'org-agenda-match-view
842   :type 'boolean)
843
844 (defcustom org-agenda-skip-scheduled-if-done nil
845   "Non-nil means don't show scheduled items in agenda when they are done.
846 This is relevant for the daily/weekly agenda, not for the TODO list.  It
847 applies only to the actual date of the scheduling.  Warnings about an item
848 with a past scheduling dates are always turned off when the item is DONE."
849   :group 'org-agenda-skip
850   :group 'org-agenda-daily/weekly
851   :type 'boolean)
852
853 (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil
854   "Non-nil means skip scheduling line if same entry shows because of deadline.
855
856 In the agenda of today, an entry can show up multiple times
857 because it is both scheduled and has a nearby deadline, and maybe
858 a plain time stamp as well.
859
860 When this variable is nil, the entry will be shown several times.
861
862 When set to t, then only the deadline is shown and the fact that
863 the entry is scheduled today or was scheduled previously is not
864 shown.
865
866 When set to the symbol `not-today', skip scheduled previously,
867 but not scheduled today.
868
869 When set to the symbol `repeated-after-deadline', skip scheduled
870 items if they are repeated beyond the current deadline."
871   :group 'org-agenda-skip
872   :group 'org-agenda-daily/weekly
873   :type '(choice
874       (const :tag "Never" nil)
875       (const :tag "Always" t)
876       (const :tag "Not when scheduled today" not-today)
877       (const :tag "When repeated past deadline" repeated-after-deadline)))
878
879 (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
880   "Non-nil means skip timestamp line if same entry shows because of deadline.
881 In the agenda of today, an entry can show up multiple times
882 because it has both a plain timestamp and has a nearby deadline.
883 When this variable is t, then only the deadline is shown and the
884 fact that the entry has a timestamp for or including today is not
885 shown.  When this variable is nil, the entry will be shown
886 several times."
887   :group 'org-agenda-skip
888   :group 'org-agenda-daily/weekly
889   :version "24.1"
890   :type '(choice
891       (const :tag "Never" nil)
892       (const :tag "Always" t)))
893
894 (defcustom org-agenda-skip-deadline-if-done nil
895   "Non-nil means don't show deadlines when the corresponding item is done.
896 When nil, the deadline is still shown and should give you a happy feeling.
897 This is relevant for the daily/weekly agenda.  It applies only to the
898 actual date of the deadline.  Warnings about approaching and past-due
899 deadlines are always turned off when the item is DONE."
900   :group 'org-agenda-skip
901   :group 'org-agenda-daily/weekly
902   :type 'boolean)
903
904 (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil
905   "Non-nil means skip deadline prewarning when entry is also scheduled.
906 This will apply on all days where a prewarning for the deadline would
907 be shown, but not at the day when the entry is actually due.  On that day,
908 the deadline will be shown anyway.
909 This variable may be set to nil, t, the symbol `pre-scheduled',
910 or a number which will then give the number of days before the actual
911 deadline when the prewarnings should resume.  The symbol `pre-scheduled'
912 eliminates the deadline prewarning only prior to the scheduled date.
913 This can be used in a workflow where the first showing of the deadline will
914 trigger you to schedule it, and then you don't want to be reminded of it
915 because you will take care of it on the day when scheduled."
916   :group 'org-agenda-skip
917   :group 'org-agenda-daily/weekly
918   :version "24.1"
919   :type '(choice
920       (const :tag "Always show prewarning" nil)
921       (const :tag "Remove prewarning prior to scheduled date" pre-scheduled)
922       (const :tag "Remove prewarning if entry is scheduled" t)
923       (integer :tag "Restart prewarning N days before deadline")))
924
925 (defcustom org-agenda-skip-scheduled-delay-if-deadline nil
926   "Non-nil means skip scheduled delay when entry also has a deadline.
927 This variable may be set to nil, t, the symbol `post-deadline',
928 or a number which will then give the number of days after the actual
929 scheduled date when the delay should expire.  The symbol `post-deadline'
930 eliminates the schedule delay when the date is posterior to the deadline."
931   :group 'org-agenda-skip
932   :group 'org-agenda-daily/weekly
933   :version "24.4"
934   :package-version '(Org . "8.0")
935   :type '(choice
936       (const :tag "Always honor delay" nil)
937       (const :tag "Ignore delay if posterior to the deadline" post-deadline)
938       (const :tag "Ignore delay if entry has a deadline" t)
939       (integer :tag "Honor delay up until N days after the scheduled date")))
940
941 (defcustom org-agenda-skip-additional-timestamps-same-entry nil
942   "When nil, multiple same-day timestamps in entry make multiple agenda lines.
943 When non-nil, after the search for timestamps has matched once in an
944 entry, the rest of the entry will not be searched."
945   :group 'org-agenda-skip
946   :type 'boolean)
947
948 (defcustom org-agenda-skip-timestamp-if-done nil
949   "Non-nil means don't select item by timestamp or -range if it is DONE."
950   :group 'org-agenda-skip
951   :group 'org-agenda-daily/weekly
952   :type 'boolean)
953
954 (defcustom org-agenda-dim-blocked-tasks t
955   "Non-nil means dim blocked tasks in the agenda display.
956 This causes some overhead during agenda construction, but if you
957 have turned on `org-enforce-todo-dependencies',
958 `org-enforce-todo-checkbox-dependencies', or any other blocking
959 mechanism, this will create useful feedback in the agenda.
960
961 Instead of t, this variable can also have the value `invisible'.
962 Then blocked tasks will be invisible and only become visible when
963 they become unblocked.  An exemption to this behavior is when a task is
964 blocked because of unchecked checkboxes below it.  Since checkboxes do
965 not show up in the agenda views, making this task invisible you remove any
966 trace from agenda views that there is something to do.  Therefore, a task
967 that is blocked because of checkboxes will never be made invisible, it
968 will only be dimmed."
969   :group 'org-agenda-daily/weekly
970   :group 'org-agenda-todo-list
971   :version "24.3"
972   :type '(choice
973       (const :tag "Do not dim" nil)
974       (const :tag "Dim to a gray face" t)
975       (const :tag "Make invisible" invisible)))
976
977 (defgroup org-agenda-startup nil
978   "Options concerning initial settings in the Agenda in Org Mode."
979   :tag "Org Agenda Startup"
980   :group 'org-agenda)
981
982 (defcustom org-agenda-menu-show-matcher t
983   "Non-nil means show the match string in the agenda dispatcher menu.
984 When nil, the matcher string is not shown, but is put into the help-echo
985 property so than moving the mouse over the command shows it.
986 Setting it to nil is good if matcher strings are very long and/or if
987 you want to use two-columns display (see `org-agenda-menu-two-columns')."
988   :group 'org-agenda
989   :version "24.1"
990   :type 'boolean)
991
992 (defcustom org-agenda-menu-two-columns nil
993   "Non-nil means, use two columns to show custom commands in the dispatcher.
994 If you use this, you probably want to set `org-agenda-menu-show-matcher'
995 to nil."
996   :group 'org-agenda
997   :version "24.1"
998   :type 'boolean)
999
1000 (defcustom org-agenda-finalize-hook nil
1001   "Hook run just before displaying an agenda buffer.
1002 The buffer is still writable when the hook is called.
1003
1004 You can modify some of the buffer substrings but you should be
1005 extra careful not to modify the text properties of the agenda
1006 headlines as the agenda display heavily relies on them."
1007   :group 'org-agenda-startup
1008   :type 'hook)
1009
1010 (defcustom org-agenda-mouse-1-follows-link nil
1011   "Non-nil means mouse-1 on a link will follow the link in the agenda.
1012 A longer mouse click will still set point.  Needs to be set
1013 before org.el is loaded."
1014   :group 'org-agenda-startup
1015   :type 'boolean)
1016
1017 (defcustom org-agenda-start-with-follow-mode nil
1018   "The initial value of follow mode in a newly created agenda window."
1019   :group 'org-agenda-startup
1020   :type 'boolean)
1021
1022 (defcustom org-agenda-follow-indirect nil
1023   "Non-nil means `org-agenda-follow-mode' displays only the
1024 current item's tree, in an indirect buffer."
1025   :group 'org-agenda
1026   :version "24.1"
1027   :type 'boolean)
1028
1029 (defcustom org-agenda-show-outline-path t
1030   "Non-nil means show outline path in echo area after line motion."
1031   :group 'org-agenda-startup
1032   :type 'boolean)
1033
1034 (defcustom org-agenda-start-with-entry-text-mode nil
1035   "The initial value of entry-text-mode in a newly created agenda window."
1036   :group 'org-agenda-startup
1037   :type 'boolean)
1038
1039 (defcustom org-agenda-entry-text-maxlines 5
1040   "Number of text lines to be added when `E' is pressed in the agenda.
1041
1042 Note that this variable only used during agenda display.  To add entry text
1043 when exporting the agenda, configure the variable
1044 `org-agenda-add-entry-text-maxlines'."
1045   :group 'org-agenda
1046   :type 'integer)
1047
1048 (defcustom org-agenda-entry-text-exclude-regexps nil
1049   "List of regular expressions to clean up entry text.
1050 The complete matches of all regular expressions in this list will be
1051 removed from entry text before it is shown in the agenda."
1052   :group 'org-agenda
1053   :type '(repeat (regexp)))
1054
1055 (defcustom org-agenda-entry-text-leaders "    > "
1056   "Text prepended to the entry text in agenda buffers."
1057   :version "24.4"
1058   :package-version '(Org . "8.0")
1059   :group 'org-agenda
1060   :type 'string)
1061
1062 (defvar org-agenda-entry-text-cleanup-hook nil
1063   "Hook that is run after basic cleanup of entry text to be shown in agenda.
1064 This cleanup is done in a temporary buffer, so the function may inspect and
1065 change the entire buffer.
1066 Some default stuff like drawers and scheduling/deadline dates will already
1067 have been removed when this is called, as will any matches for regular
1068 expressions listed in `org-agenda-entry-text-exclude-regexps'.")
1069
1070 (defvar org-agenda-include-inactive-timestamps nil
1071   "Non-nil means include inactive time stamps in agenda.
1072 Dynamically scoped.")
1073
1074 (defgroup org-agenda-windows nil
1075   "Options concerning the windows used by the Agenda in Org Mode."
1076   :tag "Org Agenda Windows"
1077   :group 'org-agenda)
1078
1079 (defcustom org-agenda-window-setup 'reorganize-frame
1080   "How the agenda buffer should be displayed.
1081 Possible values for this option are:
1082
1083 current-window    Show agenda in the current window, keeping all other windows.
1084 other-window      Use `switch-to-buffer-other-window' to display agenda.
1085 only-window       Show agenda, deleting all other windows.
1086 reorganize-frame  Show only two windows on the current frame, the current
1087                   window and the agenda.
1088 other-frame       Use `switch-to-buffer-other-frame' to display agenda.
1089                   Also, when exiting the agenda, kill that frame.
1090 See also the variable `org-agenda-restore-windows-after-quit'."
1091   :group 'org-agenda-windows
1092   :type '(choice
1093       (const current-window)
1094       (const other-frame)
1095       (const other-window)
1096       (const only-window)
1097       (const reorganize-frame)))
1098
1099 (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
1100   "The min and max height of the agenda window as a fraction of frame height.
1101 The value of the variable is a cons cell with two numbers between 0 and 1.
1102 It only matters if `org-agenda-window-setup' is `reorganize-frame'."
1103   :group 'org-agenda-windows
1104   :type '(cons (number :tag "Minimum") (number :tag "Maximum")))
1105
1106 (defcustom org-agenda-restore-windows-after-quit nil
1107   "Non-nil means restore window configuration upon exiting agenda.
1108 Before the window configuration is changed for displaying the agenda,
1109 the current status is recorded.  When the agenda is exited with
1110 `q' or `x' and this option is set, the old state is restored.  If
1111 `org-agenda-window-setup' is `other-frame', the value of this
1112 option will be ignored."
1113   :group 'org-agenda-windows
1114   :type 'boolean)
1115
1116 (defcustom org-agenda-span 'week
1117   "Number of days to include in overview display.
1118 Can be day, week, month, year, or any number of days.
1119 Custom commands can set this variable in the options section."
1120   :group 'org-agenda-daily/weekly
1121   :type '(choice (const :tag "Day" day)
1122          (const :tag "Week" week)
1123          (const :tag "Fortnight" fortnight)
1124          (const :tag "Month" month)
1125          (const :tag "Year" year)
1126          (integer :tag "Custom")))
1127
1128 (defcustom org-agenda-start-on-weekday 1
1129   "Non-nil means start the overview always on the specified weekday.
1130 0 denotes Sunday, 1 denotes Monday, etc.
1131 When nil, always start on the current day.
1132 Custom commands can set this variable in the options section."
1133   :group 'org-agenda-daily/weekly
1134   :type '(choice (const :tag "Today" nil)
1135          (integer :tag "Weekday No.")))
1136
1137 (defcustom org-agenda-show-all-dates t
1138   "Non-nil means `org-agenda' shows every day in the selected range.
1139 When nil, only the days which actually have entries are shown."
1140   :group 'org-agenda-daily/weekly
1141   :type 'boolean)
1142
1143 (defcustom org-agenda-format-date 'org-agenda-format-date-aligned
1144   "Format string for displaying dates in the agenda.
1145 Used by the daily/weekly agenda.  This should be a format string
1146 understood by `format-time-string', or a function returning the
1147 formatted date as a string.  The function must take a single
1148 argument, a calendar-style date list like (month day year)."
1149   :group 'org-agenda-daily/weekly
1150   :type '(choice
1151       (string :tag "Format string")
1152       (function :tag "Function")))
1153
1154 (defun org-agenda-format-date-aligned (date)
1155   "Format a DATE string for display in the daily/weekly agenda.
1156 This function makes sure that dates are aligned for easy reading."
1157   (require 'cal-iso)
1158   (let* ((dayname (calendar-day-name date))
1159      (day (cadr date))
1160      (day-of-week (calendar-day-of-week date))
1161      (month (car date))
1162      (monthname (calendar-month-name month))
1163      (year (nth 2 date))
1164      (iso-week (org-days-to-iso-week
1165             (calendar-absolute-from-gregorian date)))
1166      (weekyear (cond ((and (= month 1) (>= iso-week 52))
1167               (1- year))
1168              ((and (= month 12) (<= iso-week 1))
1169               (1+ year))
1170              (t year)))
1171      (weekstring (if (= day-of-week 1)
1172              (format " W%02d" iso-week)
1173                "")))
1174     (format "%-10s %2d %s %4d%s"
1175         dayname day monthname year weekstring)))
1176
1177 (defcustom org-agenda-time-leading-zero nil
1178   "Non-nil means use leading zero for military times in agenda.
1179 For example, 9:30am would become 09:30 rather than  9:30."
1180   :group 'org-agenda-daily/weekly
1181   :version "24.1"
1182   :type 'boolean)
1183
1184 (defcustom org-agenda-timegrid-use-ampm nil
1185   "When set, show AM/PM style timestamps on the timegrid."
1186   :group 'org-agenda
1187   :version "24.1"
1188   :type 'boolean)
1189
1190 (defun org-agenda-time-of-day-to-ampm (time)
1191   "Convert TIME of a string like \"13:45\" to an AM/PM style time string."
1192   (let* ((hour-number (string-to-number (substring time 0 -3)))
1193          (minute (substring time -2))
1194          (ampm "am"))
1195     (cond
1196      ((equal hour-number 12)
1197       (setq ampm "pm"))
1198      ((> hour-number 12)
1199       (setq ampm "pm")
1200       (setq hour-number (- hour-number 12))))
1201     (concat
1202      (if org-agenda-time-leading-zero
1203      (format "%02d" hour-number)
1204        (format "%02s" (number-to-string hour-number)))
1205      ":" minute ampm)))
1206
1207 (defun org-agenda-time-of-day-to-ampm-maybe (time)
1208   "Conditionally convert TIME to AM/PM format based on `org-agenda-timegrid-use-ampm'."
1209   (if org-agenda-timegrid-use-ampm
1210       (org-agenda-time-of-day-to-ampm time)
1211     time))
1212
1213 (defcustom org-agenda-weekend-days '(6 0)
1214   "Which days are weekend?
1215 These days get the special face `org-agenda-date-weekend' in the agenda."
1216   :group 'org-agenda-daily/weekly
1217   :type '(set :greedy t
1218           (const :tag "Monday" 1)
1219           (const :tag "Tuesday" 2)
1220           (const :tag "Wednesday" 3)
1221           (const :tag "Thursday" 4)
1222           (const :tag "Friday" 5)
1223           (const :tag "Saturday" 6)
1224           (const :tag "Sunday" 0)))
1225
1226 (defcustom org-agenda-move-date-from-past-immediately-to-today t
1227   "Non-nil means jump to today when moving a past date forward in time.
1228 When using S-right in the agenda to move a a date forward, and the date
1229 stamp currently points to the past, the first key press will move it
1230 to today.  WHen nil, just move one day forward even if the date stays
1231 in the past."
1232   :group 'org-agenda-daily/weekly
1233   :version "24.1"
1234   :type 'boolean)
1235
1236 (defcustom org-agenda-include-diary nil
1237   "If non-nil, include in the agenda entries from the Emacs Calendar's diary.
1238 Custom commands can set this variable in the options section."
1239   :group 'org-agenda-daily/weekly
1240   :type 'boolean)
1241
1242 (defcustom org-agenda-include-deadlines t
1243   "If non-nil, include entries within their deadline warning period.
1244 Custom commands can set this variable in the options section."
1245   :group 'org-agenda-daily/weekly
1246   :version "24.1"
1247   :type 'boolean)
1248
1249 (defcustom org-agenda-show-future-repeats t
1250   "Non-nil shows repeated entries in the future part of the agenda.
1251 When set to the symbol `next' only the first future repeat is shown."
1252   :group 'org-agenda-daily/weekly
1253   :type '(choice
1254       (const :tag "Show all repeated entries" t)
1255       (const :tag "Show next repeated entry" next)
1256       (const :tag "Do not show repeated entries" nil))
1257   :version "26.1"
1258   :package-version '(Org . "9.1")
1259   :safe #'symbolp)
1260
1261 (defcustom org-agenda-prefer-last-repeat nil
1262   "Non-nil sets date for repeated entries to their last repeat.
1263
1264 When nil, display SCHEDULED and DEADLINE dates at their base
1265 date, and in today's agenda, as a reminder.  Display plain
1266 time-stamps, on the other hand, at every repeat date in the past
1267 in addition to the base date.
1268
1269 When non-nil, show a repeated entry at its latest repeat date,
1270 possibly being today even if it wasn't marked as done.  This
1271 setting is useful if you do not always mark repeated entries as
1272 done and, yet, consider that reaching repeat date starts the task
1273 anew.
1274
1275 When set to a list of strings, prefer last repeats only for
1276 entries with these TODO keywords."
1277   :group 'org-agenda-daily/weekly
1278   :type '(choice
1279       (const :tag "Prefer last repeat" t)
1280       (const :tag "Prefer base date" nil)
1281       (repeat :tag "Prefer last repeat for entries with these TODO keywords"
1282           (string :tag "TODO keyword")))
1283   :version "26.1"
1284   :package-version '(Org . "9.1")
1285   :safe (lambda (x) (or (booleanp x) (consp x))))
1286
1287 (defcustom org-scheduled-past-days 10000
1288   "Number of days to continue listing scheduled items not marked DONE.
1289 When an item is scheduled on a date, it shows up in the agenda on
1290 this day and will be listed until it is marked done or for the
1291 number of days given here."
1292   :group 'org-agenda-daily/weekly
1293   :type 'integer
1294   :safe 'integerp)
1295
1296 (defcustom org-deadline-past-days 10000
1297   "Number of days to warn about missed deadlines.
1298 When an item has deadline on a date, it shows up in the agenda on
1299 this day and will appear as a reminder until it is marked DONE or
1300 for the number of days given here."
1301   :group 'org-agenda-daily/weekly
1302   :type 'integer
1303   :version "26.1"
1304   :package-version '(Org . "9.1")
1305   :safe 'integerp)
1306
1307 (defcustom org-agenda-log-mode-items '(closed clock)
1308   "List of items that should be shown in agenda log mode.
1309 \\<org-agenda-mode-map>\
1310 This list may contain the following symbols:
1311
1312   closed    Show entries that have been closed on that day.
1313   clock     Show entries that have received clocked time on that day.
1314   state     Show all logged state changes.
1315 Note that instead of changing this variable, you can also press \
1316 `\\[universal-argument] \\[org-agenda-log-mode]' in
1317 the agenda to display all available LOG items temporarily."
1318   :group 'org-agenda-daily/weekly
1319   :type '(set :greedy t (const closed) (const clock) (const state)))
1320
1321 (defcustom org-agenda-clock-consistency-checks
1322   '(:max-duration "10:00" :min-duration 0 :max-gap "0:05"
1323           :gap-ok-around ("4:00")
1324           :default-face ((:background "DarkRed") (:foreground "white"))
1325           :overlap-face nil :gap-face nil :no-end-time-face nil
1326           :long-face nil :short-face nil)
1327   "This is a property list, with the following keys:
1328
1329 :max-duration    Mark clocking chunks that are longer than this time.
1330                  This is a time string like \"HH:MM\", or the number
1331                  of minutes as an integer.
1332
1333 :min-duration    Mark clocking chunks that are shorter that this.
1334                  This is a time string like \"HH:MM\", or the number
1335                  of minutes as an integer.
1336
1337 :max-gap         Mark gaps between clocking chunks that are longer than
1338                  this duration.  A number of minutes, or a string
1339                  like \"HH:MM\".
1340
1341 :gap-ok-around   List of times during the day which are usually not working
1342                  times.  When a gap is detected, but the gap contains any
1343                  of these times, the gap is *not* reported.  For example,
1344                  if this is (\"4:00\" \"13:00\") then gaps that contain
1345                  4:00 in the morning (i.e. the night) and 13:00
1346                  (i.e. a typical lunch time) do not cause a warning.
1347                  You should have at least one time during the night in this
1348                  list, or otherwise the first task each morning will trigger
1349                  a warning because it follows a long gap.
1350
1351 Furthermore, the following properties can be used to define faces for
1352 issue display.
1353
1354 :default-face         the default face, if the specific face is undefined
1355 :overlap-face         face for overlapping clocks
1356 :gap-face             face for gaps between clocks
1357 :no-end-time-face     face for incomplete clocks
1358 :long-face            face for clock intervals that are too long
1359 :short-face           face for clock intervals that are too short"
1360   :group 'org-agenda-daily/weekly
1361   :group 'org-clock
1362   :version "24.1"
1363   :type 'plist)
1364
1365 (defcustom org-agenda-log-mode-add-notes t
1366   "Non-nil means add first line of notes to log entries in agenda views.
1367 If a log item like a state change or a clock entry is associated with
1368 notes, the first line of these notes will be added to the entry in the
1369 agenda display."
1370   :group 'org-agenda-daily/weekly
1371   :type 'boolean)
1372
1373 (defcustom org-agenda-start-with-log-mode nil
1374   "The initial value of log-mode in a newly created agenda window.
1375 See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further
1376 explanations on the possible values."
1377   :group 'org-agenda-startup
1378   :group 'org-agenda-daily/weekly
1379   :type '(choice (const :tag "Don't show log items" nil)
1380          (const :tag "Show only log items" only)
1381          (const :tag "Show all possible log items" clockcheck)
1382          (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
1383              (choice (const :tag "Show closed log items" closed)
1384                  (const :tag "Show clocked log items" clock)
1385                  (const :tag "Show all logged state changes" state)))))
1386
1387 (defcustom org-agenda-start-with-clockreport-mode nil
1388   "The initial value of clockreport-mode in a newly created agenda window."
1389   :group 'org-agenda-startup
1390   :group 'org-agenda-daily/weekly
1391   :type 'boolean)
1392
1393 (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2)
1394   "Property list with parameters for the clocktable in clockreport mode.
1395 This is the display mode that shows a clock table in the daily/weekly
1396 agenda, the properties for this dynamic block can be set here.
1397 The usual clocktable parameters are allowed here, but you cannot set
1398 the properties :name, :tstart, :tend, :block, and :scope - these will
1399 be overwritten to make sure the content accurately reflects the
1400 current display in the agenda."
1401   :group 'org-agenda-daily/weekly
1402   :type 'plist)
1403
1404 (defcustom org-agenda-search-view-always-boolean nil
1405   "Non-nil means the search string is interpreted as individual parts.
1406
1407 The search string for search view can either be interpreted as a phrase,
1408 or as a list of snippets that define a boolean search for a number of
1409 strings.
1410
1411 When this is non-nil, the string will be split on whitespace, and each
1412 snippet will be searched individually, and all must match in order to
1413 select an entry.  A snippet is then a single string of non-white
1414 characters, or a string in double quotes, or a regexp in {} braces.
1415 If a snippet is preceded by \"-\", the snippet must *not* match.
1416 \"+\" is syntactic sugar for positive selection.  Each snippet may
1417 be found as a full word or a partial word, but see the variable
1418 `org-agenda-search-view-force-full-words'.
1419
1420 When this is nil, search will look for the entire search phrase as one,
1421 with each space character matching any amount of whitespace, including
1422 line breaks.
1423
1424 Even when this is nil, you can still switch to Boolean search dynamically
1425 by preceding the first snippet with \"+\" or \"-\".  If the first snippet
1426 is a regexp marked with braces like \"{abc}\", this will also switch to
1427 boolean search."
1428   :group 'org-agenda-search-view
1429   :version "24.1"
1430   :type 'boolean)
1431
1432 (defvaralias 'org-agenda-search-view-search-words-only
1433   'org-agenda-search-view-always-boolean)
1434
1435 (defcustom org-agenda-search-view-force-full-words nil
1436   "Non-nil means, search words must be matches as complete words.
1437 When nil, they may also match part of a word."
1438   :group 'org-agenda-search-view
1439   :version "24.1"
1440   :type 'boolean)
1441
1442 (defcustom org-agenda-search-view-max-outline-level 0
1443   "Maximum outline level to display in search view.
1444 E.g. when this is set to 1, the search view will only
1445 show headlines of level 1.  When set to 0, the default
1446 value, don't limit agenda view by outline level."
1447   :group 'org-agenda-search-view
1448   :version "26.1"
1449   :package-version '(Org . "8.3")
1450   :type 'integer)
1451
1452 (defgroup org-agenda-time-grid nil
1453   "Options concerning the time grid in the Org Agenda."
1454   :tag "Org Agenda Time Grid"
1455   :group 'org-agenda)
1456
1457 (defcustom org-agenda-search-headline-for-time t
1458   "Non-nil means search headline for a time-of-day.
1459 If the headline contains a time-of-day in one format or another, it will
1460 be used to sort the entry into the time sequence of items for a day.
1461 Some people have time stamps in the headline that refer to the creation
1462 time or so, and then this produces an unwanted side effect.  If this is
1463 the case for your, use this variable to turn off searching the headline
1464 for a time."
1465   :group 'org-agenda-time-grid
1466   :type 'boolean)
1467
1468 (defcustom org-agenda-use-time-grid t
1469   "Non-nil means show a time grid in the agenda schedule.
1470 A time grid is a set of lines for specific times (like every two hours between
1471 8:00 and 20:00).  The items scheduled for a day at specific times are
1472 sorted in between these lines.
1473 For details about when the grid will be shown, and what it will look like, see
1474 the variable `org-agenda-time-grid'."
1475   :group 'org-agenda-time-grid
1476   :type 'boolean)
1477
1478 (defcustom org-agenda-time-grid
1479   '((daily today require-timed)
1480     (800 1000 1200 1400 1600 1800 2000)
1481     "......"
1482     "----------------")
1483
1484   "The settings for time grid for agenda display.
1485 This is a list of four items.  The first item is again a list.  It contains
1486 symbols specifying conditions when the grid should be displayed:
1487
1488  daily         if the agenda shows a single day
1489  weekly        if the agenda shows an entire week
1490  today         show grid on current date, independent of daily/weekly display
1491  require-timed show grid only if at least one item has a time specification
1492  remove-match  skip grid times already present in an entry
1493
1494 The second item is a list of integers, indicating the times that
1495 should have a grid line.
1496
1497 The third item is a string which will be placed right after the
1498 times that have a grid line.
1499
1500 The fourth item is a string placed after the grid times.  This
1501 will align with agenda items"
1502   :group 'org-agenda-time-grid
1503   :type
1504   '(list
1505     (set :greedy t :tag "Grid Display Options"
1506      (const :tag "Show grid in single day agenda display" daily)
1507      (const :tag "Show grid in weekly agenda display" weekly)
1508      (const :tag "Always show grid for today" today)
1509      (const :tag "Show grid only if any timed entries are present"
1510         require-timed)
1511      (const :tag "Skip grid times already present in an entry"
1512         remove-match))
1513     (repeat :tag "Grid Times" (integer :tag "Time"))
1514     (string :tag "Grid String (after agenda times)")
1515     (string :tag "Grid String (aligns with agenda items)")))
1516
1517 (defcustom org-agenda-show-current-time-in-grid t
1518   "Non-nil means show the current time in the time grid."
1519   :group 'org-agenda-time-grid
1520   :version "24.1"
1521   :type 'boolean)
1522
1523 (defcustom org-agenda-current-time-string
1524   "now - - - - - - - - - - - - - - - - - - - - - - - - -"
1525   "The string for the current time marker in the agenda."
1526   :group 'org-agenda-time-grid
1527   :version "24.1"
1528   :type 'string)
1529
1530 (defgroup org-agenda-sorting nil
1531   "Options concerning sorting in the Org Agenda."
1532   :tag "Org Agenda Sorting"
1533   :group 'org-agenda)
1534
1535 (defcustom org-agenda-sorting-strategy
1536   '((agenda habit-down time-up priority-down category-keep)
1537     (todo   priority-down category-keep)
1538     (tags   priority-down category-keep)
1539     (search category-keep))
1540   "Sorting structure for the agenda items of a single day.
1541 This is a list of symbols which will be used in sequence to determine
1542 if an entry should be listed before another entry.  The following
1543 symbols are recognized:
1544
1545 time-up            Put entries with time-of-day indications first, early first
1546 time-down          Put entries with time-of-day indications first, late first
1547 timestamp-up       Sort by any timestamp, early first
1548 timestamp-down     Sort by any timestamp, late first
1549 scheduled-up       Sort by scheduled timestamp, early first
1550 scheduled-down     Sort by scheduled timestamp, late first
1551 deadline-up        Sort by deadline timestamp, early first
1552 deadline-down      Sort by deadline timestamp, late first
1553 ts-up              Sort by active timestamp, early first
1554 ts-down            Sort by active timestamp, late first
1555 tsia-up            Sort by inactive timestamp, early first
1556 tsia-down          Sort by inactive timestamp, late first
1557 category-keep      Keep the default order of categories, corresponding to the
1558            sequence in `org-agenda-files'.
1559 category-up        Sort alphabetically by category, A-Z.
1560 category-down      Sort alphabetically by category, Z-A.
1561 tag-up             Sort alphabetically by last tag, A-Z.
1562 tag-down           Sort alphabetically by last tag, Z-A.
1563 priority-up        Sort numerically by priority, high priority last.
1564 priority-down      Sort numerically by priority, high priority first.
1565 todo-state-up      Sort by todo state, tasks that are done last.
1566 todo-state-down    Sort by todo state, tasks that are done first.
1567 effort-up          Sort numerically by estimated effort, high effort last.
1568 effort-down        Sort numerically by estimated effort, high effort first.
1569 user-defined-up    Sort according to `org-agenda-cmp-user-defined', high last.
1570 user-defined-down  Sort according to `org-agenda-cmp-user-defined', high first.
1571 habit-up           Put entries that are habits first
1572 habit-down         Put entries that are habits last
1573 alpha-up           Sort headlines alphabetically
1574 alpha-down         Sort headlines alphabetically, reversed
1575
1576 The different possibilities will be tried in sequence, and testing stops
1577 if one comparison returns a \"not-equal\".  For example, the default
1578     '(time-up category-keep priority-down)
1579 means: Pull out all entries having a specified time of day and sort them,
1580 in order to make a time schedule for the current day the first thing in the
1581 agenda listing for the day.  Of the entries without a time indication, keep
1582 the grouped in categories, don't sort the categories, but keep them in
1583 the sequence given in `org-agenda-files'.  Within each category sort by
1584 priority.
1585
1586 Leaving out `category-keep' would mean that items will be sorted across
1587 categories by priority.
1588
1589 Instead of a single list, this can also be a set of list for specific
1590 contents, with a context symbol in the car of the list, any of
1591 `agenda', `todo', `tags', `search' for the corresponding agenda views.
1592
1593 Custom commands can bind this variable in the options section."
1594   :group 'org-agenda-sorting
1595   :type `(choice
1596       (repeat :tag "General" ,org-sorting-choice)
1597       (list :tag "Individually"
1598         (cons (const :tag "Strategy for Weekly/Daily agenda" agenda)
1599               (repeat ,org-sorting-choice))
1600         (cons (const :tag "Strategy for TODO lists" todo)
1601               (repeat ,org-sorting-choice))
1602         (cons (const :tag "Strategy for Tags matches" tags)
1603               (repeat ,org-sorting-choice))
1604         (cons (const :tag "Strategy for search matches" search)
1605               (repeat ,org-sorting-choice)))))
1606
1607 (defcustom org-agenda-cmp-user-defined nil
1608   "A function to define the comparison `user-defined'.
1609 This function must receive two arguments, agenda entry a and b.
1610 If a>b, return +1.  If a<b, return -1.  If they are equal as seen by
1611 the user comparison, return nil.
1612 When this is defined, you can make `user-defined-up' and `user-defined-down'
1613 part of an agenda sorting strategy."
1614   :group 'org-agenda-sorting
1615   :type 'symbol)
1616
1617 (defcustom org-sort-agenda-notime-is-late t
1618   "Non-nil means items without time are considered late.
1619 This is only relevant for sorting.  When t, items which have no explicit
1620 time like 15:30 will be considered as 99:01, i.e. later than any items which
1621 do have a time.  When nil, the default time is before 0:00.  You can use this
1622 option to decide if the schedule for today should come before or after timeless
1623 agenda entries."
1624   :group 'org-agenda-sorting
1625   :type 'boolean)
1626
1627 (defcustom org-sort-agenda-noeffort-is-high t
1628   "Non-nil means items without effort estimate are sorted as high effort.
1629 This also applies when filtering an agenda view with respect to the
1630 < or > effort operator.  Then, tasks with no effort defined will be treated
1631 as tasks with high effort.
1632 When nil, such items are sorted as 0 minutes effort."
1633   :group 'org-agenda-sorting
1634   :type 'boolean)
1635
1636 (defgroup org-agenda-line-format nil
1637   "Options concerning the entry prefix in the Org agenda display."
1638   :tag "Org Agenda Line Format"
1639   :group 'org-agenda)
1640
1641 (defcustom org-agenda-prefix-format
1642   '((agenda  . " %i %-12:c%?-12t% s")
1643     (todo  . " %i %-12:c")
1644     (tags  . " %i %-12:c")
1645     (search . " %i %-12:c"))
1646   "Format specifications for the prefix of items in the agenda views.
1647
1648 An alist with one entry per agenda type.  The keys of the
1649 sublists are `agenda', `todo', `search' and `tags'.  The values
1650 are format strings.
1651
1652 This format works similar to a printf format, with the following meaning:
1653
1654   %c   the category of the item, \"Diary\" for entries from the diary,
1655        or as given by the CATEGORY keyword or derived from the file name
1656   %e   the effort required by the item
1657   %l   the level of the item (insert X space(s) if item is of level X)
1658   %i   the icon category of the item, see `org-agenda-category-icon-alist'
1659   %T   the last tag of the item (ignore inherited tags, which come first)
1660   %t   the HH:MM time-of-day specification if one applies to the entry
1661   %s   Scheduling/Deadline information, a short string
1662   %b   show breadcrumbs, i.e., the names of the higher levels
1663   %(expression) Eval EXPRESSION and replace the control string
1664                 by the result
1665
1666 All specifiers work basically like the standard `%s' of printf, but may
1667 contain two additional characters: a question mark just after the `%'
1668 and a whitespace/punctuation character just before the final letter.
1669
1670 If the first character after `%' is a question mark, the entire field
1671 will only be included if the corresponding value applies to the current
1672 entry.  This is useful for fields which should have fixed width when
1673 present, but zero width when absent.  For example, \"%?-12t\" will
1674 result in a 12 character time field if a time of the day is specified,
1675 but will completely disappear in entries which do not contain a time.
1676
1677 If there is punctuation or whitespace character just before the
1678 final format letter, this character will be appended to the field
1679 value if the value is not empty.  For example, the format
1680 \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\".  If
1681 the category is empty, no additional colon is inserted.
1682
1683 The default value for the agenda sublist is \"  %-12:c%?-12t% s\",
1684 which means:
1685
1686 - Indent the line with two space characters
1687 - Give the category a 12 chars wide field, padded with whitespace on
1688   the right (because of `-').  Append a colon if there is a category
1689   (because of `:').
1690 - If there is a time-of-day, put it into a 12 chars wide field.  If no
1691   time, don't put in an empty field, just skip it (because of '?').
1692 - Finally, put the scheduling information.
1693
1694 See also the variables `org-agenda-remove-times-when-in-prefix' and
1695 `org-agenda-remove-tags'.
1696
1697 Custom commands can set this variable in the options section."
1698   :type '(choice
1699       (string :tag "General format")
1700       (list :greedy t :tag "View dependent"
1701         (cons  (const agenda) (string :tag "Format"))
1702         (cons  (const todo) (string :tag "Format"))
1703         (cons  (const tags) (string :tag "Format"))
1704         (cons  (const search) (string :tag "Format"))))
1705   :group 'org-agenda-line-format
1706   :version "26.1"
1707   :package-version '(Org . "9.1"))
1708
1709 (defvar org-prefix-format-compiled nil
1710   "The compiled prefix format and associated variables.
1711 This is a list where first element is a list of variable bindings, and second
1712 element is the compiled format expression.  See the variable
1713 `org-agenda-prefix-format'.")
1714
1715 (defcustom org-agenda-todo-keyword-format "%-1s"
1716   "Format for the TODO keyword in agenda lines.
1717 Set this to something like \"%-12s\" if you want all TODO keywords
1718 to occupy a fixed space in the agenda display."
1719   :group 'org-agenda-line-format
1720   :type 'string)
1721
1722 (defcustom org-agenda-diary-sexp-prefix nil
1723   "A regexp that matches part of a diary sexp entry
1724 which should be treated as scheduling/deadline information in
1725 `org-agenda'.
1726
1727 For example, you can use this to extract the `diary-remind-message' from
1728 `diary-remind' entries."
1729   :group 'org-agenda-line-format
1730   :type '(choice (const :tag "None" nil) (regexp :tag "Regexp")))
1731
1732 (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ")
1733   "Text preceding timerange entries in the agenda view.
1734 This is a list with two strings.  The first applies when the range
1735 is entirely on one day.  The second applies if the range spans several days.
1736 The strings may have two \"%d\" format specifiers which will be filled
1737 with the sequence number of the days, and the total number of days in the
1738 range, respectively."
1739   :group 'org-agenda-line-format
1740   :type '(list
1741       (string :tag "Deadline today   ")
1742       (choice :tag "Deadline relative"
1743           (string :tag "Format string")
1744           (function))))
1745
1746 (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
1747   "Text preceding scheduled items in the agenda view.
1748 This is a list with two strings.  The first applies when the item is
1749 scheduled on the current day.  The second applies when it has been scheduled
1750 previously, it may contain a %d indicating that this is the nth time that
1751 this item is scheduled, due to automatic rescheduling of unfinished items
1752 for the following day.  So this number is one larger than the number of days
1753 that passed since this item was scheduled first."
1754   :group 'org-agenda-line-format
1755   :version "24.4"
1756   :package-version '(Org . "8.0")
1757   :type '(list
1758       (string :tag "Scheduled today     ")
1759       (string :tag "Scheduled previously")))
1760
1761 (defcustom org-agenda-inactive-leader "["
1762   "Text preceding item pulled into the agenda by inactive time stamps.
1763 These entries are added to the agenda when pressing \"[\"."
1764   :group 'org-agenda-line-format
1765   :version "24.1"
1766   :type 'string)
1767
1768 (defcustom org-agenda-deadline-leaders '("Deadline:  " "In %3d d.: " "%2d d. ago: ")
1769   "Text preceding deadline items in the agenda view.
1770 This is a list with three strings.  The first applies when the item has its
1771 deadline on the current day.  The second applies when the deadline is in the
1772 future, the third one when it is in the past.  The strings may contain %d
1773 to capture the number of days."
1774   :group 'org-agenda-line-format
1775   :version "24.4"
1776   :package-version '(Org . "8.0")
1777   :type '(list
1778       (string :tag "Deadline today          ")
1779       (string :tag "Deadline in the future  ")
1780       (string :tag "Deadline in the past    ")))
1781
1782 (defcustom org-agenda-remove-times-when-in-prefix t
1783   "Non-nil means remove duplicate time specifications in agenda items.
1784 When the format `org-agenda-prefix-format' contains a `%t' specifier, a
1785 time-of-day specification in a headline or diary entry is extracted and
1786 placed into the prefix.  If this option is non-nil, the original specification
1787 \(a timestamp or -range, or just a plain time(range) specification like
1788 11:30-4pm) will be removed for agenda display.  This makes the agenda less
1789 cluttered.
1790 The option can be t or nil.  It may also be the symbol `beg', indicating
1791 that the time should only be removed when it is located at the beginning of
1792 the headline/diary entry."
1793   :group 'org-agenda-line-format
1794   :type '(choice
1795       (const :tag "Always" t)
1796       (const :tag "Never" nil)
1797       (const :tag "When at beginning of entry" beg)))
1798
1799 (defcustom org-agenda-remove-timeranges-from-blocks nil
1800   "Non-nil means remove time ranges specifications in agenda
1801 items that span on several days."
1802   :group 'org-agenda-line-format
1803   :version "24.1"
1804   :type 'boolean)
1805
1806 (defcustom org-agenda-default-appointment-duration nil
1807   "Default duration for appointments that only have a starting time.
1808 When nil, no duration is specified in such cases.
1809 When non-nil, this must be the number of minutes, e.g. 60 for one hour."
1810   :group 'org-agenda-line-format
1811   :type '(choice
1812       (integer :tag "Minutes")
1813       (const :tag "No default duration")))
1814
1815 (defcustom org-agenda-show-inherited-tags t
1816   "Non-nil means show inherited tags in each agenda line.
1817
1818 When this option is set to `always', it takes precedence over
1819 `org-agenda-use-tag-inheritance' and inherited tags are shown
1820 in every agenda.
1821
1822 When this option is set to t (the default), inherited tags are
1823 shown when they are available, i.e. when the value of
1824 `org-agenda-use-tag-inheritance' enables tag inheritance for the
1825 given agenda type.
1826
1827 This can be set to a list of agenda types in which the agenda
1828 must display the inherited tags.  Available types are `todo',
1829 `agenda' and `search'.
1830
1831 When set to nil, never show inherited tags in agenda lines."
1832   :group 'org-agenda-line-format
1833   :group 'org-agenda
1834   :version "24.3"
1835   :type '(choice
1836       (const :tag "Show inherited tags when available" t)
1837       (const :tag "Always show inherited tags" always)
1838       (repeat :tag "Show inherited tags only in selected agenda types"
1839           (symbol :tag "Agenda type"))))
1840
1841 (defcustom org-agenda-use-tag-inheritance '(todo search agenda)
1842   "List of agenda view types where to use tag inheritance.
1843
1844 In tags/tags-todo/tags-tree agenda views, tag inheritance is
1845 controlled by `org-use-tag-inheritance'.  In other agenda types,
1846 `org-use-tag-inheritance' is not used for the selection of the
1847 agenda entries.  Still, you may want the agenda to be aware of
1848 the inherited tags anyway, e.g. for later tag filtering.
1849
1850 Allowed value are `todo', `search' and `agenda'.
1851
1852 This variable has no effect if `org-agenda-show-inherited-tags'
1853 is set to `always'.  In that case, the agenda is aware of those
1854 tags.
1855
1856 The default value sets tags in every agenda type.  Setting this
1857 option to nil will speed up non-tags agenda view a lot."
1858   :group 'org-agenda
1859   :version "26.1"
1860   :package-version '(Org . "9.1")
1861   :type '(choice
1862       (const :tag "Use tag inheritance in all agenda types" t)
1863       (repeat :tag "Use tag inheritance in selected agenda types"
1864           (symbol :tag "Agenda type"))))
1865
1866 (defcustom org-agenda-hide-tags-regexp nil
1867   "Regular expression used to filter away specific tags in agenda views.
1868 This means that these tags will be present, but not be shown in the agenda
1869 line.  Secondary filtering will still work on the hidden tags.
1870 Nil means don't hide any tags."
1871   :group 'org-agenda-line-format
1872   :type '(choice
1873       (const  :tag "Hide none" nil)
1874       (string :tag "Regexp   ")))
1875
1876 (defcustom org-agenda-remove-tags nil
1877   "Non-nil means remove the tags from the headline copy in the agenda.
1878 When this is the symbol `prefix', only remove tags when
1879 `org-agenda-prefix-format' contains a `%T' specifier."
1880   :group 'org-agenda-line-format
1881   :type '(choice
1882       (const :tag "Always" t)
1883       (const :tag "Never" nil)
1884       (const :tag "When prefix format contains %T" prefix)))
1885
1886 (defvaralias 'org-agenda-remove-tags-when-in-prefix
1887   'org-agenda-remove-tags)
1888
1889 (defcustom org-agenda-tags-column 'auto
1890   "Shift tags in agenda items to this column.
1891 If set to `auto', tags will be automatically aligned to the right
1892 edge of the window.
1893
1894 If set to a positive number, tags will be left-aligned to that
1895 column.  If set to a negative number, tags will be right-aligned
1896 to that column.  For example, -80 works well for a normal 80
1897 character screen."
1898   :group 'org-agenda-line-format
1899   :type '(choice
1900       (const :tag "Automatically align to right edge of window" auto)
1901       (integer :tag "Specific column" -80))
1902   :package-version '(Org . "9.1")
1903   :version "26.1")
1904
1905 (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
1906
1907 (defcustom org-agenda-fontify-priorities 'cookies
1908   "Non-nil means highlight low and high priorities in agenda.
1909 When t, the highest priority entries are bold, lowest priority italic.
1910 However, settings in `org-priority-faces' will overrule these faces.
1911 When this variable is the symbol `cookies', only fontify the
1912 cookies, not the entire task.
1913 This may also be an association list of priority faces, whose
1914 keys are the character values of `org-highest-priority',
1915 `org-default-priority', and `org-lowest-priority' (the default values
1916 are ?A, ?B, and ?C, respectively).  The face may be a named face, a
1917 color as a string, or a list like `(:background \"Red\")'.
1918 If it is a color, the variable `org-faces-easy-properties'
1919 determines if it is a foreground or a background color."
1920   :group 'org-agenda-line-format
1921   :type '(choice
1922       (const :tag "Never" nil)
1923       (const :tag "Defaults" t)
1924       (const :tag "Cookies only" cookies)
1925       (repeat :tag "Specify"
1926           (list (character :tag "Priority" :value ?A)
1927             (choice    :tag "Face    "
1928                    (string :tag "Color")
1929                    (sexp :tag "Face"))))))
1930
1931 (defcustom org-agenda-day-face-function nil
1932   "Function called to determine what face should be used to display a day.
1933 The only argument passed to that function is the day.  It should
1934 returns a face, or nil if does not want to specify a face and let
1935 the normal rules apply."
1936   :group 'org-agenda-line-format
1937   :version "24.1"
1938   :type '(choice (const nil) (function)))
1939
1940 (defcustom org-agenda-category-icon-alist nil
1941   "Alist of category icon to be displayed in agenda views.
1942
1943 Each entry should have the following format:
1944
1945   (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS)
1946
1947 Where CATEGORY-REGEXP is a regexp matching the categories where
1948 the icon should be displayed.
1949 FILE-OR-DATA either a file path or a string containing image data.
1950
1951 The other fields can be omitted safely if not needed:
1952 TYPE indicates the image type.
1953 DATA-P is a boolean indicating whether the FILE-OR-DATA string is
1954 image data.
1955 PROPS are additional image attributes to assign to the image,
1956 like, e.g. `:ascent center'.
1957
1958    (\"Org\" \"/path/to/icon.png\" nil nil :ascent center)
1959
1960 If you want to set the display properties yourself, just put a
1961 list as second element:
1962
1963   (CATEGORY-REGEXP (MY PROPERTY LIST))
1964
1965 For example, to display a 16px horizontal space for Emacs
1966 category, you can use:
1967
1968   (\"Emacs\" \\='(space . (:width (16))))"
1969   :group 'org-agenda-line-format
1970   :version "24.1"
1971   :type '(alist :key-type (string :tag "Regexp matching category")
1972         :value-type (choice (list :tag "Icon"
1973                       (string :tag "File or data")
1974                       (symbol :tag "Type")
1975                       (boolean :tag "Data?")
1976                       (repeat :tag "Extra image properties" :inline t symbol))
1977                     (list :tag "Display properties" sexp))))
1978
1979 (defgroup org-agenda-column-view nil
1980   "Options concerning column view in the agenda."
1981   :tag "Org Agenda Column View"
1982   :group 'org-agenda)
1983
1984 (defcustom org-agenda-view-columns-initially nil
1985   "When non-nil, switch to columns view right after creating the agenda."
1986   :group 'org-agenda-column-view
1987   :type 'boolean
1988   :version "26.1"
1989   :package-version '(Org . "9.0")
1990   :safe #'booleanp)
1991
1992 (defcustom org-agenda-columns-show-summaries t
1993   "Non-nil means show summaries for columns displayed in the agenda view."
1994   :group 'org-agenda-column-view
1995   :type 'boolean)
1996
1997 (defcustom org-agenda-columns-compute-summary-properties t
1998   "Non-nil means recompute all summary properties before column view.
1999 When column view in the agenda is listing properties that have a summary
2000 operator, it can go to all relevant buffers and recompute the summaries
2001 there.  This can mean overhead for the agenda column view, but is necessary
2002 to have thing up to date.
2003 As a special case, a CLOCKSUM property also makes sure that the clock
2004 computations are current."
2005   :group 'org-agenda-column-view
2006   :type 'boolean)
2007
2008 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil
2009   "Non-nil means the duration of an appointment will add to day effort.
2010 The property to which appointment durations will be added is the one given
2011 in the option `org-effort-property'.  If an appointment does not have
2012 an end time, `org-agenda-default-appointment-duration' will be used.  If that
2013 is not set, an appointment without end time will not contribute to the time
2014 estimate."
2015   :group 'org-agenda-column-view
2016   :type 'boolean)
2017
2018 (defcustom org-agenda-auto-exclude-function nil
2019   "A function called with a tag to decide if it is filtered on \
2020 \\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] RET'.
2021 The sole argument to the function, which is called once for each
2022 possible tag, is a string giving the name of the tag.  The
2023 function should return either nil if the tag should be included
2024 as normal, or \"-<TAG>\" to exclude the tag.
2025 Note that for the purpose of tag filtering, only the lower-case version of
2026 all tags will be considered, so that this function will only ever see
2027 the lower-case version of all tags."
2028   :group 'org-agenda
2029   :type '(choice (const nil) (function)))
2030
2031 (defcustom org-agenda-bulk-custom-functions nil
2032   "Alist of characters and custom functions for bulk actions.
2033 For example, this value makes those two functions available:
2034
2035   \\='((?R set-category)
2036     (?C bulk-cut))
2037
2038 With selected entries in an agenda buffer, `B R' will call
2039 the custom function `set-category' on the selected entries.
2040 Note that functions in this alist don't need to be quoted."
2041   :type '(alist :key-type character :value-type (group function))
2042   :version "24.1"
2043   :group 'org-agenda)
2044
2045 (defmacro org-agenda-with-point-at-orig-entry (string &rest body)
2046   "Execute BODY with point at location given by `org-hd-marker' property.
2047 If STRING is non-nil, the text property will be fetched from position 0
2048 in that string.  If STRING is nil, it will be fetched from the beginning
2049 of the current line."
2050   (org-with-gensyms (marker)
2051     `(let ((,marker (get-text-property (if ,string 0 (point-at-bol))
2052                        'org-hd-marker ,string)))
2053        (with-current-buffer (marker-buffer ,marker)
2054      (save-excursion
2055        (goto-char ,marker)
2056        ,@body)))))
2057 (def-edebug-spec org-agenda-with-point-at-orig-entry (form body))
2058
2059 (defun org-add-agenda-custom-command (entry)
2060   "Replace or add a command in `org-agenda-custom-commands'.
2061 This is mostly for hacking and trying a new command - once the command
2062 works you probably want to add it to `org-agenda-custom-commands' for good."
2063   (let ((ass (assoc (car entry) org-agenda-custom-commands)))
2064     (if ass
2065     (setcdr ass (cdr entry))
2066       (push entry org-agenda-custom-commands))))
2067
2068 ;;; Define the org-agenda-mode
2069
2070 (defvar org-agenda-mode-map (make-sparse-keymap)
2071   "Keymap for `org-agenda-mode'.")
2072 (defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
2073
2074 (defvar org-agenda-menu) ; defined later in this file.
2075 (defvar org-agenda-restrict nil) ; defined later in this file.
2076 (defvar org-agenda-follow-mode nil)
2077 (defvar org-agenda-entry-text-mode nil)
2078 (defvar org-agenda-clockreport-mode nil)
2079 (defvar org-agenda-show-log nil
2080   "When non-nil, show the log in the agenda.
2081 Do not set this directly; instead use
2082 `org-agenda-start-with-log-mode', which see.")
2083 (defvar org-agenda-redo-command nil)
2084 (defvar org-agenda-query-string nil)
2085 (defvar org-agenda-mode-hook nil
2086   "Hook run after `org-agenda-mode' is turned on.
2087 The buffer is still writable when this hook is called.")
2088 (defvar org-agenda-type nil)
2089 (defvar org-agenda-force-single-file nil)
2090 (defvar org-agenda-bulk-marked-entries nil
2091   "List of markers that refer to marked entries in the agenda.")
2092 (defvar org-agenda-current-date nil
2093   "Active date when building the agenda.")
2094
2095 ;;; Multiple agenda buffers support
2096
2097 (defcustom org-agenda-sticky nil
2098   "Non-nil means agenda q key will bury agenda buffers.
2099 Agenda commands will then show existing buffer instead of generating new ones.
2100 When nil, `q' will kill the single agenda buffer."
2101   :group 'org-agenda
2102   :version "24.3"
2103   :type 'boolean)
2104
2105
2106 ;;;###autoload
2107 (defun org-toggle-sticky-agenda (&optional arg)
2108   "Toggle `org-agenda-sticky'."
2109   (interactive "P")
2110   (let ((new-value (if arg
2111                (> (prefix-numeric-value arg) 0)
2112              (not org-agenda-sticky))))
2113     (if (equal new-value org-agenda-sticky)
2114     (and (called-interactively-p 'interactive)
2115          (message "Sticky agenda was already %s"
2116               (if org-agenda-sticky "enabled" "disabled")))
2117       (setq org-agenda-sticky new-value)
2118       (org-agenda-kill-all-agenda-buffers)
2119       (and (called-interactively-p 'interactive)
2120        (message "Sticky agenda %s"
2121             (if org-agenda-sticky "enabled" "disabled"))))))
2122
2123 (defvar org-agenda-buffer nil
2124   "Agenda buffer currently being generated.")
2125
2126 (defvar org-agenda-last-prefix-arg nil)
2127 (defvar org-agenda-this-buffer-name nil)
2128 (defvar org-agenda-doing-sticky-redo nil)
2129 (defvar org-agenda-this-buffer-is-sticky nil)
2130 (defvar org-agenda-last-indirect-buffer nil
2131   "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.")
2132
2133 (defconst org-agenda-local-vars
2134   '(org-agenda-this-buffer-name
2135     org-agenda-undo-list
2136     org-agenda-pending-undo-list
2137     org-agenda-follow-mode
2138     org-agenda-entry-text-mode
2139     org-agenda-clockreport-mode
2140     org-agenda-show-log
2141     org-agenda-redo-command
2142     org-agenda-query-string
2143     org-agenda-type
2144     org-agenda-bulk-marked-entries
2145     org-agenda-undo-has-started-in
2146     org-agenda-info
2147     org-agenda-pre-window-conf
2148     org-agenda-columns-active
2149     org-agenda-tag-filter
2150     org-agenda-category-filter
2151     org-agenda-top-headline-filter
2152     org-agenda-regexp-filter
2153     org-agenda-effort-filter
2154     org-agenda-markers
2155     org-agenda-last-search-view-search-was-boolean
2156     org-agenda-last-indirect-buffer
2157     org-agenda-filtered-by-category
2158     org-agenda-filter-form
2159     org-agenda-cycle-counter
2160     org-agenda-last-prefix-arg)
2161   "Variables that must be local in agenda buffers to allow multiple buffers.")
2162
2163 (defun org-agenda-mode ()
2164   "Mode for time-sorted view on action items in Org files.
2165
2166 The following commands are available:
2167
2168 \\{org-agenda-mode-map}"
2169   (interactive)
2170   (cond (org-agenda-doing-sticky-redo
2171      ;; Refreshing sticky agenda-buffer
2172      ;;
2173      ;; Preserve the value of `org-agenda-local-vars' variables,
2174      ;; while letting `kill-all-local-variables' kill the rest
2175      (let ((save (buffer-local-variables)))
2176        (kill-all-local-variables)
2177        (mapc #'make-local-variable org-agenda-local-vars)
2178        (dolist (elem save)
2179          (pcase elem
2180            (`(,var . ,val)        ;ignore unbound variables
2181         (when (and val (memq var org-agenda-local-vars))
2182           (set var val))))))
2183      (setq-local org-agenda-this-buffer-is-sticky t))
2184     (org-agenda-sticky
2185      ;; Creating a sticky Agenda buffer for the first time
2186      (kill-all-local-variables)
2187      (mapc 'make-local-variable org-agenda-local-vars)
2188      (setq-local org-agenda-this-buffer-is-sticky t))
2189     (t
2190      ;; Creating a non-sticky agenda buffer
2191      (kill-all-local-variables)
2192      (setq-local org-agenda-this-buffer-is-sticky nil)))
2193   (setq org-agenda-undo-list nil
2194     org-agenda-pending-undo-list nil
2195     org-agenda-bulk-marked-entries nil)
2196   (setq major-mode 'org-agenda-mode)
2197   ;; Keep global-font-lock-mode from turning on font-lock-mode
2198   (setq-local font-lock-global-modes (list 'not major-mode))
2199   (setq mode-name "Org-Agenda")
2200   (setq indent-tabs-mode nil)
2201   (use-local-map org-agenda-mode-map)
2202   (easy-menu-add org-agenda-menu)
2203   (if org-startup-truncated (setq truncate-lines t))
2204   (setq-local line-move-visual nil)
2205   (add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
2206   (add-hook 'pre-command-hook 'org-unhighlight nil 'local)
2207   ;; Make sure properties are removed when copying text
2208   (add-hook 'filter-buffer-substring-functions
2209         (lambda (fun start end delete)
2210           (substring-no-properties (funcall fun start end delete)))
2211         nil t)
2212   (unless org-agenda-keep-modes
2213     (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
2214       org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
2215       org-agenda-show-log org-agenda-start-with-log-mode
2216       org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode))
2217   (add-to-invisibility-spec '(org-filtered))
2218   (add-to-invisibility-spec '(org-link))
2219   (easy-menu-change
2220    '("Agenda") "Agenda Files"
2221    (append
2222     (list
2223      (vector
2224       (if (get 'org-agenda-files 'org-restrict)
2225       "Restricted to single file"
2226     "Edit File List")
2227       '(org-edit-agenda-file-list)
2228       (not (get 'org-agenda-files 'org-restrict)))
2229      "--")
2230     (mapcar 'org-file-menu-entry (org-agenda-files))))
2231   (org-agenda-set-mode-name)
2232   (apply
2233    (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks)
2234    (list 'org-agenda-mode-hook)))
2235
2236 (substitute-key-definition 'undo 'org-agenda-undo
2237                org-agenda-mode-map global-map)
2238 (org-defkey org-agenda-mode-map "\C-i"     'org-agenda-goto)
2239 (org-defkey org-agenda-mode-map [(tab)]    'org-agenda-goto)
2240 (org-defkey org-agenda-mode-map "\C-m"     'org-agenda-switch-to)
2241 (org-defkey org-agenda-mode-map "\C-k"     'org-agenda-kill)
2242 (org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
2243 (org-defkey org-agenda-mode-map [(meta down)] 'org-agenda-drag-line-forward)
2244 (org-defkey org-agenda-mode-map [(meta up)] 'org-agenda-drag-line-backward)
2245 (org-defkey org-agenda-mode-map "m"        'org-agenda-bulk-mark)
2246 (org-defkey org-agenda-mode-map "\M-m"     'org-agenda-bulk-toggle)
2247 (org-defkey org-agenda-mode-map "*"        'org-agenda-bulk-mark-all)
2248 (org-defkey org-agenda-mode-map "\M-*"     'org-agenda-bulk-toggle-all)
2249 (org-defkey org-agenda-mode-map "#"        'org-agenda-dim-blocked-tasks)
2250 (org-defkey org-agenda-mode-map "%"        'org-agenda-bulk-mark-regexp)
2251 (org-defkey org-agenda-mode-map "u"        'org-agenda-bulk-unmark)
2252 (org-defkey org-agenda-mode-map "U"        'org-agenda-bulk-unmark-all)
2253 (org-defkey org-agenda-mode-map "B"        'org-agenda-bulk-action)
2254 (org-defkey org-agenda-mode-map "k"        'org-agenda-capture)
2255 (org-defkey org-agenda-mode-map "A"        'org-agenda-append-agenda)
2256 (org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload)
2257 (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default)
2258 (org-defkey org-agenda-mode-map "\C-c\C-xa"    'org-agenda-toggle-archive-tag)
2259 (org-defkey org-agenda-mode-map "\C-c\C-xA"    'org-agenda-archive-to-archive-sibling)
2260 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive)
2261 (org-defkey org-agenda-mode-map "\C-c$"        'org-agenda-archive)
2262 (org-defkey org-agenda-mode-map "$"        'org-agenda-archive)
2263 (org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link)
2264 (org-defkey org-agenda-mode-map " "        'org-agenda-show-and-scroll-up)
2265 (org-defkey org-agenda-mode-map [backspace] 'org-agenda-show-scroll-down)
2266 (org-defkey org-agenda-mode-map "\d" 'org-agenda-show-scroll-down)
2267 (org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset)
2268 (org-defkey org-agenda-mode-map [(control shift left)]  'org-agenda-todo-previousset)
2269 (org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer)
2270 (org-defkey org-agenda-mode-map "o"        'delete-other-windows)
2271 (org-defkey org-agenda-mode-map "L"        'org-agenda-recenter)
2272 (org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
2273 (org-defkey org-agenda-mode-map "t"        'org-agenda-todo)
2274 (org-defkey org-agenda-mode-map "a"        'org-agenda-archive-default-with-confirmation)
2275 (org-defkey org-agenda-mode-map ":"        'org-agenda-set-tags)
2276 (org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags)
2277 (org-defkey org-agenda-mode-map "."        'org-agenda-goto-today)
2278 (org-defkey org-agenda-mode-map "j"        'org-agenda-goto-date)
2279 (org-defkey org-agenda-mode-map "d"        'org-agenda-day-view)
2280 (org-defkey org-agenda-mode-map "w"        'org-agenda-week-view)
2281 (org-defkey org-agenda-mode-map "y"        'org-agenda-year-view)
2282 (org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note)
2283 (org-defkey org-agenda-mode-map "z"        'org-agenda-add-note)
2284 (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later)
2285 (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier)
2286 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later)
2287 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier)
2288
2289 (org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt)
2290 (org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
2291 (org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
2292 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
2293   (while l (org-defkey org-agenda-mode-map
2294                (int-to-string (pop l)) 'digit-argument)))
2295
2296 (org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode)
2297 (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode)
2298 (org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode)
2299 (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
2300 (org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch)
2301 (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
2302 (org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines)
2303 (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
2304 (org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
2305 (org-defkey org-agenda-mode-map "g" 'org-agenda-redo-all)
2306 (org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort)
2307 (org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort)
2308 (org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
2309         'org-clock-modify-effort-estimate)
2310 (org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property)
2311 (org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
2312 (org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit)
2313 (org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
2314 (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write)
2315 (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
2316 (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
2317 (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
2318 (org-defkey org-agenda-mode-map "n" 'org-agenda-next-line)
2319 (org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line)
2320 (org-defkey org-agenda-mode-map "N" 'org-agenda-next-item)
2321 (org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item)
2322 (substitute-key-definition 'next-line 'org-agenda-next-line
2323                org-agenda-mode-map global-map)
2324 (substitute-key-definition 'previous-line 'org-agenda-previous-line
2325                org-agenda-mode-map global-map)
2326 (org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach)
2327 (org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line)
2328 (org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line)
2329 (org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority)
2330 (org-defkey org-agenda-mode-map "," 'org-agenda-priority)
2331 (org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry)
2332 (org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar)
2333 (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date)
2334 (org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
2335 (org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
2336 (org-defkey org-agenda-mode-map "h" 'org-agenda-holidays)
2337 (org-defkey org-agenda-mode-map "H" 'org-agenda-holidays)
2338 (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in)
2339 (org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in)
2340 (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out)
2341 (org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out)
2342 (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel)
2343 (org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel)
2344 (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
2345 (org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto)
2346 (org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up)
2347 (org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down)
2348 (org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up)
2349 (org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down)
2350 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up)
2351 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down)
2352 (org-defkey org-agenda-mode-map "f" 'org-agenda-later)
2353 (org-defkey org-agenda-mode-map "b" 'org-agenda-earlier)
2354 (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
2355 (org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
2356 (org-defkey org-agenda-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock-from-agenda)
2357
2358 (org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add)
2359 (org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
2360 (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
2361 (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
2362 (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
2363 (org-defkey org-agenda-mode-map "_" 'org-agenda-filter-by-effort)
2364 (org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp)
2365 (org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all)
2366 (org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively)
2367 (org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
2368 (org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline)
2369 (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
2370 (org-defkey org-agenda-mode-map "\C-c\C-x_" 'org-timer-stop)
2371 (define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
2372 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg"    'org-mobile-pull)
2373 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp"    'org-mobile-push)
2374
2375 (org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse)
2376 (org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse)
2377
2378 (define-key org-agenda-mode-map [remap forward-paragraph] 'org-agenda-forward-block)
2379 (define-key org-agenda-mode-map [remap backward-paragraph] 'org-agenda-backward-block)
2380
2381 (when org-agenda-mouse-1-follows-link
2382   (org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
2383 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
2384   '("Agenda"
2385     ("Agenda Files")
2386     "--"
2387     ("Agenda Dates"
2388      ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)]
2389      ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
2390      ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
2391      ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
2392     "--"
2393     ("View"
2394      ["Day View" org-agenda-day-view
2395       :active (org-agenda-check-type nil 'agenda)
2396       :style radio :selected (eq org-agenda-current-span 'day)
2397       :keys "v d  (or just d)"]
2398      ["Week View" org-agenda-week-view
2399       :active (org-agenda-check-type nil 'agenda)
2400       :style radio :selected (eq org-agenda-current-span 'week)
2401       :keys "v w"]
2402      ["Fortnight View" org-agenda-fortnight-view
2403       :active (org-agenda-check-type nil 'agenda)
2404       :style radio :selected (eq org-agenda-current-span 'fortnight)
2405       :keys "v t"]
2406      ["Month View" org-agenda-month-view
2407       :active (org-agenda-check-type nil 'agenda)
2408       :style radio :selected (eq org-agenda-current-span 'month)
2409       :keys "v m"]
2410      ["Year View" org-agenda-year-view
2411       :active (org-agenda-check-type nil 'agenda)
2412       :style radio :selected (eq org-agenda-current-span 'year)
2413       :keys "v y"]
2414      "--"
2415      ["Include Diary" org-agenda-toggle-diary
2416       :style toggle :selected org-agenda-include-diary
2417       :active (org-agenda-check-type nil 'agenda)]
2418      ["Include Deadlines" org-agenda-toggle-deadlines
2419       :style toggle :selected org-agenda-include-deadlines
2420       :active (org-agenda-check-type nil 'agenda)]
2421      ["Use Time Grid" org-agenda-toggle-time-grid
2422       :style toggle :selected org-agenda-use-time-grid
2423       :active (org-agenda-check-type nil 'agenda)]
2424      "--"
2425      ["Show clock report" org-agenda-clockreport-mode
2426       :style toggle :selected org-agenda-clockreport-mode
2427       :active (org-agenda-check-type nil 'agenda)]
2428      ["Show some entry text" org-agenda-entry-text-mode
2429       :style toggle :selected org-agenda-entry-text-mode
2430       :active t]
2431      "--"
2432      ["Show Logbook entries" org-agenda-log-mode
2433       :style toggle :selected org-agenda-show-log
2434       :active (org-agenda-check-type nil 'agenda)
2435       :keys "v l (or just l)"]
2436      ["Include archived trees" org-agenda-archives-mode
2437       :style toggle :selected org-agenda-archives-mode :active t
2438       :keys "v a"]
2439      ["Include archive files" (org-agenda-archives-mode t)
2440       :style toggle :selected (eq org-agenda-archives-mode t) :active t
2441       :keys "v A"]
2442      "--"
2443      ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
2444     ["Write view to file" org-agenda-write t]
2445     ["Rebuild buffer" org-agenda-redo t]
2446     ["Save all Org buffers" org-save-all-org-buffers t]
2447     "--"
2448     ["Show original entry" org-agenda-show t]
2449     ["Go To (other window)" org-agenda-goto t]
2450     ["Go To (this window)" org-agenda-switch-to t]
2451     ["Capture with cursor date" org-agenda-capture t]
2452     ["Follow Mode" org-agenda-follow-mode
2453      :style toggle :selected org-agenda-follow-mode :active t]
2454     ;;    ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
2455     "--"
2456     ("TODO"
2457      ["Cycle TODO" org-agenda-todo t]
2458      ["Next TODO set" org-agenda-todo-nextset t]
2459      ["Previous TODO set" org-agenda-todo-previousset t]
2460      ["Add note" org-agenda-add-note t])
2461     ("Archive/Refile/Delete"
2462      ["Archive default" org-agenda-archive-default t]
2463      ["Archive default" org-agenda-archive-default-with-confirmation t]
2464      ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
2465      ["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
2466      ["Archive subtree" org-agenda-archive t]
2467      "--"
2468      ["Refile" org-agenda-refile t]
2469      "--"
2470      ["Delete subtree" org-agenda-kill t])
2471     ("Bulk action"
2472      ["Mark entry" org-agenda-bulk-mark t]
2473      ["Mark all" org-agenda-bulk-mark-all t]
2474      ["Unmark entry" org-agenda-bulk-unmark t]
2475      ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"]
2476      ["Toggle mark" org-agenda-bulk-toggle t]
2477      ["Toggle all" org-agenda-bulk-toggle-all t]
2478      ["Mark regexp" org-agenda-bulk-mark-regexp t])
2479     ["Act on all marked" org-agenda-bulk-action t]
2480     "--"
2481     ("Tags and Properties"
2482      ["Show all Tags" org-agenda-show-tags t]
2483      ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))]
2484      ["Change tag in region" org-agenda-set-tags (org-region-active-p)]
2485      "--"
2486      ["Column View" org-columns t])
2487     ("Deadline/Schedule"
2488      ["Schedule" org-agenda-schedule t]
2489      ["Set Deadline" org-agenda-deadline t]
2490      "--"
2491      ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)]
2492      ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)]
2493      ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"]
2494      ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"]
2495      ["Change Time +  min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"]
2496      ["Change Time -  min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"]
2497      ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)])
2498     ("Clock and Effort"
2499      ["Clock in" org-agenda-clock-in t]
2500      ["Clock out" org-agenda-clock-out t]
2501      ["Clock cancel" org-agenda-clock-cancel t]
2502      ["Goto running clock" org-clock-goto t]
2503      "--"
2504      ["Set Effort" org-agenda-set-effort t]
2505      ["Change clocked effort" org-clock-modify-effort-estimate
2506       (org-clock-is-active)])
2507     ("Priority"
2508      ["Set Priority" org-agenda-priority t]
2509      ["Increase Priority" org-agenda-priority-up t]
2510      ["Decrease Priority" org-agenda-priority-down t]
2511      ["Show Priority" org-show-priority t])
2512     ("Calendar/Diary"
2513      ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)]
2514      ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)]
2515      ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)]
2516      ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)]
2517      ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)]
2518      ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)]
2519      "--"
2520      ["Create iCalendar File" org-icalendar-combine-agenda-files t])
2521     "--"
2522     ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
2523     "--"
2524     ("MobileOrg"
2525      ["Push Files and Views" org-mobile-push t]
2526      ["Get Captured and Flagged" org-mobile-pull t]
2527      ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"]
2528      ["Show note / unflag" org-agenda-show-the-flagging-note t]
2529      "--"
2530      ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
2531     "--"
2532     ["Quit" org-agenda-quit t]
2533     ["Exit and Release Buffers" org-agenda-exit t]
2534     ))
2535
2536 ;;; Agenda undo
2537
2538 (defvar org-agenda-allow-remote-undo t
2539   "Non-nil means allow remote undo from the agenda buffer.")
2540 (defvar org-agenda-undo-has-started-in nil
2541   "Buffers that have already seen `undo-start' in the current undo sequence.")
2542
2543 (defun org-agenda-undo ()
2544   "Undo a remote editing step in the agenda.
2545 This undoes changes both in the agenda buffer and in the remote buffer
2546 that have been changed along."
2547   (interactive)
2548   (or org-agenda-allow-remote-undo
2549       (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
2550   (if (not (eq this-command last-command))
2551       (setq org-agenda-undo-has-started-in nil
2552         org-agenda-pending-undo-list org-agenda-undo-list))
2553   (if (not org-agenda-pending-undo-list)
2554       (user-error "No further undo information"))
2555   (let* ((entry (pop org-agenda-pending-undo-list))
2556      buf line cmd rembuf)
2557     (setq cmd (pop entry) line (pop entry))
2558     (setq rembuf (nth 2 entry))
2559     (org-with-remote-undo rembuf
2560       (while (bufferp (setq buf (pop entry)))
2561     (if (pop entry)
2562         (with-current-buffer buf
2563           (let ((last-undo-buffer buf)
2564                     (inhibit-read-only t))
2565         (unless (memq buf org-agenda-undo-has-started-in)
2566           (push buf org-agenda-undo-has-started-in)
2567           (make-local-variable 'pending-undo-list)
2568           (undo-start))
2569         (while (and pending-undo-list
2570                 (listp pending-undo-list)
2571                 (not (car pending-undo-list)))
2572           (pop pending-undo-list))
2573         (undo-more 1))))))
2574     (org-goto-line line)
2575     (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf))))
2576
2577 (defun org-verify-change-for-undo (l1 l2)
2578   "Verify that a real change occurred between the undo lists L1 and L2."
2579   (while (and l1 (listp l1) (null (car l1))) (pop l1))
2580   (while (and l2 (listp l2) (null (car l2))) (pop l2))
2581   (not (eq l1 l2)))
2582
2583 ;;; Agenda dispatch
2584
2585 (defvar org-agenda-restrict-begin (make-marker))
2586 (defvar org-agenda-restrict-end (make-marker))
2587 (defvar org-agenda-last-dispatch-buffer nil)
2588 (defvar org-agenda-overriding-restriction nil)
2589
2590 (defcustom org-agenda-custom-commands-contexts nil
2591   "Alist of custom agenda keys and contextual rules.
2592
2593 For example, if you have a custom agenda command \"p\" and you
2594 want this command to be accessible only from plain text files,
2595 use this:
2596
2597    \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\"))))
2598
2599 Here are the available contexts definitions:
2600
2601       in-file: command displayed only in matching files
2602       in-mode: command displayed only in matching modes
2603   not-in-file: command not displayed in matching files
2604   not-in-mode: command not displayed in matching modes
2605     in-buffer: command displayed only in matching buffers
2606 not-in-buffer: command not displayed in matching buffers
2607    [function]: a custom function taking no argument
2608
2609 If you define several checks, the agenda command will be
2610 accessible if there is at least one valid check.
2611
2612 You can also bind a key to another agenda custom command
2613 depending on contextual rules.
2614
2615     \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\"))))
2616
2617 Here it means: in .txt files, use \"p\" as the key for the
2618 agenda command otherwise associated with \"q\".  (The command
2619 originally associated with \"q\" is not displayed to avoid
2620 duplicates.)"
2621   :version "24.3"
2622   :group 'org-agenda-custom-commands
2623   :type '(repeat (list :tag "Rule"
2624                (string :tag "        Agenda key")
2625                (string :tag "Replace by command")
2626                (repeat :tag "Available when"
2627                    (choice
2628                 (cons :tag "Condition"
2629                       (choice
2630                        (const :tag "In file" in-file)
2631                        (const :tag "Not in file" not-in-file)
2632                        (const :tag "In buffer" in-buffer)
2633                        (const :tag "Not in buffer" not-in-buffer)
2634                        (const :tag "In mode" in-mode)
2635                        (const :tag "Not in mode" not-in-mode))
2636                       (regexp))
2637                 (function :tag "Custom function"))))))
2638
2639 (defcustom org-agenda-max-entries nil
2640   "Maximum number of entries to display in an agenda.
2641 This can be nil (no limit) or an integer or an alist of agenda
2642 types with an associated number of entries to display in this
2643 type."
2644   :version "24.4"
2645   :package-version '(Org . "8.0")
2646   :group 'org-agenda-custom-commands
2647   :type '(choice (symbol :tag "No limit" nil)
2648          (integer :tag "Max number of entries")
2649          (repeat
2650           (cons (choice :tag "Agenda type"
2651                 (const agenda)
2652                 (const todo)
2653                 (const tags)
2654                 (const search))
2655             (integer :tag "Max number of entries")))))
2656
2657 (defcustom org-agenda-max-todos nil
2658   "Maximum number of TODOs to display in an agenda.
2659 This can be nil (no limit) or an integer or an alist of agenda
2660 types with an associated number of entries to display in this
2661 type."
2662   :version "24.4"
2663   :package-version '(Org . "8.0")
2664   :group 'org-agenda-custom-commands
2665   :type '(choice (symbol :tag "No limit" nil)
2666          (integer :tag "Max number of TODOs")
2667          (repeat
2668           (cons (choice :tag "Agenda type"
2669                 (const agenda)
2670                 (const todo)
2671                 (const tags)
2672                 (const search))
2673             (integer :tag "Max number of TODOs")))))
2674
2675 (defcustom org-agenda-max-tags nil
2676   "Maximum number of tagged entries to display in an agenda.
2677 This can be nil (no limit) or an integer or an alist of agenda
2678 types with an associated number of entries to display in this
2679 type."
2680   :version "24.4"
2681   :package-version '(Org . "8.0")
2682   :group 'org-agenda-custom-commands
2683   :type '(choice (symbol :tag "No limit" nil)
2684          (integer :tag "Max number of tagged entries")
2685          (repeat
2686           (cons (choice :tag "Agenda type"
2687                 (const agenda)
2688                 (const todo)
2689                 (const tags)
2690                 (const search))
2691             (integer :tag "Max number of tagged entries")))))
2692
2693 (defcustom org-agenda-max-effort nil
2694   "Maximum cumulated effort duration for the agenda.
2695 This can be nil (no limit) or a number of minutes (as an integer)
2696 or an alist of agenda types with an associated number of minutes
2697 to limit entries to in this type."
2698   :version "24.4"
2699   :package-version '(Org . "8.0")
2700   :group 'org-agenda-custom-commands
2701   :type '(choice (symbol :tag "No limit" nil)
2702          (integer :tag "Max number of minutes")
2703          (repeat
2704           (cons (choice :tag "Agenda type"
2705                 (const agenda)
2706                 (const todo)
2707                 (const tags)
2708                 (const search))
2709             (integer :tag "Max number of minutes")))))
2710
2711 (defvar org-agenda-keep-restricted-file-list nil)
2712 (defvar org-keys nil)
2713 (defvar org-match nil)
2714 ;;;###autoload
2715 (defun org-agenda (&optional arg org-keys restriction)
2716   "Dispatch agenda commands to collect entries to the agenda buffer.
2717 Prompts for a command to execute.  Any prefix arg will be passed
2718 on to the selected command.  The default selections are:
2719
2720 a     Call `org-agenda-list' to display the agenda for current day or week.
2721 t     Call `org-todo-list' to display the global todo list.
2722 T     Call `org-todo-list' to display the global todo list, select only
2723       entries with a specific TODO keyword (the user gets a prompt).
2724 m     Call `org-tags-view' to display headlines with tags matching
2725       a condition  (the user is prompted for the condition).
2726 M     Like `m', but select only TODO entries, no ordinary headlines.
2727 e     Export views to associated files.
2728 s     Search entries for keywords.
2729 S     Search entries for keywords, only with TODO keywords.
2730 /     Multi occur across all agenda files and also files listed
2731       in `org-agenda-text-search-extra-files'.
2732 <     Restrict agenda commands to buffer, subtree, or region.
2733       Press several times to get the desired effect.
2734 >     Remove a previous restriction.
2735 #     List \"stuck\" projects.
2736 !     Configure what \"stuck\" means.
2737 C     Configure custom agenda commands.
2738
2739 More commands can be added by configuring the variable
2740 `org-agenda-custom-commands'.  In particular, specific tags and TODO keyword
2741 searches can be pre-defined in this way.
2742
2743 If the current buffer is in Org mode and visiting a file, you can also
2744 first press `<' once to indicate that the agenda should be temporarily
2745 \(until the next use of `\\[org-agenda]') restricted to the current file.
2746 Pressing `<' twice means to restrict to the current subtree or region
2747 \(if active)."
2748   (interactive "P")
2749   (catch 'exit
2750     (let* ((prefix-descriptions nil)
2751        (org-agenda-buffer-name org-agenda-buffer-name)
2752        (org-agenda-window-setup (if (equal (buffer-name)
2753                            org-agenda-buffer-name)
2754                     'current-window
2755                       org-agenda-window-setup))
2756        (org-agenda-custom-commands-orig org-agenda-custom-commands)
2757        (org-agenda-custom-commands
2758         ;; normalize different versions
2759         (delq nil
2760           (mapcar
2761            (lambda (x)
2762              (cond ((stringp (cdr x))
2763                 (push x prefix-descriptions)
2764                 nil)
2765                ((stringp (nth 1 x)) x)
2766                ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
2767                (t (cons (car x) (cons "" (cdr x))))))
2768            org-agenda-custom-commands)))
2769        (org-agenda-custom-commands
2770         (org-contextualize-keys
2771          org-agenda-custom-commands org-agenda-custom-commands-contexts))
2772        (buf (current-buffer))
2773        (bfn (buffer-file-name (buffer-base-buffer)))
2774        entry key type org-match lprops ans)
2775       ;; Turn off restriction unless there is an overriding one,
2776       (unless org-agenda-overriding-restriction
2777     (unless org-agenda-keep-restricted-file-list
2778       ;; There is a request to keep the file list in place
2779       (put 'org-agenda-files 'org-restrict nil))
2780     (setq org-agenda-restrict nil)
2781     (move-marker org-agenda-restrict-begin nil)
2782     (move-marker org-agenda-restrict-end nil))
2783       ;; Delete old local properties
2784       (put 'org-agenda-redo-command 'org-lprops nil)
2785       ;; Delete previously set last-arguments
2786       (put 'org-agenda-redo-command 'last-args nil)
2787       ;; Remember where this call originated
2788       (setq org-agenda-last-dispatch-buffer (current-buffer))
2789       (unless org-keys
2790     (setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
2791           org-keys (car ans)
2792           restriction (cdr ans)))
2793       ;; If we have sticky agenda buffers, set a name for the buffer,
2794       ;; depending on the invoking keys.  The user may still set this
2795       ;; as a command option, which will overwrite what we do here.
2796       (if org-agenda-sticky
2797       (setq org-agenda-buffer-name
2798         (format "*Org Agenda(%s)*" org-keys)))
2799       ;; Establish the restriction, if any
2800       (when (and (not org-agenda-overriding-restriction) restriction)
2801     (put 'org-agenda-files 'org-restrict (list bfn))
2802     (cond
2803      ((eq restriction 'region)
2804       (setq org-agenda-restrict (current-buffer))
2805       (move-marker org-agenda-restrict-begin (region-beginning))
2806       (move-marker org-agenda-restrict-end (region-end)))
2807      ((eq restriction 'subtree)
2808       (save-excursion
2809         (setq org-agenda-restrict (current-buffer))
2810         (org-back-to-heading t)
2811         (move-marker org-agenda-restrict-begin (point))
2812         (move-marker org-agenda-restrict-end
2813              (progn (org-end-of-subtree t)))))))
2814
2815       ;; For example the todo list should not need it (but does...)
2816       (cond
2817        ((setq entry (assoc org-keys org-agenda-custom-commands))
2818     (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
2819         (progn
2820           (setq type (nth 2 entry) org-match (eval (nth 3 entry))
2821             lprops (nth 4 entry))
2822           (if org-agenda-sticky
2823           (setq org-agenda-buffer-name
2824             (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
2825                 (format "*Org Agenda(%s)*" org-keys))))
2826           (put 'org-agenda-redo-command 'org-lprops lprops)
2827           (cond
2828            ((eq type 'agenda)
2829         (org-let lprops '(org-agenda-list current-prefix-arg)))
2830            ((eq type 'agenda*)
2831         (org-let lprops '(org-agenda-list current-prefix-arg nil nil t)))
2832            ((eq type 'alltodo)
2833         (org-let lprops '(org-todo-list current-prefix-arg)))
2834            ((eq type 'search)
2835         (org-let lprops '(org-search-view current-prefix-arg org-match nil)))
2836            ((eq type 'stuck)
2837         (org-let lprops '(org-agenda-list-stuck-projects
2838                   current-prefix-arg)))
2839            ((eq type 'tags)
2840         (org-let lprops '(org-tags-view current-prefix-arg org-match)))
2841            ((eq type 'tags-todo)
2842         (org-let lprops '(org-tags-view '(4) org-match)))
2843            ((eq type 'todo)
2844         (org-let lprops '(org-todo-list org-match)))
2845            ((eq type 'tags-tree)
2846         (org-check-for-org-mode)
2847         (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match)))
2848            ((eq type 'todo-tree)
2849         (org-check-for-org-mode)
2850         (org-let lprops
2851           '(org-occur (concat "^" org-outline-regexp "[ \t]*"
2852                       (regexp-quote org-match) "\\>"))))
2853            ((eq type 'occur-tree)
2854         (org-check-for-org-mode)
2855         (org-let lprops '(org-occur org-match)))
2856            ((functionp type)
2857         (org-let lprops '(funcall type org-match)))
2858            ((fboundp type)
2859         (org-let lprops '(funcall type org-match)))
2860            (t (user-error "Invalid custom agenda command type %s" type))))
2861       (org-agenda-run-series (nth 1 entry) (cddr entry))))
2862        ((equal org-keys "C")
2863     (setq org-agenda-custom-commands org-agenda-custom-commands-orig)
2864     (customize-variable 'org-agenda-custom-commands))
2865        ((equal org-keys "a") (call-interactively 'org-agenda-list))
2866        ((equal org-keys "s") (call-interactively 'org-search-view))
2867        ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4))))
2868        ((equal org-keys "t") (call-interactively 'org-todo-list))
2869        ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
2870        ((equal org-keys "m") (call-interactively 'org-tags-view))
2871        ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
2872        ((equal org-keys "e") (call-interactively 'org-store-agenda-views))
2873        ((equal org-keys "?") (org-tags-view nil "+FLAGGED")
2874     (add-hook
2875      'post-command-hook
2876      (lambda ()
2877        (unless (current-message)
2878          (let* ((m (org-agenda-get-any-marker))
2879             (note (and m (org-entry-get m "THEFLAGGINGNOTE"))))
2880            (when note
2881          (message (concat
2882                "FLAGGING-NOTE ([?] for more info): "
2883                (org-add-props
2884                    (replace-regexp-in-string
2885                 "\\\\n" "//"
2886                 (copy-sequence note))
2887                    nil 'face 'org-warning)))))))
2888      t t))
2889        ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
2890        ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
2891        ((equal org-keys "!") (customize-variable 'org-stuck-projects))
2892        (t (user-error "Invalid agenda key"))))))
2893
2894 (defvar org-agenda-multi)
2895
2896 (defun org-agenda-append-agenda ()
2897   "Append another agenda view to the current one.
2898 This function allows interactive building of block agendas.
2899 Agenda views are separated by `org-agenda-block-separator'."
2900   (interactive)
2901   (unless (derived-mode-p 'org-agenda-mode)
2902     (user-error "Can only append from within agenda buffer"))
2903   (let ((org-agenda-multi t))
2904     (org-agenda)
2905     (widen)
2906     (org-agenda-finalize)
2907     (setq buffer-read-only t)
2908     (org-agenda-fit-window-to-buffer)))
2909
2910 (defun org-agenda-normalize-custom-commands (cmds)
2911   "Normalize custom commands CMDS."
2912   (delq nil
2913     (mapcar
2914      (lambda (x)
2915        (cond ((stringp (cdr x)) nil)
2916          ((stringp (nth 1 x)) x)
2917          ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
2918          (t (cons (car x) (cons "" (cdr x))))))
2919      cmds)))
2920
2921 (defun org-agenda-get-restriction-and-command (prefix-descriptions)
2922   "The user interface for selecting an agenda command."
2923   (catch 'exit
2924     (let* ((bfn (buffer-file-name (buffer-base-buffer)))
2925        (restrict-ok (and bfn (derived-mode-p 'org-mode)))
2926        (region-p (org-region-active-p))
2927        (custom org-agenda-custom-commands)
2928        (selstring "")
2929        restriction second-time
2930        c entry key type match prefixes rmheader header-end custom1 desc
2931        line lines left right n n1)
2932       (save-window-excursion
2933     (delete-other-windows)
2934     (org-switch-to-buffer-other-window " *Agenda Commands*")
2935     (erase-buffer)
2936     (insert (eval-when-compile
2937           (let ((header
2938              "Press key for an agenda command:
2939 --------------------------------        <   Buffer, subtree/region restriction
2940 a   Agenda for current week or day      >   Remove restriction
2941 t   List of all TODO entries            e   Export agenda views
2942 m   Match a TAGS/PROP/TODO query        T   Entries with special TODO kwd
2943 s   Search for keywords                 M   Like m, but only TODO entries
2944 /   Multi-occur                         S   Like s, but only TODO entries
2945 ?   Find :FLAGGED: entries              C   Configure custom agenda commands
2946 *   Toggle sticky agenda views          #   List stuck projects (!=configure)
2947 ")
2948             (start 0))
2949             (while (string-match
2950                 "\\(^\\|   \\|(\\)\\(\\S-\\)\\( \\|=\\)"
2951                 header start)
2952               (setq start (match-end 0))
2953               (add-text-properties (match-beginning 2) (match-end 2)
2954                        '(face bold) header))
2955             header)))
2956     (setq header-end (point-marker))
2957     (while t
2958       (setq custom1 custom)
2959       (when (eq rmheader t)
2960         (org-goto-line 1)
2961         (re-search-forward ":" nil t)
2962         (delete-region (match-end 0) (point-at-eol))
2963         (forward-char 1)
2964         (looking-at "-+")
2965         (delete-region (match-end 0) (point-at-eol))
2966         (move-marker header-end (match-end 0)))
2967       (goto-char header-end)
2968       (delete-region (point) (point-max))
2969
2970       ;; Produce all the lines that describe custom commands and prefixes
2971       (setq lines nil)
2972       (while (setq entry (pop custom1))
2973         (setq key (car entry) desc (nth 1 entry)
2974           type (nth 2 entry)
2975           match (nth 3 entry))
2976         (if (> (length key) 1)
2977         (cl-pushnew (string-to-char key) prefixes :test #'equal)
2978           (setq line
2979             (format
2980              "%-4s%-14s"
2981              (org-add-props (copy-sequence key)
2982              '(face bold))
2983              (cond
2984               ((string-match "\\S-" desc) desc)
2985               ((eq type 'agenda) "Agenda for current week or day")
2986               ((eq type 'agenda*) "Appointments for current week or day")
2987               ((eq type 'alltodo) "List of all TODO entries")
2988               ((eq type 'search) "Word search")
2989               ((eq type 'stuck) "List of stuck projects")
2990               ((eq type 'todo) "TODO keyword")
2991               ((eq type 'tags) "Tags query")
2992               ((eq type 'tags-todo) "Tags (TODO)")
2993               ((eq type 'tags-tree) "Tags tree")
2994               ((eq type 'todo-tree) "TODO kwd tree")
2995               ((eq type 'occur-tree) "Occur tree")
2996               ((functionp type) (if (symbolp type)
2997                         (symbol-name type)
2998                       "Lambda expression"))
2999               (t "???"))))
3000           (if org-agenda-menu-show-matcher
3001           (setq line
3002             (concat line ": "
3003                 (cond
3004                  ((stringp match)
3005                   (setq match (copy-sequence match))
3006                   (org-add-props match nil 'face 'org-warning))
3007                  ((listp type)
3008                   (format "set of %d commands" (length type))))))
3009         (if (org-string-nw-p match)
3010             (add-text-properties
3011              0 (length line) (list 'help-echo
3012                        (concat "Matcher: " match)) line)))
3013           (push line lines)))
3014       (setq lines (nreverse lines))
3015       (when prefixes
3016         (mapc (lambda (x)
3017             (push
3018              (format "%s   %s"
3019                  (org-add-props (char-to-string x)
3020                  nil 'face 'bold)
3021                  (or (cdr (assoc (concat selstring
3022                              (char-to-string x))
3023                          prefix-descriptions))
3024                  "Prefix key"))
3025              lines))
3026           prefixes))
3027
3028       ;; Check if we should display in two columns
3029       (if org-agenda-menu-two-columns
3030           (progn
3031         (setq n (length lines)
3032               n1 (+ (/ n 2) (mod n 2))
3033               right (nthcdr n1 lines)
3034               left (copy-sequence lines))
3035         (setcdr (nthcdr (1- n1) left) nil))
3036         (setq left lines right nil))
3037       (while left
3038         (insert "\n" (pop left))
3039         (when right
3040           (if (< (current-column) 40)
3041           (move-to-column 40 t)
3042         (insert "   "))
3043           (insert (pop right))))
3044
3045       ;; Make the window the right size
3046       (goto-char (point-min))
3047       (if second-time
3048           (if (not (pos-visible-in-window-p (point-max)))
3049           (org-fit-window-to-buffer))
3050         (setq second-time t)
3051         (org-fit-window-to-buffer))
3052
3053       ;; Ask for selection
3054       (message "Press key for agenda command%s:"
3055            (if (or restrict-ok org-agenda-overriding-restriction)
3056                (if org-agenda-overriding-restriction
3057                " (restriction lock active)"
3058              (if restriction
3059                  (format " (restricted to %s)" restriction)
3060                " (unrestricted)"))
3061              ""))
3062       (setq c (read-char-exclusive))
3063       (message "")
3064       (cond
3065        ((assoc (char-to-string c) custom)
3066         (setq selstring (concat selstring (char-to-string c)))
3067         (throw 'exit (cons selstring restriction)))
3068        ((memq c prefixes)
3069         (setq selstring (concat selstring (char-to-string c))
3070           prefixes nil
3071           rmheader (or rmheader t)
3072           custom (delq nil (mapcar
3073                     (lambda (x)
3074                       (if (or (= (length (car x)) 1)
3075                           (/= (string-to-char (car x)) c))
3076                       nil
3077                     (cons (substring (car x) 1) (cdr x))))
3078                     custom))))
3079        ((eq c ?*)
3080         (call-interactively 'org-toggle-sticky-agenda)
3081         (sit-for 2))
3082        ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
3083         (message "Restriction is only possible in Org buffers")
3084         (ding) (sit-for 1))
3085        ((eq c ?1)
3086         (org-agenda-remove-restriction-lock 'noupdate)
3087         (setq restriction 'buffer))
3088        ((eq c ?0)
3089         (org-agenda-remove-restriction-lock 'noupdate)
3090         (setq restriction (if region-p 'region 'subtree)))
3091        ((eq c ?<)
3092         (org-agenda-remove-restriction-lock 'noupdate)
3093         (setq restriction
3094           (cond
3095            ((eq restriction 'buffer)
3096             (if region-p 'region 'subtree))
3097            ((memq restriction '(subtree region))
3098             nil)
3099            (t 'buffer))))
3100        ((eq c ?>)
3101         (org-agenda-remove-restriction-lock 'noupdate)
3102         (setq restriction nil))
3103        ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
3104         (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
3105            ((and (> (length selstring) 0) (eq c ?\d))
3106             (delete-window)
3107             (org-agenda-get-restriction-and-command prefix-descriptions))
3108
3109        ((equal c ?q) (error "Abort"))
3110        (t (user-error "Invalid key %c" c))))))))
3111
3112 (defun org-agenda-fit-window-to-buffer ()
3113   "Fit the window to the buffer size."
3114   (and (memq org-agenda-window-setup '(reorganize-frame))
3115        (fboundp 'fit-window-to-buffer)
3116        (if (and (= (cdr org-agenda-window-frame-fractions) 1.0)
3117         (= (car org-agenda-window-frame-fractions) 1.0))
3118        (delete-other-windows)
3119      (org-fit-window-to-buffer
3120       nil
3121       (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
3122       (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))))
3123
3124 (defvar org-cmd nil)
3125 (defvar org-agenda-overriding-cmd nil)
3126 (defvar org-agenda-overriding-arguments nil)
3127 (defvar org-agenda-overriding-cmd-arguments nil)
3128 (defun org-agenda-run-series (name series)
3129   "Run agenda NAME as a SERIES of agenda commands."
3130   (org-let (nth 1 series) '(org-agenda-prepare name))
3131   ;; We need to reset agenda markers here, because when constructing a
3132   ;; block agenda, the individual blocks do not do that.
3133   (org-agenda-reset-markers)
3134   (let* ((org-agenda-multi t)
3135      (redo (list 'org-agenda-run-series name (list 'quote series)))
3136      (cmds (car series))
3137      (gprops (nth 1 series))
3138      match ;; The byte compiler incorrectly complains about this.  Keep it!
3139      org-cmd type lprops)
3140     (while (setq org-cmd (pop cmds))
3141       (setq type (car org-cmd))
3142       (setq match (eval (nth 1 org-cmd)))
3143       (setq lprops (nth 2 org-cmd))
3144       (let ((org-agenda-overriding-arguments
3145          (if (eq org-agenda-overriding-cmd org-cmd)
3146          (or org-agenda-overriding-arguments
3147              org-agenda-overriding-cmd-arguments))))
3148     (cond
3149      ((eq type 'agenda)
3150       (org-let2 gprops lprops
3151         '(call-interactively 'org-agenda-list)))
3152      ((eq type 'agenda*)
3153       (org-let2 gprops lprops
3154         '(funcall 'org-agenda-list nil nil t)))
3155      ((eq type 'alltodo)
3156       (org-let2 gprops lprops
3157         '(call-interactively 'org-todo-list)))
3158      ((eq type 'search)
3159       (org-let2 gprops lprops
3160         '(org-search-view current-prefix-arg match nil)))
3161      ((eq type 'stuck)
3162       (org-let2 gprops lprops
3163         '(call-interactively 'org-agenda-list-stuck-projects)))
3164      ((eq type 'tags)
3165       (org-let2 gprops lprops
3166         '(org-tags-view current-prefix-arg match)))
3167      ((eq type 'tags-todo)
3168       (org-let2 gprops lprops
3169         '(org-tags-view '(4) match)))
3170      ((eq type 'todo)
3171       (org-let2 gprops lprops
3172         '(org-todo-list match)))
3173      ((fboundp type)
3174       (org-let2 gprops lprops
3175         '(funcall type match)))
3176      (t (error "Invalid type in command series")))))
3177     (widen)
3178     (let ((inhibit-read-only t))
3179       (add-text-properties (point-min) (point-max)
3180                `(org-series t org-series-redo-cmd ,redo)))
3181     (setq org-agenda-redo-command redo)
3182     (goto-char (point-min)))
3183   (org-agenda-fit-window-to-buffer)
3184   (org-let (nth 1 series) '(org-agenda-finalize)))
3185
3186 ;;;###autoload
3187 (defmacro org-batch-agenda (cmd-key &rest parameters)
3188   "Run an agenda command in batch mode and send the result to STDOUT.
3189 If CMD-KEY is a string of length 1, it is used as a key in
3190 `org-agenda-custom-commands' and triggers this command.  If it is a
3191 longer string it is used as a tags/todo match string.
3192 Parameters are alternating variable names and values that will be bound
3193 before running the agenda command."
3194   (org-eval-in-environment (org-make-parameter-alist parameters)
3195     (let (org-agenda-sticky)
3196       (if (> (length cmd-key) 1)
3197       (org-tags-view nil cmd-key)
3198     (org-agenda nil cmd-key))))
3199   (set-buffer org-agenda-buffer-name)
3200   (princ (buffer-string)))
3201
3202 (defvar org-agenda-info nil)
3203
3204 ;;;###autoload
3205 (defmacro org-batch-agenda-csv (cmd-key &rest parameters)
3206   "Run an agenda command in batch mode and send the result to STDOUT.
3207 If CMD-KEY is a string of length 1, it is used as a key in
3208 `org-agenda-custom-commands' and triggers this command.  If it is a
3209 longer string it is used as a tags/todo match string.
3210 Parameters are alternating variable names and values that will be bound
3211 before running the agenda command.
3212
3213 The output gives a line for each selected agenda item.  Each
3214 item is a list of comma-separated values, like this:
3215
3216 category,head,type,todo,tags,date,time,extra,priority-l,priority-n
3217
3218 category     The category of the item
3219 head         The headline, without TODO kwd, TAGS and PRIORITY
3220 type         The type of the agenda entry, can be
3221                 todo               selected in TODO match
3222                 tagsmatch          selected in tags match
3223                 diary              imported from diary
3224                 deadline           a deadline on given date
3225                 scheduled          scheduled on given date
3226                 timestamp          entry has timestamp on given date
3227                 closed             entry was closed on given date
3228                 upcoming-deadline  warning about deadline
3229                 past-scheduled     forwarded scheduled item
3230                 block              entry has date block including g. date
3231 todo         The todo keyword, if any
3232 tags         All tags including inherited ones, separated by colons
3233 date         The relevant date, like 2007-2-14
3234 time         The time, like 15:00-16:50
3235 extra        Sting with extra planning info
3236 priority-l   The priority letter if any was given
3237 priority-n   The computed numerical priority
3238 agenda-day   The day in the agenda where this is listed"
3239   (org-eval-in-environment (append '((org-agenda-remove-tags t))
3240                    (org-make-parameter-alist parameters))
3241     (if (> (length cmd-key) 2)
3242     (org-tags-view nil cmd-key)
3243       (org-agenda nil cmd-key)))
3244   (set-buffer org-agenda-buffer-name)
3245   (let* ((lines (org-split-string (buffer-string) "\n"))
3246      line)
3247     (while (setq line (pop lines))
3248       (catch 'next
3249     (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
3250     (setq org-agenda-info
3251           (org-fix-agenda-info (text-properties-at 0 line)))
3252     (princ
3253      (mapconcat 'org-agenda-export-csv-mapper
3254             '(org-category txt type todo tags date time extra
3255                    priority-letter priority agenda-day)
3256             ","))
3257     (princ "\n")))))
3258
3259 (defun org-fix-agenda-info (props)
3260   "Make sure all properties on an agenda item have a canonical form.
3261 This ensures the export commands can easily use it."
3262   (let (tmp re)
3263     (when (setq tmp (plist-get props 'tags))
3264       (setq props (plist-put props 'tags (mapconcat 'identity tmp ":"))))
3265     (when (setq tmp (plist-get props 'date))
3266       (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
3267       (let ((calendar-date-display-form '(year "-" month "-" day)))
3268     '((format "%4d, %9s %2s, %4s" dayname monthname day year))
3269
3270     (setq tmp (calendar-date-string tmp)))
3271       (setq props (plist-put props 'date tmp)))
3272     (when (setq tmp (plist-get props 'day))
3273       (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
3274       (let ((calendar-date-display-form '(year "-" month "-" day)))
3275     (setq tmp (calendar-date-string tmp)))
3276       (setq props (plist-put props 'day tmp))
3277       (setq props (plist-put props 'agenda-day tmp)))
3278     (when (setq tmp (plist-get props 'txt))
3279       (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp)
3280     (plist-put props 'priority-letter (match-string 1 tmp))
3281     (setq tmp (replace-match "" t t tmp)))
3282       (when (and (setq re (plist-get props 'org-todo-regexp))
3283          (setq re (concat "\\`\\.*" re " ?"))
3284          (let ((case-fold-search nil)) (string-match re tmp)))
3285     (plist-put props 'todo (match-string 1 tmp))
3286     (setq tmp (replace-match "" t t tmp)))
3287       (plist-put props 'txt tmp)))
3288   props)
3289
3290 (defun org-agenda-export-csv-mapper (prop)
3291   (let ((res (plist-get org-agenda-info prop)))
3292     (setq res
3293       (cond
3294        ((not res) "")
3295        ((stringp res) res)
3296        (t (prin1-to-string res))))
3297     (org-trim (replace-regexp-in-string "," ";" res nil t))))
3298
3299 ;;;###autoload
3300 (defun org-store-agenda-views (&rest parameters)
3301   "Store agenda views."
3302   (interactive)
3303   (eval (list 'org-batch-store-agenda-views)))
3304
3305 ;;;###autoload
3306 (defmacro org-batch-store-agenda-views (&rest parameters)
3307   "Run all custom agenda commands that have a file argument."
3308   (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
3309     (pop-up-frames nil)
3310     (dir default-directory)
3311     (pars (org-make-parameter-alist parameters))
3312     cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
3313     (save-window-excursion
3314       (while cmds
3315     (setq cmd (pop cmds)
3316           thiscmdkey (car cmd)
3317           thiscmdcmd (cdr cmd)
3318           match (nth 2 thiscmdcmd)
3319           bufname (if org-agenda-sticky
3320               (or (and (stringp match)
3321                    (format "*Org Agenda(%s:%s)*" thiscmdkey match))
3322                   (format "*Org Agenda(%s)*" thiscmdkey))
3323             org-agenda-buffer-name)
3324           cmd-or-set (nth 2 cmd)
3325           opts (nth (if (listp cmd-or-set) 3 4) cmd)
3326           files (nth (if (listp cmd-or-set) 4 5) cmd))
3327     (if (stringp files) (setq files (list files)))
3328     (when files
3329       (org-eval-in-environment (append org-agenda-exporter-settings
3330                        opts pars)
3331         (org-agenda nil thiscmdkey))
3332       (set-buffer bufname)
3333       (while files
3334         (org-eval-in-environment (append org-agenda-exporter-settings
3335                          opts pars)
3336           (org-agenda-write (expand-file-name (pop files) dir) nil t bufname)))
3337       (and (get-buffer bufname)
3338            (kill-buffer bufname)))))))
3339
3340 (defvar org-agenda-current-span nil
3341   "The current span used in the agenda view.") ; local variable in the agenda buffer
3342 (defun org-agenda-mark-header-line (pos)
3343   "Mark the line at POS as an agenda structure header."
3344   (save-excursion
3345     (goto-char pos)
3346     (put-text-property (point-at-bol) (point-at-eol)
3347                'org-agenda-structural-header t)
3348     (when org-agenda-title-append
3349       (put-text-property (point-at-bol) (point-at-eol)
3350              'org-agenda-title-append org-agenda-title-append))))
3351
3352 (defvar org-mobile-creating-agendas) ; defined in org-mobile.el
3353 (defvar org-agenda-write-buffer-name "Agenda View")
3354 (defun org-agenda-write (file &optional open nosettings agenda-bufname)
3355   "Write the current buffer (an agenda view) as a file.
3356
3357 Depending on the extension of the file name, plain text (.txt),
3358 HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
3359 If the extension is .ics, translate visible agenda into iCalendar
3360 format.  If the extension is .org, collect all subtrees
3361 corresponding to the agenda entries and add them in an .org file.
3362
3363 With prefix argument OPEN, open the new file immediately.  If
3364 NOSETTINGS is given, do not scope the settings of
3365 `org-agenda-exporter-settings' into the export commands.  This is
3366 used when the settings have already been scoped and we do not
3367 wish to overrule other, higher priority settings.  If
3368 AGENDA-BUFFER-NAME is provided, use this as the buffer name for
3369 the agenda to write."
3370   (interactive "FWrite agenda to file: \nP")
3371   (if (or (not (file-writable-p file))
3372       (and (file-exists-p file)
3373            (if (called-interactively-p 'any)
3374            (not (y-or-n-p (format "Overwrite existing file %s? " file))))))
3375       (user-error "Cannot write agenda to file %s" file))
3376   (org-let (if nosettings nil org-agenda-exporter-settings)
3377     '(save-excursion
3378        (save-window-excursion
3379      (let ((bs (copy-sequence (buffer-string)))
3380            (extension (file-name-extension file))
3381            (default-directory (file-name-directory file))
3382            beg content)
3383        (with-temp-buffer
3384          (rename-buffer org-agenda-write-buffer-name t)
3385          (set-buffer-modified-p nil)
3386          (insert bs)
3387          (org-agenda-remove-marked-text 'invisible 'org-filtered)
3388          (run-hooks 'org-agenda-before-write-hook)
3389          (cond
3390           ((bound-and-true-p org-mobile-creating-agendas)
3391            (org-mobile-write-agenda-for-mobile file))
3392           ((string= "org" extension)
3393            (let (content p m message-log-max)
3394          (goto-char (point-min))
3395          (while (setq p (next-single-property-change (point) 'org-hd-marker nil))
3396            (goto-char p)
3397            (setq m (get-text-property (point) 'org-hd-marker))
3398            (when m
3399              (push (save-excursion
3400                  (set-buffer (marker-buffer m))
3401                  (goto-char m)
3402                  (org-copy-subtree 1 nil t t)
3403                  org-subtree-clip)
3404                content)))
3405          (find-file file)
3406          (erase-buffer)
3407          (dolist (s content) (org-paste-subtree 1 s))
3408          (write-file file)
3409          (kill-buffer (current-buffer))
3410          (message "Org file written to %s" file)))
3411           ((member extension '("html" "htm"))
3412            (or (require 'htmlize nil t)
3413            (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
3414            (set-buffer (htmlize-buffer (current-buffer)))
3415            (when org-agenda-export-html-style
3416          ;; replace <style> section with org-agenda-export-html-style
3417          (goto-char (point-min))
3418          (kill-region (- (search-forward "<style") 6)
3419                   (search-forward "</style>"))
3420          (insert org-agenda-export-html-style))
3421            (write-file file)
3422            (kill-buffer (current-buffer))
3423            (message "HTML written to %s" file))
3424           ((string= "ps" extension)
3425            (require 'ps-print)
3426            (ps-print-buffer-with-faces file)
3427            (message "Postscript written to %s" file))
3428           ((string= "pdf" extension)
3429            (require 'ps-print)
3430            (ps-print-buffer-with-faces
3431         (concat (file-name-sans-extension file) ".ps"))
3432            (call-process "ps2pdf" nil nil nil
3433                  (expand-file-name
3434                   (concat (file-name-sans-extension file) ".ps"))
3435                  (expand-file-name file))
3436            (delete-file (concat (file-name-sans-extension file) ".ps"))
3437            (message "PDF written to %s" file))
3438           ((string= "ics" extension)
3439            (require 'ox-icalendar)
3440            (org-icalendar-export-current-agenda (expand-file-name file)))
3441           (t
3442            (let ((bs (buffer-string)))
3443          (find-file file)
3444          (erase-buffer)
3445          (insert bs)
3446          (save-buffer 0)
3447          (kill-buffer (current-buffer))
3448          (message "Plain text written to %s" file))))))))
3449     (set-buffer (or agenda-bufname
3450             (and (called-interactively-p 'any) (buffer-name))
3451             org-agenda-buffer-name)))
3452   (when open (org-open-file file)))
3453
3454 (defun org-agenda-remove-marked-text (property &optional value)
3455   "Delete all text marked with VALUE of PROPERTY.
3456 VALUE defaults to t."
3457   (let (beg)
3458     (setq value (or value t))
3459     (while (setq beg (text-property-any (point-min) (point-max)
3460                     property value))
3461       (delete-region
3462        beg (or (next-single-property-change beg property)
3463            (point-max))))))
3464
3465 (defun org-agenda-add-entry-text ()
3466   "Add entry text to agenda lines.
3467 This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
3468 entry text following headings shown in the agenda.
3469 Drawers will be excluded, also the line with scheduling/deadline info."
3470   (when (and (> org-agenda-add-entry-text-maxlines 0)
3471          (not (bound-and-true-p org-mobile-creating-agendas)))
3472     (let (m txt)
3473       (goto-char (point-min))
3474       (while (not (eobp))
3475     (if (not (setq m (org-get-at-bol 'org-hd-marker)))
3476         (beginning-of-line 2)
3477       (setq txt (org-agenda-get-some-entry-text
3478              m org-agenda-add-entry-text-maxlines "    > "))
3479       (end-of-line 1)
3480       (if (string-match "\\S-" txt)
3481           (insert "\n" txt)
3482         (or (eobp) (forward-char 1))))))))
3483
3484 (defun org-agenda-get-some-entry-text (marker n-lines &optional indent
3485                           &rest keep)
3486   "Extract entry text from MARKER, at most N-LINES lines.
3487 This will ignore drawers etc, just get the text.
3488 If INDENT is given, prefix every line with this string.  If KEEP is
3489 given, it is a list of symbols, defining stuff that should not be
3490 removed from the entry content.  Currently only `planning' is allowed here."
3491   (let (txt drawer-re kwd-time-re ind)
3492     (save-excursion
3493       (with-current-buffer (marker-buffer marker)
3494     (if (not (derived-mode-p 'org-mode))
3495         (setq txt "")
3496       (org-with-wide-buffer
3497        (goto-char marker)
3498        (end-of-line 1)
3499        (setq txt (buffer-substring
3500               (min (1+ (point)) (point-max))
3501               (progn (outline-next-heading) (point)))
3502          drawer-re org-drawer-regexp
3503          kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
3504                      ".*\n?"))
3505        (with-temp-buffer
3506          (insert txt)
3507          (when org-agenda-add-entry-text-descriptive-links
3508            (goto-char (point-min))
3509            (while (org-activate-links (point-max))
3510          (add-text-properties (match-beginning 0) (match-end 0)
3511                       '(face org-link))))
3512          (goto-char (point-min))
3513          (while (re-search-forward org-bracket-link-regexp (point-max) t)
3514            (set-text-properties (match-beginning 0) (match-end 0)
3515                     nil))
3516          (goto-char (point-min))
3517          (while (re-search-forward drawer-re nil t)
3518            (delete-region
3519         (match-beginning 0)
3520         (progn (re-search-forward
3521             "^[ \t]*:END:.*\n?" nil 'move)
3522                (point))))
3523          (unless (member 'planning keep)
3524            (goto-char (point-min))
3525            (while (re-search-forward kwd-time-re nil t)
3526          (replace-match "")))
3527          (goto-char (point-min))
3528          (when org-agenda-entry-text-exclude-regexps
3529            (let ((re-list org-agenda-entry-text-exclude-regexps)    re)
3530          (while (setq re (pop re-list))
3531            (goto-char (point-min))
3532            (while (re-search-forward re nil t)
3533              (replace-match "")))))
3534          (goto-char (point-max))
3535          (skip-chars-backward " \t\n")
3536          (if (looking-at "[ \t\n]+\\'") (replace-match ""))
3537
3538          ;; find and remove min common indentation
3539          (goto-char (point-min))
3540          (untabify (point-min) (point-max))
3541          (setq ind (org-get-indentation))
3542          (while (not (eobp))
3543            (unless (looking-at "[ \t]*$")
3544          (setq ind (min ind (org-get-indentation))))
3545            (beginning-of-line 2))
3546          (goto-char (point-min))
3547          (while (not (eobp))
3548            (unless (looking-at "[ \t]*$")
3549          (move-to-column ind)
3550          (delete-region (point-at-bol) (point)))
3551            (beginning-of-line 2))
3552
3553          (run-hooks 'org-agenda-entry-text-cleanup-hook)
3554
3555          (goto-char (point-min))
3556          (when indent
3557            (while (and (not (eobp)) (re-search-forward "^" nil t))
3558          (replace-match indent t t)))
3559          (goto-char (point-min))
3560          (while (looking-at "[ \t]*\n") (replace-match ""))
3561          (goto-char (point-max))
3562          (when (> (org-current-line)
3563               n-lines)
3564            (org-goto-line (1+ n-lines))
3565            (backward-char 1))
3566          (setq txt (buffer-substring (point-min) (point))))))))
3567     txt))
3568
3569 (defun org-check-for-org-mode ()
3570   "Make sure current buffer is in Org mode.  Error if not."
3571   (or (derived-mode-p 'org-mode)
3572       (error "Cannot execute Org agenda command on buffer in %s"
3573          major-mode)))
3574
3575 ;;; Agenda prepare and finalize
3576
3577 (defvar org-agenda-multi nil)  ; dynamically scoped
3578 (defvar org-agenda-pre-window-conf nil)
3579 (defvar org-agenda-columns-active nil)
3580 (defvar org-agenda-name nil)
3581 (defvar org-agenda-tag-filter nil)
3582 (defvar org-agenda-category-filter nil)
3583 (defvar org-agenda-regexp-filter nil)
3584 (defvar org-agenda-effort-filter nil)
3585 (defvar org-agenda-top-headline-filter nil)
3586 (defvar org-agenda-tag-filter-preset nil
3587   "A preset of the tags filter used for secondary agenda filtering.
3588 This must be a list of strings, each string must be a single tag preceded
3589 by \"+\" or \"-\".
3590 This variable should not be set directly, but agenda custom commands can
3591 bind it in the options section.  The preset filter is a global property of
3592 the entire agenda view.  In a block agenda, it will not work reliably to
3593 define a filter for one of the individual blocks.  You need to set it in
3594 the global options and expect it to be applied to the entire view.")
3595
3596 (defvar org-agenda-category-filter-preset nil
3597   "A preset of the category filter used for secondary agenda filtering.
3598 This must be a list of strings, each string must be a single category
3599 preceded by \"+\" or \"-\".
3600 This variable should not be set directly, but agenda custom commands can
3601 bind it in the options section.  The preset filter is a global property of
3602 the entire agenda view.  In a block agenda, it will not work reliably to
3603 define a filter for one of the individual blocks.  You need to set it in
3604 the global options and expect it to be applied to the entire view.")
3605
3606 (defvar org-agenda-regexp-filter-preset nil
3607   "A preset of the regexp filter used for secondary agenda filtering.
3608 This must be a list of strings, each string must be a single regexp
3609 preceded by \"+\" or \"-\".
3610 This variable should not be set directly, but agenda custom commands can
3611 bind it in the options section.  The preset filter is a global property of
3612 the entire agenda view.  In a block agenda, it will not work reliably to
3613 define a filter for one of the individual blocks.  You need to set it in
3614 the global options and expect it to be applied to the entire view.")
3615
3616 (defvar org-agenda-effort-filter-preset nil
3617   "A preset of the effort condition used for secondary agenda filtering.
3618 This must be a list of strings, each string must be a single regexp
3619 preceded by \"+\" or \"-\".
3620 This variable should not be set directly, but agenda custom commands can
3621 bind it in the options section.  The preset filter is a global property of
3622 the entire agenda view.  In a block agenda, it will not work reliably to
3623 define a filter for one of the individual blocks.  You need to set it in
3624 the global options and expect it to be applied to the entire view.")
3625
3626 (defun org-agenda-use-sticky-p ()
3627   "Return non-nil if an agenda buffer named
3628 `org-agenda-buffer-name' exists and should be shown instead of
3629 generating a new one."
3630   (and
3631    ;; turned off by user
3632    org-agenda-sticky
3633    ;; For multi-agenda buffer already exists
3634    (not org-agenda-multi)
3635    ;; buffer found
3636    (get-buffer org-agenda-buffer-name)
3637    ;; C-u parameter is same as last call
3638    (with-current-buffer (get-buffer org-agenda-buffer-name)
3639      (and
3640       (equal current-prefix-arg
3641          org-agenda-last-prefix-arg)
3642       ;; In case user turned stickiness on, while having existing
3643       ;; Agenda buffer active, don't reuse that buffer, because it
3644       ;; does not have org variables local
3645       org-agenda-this-buffer-is-sticky))))
3646
3647 (defun org-agenda-prepare-window (abuf filter-alist)
3648   "Setup agenda buffer in the window.
3649 ABUF is the buffer for the agenda window.
3650 FILTER-ALIST is an alist of filters we need to apply when
3651 `org-agenda-persistent-filter' is non-nil."
3652   (let* ((awin (get-buffer-window abuf)) wconf)
3653     (cond
3654      ((equal (current-buffer) abuf) nil)
3655      (awin (select-window awin))
3656      ((not (setq wconf (current-window-configuration))))
3657      ((eq org-agenda-window-setup 'current-window)
3658       (pop-to-buffer-same-window abuf))
3659      ((eq org-agenda-window-setup 'other-window)
3660       (org-switch-to-buffer-other-window abuf))
3661      ((eq org-agenda-window-setup 'other-frame)
3662       (switch-to-buffer-other-frame abuf))
3663      ((eq org-agenda-window-setup 'only-window)
3664       (delete-other-windows)
3665       (pop-to-buffer-same-window abuf))
3666      ((eq org-agenda-window-setup 'reorganize-frame)
3667       (delete-other-windows)
3668       (org-switch-to-buffer-other-window abuf)))
3669     (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist)))
3670     (setq org-agenda-category-filter (cdr (assq 'cat filter-alist)))
3671     (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist)))
3672     (setq org-agenda-regexp-filter (cdr (assq 're filter-alist)))
3673     ;; Additional test in case agenda is invoked from within agenda
3674     ;; buffer via elisp link.
3675     (unless (equal (current-buffer) abuf)
3676       (pop-to-buffer-same-window abuf))
3677     (setq org-agenda-pre-window-conf
3678       (or wconf org-agenda-pre-window-conf))))
3679
3680 (defun org-agenda-prepare (&optional name)
3681   (let ((filter-alist (if org-agenda-persistent-filter
3682               (with-current-buffer
3683                   (get-buffer-create org-agenda-buffer-name)
3684                 (list `(tag . ,org-agenda-tag-filter)
3685                   `(re . ,org-agenda-regexp-filter)
3686                   `(effort . ,org-agenda-effort-filter)
3687                   `(cat . ,org-agenda-category-filter))))))
3688     (if (org-agenda-use-sticky-p)
3689     (progn
3690       (put 'org-agenda-tag-filter :preset-filter nil)
3691       (put 'org-agenda-category-filter :preset-filter nil)
3692       (put 'org-agenda-regexp-filter :preset-filter nil)
3693       ;; Popup existing buffer
3694       (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
3695                      filter-alist)
3696       (message "Sticky Agenda buffer, use `r' to refresh")
3697       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
3698       (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
3699       (setq org-todo-keywords-for-agenda nil)
3700       (put 'org-agenda-tag-filter :preset-filter
3701        org-agenda-tag-filter-preset)
3702       (put 'org-agenda-category-filter :preset-filter
3703        org-agenda-category-filter-preset)
3704       (put 'org-agenda-regexp-filter :preset-filter
3705        org-agenda-regexp-filter-preset)
3706       (put 'org-agenda-effort-filter :preset-filter
3707        org-agenda-effort-filter-preset)
3708       (if org-agenda-multi
3709       (progn
3710         (setq buffer-read-only nil)
3711         (goto-char (point-max))
3712         (unless (or (bobp) org-agenda-compact-blocks
3713             (not org-agenda-block-separator))
3714           (insert "\n"
3715               (if (stringp org-agenda-block-separator)
3716               org-agenda-block-separator
3717             (make-string (window-width) org-agenda-block-separator))
3718               "\n"))
3719         (narrow-to-region (point) (point-max)))
3720     (setq org-done-keywords-for-agenda nil)
3721     ;; Setting any org variables that are in org-agenda-local-vars
3722     ;; list need to be done after the prepare call
3723     (org-agenda-prepare-window
3724      (get-buffer-create org-agenda-buffer-name) filter-alist)
3725     (setq buffer-read-only nil)
3726     (org-agenda-reset-markers)
3727     (let ((inhibit-read-only t)) (erase-buffer))
3728     (org-agenda-mode)
3729     (setq org-agenda-buffer (current-buffer))
3730     (setq org-agenda-contributing-files nil)
3731     (setq org-agenda-columns-active nil)
3732     (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
3733     (setq org-todo-keywords-for-agenda
3734           (org-uniquify org-todo-keywords-for-agenda))
3735     (setq org-done-keywords-for-agenda
3736           (org-uniquify org-done-keywords-for-agenda))
3737     (setq org-agenda-last-prefix-arg current-prefix-arg)
3738     (setq org-agenda-this-buffer-name org-agenda-buffer-name)
3739     (and name (not org-agenda-name)
3740          (setq-local org-agenda-name name)))
3741       (setq buffer-read-only nil))))
3742
3743 (defvar org-agenda-overriding-columns-format)  ; From org-colview.el
3744 (defun org-agenda-finalize ()
3745   "Finishing touch for the agenda buffer, called just before displaying it."
3746   (unless org-agenda-multi
3747     (save-excursion
3748       (let ((inhibit-read-only t))
3749     (goto-char (point-min))
3750     (save-excursion
3751       (while (org-activate-links (point-max))
3752         (add-text-properties (match-beginning 0) (match-end 0)
3753                  '(face org-link))))
3754     (unless (eq org-agenda-remove-tags t)
3755       (org-agenda-align-tags))
3756     (unless org-agenda-with-colors
3757       (remove-text-properties (point-min) (point-max) '(face nil)))
3758     (if (and (boundp 'org-agenda-overriding-columns-format)
3759          org-agenda-overriding-columns-format)
3760         (setq-local org-agenda-overriding-columns-format
3761             org-agenda-overriding-columns-format))
3762     (if (and (boundp 'org-agenda-view-columns-initially)
3763          org-agenda-view-columns-initially)
3764         (org-agenda-columns))
3765     (when org-agenda-fontify-priorities
3766       (org-agenda-fontify-priorities))
3767     (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
3768       (org-agenda-dim-blocked-tasks))
3769     (org-agenda-mark-clocking-task)
3770     (when org-agenda-entry-text-mode
3771       (org-agenda-entry-text-hide)
3772       (org-agenda-entry-text-show))
3773     (if (and (functionp 'org-habit-insert-consistency-graphs)
3774          (save-excursion (next-single-property-change (point-min) 'org-habit-p)))
3775         (org-habit-insert-consistency-graphs))
3776     (setq org-agenda-type (org-get-at-bol 'org-agenda-type))
3777     (unless (or (eq org-agenda-show-inherited-tags 'always)
3778             (and (listp org-agenda-show-inherited-tags)
3779              (memq org-agenda-type org-agenda-show-inherited-tags))
3780             (and (eq org-agenda-show-inherited-tags t)
3781              (or (eq org-agenda-use-tag-inheritance t)
3782                  (and (listp org-agenda-use-tag-inheritance)
3783                   (not (memq org-agenda-type
3784                          org-agenda-use-tag-inheritance))))))
3785       (let (mrk)
3786         (save-excursion
3787           (goto-char (point-min))
3788           (while (equal (forward-line) 0)
3789         (when (setq mrk (get-text-property (point) 'org-hd-marker))
3790           (put-text-property (point-at-bol) (point-at-eol)
3791                      'tags (org-with-point-at mrk
3792                          (delete-dups
3793                           (mapcar 'downcase (org-get-tags-at))))))))))
3794     (run-hooks 'org-agenda-finalize-hook)
3795     (when org-agenda-top-headline-filter
3796       (org-agenda-filter-top-headline-apply
3797        org-agenda-top-headline-filter))
3798     (when org-agenda-tag-filter
3799       (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
3800     (when (get 'org-agenda-tag-filter :preset-filter)
3801       (org-agenda-filter-apply
3802        (get 'org-agenda-tag-filter :preset-filter) 'tag t))
3803     (when org-agenda-category-filter
3804       (org-agenda-filter-apply org-agenda-category-filter 'category))
3805     (when (get 'org-agenda-category-filter :preset-filter)
3806       (org-agenda-filter-apply
3807        (get 'org-agenda-category-filter :preset-filter) 'category))
3808     (when org-agenda-regexp-filter
3809       (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
3810     (when (get 'org-agenda-regexp-filter :preset-filter)
3811       (org-agenda-filter-apply
3812        (get 'org-agenda-regexp-filter :preset-filter) 'regexp))
3813     (when org-agenda-effort-filter
3814       (org-agenda-filter-apply org-agenda-effort-filter 'effort))
3815     (when (get 'org-agenda-effort-filter :preset-filter)
3816       (org-agenda-filter-apply
3817        (get 'org-agenda-effort-filter :preset-filter) 'effort))
3818     (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
3819
3820 (defun org-agenda-mark-clocking-task ()
3821   "Mark the current clock entry in the agenda if it is present."
3822   ;; We need to widen when `org-agenda-finalize' is called from
3823   ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
3824   (when (bound-and-true-p org-clock-current-task)
3825     (save-restriction
3826       (widen)
3827       (org-agenda-unmark-clocking-task)
3828       (when (marker-buffer org-clock-hd-marker)
3829     (save-excursion
3830       (goto-char (point-min))
3831       (let (s ov)
3832         (while (setq s (next-single-property-change (point) 'org-hd-marker))
3833           (goto-char s)
3834           (when (equal (org-get-at-bol 'org-hd-marker)
3835                org-clock-hd-marker)
3836         (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
3837         (overlay-put ov 'type 'org-agenda-clocking)
3838         (overlay-put ov 'face 'org-agenda-clocking)
3839         (overlay-put ov 'help-echo
3840                  "The clock is running in this item")))))))))
3841
3842 (defun org-agenda-unmark-clocking-task ()
3843   "Unmark the current clocking task."
3844   (mapc (lambda (o)
3845       (if (eq (overlay-get o 'type) 'org-agenda-clocking)
3846           (delete-overlay o)))
3847     (overlays-in (point-min) (point-max))))
3848
3849 (defun org-agenda-fontify-priorities ()
3850   "Make highest priority lines bold, and lowest italic."
3851   (interactive)
3852   (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority)
3853            (delete-overlay o)))
3854     (overlays-in (point-min) (point-max)))
3855   (save-excursion
3856     (let (b e p ov h l)
3857       (goto-char (point-min))
3858       (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
3859     (setq h (or (get-char-property (point) 'org-highest-priority)
3860             org-highest-priority)
3861           l (or (get-char-property (point) 'org-lowest-priority)
3862             org-lowest-priority)
3863           p (string-to-char (match-string 1))
3864           b (match-beginning 0)
3865           e (if (eq org-agenda-fontify-priorities 'cookies)
3866             (match-end 0)
3867           (point-at-eol))
3868           ov (make-overlay b e))
3869     (overlay-put
3870      ov 'face
3871      (let ((special-face
3872         (cond ((org-face-from-face-or-color
3873             'priority 'org-priority
3874             (cdr (assoc p org-priority-faces))))
3875               ((and (listp org-agenda-fontify-priorities)
3876                 (org-face-from-face-or-color
3877                  'priority 'org-priority
3878                  (cdr (assoc p org-agenda-fontify-priorities)))))
3879               ((equal p l) 'italic)
3880               ((equal p h) 'bold))))
3881        (if special-face (list special-face 'org-priority) 'org-priority)))
3882     (overlay-put ov 'org-type 'org-priority)))))
3883
3884 (defvar org-depend-tag-blocked)
3885
3886 (defun org-agenda-dim-blocked-tasks (&optional invisible)
3887   "Dim currently blocked TODOs in the agenda display.
3888 When INVISIBLE is non-nil, hide currently blocked TODO instead of
3889 dimming them."
3890   (interactive "P")
3891   (when (called-interactively-p 'interactive)
3892     (message "Dim or hide blocked tasks..."))
3893   (dolist (o (overlays-in (point-min) (point-max)))
3894     (when (eq (overlay-get o 'org-type) 'org-blocked-todo)
3895       (delete-overlay o)))
3896   (save-excursion
3897     (let ((inhibit-read-only t))
3898       (goto-char (point-min))
3899       (while (let ((pos (text-property-not-all
3900              (point) (point-max) 'org-todo-blocked nil)))
3901            (when pos (goto-char pos)))
3902     (let* ((invisible (eq (org-get-at-bol 'org-todo-blocked) 'invisible))
3903            (ov (make-overlay (if invisible
3904                      (line-end-position 0)
3905                    (line-beginning-position))
3906                  (line-end-position))))
3907       (if invisible
3908           (overlay-put ov 'invisible t)
3909         (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
3910       (overlay-put ov 'org-type 'org-blocked-todo))
3911     (forward-line))))
3912   (when (called-interactively-p 'interactive)
3913     (message "Dim or hide blocked tasks...done")))
3914
3915 (defun org-agenda--mark-blocked-entry (entry)
3916   "For ENTRY a string with the text property `org-hd-marker', if
3917 the header at `org-hd-marker' is blocked according to
3918 `org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is
3919 'invisible and the header is not blocked by checkboxes, set the
3920 text property `org-todo-blocked' to 'invisible, otherwise set it
3921 to t."
3922   (when (get-text-property 0 'todo-state entry)
3923     (let ((entry-marker (get-text-property 0 'org-hd-marker entry))
3924           (org-blocked-by-checkboxes nil)
3925       ;; Necessary so that `org-entry-blocked-p' does not change
3926       ;; the buffer.
3927           (org-depend-tag-blocked nil))
3928       (when entry-marker
3929     (let ((blocked
3930            (with-current-buffer (marker-buffer entry-marker)
3931          (save-excursion
3932            (goto-char entry-marker)
3933            (org-entry-blocked-p)))))
3934       (when blocked
3935         (let ((really-invisible
3936            (and (not org-blocked-by-checkboxes)
3937             (eq org-agenda-dim-blocked-tasks 'invisible))))
3938           (put-text-property
3939            0 (length entry) 'org-todo-blocked
3940            (if really-invisible 'invisible t)
3941            entry)))))))
3942   entry)
3943
3944 (defvar org-agenda-skip-function nil
3945   "Function to be called at each match during agenda construction.
3946 If this function returns nil, the current match should not be skipped.
3947 Otherwise, the function must return a position from where the search
3948 should be continued.
3949 This may also be a Lisp form, it will be evaluated.
3950 Never set this variable using `setq' or so, because then it will apply
3951 to all future agenda commands.  If you do want a global skipping condition,
3952 use the option `org-agenda-skip-function-global' instead.
3953 The correct usage for `org-agenda-skip-function' is to bind it with
3954 `let' to scope it dynamically into the agenda-constructing command.
3955 A good way to set it is through options in `org-agenda-custom-commands'.")
3956
3957 (defun org-agenda-skip ()
3958   "Throw to `:skip' in places that should be skipped.
3959 Also moves point to the end of the skipped region, so that search can
3960 continue from there."
3961   (let ((p (point-at-bol)) to)
3962     (when (or
3963        (save-excursion (goto-char p) (looking-at comment-start-skip))
3964        (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
3965         (get-text-property p :org-archived)
3966         (org-end-of-subtree t))
3967        (and org-agenda-skip-comment-trees
3968         (get-text-property p :org-comment)
3969         (org-end-of-subtree t))
3970        (and (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global)
3971                  (org-agenda-skip-eval org-agenda-skip-function)))
3972         (goto-char to))
3973        (org-in-src-block-p t))
3974       (throw :skip t))))
3975
3976 (defun org-agenda-skip-eval (form)
3977   "If FORM is a function or a list, call (or eval) it and return the result.
3978 `save-excursion' and `save-match-data' are wrapped around the call, so point
3979 and match data are returned to the previous state no matter what these
3980 functions do."
3981   (let (fp)
3982     (and form
3983      (or (setq fp (functionp form))
3984          (consp form))
3985      (save-excursion
3986        (save-match-data
3987          (if fp
3988          (funcall form)
3989            (eval form)))))))
3990
3991 (defvar org-agenda-markers nil
3992   "List of all currently active markers created by `org-agenda'.")
3993 (defvar org-agenda-last-marker-time (float-time)
3994   "Creation time of the last agenda marker.")
3995
3996 (defun org-agenda-new-marker (&optional pos)
3997   "Return a new agenda marker.
3998 Maker is at point, or at POS if non-nil.  Org mode keeps a list of
3999 these markers and resets them when they are no longer in use."
4000   (let ((m (copy-marker (or pos (point)) t)))
4001     (setq org-agenda-last-marker-time (float-time))
4002     (if org-agenda-buffer
4003     (with-current-buffer org-agenda-buffer
4004       (push m org-agenda-markers))
4005       (push m org-agenda-markers))
4006     m))
4007
4008 (defun org-agenda-reset-markers ()
4009   "Reset markers created by `org-agenda'."
4010   (while org-agenda-markers
4011     (move-marker (pop org-agenda-markers) nil)))
4012
4013 (defun org-agenda-save-markers-for-cut-and-paste (beg end)
4014   "Save relative positions of markers in region.
4015 This check for agenda markers in all agenda buffers currently active."
4016   (dolist (buf (buffer-list))
4017     (with-current-buffer buf
4018       (when (eq major-mode 'org-agenda-mode)
4019     (mapc (lambda (m) (org-check-and-save-marker m beg end))
4020           org-agenda-markers)))))
4021
4022 ;;; Entry text mode
4023
4024 (defun org-agenda-entry-text-show-here ()
4025   "Add some text from the entry as context to the current line."
4026   (let (m txt o)
4027     (setq m (org-get-at-bol 'org-hd-marker))
4028     (unless (marker-buffer m)
4029       (error "No marker points to an entry here"))
4030     (setq txt (concat "\n" (org-no-properties
4031                 (org-agenda-get-some-entry-text
4032                  m org-agenda-entry-text-maxlines
4033                  org-agenda-entry-text-leaders))))
4034     (when (string-match "\\S-" txt)
4035       (setq o (make-overlay (point-at-bol) (point-at-eol)))
4036       (overlay-put o 'evaporate t)
4037       (overlay-put o 'org-overlay-type 'agenda-entry-content)
4038       (overlay-put o 'after-string txt))))
4039
4040 (defun org-agenda-entry-text-show ()
4041   "Add entry context for all agenda lines."
4042   (interactive)
4043   (save-excursion
4044     (goto-char (point-max))
4045     (beginning-of-line 1)
4046     (while (not (bobp))
4047       (when (org-get-at-bol 'org-hd-marker)
4048     (org-agenda-entry-text-show-here))
4049       (beginning-of-line 0))))
4050
4051 (defun org-agenda-entry-text-hide ()
4052   "Remove any shown entry context."
4053   (delq nil
4054     (mapcar (lambda (o)
4055           (if (eq (overlay-get o 'org-overlay-type)
4056               'agenda-entry-content)
4057               (progn (delete-overlay o) t)))
4058         (overlays-in (point-min) (point-max)))))
4059
4060 (defun org-agenda-get-day-face (date)
4061   "Return the face DATE should be displayed with."
4062   (cond ((and (functionp org-agenda-day-face-function)
4063           (funcall org-agenda-day-face-function date)))
4064     ((org-agenda-today-p date) 'org-agenda-date-today)
4065     ((memq (calendar-day-of-week date) org-agenda-weekend-days)
4066      'org-agenda-date-weekend)
4067     (t 'org-agenda-date)))
4068
4069 (defvar org-agenda-show-log-scoped)
4070
4071 ;;; Agenda Daily/Weekly
4072
4073 (defvar org-agenda-start-day nil  ; dynamically scoped parameter
4074   "Start day for the agenda view.
4075 Custom commands can set this variable in the options section.
4076 This is usually a string like \"2007-11-01\", \"+2d\" or any other
4077 input allowed when reading a date through the Org calendar.
4078 See the docstring of `org-read-date' for details.")
4079 (defvar org-starting-day nil) ; local variable in the agenda buffer
4080 (defvar org-arg-loc nil) ; local variable
4081
4082 (defvar org-agenda-buffer-tmp-name nil)
4083 ;;;###autoload
4084 (defun org-agenda-list (&optional arg start-day span with-hour)
4085   "Produce a daily/weekly view from all files in variable `org-agenda-files'.
4086 The view will be for the current day or week, but from the overview buffer
4087 you will be able to go to other days/weeks.
4088
4089 With a numeric prefix argument in an interactive call, the agenda will
4090 span ARG days.  Lisp programs should instead specify SPAN to change
4091 the number of days.  SPAN defaults to `org-agenda-span'.
4092
4093 START-DAY defaults to TODAY, or to the most recent match for the weekday
4094 given in `org-agenda-start-on-weekday'.
4095
4096 When WITH-HOUR is non-nil, only include scheduled and deadline
4097 items if they have an hour specification like [h]h:mm."
4098   (interactive "P")
4099   (if org-agenda-overriding-arguments
4100       (setq arg (car org-agenda-overriding-arguments)
4101         start-day (nth 1 org-agenda-overriding-arguments)
4102         span (nth 2 org-agenda-overriding-arguments)))
4103   (if (and (integerp arg) (> arg 0))
4104       (setq span arg arg nil))
4105   (catch 'exit
4106     (setq org-agenda-buffer-name
4107       (or org-agenda-buffer-tmp-name
4108           (and org-agenda-doing-sticky-redo org-agenda-buffer-name)
4109           (if org-agenda-sticky
4110           (cond ((and org-keys (stringp org-match))
4111              (format "*Org Agenda(%s:%s)*" org-keys org-match))
4112             (org-keys
4113              (format "*Org Agenda(%s)*" org-keys))
4114             (t "*Org Agenda(a)*")))
4115           "*Org Agenda*"))
4116     (org-agenda-prepare "Day/Week")
4117     (setq start-day (or start-day org-agenda-start-day))
4118     (if (stringp start-day)
4119     ;; Convert to an absolute day number
4120     (setq start-day (time-to-days (org-read-date nil t start-day))))
4121     (org-compile-prefix-format 'agenda)
4122     (org-set-sorting-strategy 'agenda)
4123     (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span)))
4124        (today (org-today))
4125        (sd (or start-day today))
4126        (ndays (org-agenda-span-to-ndays span sd))
4127        (org-agenda-start-on-weekday
4128         (if (or (eq ndays 7) (eq ndays 14))
4129         org-agenda-start-on-weekday))
4130        (thefiles (org-agenda-files nil 'ifmode))
4131        (files thefiles)
4132        (start (if (or (null org-agenda-start-on-weekday)
4133               (< ndays 7))
4134               sd
4135             (let* ((nt (calendar-day-of-week
4136                 (calendar-gregorian-from-absolute sd)))
4137                (n1 org-agenda-start-on-weekday)
4138                (d (- nt n1)))
4139               (- sd (+ (if (< d 0) 7 0) d)))))
4140        (day-numbers (list start))
4141        (day-cnt 0)
4142        (inhibit-redisplay (not debug-on-error))
4143        (org-agenda-show-log-scoped org-agenda-show-log)
4144        s e rtn rtnall file date d start-pos end-pos todayp
4145        clocktable-start clocktable-end filter)
4146       (setq org-agenda-redo-command
4147         (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
4148       (dotimes (n (1- ndays))
4149     (push (1+ (car day-numbers)) day-numbers))
4150       (setq day-numbers (nreverse day-numbers))
4151       (setq clocktable-start (car day-numbers)
4152         clocktable-end (1+ (or (org-last day-numbers) 0)))
4153       (setq-local org-starting-day (car day-numbers))
4154       (setq-local org-arg-loc arg)
4155       (setq-local org-agenda-current-span (org-agenda-ndays-to-span span))
4156       (unless org-agenda-compact-blocks
4157     (let* ((d1 (car day-numbers))
4158            (d2 (org-last day-numbers))
4159            (w1 (org-days-to-iso-week d1))
4160            (w2 (org-days-to-iso-week d2)))
4161       (setq s (point))
4162       (if org-agenda-overriding-header
4163           (insert (org-add-props (copy-sequence org-agenda-overriding-header)
4164               nil 'face 'org-agenda-structure) "\n")
4165         (insert (org-agenda-span-name span)
4166             "-agenda"
4167             (if (< (- d2 d1) 350)
4168             (if (= w1 w2)
4169                 (format " (W%02d)" w1)
4170               (format " (W%02d-W%02d)" w1 w2))
4171               "")
4172             ":\n")))
4173     (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
4174                           'org-date-line t))
4175     (org-agenda-mark-header-line s))
4176       (while (setq d (pop day-numbers))
4177     (setq date (calendar-gregorian-from-absolute d)
4178           s (point))
4179     (if (or (setq todayp (= d today))
4180         (and (not start-pos) (= d sd)))
4181         (setq start-pos (point))
4182       (if (and start-pos (not end-pos))
4183           (setq end-pos (point))))
4184     (setq files thefiles
4185           rtnall nil)
4186     (while (setq file (pop files))
4187       (catch 'nextfile
4188         (org-check-agenda-file file)
4189         (let ((org-agenda-entry-types org-agenda-entry-types))
4190           ;; Starred types override non-starred equivalents
4191           (when (member :deadline* org-agenda-entry-types)
4192         (setq org-agenda-entry-types
4193               (delq :deadline org-agenda-entry-types)))
4194           (when (member :scheduled* org-agenda-entry-types)
4195         (setq org-agenda-entry-types
4196               (delq :scheduled org-agenda-entry-types)))
4197           ;; Honor with-hour
4198           (when with-hour
4199         (when (member :deadline org-agenda-entry-types)
4200           (setq org-agenda-entry-types
4201             (delq :deadline org-agenda-entry-types))
4202           (push :deadline* org-agenda-entry-types))
4203         (when (member :scheduled org-agenda-entry-types)
4204           (setq org-agenda-entry-types
4205             (delq :scheduled org-agenda-entry-types))
4206           (push :scheduled* org-agenda-entry-types)))
4207           (unless org-agenda-include-deadlines
4208         (setq org-agenda-entry-types
4209               (delq :deadline* (delq :deadline org-agenda-entry-types))))
4210           (cond
4211            ((memq org-agenda-show-log-scoped '(only clockcheck))
4212         (setq rtn (org-agenda-get-day-entries
4213                file date :closed)))
4214            (org-agenda-show-log-scoped
4215         (setq rtn (apply 'org-agenda-get-day-entries
4216                  file date
4217                  (append '(:closed) org-agenda-entry-types))))
4218            (t
4219         (setq rtn (apply 'org-agenda-get-day-entries
4220                  file date
4221                  org-agenda-entry-types)))))
4222         (setq rtnall (append rtnall rtn)))) ;; all entries
4223     (if org-agenda-include-diary
4224         (let ((org-agenda-search-headline-for-time t))
4225           (require 'diary-lib)
4226           (setq rtn (org-get-entries-from-diary date))
4227           (setq rtnall (append rtnall rtn))))
4228     (if (or rtnall org-agenda-show-all-dates)
4229         (progn
4230           (setq day-cnt (1+ day-cnt))
4231           (insert
4232            (if (stringp org-agenda-format-date)
4233            (format-time-string org-agenda-format-date
4234                        (org-time-from-absolute date))
4235          (funcall org-agenda-format-date date))
4236            "\n")
4237           (put-text-property s (1- (point)) 'face
4238                  (org-agenda-get-day-face date))
4239           (put-text-property s (1- (point)) 'org-date-line t)
4240           (put-text-property s (1- (point)) 'org-agenda-date-header t)
4241           (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
4242           (when todayp
4243         (put-text-property s (1- (point)) 'org-today t))
4244           (setq rtnall
4245             (org-agenda-add-time-grid-maybe rtnall ndays todayp))
4246           (if rtnall (insert ;; all entries
4247               (org-agenda-finalize-entries rtnall 'agenda)
4248               "\n"))
4249           (put-text-property s (1- (point)) 'day d)
4250           (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
4251       (when (and org-agenda-clockreport-mode clocktable-start)
4252     (let ((org-agenda-files (org-agenda-files nil 'ifmode))
4253           ;; the above line is to ensure the restricted range!
4254           (p (copy-sequence org-agenda-clockreport-parameter-plist))
4255           tbl)
4256       (setq p (org-plist-delete p :block))
4257       (setq p (plist-put p :tstart clocktable-start))
4258       (setq p (plist-put p :tend clocktable-end))
4259       (setq p (plist-put p :scope 'agenda))
4260       (setq tbl (apply 'org-clock-get-clocktable p))
4261       (insert tbl)))
4262       (goto-char (point-min))
4263       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
4264       (unless (or (not (get-buffer-window))
4265           (and (pos-visible-in-window-p (point-min))
4266                (pos-visible-in-window-p (point-max))))
4267     (goto-char (1- (point-max)))
4268     (recenter -1)
4269     (if (not (pos-visible-in-window-p (or start-pos 1)))
4270         (progn
4271           (goto-char (or start-pos 1))
4272           (recenter 1))))
4273       (goto-char (or start-pos 1))
4274       (add-text-properties (point-min) (point-max)
4275                `(org-agenda-type agenda
4276                          org-last-args (,arg ,start-day ,span)
4277                          org-redo-cmd ,org-agenda-redo-command
4278                          org-series-cmd ,org-cmd))
4279       (if (eq org-agenda-show-log-scoped 'clockcheck)
4280       (org-agenda-show-clocking-issues))
4281       (org-agenda-finalize)
4282       (setq buffer-read-only t)
4283       (message ""))))
4284
4285 (defun org-agenda-ndays-to-span (n)
4286   "Return a span symbol for a span of N days, or N if none matches."
4287   (cond ((symbolp n) n)
4288     ((= n 1) 'day)
4289     ((= n 7) 'week)
4290     ((= n 14) 'fortnight)
4291     (t n)))
4292
4293 (defun org-agenda-span-to-ndays (span &optional start-day)
4294   "Return ndays from SPAN, possibly starting at START-DAY.
4295 START-DAY is an absolute time value."
4296   (cond ((numberp span) span)
4297     ((eq span 'day) 1)
4298     ((eq span 'week) 7)
4299     ((eq span 'fortnight) 14)
4300     ((eq span 'month)
4301      (let ((date (calendar-gregorian-from-absolute start-day)))
4302        (calendar-last-day-of-month (car date) (cl-caddr date))))
4303     ((eq span 'year)
4304      (let ((date (calendar-gregorian-from-absolute start-day)))
4305        (if (calendar-leap-year-p (cl-caddr date)) 366 365)))))
4306
4307 (defun org-agenda-span-name (span)
4308   "Return a SPAN name."
4309   (if (null span)
4310       ""
4311     (if (symbolp span)
4312     (capitalize (symbol-name span))
4313       (format "%d days" span))))
4314
4315 ;;; Agenda word search
4316
4317 (defvar org-agenda-search-history nil)
4318
4319 (defvar org-search-syntax-table nil
4320   "Special syntax table for Org search.
4321 In this table, we have single quotes not as word constituents, to
4322 that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
4323
4324 (defvar org-mode-syntax-table) ; From org.el
4325 (defun org-search-syntax-table ()
4326   (unless org-search-syntax-table
4327     (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table))
4328     (modify-syntax-entry ?' "." org-search-syntax-table)
4329     (modify-syntax-entry ?` "." org-search-syntax-table))
4330   org-search-syntax-table)
4331
4332 (defvar org-agenda-last-search-view-search-was-boolean nil)
4333
4334 ;;;###autoload
4335 (defun org-search-view (&optional todo-only string edit-at)
4336   "Show all entries that contain a phrase or words or regular expressions.
4337
4338 With optional prefix argument TODO-ONLY, only consider entries that are
4339 TODO entries.  The argument STRING can be used to pass a default search
4340 string into this function.  If EDIT-AT is non-nil, it means that the
4341 user should get a chance to edit this string, with cursor at position
4342 EDIT-AT.
4343
4344 The search string can be viewed either as a phrase that should be found as
4345 is, or it can be broken into a number of snippets, each of which must match
4346 in a Boolean way to select an entry.  The default depends on the variable
4347 `org-agenda-search-view-always-boolean'.
4348 Even if this is turned off (the default) you can always switch to
4349 Boolean search dynamically by preceding the first word with  \"+\" or \"-\".
4350
4351 The default is a direct search of the whole phrase, where each space in
4352 the search string can expand to an arbitrary amount of whitespace,
4353 including newlines.
4354
4355 If using a Boolean search, the search string is split on whitespace and
4356 each snippet is searched separately, with logical AND to select an entry.
4357 Words prefixed with a minus must *not* occur in the entry.  Words without
4358 a prefix or prefixed with a plus must occur in the entry.  Matching is
4359 case-insensitive.  Words are enclosed by word delimiters (i.e. they must
4360 match whole words, not parts of a word) if
4361 `org-agenda-search-view-force-full-words' is set (default is nil).
4362
4363 Boolean search snippets enclosed by curly braces are interpreted as
4364 regular expressions that must or (when preceded with \"-\") must not
4365 match in the entry.  Snippets enclosed into double quotes will be taken
4366 as a whole, to include whitespace.
4367
4368 - If the search string starts with an asterisk, search only in headlines.
4369 - If (possibly after the leading star) the search string starts with an
4370   exclamation mark, this also means to look at TODO entries only, an effect
4371   that can also be achieved with a prefix argument.
4372 - If (possibly after star and exclamation mark) the search string starts
4373   with a colon, this will mean that the (non-regexp) snippets of the
4374   Boolean search must match as full words.
4375
4376 This command searches the agenda files, and in addition the files
4377 listed in `org-agenda-text-search-extra-files' unless a restriction lock
4378 is active."
4379   (interactive "P")
4380   (if org-agenda-overriding-arguments
4381       (setq todo-only (car org-agenda-overriding-arguments)
4382         string (nth 1 org-agenda-overriding-arguments)
4383         edit-at (nth 2 org-agenda-overriding-arguments)))
4384   (let* ((props (list 'face nil
4385               'done-face 'org-agenda-done
4386               'org-not-done-regexp org-not-done-regexp
4387               'org-todo-regexp org-todo-regexp
4388               'org-complex-heading-regexp org-complex-heading-regexp
4389               'mouse-face 'highlight
4390               'help-echo (format "mouse-2 or RET jump to location")))
4391      (full-words org-agenda-search-view-force-full-words)
4392      (org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
4393      regexp rtn rtnall files file pos inherited-tags
4394      marker category level tags c neg re boolean
4395      ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
4396     (unless (and (not edit-at)
4397          (stringp string)
4398          (string-match "\\S-" string))
4399       (setq string (read-string
4400             (if org-agenda-search-view-always-boolean
4401             "[+-]Word/{Regexp} ...: "
4402               "Phrase or [+-]Word/{Regexp} ...: ")
4403             (cond
4404              ((integerp edit-at) (cons string edit-at))
4405              (edit-at string))
4406             'org-agenda-search-history)))
4407     (catch 'exit
4408       (if org-agenda-sticky
4409       (setq org-agenda-buffer-name
4410         (if (stringp string)
4411             (format "*Org Agenda(%s:%s)*"
4412                 (or org-keys (or (and todo-only "S") "s")) string)
4413           (format "*Org Agenda(%s)*" (or (and todo-only "S") "s")))))
4414       (org-agenda-prepare "SEARCH")
4415       (org-compile-prefix-format 'search)
4416       (org-set-sorting-strategy 'search)
4417       (setq org-agenda-redo-command
4418         (list 'org-search-view (if todo-only t nil)
4419           (list 'if 'current-prefix-arg nil string)))
4420       (setq org-agenda-query-string string)
4421       (if (equal (string-to-char string) ?*)
4422       (setq hdl-only t
4423         words (substring string 1))
4424     (setq words string))
4425       (when (equal (string-to-char words) ?!)
4426     (setq todo-only t
4427           words (substring words 1)))
4428       (when (equal (string-to-char words) ?:)
4429     (setq full-words t
4430           words (substring words 1)))
4431       (if (or org-agenda-search-view-always-boolean
4432           (member (string-to-char words) '(?- ?+ ?\{)))
4433       (setq boolean t))
4434       (setq words (split-string words))
4435       (let (www w)
4436     (while (setq w (pop words))
4437       (while (and (string-match "\\\\\\'" w) words)
4438         (setq w (concat (substring w 0 -1) " " (pop words))))
4439       (push w www))
4440     (setq words (nreverse www) www nil)
4441     (while (setq w (pop words))
4442       (when (and (string-match "\\`[-+]?{" w)
4443              (not (string-match "}\\'" w)))
4444         (while (and words (not (string-match "}\\'" (car words))))
4445           (setq w (concat w " " (pop words))))
4446         (setq w (concat w " " (pop words))))
4447       (push w www))
4448     (setq words (nreverse www)))
4449       (setq org-agenda-last-search-view-search-was-boolean boolean)
4450       (when boolean
4451     (let (wds w)
4452       (while (setq w (pop words))
4453         (if (or (equal (substring w 0 1) "\"")
4454             (and (> (length w) 1)
4455              (member (substring w 0 1) '("+" "-"))
4456              (equal (substring w 1 2) "\"")))
4457         (while (and words (not (equal (substring w -1) "\"")))
4458           (setq w (concat w " " (pop words)))))
4459         (and (string-match "\\`\\([-+]?\\)\"" w)
4460          (setq w (replace-match "\\1" nil nil w)))
4461         (and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
4462         (push w wds))
4463       (setq words (nreverse wds))))
4464       (if boolean
4465       (mapc (lambda (w)
4466           (setq c (string-to-char w))
4467           (if (equal c ?-)
4468               (setq neg t w (substring w 1))
4469             (if (equal c ?+)
4470             (setq neg nil w (substring w 1))
4471               (setq neg nil)))
4472           (if (string-match "\\`{.*}\\'" w)
4473               (setq re (substring w 1 -1))
4474             (if full-words
4475             (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
4476               (setq re (regexp-quote (downcase w)))))
4477           (if neg (push re regexps-) (push re regexps+)))
4478         words)
4479     (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+")
4480           regexps+))
4481       (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
4482       (if (not regexps+)
4483       (setq regexp org-outline-regexp-bol)
4484     (setq regexp (pop regexps+))
4485     (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
4486                       regexp))))
4487       (setq files (org-agenda-files nil 'ifmode))
4488       ;; Add `org-agenda-text-search-extra-files' unless there is some
4489       ;; restriction.
4490       (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
4491     (pop org-agenda-text-search-extra-files)
4492     (unless (get 'org-agenda-files 'org-restrict)
4493       (setq files (org-add-archive-files files))))
4494       ;; Uniquify files.  However, let `org-check-agenda-file' handle
4495       ;; non-existent ones.
4496       (setq files (cl-remove-duplicates
4497            (append files org-agenda-text-search-extra-files)
4498            :test (lambda (a b)
4499                (and (file-exists-p a)
4500                 (file-exists-p b)
4501                 (file-equal-p a b))))
4502         rtnall nil)
4503       (while (setq file (pop files))
4504     (setq ee nil)
4505     (catch 'nextfile
4506       (org-check-agenda-file file)
4507       (setq buffer (if (file-exists-p file)
4508                (org-get-agenda-file-buffer file)
4509              (error "No such file %s" file)))
4510       (if (not buffer)
4511           ;; If file does not exist, make sure an error message is sent
4512           (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
4513                       file))))
4514       (with-current-buffer buffer
4515         (with-syntax-table (org-search-syntax-table)
4516           (unless (derived-mode-p 'org-mode)
4517         (error "Agenda file %s is not in Org mode" file))
4518           (let ((case-fold-search t))
4519         (save-excursion
4520           (save-restriction
4521             (if (eq buffer org-agenda-restrict)
4522             (narrow-to-region org-agenda-restrict-begin
4523                       org-agenda-restrict-end)
4524               (widen))
4525             (goto-char (point-min))
4526             (unless (or (org-at-heading-p)
4527                 (outline-next-heading))
4528               (throw 'nextfile t))
4529             (goto-char (max (point-min) (1- (point))))
4530             (while (re-search-forward regexp nil t)
4531               (org-back-to-heading t)
4532               (while (and (not (zerop org-agenda-search-view-max-outline-level))
4533                   (> (org-reduced-level (org-outline-level))
4534                      org-agenda-search-view-max-outline-level)
4535                   (forward-line -1)
4536                   (org-back-to-heading t)))
4537               (skip-chars-forward "* ")
4538               (setq beg (point-at-bol)
4539                 beg1 (point)
4540                 end (progn
4541                   (outline-next-heading)
4542                   (while (and (not (zerop org-agenda-search-view-max-outline-level))
4543                           (> (org-reduced-level (org-outline-level))
4544                          org-agenda-search-view-max-outline-level)
4545                           (forward-line 1)
4546                           (outline-next-heading)))
4547                   (point)))
4548
4549               (catch :skip
4550             (goto-char beg)
4551             (org-agenda-skip)
4552             (setq str (buffer-substring-no-properties
4553                    (point-at-bol)
4554                    (if hdl-only (point-at-eol) end)))
4555             (mapc (lambda (wr) (when (string-match wr str)
4556                     (goto-char (1- end))
4557                     (throw :skip t)))
4558                   regexps-)
4559             (mapc (lambda (wr) (unless (string-match wr str)
4560                     (goto-char (1- end))
4561                     (throw :skip t)))
4562                   (if todo-only
4563                   (cons (concat "^\\*+[ \t]+"
4564                                                 org-not-done-regexp)
4565                     regexps+)
4566                 regexps+))
4567             (goto-char beg)
4568             (setq marker (org-agenda-new-marker (point))
4569                   category (org-get-category)
4570                   level (make-string (org-reduced-level (org-outline-level)) ? )
4571                   inherited-tags
4572                   (or (eq org-agenda-show-inherited-tags 'always)
4573                   (and (listp org-agenda-show-inherited-tags)
4574                        (memq 'todo org-agenda-show-inherited-tags))
4575                   (and (eq org-agenda-show-inherited-tags t)
4576                        (or (eq org-agenda-use-tag-inheritance t)
4577                        (memq 'todo org-agenda-use-tag-inheritance))))
4578                   tags (org-get-tags-at nil (not inherited-tags))
4579                   txt (org-agenda-format-item
4580                    ""
4581                    (buffer-substring-no-properties
4582                     beg1 (point-at-eol))
4583                    level category tags t))
4584             (org-add-props txt props
4585               'org-marker marker 'org-hd-marker marker
4586               'org-todo-regexp org-todo-regexp
4587               'level level
4588               'org-complex-heading-regexp org-complex-heading-regexp
4589               'priority 1000
4590               'type "search")
4591             (push txt ee)
4592             (goto-char (1- end))))))))))
4593     (setq rtn (nreverse ee))
4594     (setq rtnall (append rtnall rtn)))
4595       (if org-agenda-overriding-header
4596       (insert (org-add-props (copy-sequence org-agenda-overriding-header)
4597               nil 'face 'org-agenda-structure) "\n")
4598     (insert "Search words: ")
4599     (add-text-properties (point-min) (1- (point))
4600                  (list 'face 'org-agenda-structure))
4601     (setq pos (point))
4602     (insert string "\n")
4603     (add-text-properties pos (1- (point)) (list 'face 'org-warning))
4604     (setq pos (point))
4605     (unless org-agenda-multi
4606       (insert (substitute-command-keys "\
4607 Press `\\[org-agenda-manipulate-query-add]', \
4608 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
4609 `\\[org-agenda-manipulate-query-add-re]', \
4610 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
4611 `\\[universal-argument] \\[org-agenda-redo]' to edit\n"))
4612       (add-text-properties pos (1- (point))
4613                    (list 'face 'org-agenda-structure))))
4614       (org-agenda-mark-header-line (point-min))
4615       (when rtnall
4616     (insert (org-agenda-finalize-entries rtnall 'search) "\n"))
4617       (goto-char (point-min))
4618       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
4619       (add-text-properties (point-min) (point-max)
4620                `(org-agenda-type search
4621                          org-last-args (,todo-only ,string ,edit-at)
4622                          org-redo-cmd ,org-agenda-redo-command
4623                          org-series-cmd ,org-cmd))
4624       (org-agenda-finalize)
4625       (setq buffer-read-only t))))
4626
4627 ;;; Agenda TODO list
4628
4629 (defun org-agenda-propertize-selected-todo-keywords (keywords)
4630   "Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
4631   (concat
4632    (if (or (equal keywords "ALL") (not keywords))
4633        (propertize "ALL" 'face 'warning)
4634      (mapconcat
4635       (lambda (kw)
4636         (propertize kw 'face (org-get-todo-face kw)))
4637       (org-split-string keywords "|")
4638       "|"))
4639    "\n"))
4640
4641 (defvar org-select-this-todo-keyword nil)
4642 (defvar org-last-arg nil)
4643
4644 ;;;###autoload
4645 (defun org-todo-list (&optional arg)
4646   "Show all (not done) TODO entries from all agenda file in a single list.
4647 The prefix arg can be used to select a specific TODO keyword and limit
4648 the list to these.  When using `\\[universal-argument]', you will be prompted
4649 for a keyword.  A numeric prefix directly selects the Nth keyword in
4650 `org-todo-keywords-1'."
4651   (interactive "P")
4652   (if org-agenda-overriding-arguments
4653       (setq arg org-agenda-overriding-arguments))
4654   (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
4655   (let* ((today (org-today))
4656      (date (calendar-gregorian-from-absolute today))
4657      (kwds org-todo-keywords-for-agenda)
4658      (completion-ignore-case t)
4659      (org-select-this-todo-keyword
4660       (if (stringp arg) arg
4661         (and arg (integerp arg) (> arg 0)
4662                  (nth (1- arg) kwds))))
4663      rtn rtnall files file pos)
4664     (when (equal arg '(4))
4665       (setq org-select-this-todo-keyword
4666         (completing-read "Keyword (or KWD1|K2D2|...): "
4667                  (mapcar #'list kwds) nil nil)))
4668     (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
4669     (catch 'exit
4670       (if org-agenda-sticky
4671       (setq org-agenda-buffer-name
4672         (if (stringp org-select-this-todo-keyword)
4673             (format "*Org Agenda(%s:%s)*" (or org-keys "t")
4674                 org-select-this-todo-keyword)
4675           (format "*Org Agenda(%s)*" (or org-keys "t")))))
4676       (org-agenda-prepare "TODO")
4677       (org-compile-prefix-format 'todo)
4678       (org-set-sorting-strategy 'todo)
4679       (setq org-agenda-redo-command
4680         `(org-todo-list (or (and (numberp current-prefix-arg)
4681                      current-prefix-arg)
4682                 ,org-select-this-todo-keyword
4683                 current-prefix-arg ,arg)))
4684       (setq files (org-agenda-files nil 'ifmode)
4685         rtnall nil)
4686       (while (setq file (pop files))
4687     (catch 'nextfile
4688       (org-check-agenda-file file)
4689       (setq rtn (org-agenda-get-day-entries file date :todo))
4690       (setq rtnall (append rtnall rtn))))
4691       (if org-agenda-overriding-header
4692       (insert (org-add-props (copy-sequence org-agenda-overriding-header)
4693               nil 'face 'org-agenda-structure) "\n")
4694     (insert "Global list of TODO items of type: ")
4695     (add-text-properties (point-min) (1- (point))
4696                  (list 'face 'org-agenda-structure
4697                    'short-heading
4698                    (concat "ToDo: "
4699                        (or org-select-this-todo-keyword "ALL"))))
4700     (org-agenda-mark-header-line (point-min))
4701     (insert (org-agenda-propertize-selected-todo-keywords
4702          org-select-this-todo-keyword))
4703     (setq pos (point))
4704     (unless org-agenda-multi
4705       (insert (substitute-command-keys "Available with \
4706 `N \\[org-agenda-redo]': (0)[ALL]"))
4707       (let ((n 0) s)
4708         (mapc (lambda (x)
4709             (setq s (format "(%d)%s" (setq n (1+ n)) x))
4710             (if (> (+ (current-column) (string-width s) 1) (frame-width))
4711             (insert "\n                     "))
4712             (insert " " s))
4713           kwds))
4714       (insert "\n"))
4715     (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
4716       (org-agenda-mark-header-line (point-min))
4717       (when rtnall
4718     (insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
4719       (goto-char (point-min))
4720       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
4721       (add-text-properties (point-min) (point-max)
4722                `(org-agenda-type todo
4723                          org-last-args ,arg
4724                          org-redo-cmd ,org-agenda-redo-command
4725                          org-series-cmd ,org-cmd))
4726       (org-agenda-finalize)
4727       (setq buffer-read-only t))))
4728
4729 ;;; Agenda tags match
4730
4731 ;;;###autoload
4732 (defun org-tags-view (&optional todo-only match)
4733   "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
4734 The prefix arg TODO-ONLY limits the search to TODO entries."
4735   (interactive "P")
4736   (if org-agenda-overriding-arguments
4737       (setq todo-only (car org-agenda-overriding-arguments)
4738         match (nth 1 org-agenda-overriding-arguments)))
4739   (let* ((org-tags-match-list-sublevels
4740       org-tags-match-list-sublevels)
4741      (completion-ignore-case t)
4742      (org--matcher-tags-todo-only todo-only)
4743      rtn rtnall files file pos matcher
4744      buffer)
4745     (when (and (stringp match) (not (string-match "\\S-" match)))
4746       (setq match nil))
4747     (catch 'exit
4748       (if org-agenda-sticky
4749       (setq org-agenda-buffer-name
4750         (if (stringp match)
4751             (format "*Org Agenda(%s:%s)*"
4752                 (or org-keys (or (and todo-only "M") "m")) match)
4753           (format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
4754       (setq matcher (org-make-tags-matcher match))
4755       ;; Prepare agendas (and `org-tag-alist-for-agenda') before
4756       ;; expanding tags within `org-make-tags-matcher'
4757       (org-agenda-prepare (concat "TAGS " match))
4758       (setq match (car matcher)
4759         matcher (cdr matcher))
4760       (org-compile-prefix-format 'tags)
4761       (org-set-sorting-strategy 'tags)
4762       (setq org-agenda-query-string match)
4763       (setq org-agenda-redo-command
4764         (list 'org-tags-view
4765           `(quote ,org--matcher-tags-todo-only)
4766           `(if current-prefix-arg nil ,org-agenda-query-string)))
4767       (setq files (org-agenda-files nil 'ifmode)
4768         rtnall nil)
4769       (while (setq file (pop files))
4770     (catch 'nextfile
4771       (org-check-agenda-file file)
4772       (setq buffer (if (file-exists-p file)
4773                (org-get-agenda-file-buffer file)
4774              (error "No such file %s" file)))
4775       (if (not buffer)
4776           ;; If file does not exist, error message to agenda
4777           (setq rtn (list
4778              (format "ORG-AGENDA-ERROR: No such org-file %s" file))
4779             rtnall (append rtnall rtn))
4780         (with-current-buffer buffer
4781           (unless (derived-mode-p 'org-mode)
4782         (error "Agenda file %s is not in Org mode" file))
4783           (save-excursion
4784         (save-restriction
4785           (if (eq buffer org-agenda-restrict)
4786               (narrow-to-region org-agenda-restrict-begin
4787                     org-agenda-restrict-end)
4788             (widen))
4789           (setq rtn (org-scan-tags 'agenda
4790                        matcher
4791                        org--matcher-tags-todo-only))
4792           (setq rtnall (append rtnall rtn))))))))
4793       (if org-agenda-overriding-header
4794       (insert (org-add-props (copy-sequence org-agenda-overriding-header)
4795               nil 'face 'org-agenda-structure) "\n")
4796     (insert "Headlines with TAGS match: ")
4797     (add-text-properties (point-min) (1- (point))
4798                  (list 'face 'org-agenda-structure
4799                    'short-heading
4800                    (concat "Match: " match)))
4801     (setq pos (point))
4802     (insert match "\n")
4803     (add-text-properties pos (1- (point)) (list 'face 'org-warning))
4804     (setq pos (point))
4805     (unless org-agenda-multi
4806       (insert (substitute-command-keys
4807            "Press `\\[universal-argument] \\[org-agenda-redo]' \
4808 to search again with new search string\n")))
4809     (add-text-properties pos (1- (point))
4810                  (list 'face 'org-agenda-structure)))
4811       (org-agenda-mark-header-line (point-min))
4812       (when rtnall
4813     (insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
4814       (goto-char (point-min))
4815       (or org-agenda-multi (org-agenda-fit-window-to-buffer))
4816       (add-text-properties
4817        (point-min) (point-max)
4818        `(org-agenda-type tags
4819              org-last-args (,org--matcher-tags-todo-only ,match)
4820              org-redo-cmd ,org-agenda-redo-command
4821              org-series-cmd ,org-cmd))
4822       (org-agenda-finalize)
4823       (setq buffer-read-only t))))
4824
4825 ;;; Agenda Finding stuck projects
4826
4827 (defvar org-agenda-skip-regexp nil
4828   "Regular expression used in skipping subtrees for the agenda.
4829 This is basically a temporary global variable that can be set and then
4830 used by user-defined selections using `org-agenda-skip-function'.")
4831
4832 (defvar org-agenda-overriding-header nil
4833   "When set during agenda, todo and tags searches it replaces the header.
4834 This variable should not be set directly, but custom commands can bind it
4835 in the options section.")
4836
4837 (defun org-agenda-skip-entry-if (&rest conditions)
4838   "Skip entry if any of CONDITIONS is true.
4839 See `org-agenda-skip-if' for details."
4840   (org-agenda-skip-if nil conditions))
4841
4842 (defun org-agenda-skip-subtree-if (&rest conditions)
4843   "Skip subtree if any of CONDITIONS is true.
4844 See `org-agenda-skip-if' for details."
4845   (org-agenda-skip-if t conditions))
4846
4847 (defun org-agenda-skip-if (subtree conditions)
4848   "Checks current entity for CONDITIONS.
4849 If SUBTREE is non-nil, the entire subtree is checked.  Otherwise, only
4850 the entry (i.e. the text before the next heading) is checked.
4851
4852 CONDITIONS is a list of symbols, boolean OR is used to combine the results
4853 from different tests.  Valid conditions are:
4854
4855 scheduled     Check if there is a scheduled cookie
4856 notscheduled  Check if there is no scheduled cookie
4857 deadline      Check if there is a deadline
4858 notdeadline   Check if there is no deadline
4859 timestamp     Check if there is a timestamp (also deadline or scheduled)
4860 nottimestamp  Check if there is no timestamp (also deadline or scheduled)
4861 regexp        Check if regexp matches
4862 notregexp     Check if regexp does not match.
4863 todo          Check if TODO keyword matches
4864 nottodo       Check if TODO keyword does not match
4865
4866 The regexp is taken from the conditions list, it must come right after
4867 the `regexp' or `notregexp' element.
4868
4869 `todo' and `nottodo' accept as an argument a list of todo
4870 keywords, which may include \"*\" to match any todo keyword.
4871
4872     (org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\"))
4873
4874 would skip all entries with \"TODO\" or \"WAITING\" keywords.
4875
4876 Instead of a list, a keyword class may be given.  For example:
4877
4878     (org-agenda-skip-entry-if \\='nottodo \\='done)
4879
4880 would skip entries that haven't been marked with any of \"DONE\"
4881 keywords.  Possible classes are: `todo', `done', `any'.
4882
4883 If any of these conditions is met, this function returns the end point of
4884 the entity, causing the search to continue from there.  This is a function
4885 that can be put into `org-agenda-skip-function' for the duration of a command."
4886   (org-back-to-heading t)
4887   (let* ((beg (point))
4888      (end (if subtree (save-excursion (org-end-of-subtree t) (point))
4889         (org-entry-end-position)))
4890      (planning-end (if subtree end (line-end-position 2)))
4891      m)
4892     (and
4893      (or (and (memq 'scheduled conditions)
4894           (re-search-forward org-scheduled-time-regexp planning-end t))
4895      (and (memq 'notscheduled conditions)
4896           (not
4897            (save-excursion
4898          (re-search-forward org-scheduled-time-regexp planning-end t))))
4899      (and (memq 'deadline conditions)
4900           (re-search-forward org-deadline-time-regexp planning-end t))
4901      (and (memq 'notdeadline conditions)
4902           (not
4903            (save-excursion
4904          (re-search-forward org-deadline-time-regexp planning-end t))))
4905      (and (memq 'timestamp conditions)
4906           (re-search-forward org-ts-regexp end t))
4907      (and (memq 'nottimestamp conditions)
4908           (not (save-excursion (re-search-forward org-ts-regexp end t))))
4909      (and (setq m (memq 'regexp conditions))
4910           (stringp (nth 1 m))
4911           (re-search-forward (nth 1 m) end t))
4912      (and (setq m (memq 'notregexp conditions))
4913           (stringp (nth 1 m))
4914           (not (save-excursion (re-search-forward (nth 1 m) end t))))
4915      (and (or
4916            (setq m (memq 'nottodo conditions))
4917            (setq m (memq 'todo-unblocked conditions))
4918            (setq m (memq 'nottodo-unblocked conditions))
4919            (setq m (memq 'todo conditions)))
4920           (org-agenda-skip-if-todo m end)))
4921      end)))
4922
4923 (defun org-agenda-skip-if-todo (args end)
4924   "Helper function for `org-agenda-skip-if', do not use it directly.
4925 ARGS is a list with first element either `todo', `nottodo',
4926 `todo-unblocked' or `nottodo-unblocked'.  The remainder is either
4927 a list of TODO keywords, or a state symbol `todo' or `done' or
4928 `any'."
4929   (let ((todo-re
4930      (concat "^\\*+[ \t]+"
4931          (regexp-opt
4932           (pcase args
4933             (`(,_ todo)
4934              (org-delete-all org-done-keywords
4935                      (copy-sequence org-todo-keywords-1)))
4936             (`(,_ done) org-done-keywords)
4937             (`(,_ any) org-todo-keywords-1)
4938             (`(,_ ,(pred atom))
4939              (error "Invalid TODO class or type: %S" args))
4940             (`(,_ ,(pred (member "*"))) org-todo-keywords-1)
4941             (`(,_ ,todo-list) todo-list))
4942           'words))))
4943     (pcase args
4944       (`(todo . ,_)
4945        (let (case-fold-search) (re-search-forward todo-re end t)))
4946       (`(nottodo . ,_)
4947        (not (let (case-fold-search) (re-search-forward todo-re end t))))
4948       (`(todo-unblocked . ,_)
4949        (catch :unblocked
4950      (while (let (case-fold-search) (re-search-forward todo-re end t))
4951        (when (org-entry-blocked-p) (throw :unblocked t)))
4952      nil))
4953       (`(nottodo-unblocked . ,_)
4954        (catch :unblocked
4955      (while (let (case-fold-search) (re-search-forward todo-re end t))
4956        (when (org-entry-blocked-p) (throw :unblocked nil)))
4957      t))
4958       (`(,type . ,_) (error "Unknown TODO skip type: %S" type)))))
4959
4960 ;;;###autoload
4961 (defun org-agenda-list-stuck-projects (&rest ignore)
4962   "Create agenda view for projects that are stuck.
4963 Stuck projects are project that have no next actions.  For the definitions
4964 of what a project is and how to check if it stuck, customize the variable
4965 `org-stuck-projects'."
4966   (interactive)
4967   (let* ((org-agenda-overriding-header
4968       (or org-agenda-overriding-header "List of stuck projects: "))
4969      (matcher (nth 0 org-stuck-projects))
4970      (todo (nth 1 org-stuck-projects))
4971      (tags (nth 2 org-stuck-projects))
4972      (gen-re (org-string-nw-p (nth 3 org-stuck-projects)))
4973      (todo-wds
4974       (if (not (member "*" todo)) todo
4975         (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
4976         (org-delete-all org-done-keywords-for-agenda
4977                 (copy-sequence org-todo-keywords-for-agenda))))
4978      (todo-re (and todo
4979                (format "^\\*+[ \t]+\\(%s\\)\\>"
4980                    (mapconcat #'identity todo-wds "\\|"))))
4981      (tags-re (cond ((null tags) nil)
4982             ((member "*" tags)
4983              (eval-when-compile
4984                (concat org-outline-regexp-bol
4985                    ".*:[[:alnum:]_@#%]+:[ \t]*$")))
4986             (tags (concat org-outline-regexp-bol
4987                       ".*:\\("
4988                       (mapconcat #'identity tags "\\|")
4989                       "\\):[[:alnum:]_@#%:]*[ \t]*$"))
4990             (t nil)))
4991      (re-list (delq nil (list todo-re tags-re gen-re)))
4992      (skip-re
4993       (if (null re-list)
4994           (error "Missing information to identify unstuck projects")
4995         (mapconcat #'identity re-list "\\|")))
4996      (org-agenda-skip-function
4997       ;; Skip entry if `org-agenda-skip-regexp' matches anywhere
4998       ;; in the subtree.
4999       `(lambda ()
5000          (and (save-excursion
5001             (let ((case-fold-search nil))
5002               (re-search-forward
5003                ,skip-re (save-excursion (org-end-of-subtree t)) t)))
5004           (progn (outline-next-heading) (point))))))
5005     (org-tags-view nil matcher)
5006     (setq org-agenda-buffer-name (buffer-name))
5007     (with-current-buffer org-agenda-buffer-name
5008       (setq org-agenda-redo-command
5009         `(org-agenda-list-stuck-projects ,current-prefix-arg))
5010       (let ((inhibit-read-only t))
5011         (add-text-properties
5012          (point-min) (point-max)
5013          `(org-redo-cmd ,org-agenda-redo-command))))))
5014
5015 ;;; Diary integration
5016
5017 (defvar org-disable-agenda-to-diary nil)          ;Dynamically-scoped param.
5018 (defvar diary-list-entries-hook)
5019 (defvar diary-time-regexp)
5020 (defun org-get-entries-from-diary (date)
5021   "Get the (Emacs Calendar) diary entries for DATE."
5022   (require 'diary-lib)
5023   (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
5024      (diary-display-function 'diary-fancy-display)
5025      (pop-up-frames nil)
5026      (diary-list-entries-hook
5027       (cons 'org-diary-default-entry diary-list-entries-hook))
5028      (diary-file-name-prefix nil) ; turn this feature off
5029      (diary-modify-entry-list-string-function 'org-modify-diary-entry-string)
5030      entries
5031      (org-disable-agenda-to-diary t))
5032     (save-excursion
5033       (save-window-excursion
5034     (funcall (if (fboundp 'diary-list-entries)
5035              'diary-list-entries 'list-diary-entries)
5036          date 1)))
5037     (if (not (get-buffer diary-fancy-buffer))
5038     (setq entries nil)
5039       (with-current-buffer diary-fancy-buffer
5040     (setq buffer-read-only nil)
5041     (if (zerop (buffer-size))
5042         ;; No entries
5043         (setq entries nil)
5044       ;; Omit the date and other unnecessary stuff
5045       (org-agenda-cleanup-fancy-diary)
5046       ;; Add prefix to each line and extend the text properties
5047       (if (zerop (buffer-size))
5048           (setq entries nil)
5049         (setq entries (buffer-substring (point-min) (- (point-max) 1)))
5050         (setq entries
5051           (with-temp-buffer
5052             (insert entries) (goto-char (point-min))
5053             (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t)
5054               (unless (save-match-data (string-match diary-time-regexp (match-string 1)))
5055             (replace-match (concat "; " (match-string 1)))))
5056             (buffer-string)))))
5057     (set-buffer-modified-p nil)
5058     (kill-buffer diary-fancy-buffer)))
5059     (when entries
5060       (setq entries (org-split-string entries "\n"))
5061       (setq entries
5062         (mapcar
5063          (lambda (x)
5064            (setq x (org-agenda-format-item "" x nil "Diary" nil 'time))
5065            ;; Extend the text properties to the beginning of the line
5066            (org-add-props x (text-properties-at (1- (length x)) x)
5067          'type "diary" 'date date 'face 'org-agenda-diary))
5068          entries)))))
5069
5070 (defvar org-agenda-cleanup-fancy-diary-hook nil
5071   "Hook run when the fancy diary buffer is cleaned up.")
5072
5073 (defun org-agenda-cleanup-fancy-diary ()
5074   "Remove unwanted stuff in buffer created by `fancy-diary-display'.
5075 This gets rid of the date, the underline under the date, and the
5076 dummy entry installed by Org mode to ensure non-empty diary for
5077 each date.  It also removes lines that contain only whitespace."
5078   (goto-char (point-min))
5079   (if (looking-at ".*?:[ \t]*")
5080       (progn
5081     (replace-match "")
5082     (re-search-forward "\n=+$" nil t)
5083     (replace-match "")
5084     (while (re-search-backward "^ +\n?" nil t) (replace-match "")))
5085     (re-search-forward "\n=+$" nil t)
5086     (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
5087   (goto-char (point-min))
5088   (while (re-search-forward "^ +\n" nil t)
5089     (replace-match ""))
5090   (goto-char (point-min))
5091   (if (re-search-forward "^Org mode dummy\n?" nil t)
5092       (replace-match ""))
5093   (run-hooks 'org-agenda-cleanup-fancy-diary-hook))
5094
5095 ;; Make sure entries from the diary have the right text properties.
5096 (eval-after-load "diary-lib"
5097   '(if (boundp 'diary-modify-entry-list-string-function)
5098        ;; We can rely on the hook, nothing to do
5099        nil
5100      ;; Hook not available, must use advice to make this work
5101      (defadvice add-to-diary-list (before org-mark-diary-entry activate)
5102        "Make the position visible."
5103        (if (and org-disable-agenda-to-diary  ;; called from org-agenda
5104         (stringp string)
5105         buffer-file-name)
5106        (setq string (org-modify-diary-entry-string string))))))
5107
5108 (defun org-modify-diary-entry-string (string)
5109   "Add text properties to string, allowing Org to act on it."
5110   (org-add-props string nil
5111     'mouse-face 'highlight
5112     'help-echo (if buffer-file-name
5113            (format "mouse-2 or RET jump to diary file %s"
5114                (abbreviate-file-name buffer-file-name))
5115          "")
5116     'org-agenda-diary-link t
5117     'org-marker (org-agenda-new-marker (point-at-bol))))
5118
5119 (defun org-diary-default-entry ()
5120   "Add a dummy entry to the diary.
5121 Needed to avoid empty dates which mess up holiday display."
5122   ;; Catch the error if dealing with the new add-to-diary-alist
5123   (when org-disable-agenda-to-diary
5124     (condition-case nil
5125     (org-add-to-diary-list original-date "Org mode dummy" "")
5126       (error
5127        (org-add-to-diary-list original-date  "Org mode dummy" "" nil)))))
5128
5129 (defun org-add-to-diary-list (&rest args)
5130   (if (fboundp 'diary-add-to-list)
5131       (apply 'diary-add-to-list args)
5132     (apply 'add-to-diary-list args)))
5133
5134 (defvar org-diary-last-run-time nil)
5135
5136 ;;;###autoload
5137 (defun org-diary (&rest args)
5138   "Return diary information from org files.
5139 This function can be used in a \"sexp\" diary entry in the Emacs calendar.
5140 It accesses org files and extracts information from those files to be
5141 listed in the diary.  The function accepts arguments specifying what
5142 items should be listed.  For a list of arguments allowed here, see the
5143 variable `org-agenda-entry-types'.
5144
5145 The call in the diary file should look like this:
5146
5147    &%%(org-diary) ~/path/to/some/orgfile.org
5148
5149 Use a separate line for each org file to check.  Or, if you omit the file name,
5150 all files listed in `org-agenda-files' will be checked automatically:
5151
5152    &%%(org-diary)
5153
5154 If you don't give any arguments (as in the example above), the default value
5155 of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
5156 So the example above may also be written as
5157
5158    &%%(org-diary :deadline :timestamp :sexp :scheduled)
5159
5160 The function expects the lisp variables `entry' and `date' to be provided
5161 by the caller, because this is how the calendar works.  Don't use this
5162 function from a program - use `org-agenda-get-day-entries' instead."
5163   (when (> (- (float-time)
5164           org-agenda-last-marker-time)
5165        5)
5166     ;; I am not sure if this works with sticky agendas, because the marker
5167     ;; list is then no longer a global variable.
5168     (org-agenda-reset-markers))
5169   (org-compile-prefix-format 'agenda)
5170   (org-set-sorting-strategy 'agenda)
5171   (setq args (or args org-agenda-entry-types))
5172   (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
5173             (list entry)
5174           (org-agenda-files t)))
5175      (time (float-time))
5176      file rtn results)
5177     (when (or (not org-diary-last-run-time)
5178           (> (- time
5179             org-diary-last-run-time)
5180          3))
5181       (org-agenda-prepare-buffers files))
5182     (setq org-diary-last-run-time time)
5183     ;; If this is called during org-agenda, don't return any entries to
5184     ;; the calendar.  Org Agenda will list these entries itself.
5185     (if org-disable-agenda-to-diary (setq files nil))
5186     (while (setq file (pop files))
5187       (setq rtn (apply 'org-agenda-get-day-entries file date args))
5188       (setq results (append results rtn)))
5189     (when results
5190       (setq results
5191         (mapcar (lambda (i) (replace-regexp-in-string
5192                  org-bracket-link-regexp "\\3" i)) results))
5193       (concat (org-agenda-finalize-entries results) "\n"))))
5194
5195 ;;; Agenda entry finders
5196
5197 (defun org-agenda--timestamp-to-absolute (&rest args)
5198   "Call `org-time-string-to-absolute' with ARGS.
5199 However, throw `:skip' whenever an error is raised."
5200   (condition-case e
5201       (apply #'org-time-string-to-absolute args)
5202     (org-diary-sexp-no-match (throw :skip nil))
5203     (error
5204      (message "%s; Skipping entry" (error-message-string e))
5205      (throw :skip nil))))
5206
5207 (defun org-agenda-get-day-entries (file date &rest args)
5208   "Does the work for `org-diary' and `org-agenda'.
5209 FILE is the path to a file to be checked for entries.  DATE is date like
5210 the one returned by `calendar-current-date'.  ARGS are symbols indicating
5211 which kind of entries should be extracted.  For details about these, see
5212 the documentation of `org-diary'."
5213   (let* ((org-startup-folded nil)
5214      (org-startup-align-all-tables nil)
5215      (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file)
5216            (error "No such file %s" file))))
5217     (if (not buffer)
5218     ;; If file does not exist, signal it in diary nonetheless.
5219     (list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
5220       (with-current-buffer buffer
5221     (unless (derived-mode-p 'org-mode)
5222       (error "Agenda file %s is not in Org mode" file))
5223     (setq org-agenda-buffer (or org-agenda-buffer buffer))
5224     (setf org-agenda-current-date date)
5225     (save-excursion
5226       (save-restriction
5227         (if (eq buffer org-agenda-restrict)
5228         (narrow-to-region org-agenda-restrict-begin
5229                   org-agenda-restrict-end)
5230           (widen))
5231         ;; Rationalize ARGS.  Also make sure `:deadline' comes
5232         ;; first in order to populate DEADLINES before passing it.
5233         ;;
5234         ;; We use `delq' since `org-uniquify' duplicates ARGS,
5235         ;; guarding us from modifying `org-agenda-entry-types'.
5236         (setf args (org-uniquify (or args org-agenda-entry-types)))
5237         (when (and (memq :scheduled args) (memq :scheduled* args))
5238           (setf args (delq :scheduled* args)))
5239         (cond
5240          ((memq :deadline args)
5241           (setf args (cons :deadline
5242                    (delq :deadline (delq :deadline* args)))))
5243          ((memq :deadline* args)
5244           (setf args (cons :deadline* (delq :deadline* args)))))
5245         ;; Collect list of headlines.  Return them flattened.
5246         (let ((case-fold-search nil) results deadlines)
5247           (dolist (arg args (apply #'nconc (nreverse results)))
5248         (pcase arg
5249           ((and :todo (guard (org-agenda-today-p date)))
5250            (push (org-agenda-get-todos) results))
5251           (:timestamp
5252            (push (org-agenda-get-blocks) results)
5253            (push (org-agenda-get-timestamps deadlines) results))
5254           (:sexp
5255            (push (org-agenda-get-sexps) results))
5256           (:scheduled
5257            (push (org-agenda-get-scheduled deadlines) results))
5258           (:scheduled*
5259            (push (org-agenda-get-scheduled deadlines t) results))
5260           (:closed
5261            (push (org-agenda-get-progress) results))
5262           (:deadline
5263            (setf deadlines (org-agenda-get-deadlines))
5264            (push deadlines results))
5265           (:deadline*
5266            (setf deadlines (org-agenda-get-deadlines t))
5267            (push deadlines results)))))))))))
5268
5269 (defsubst org-em (x y list)
5270   "Is X or Y a member of LIST?"
5271   (or (memq x list) (memq y list)))
5272
5273 (defvar org-heading-keyword-regexp-format) ; defined in org.el
5274 (defvar org-agenda-sorting-strategy-selected nil)
5275
5276 (defun org-agenda-entry-get-agenda-timestamp (pom)
5277   "Retrieve timestamp information for sorting agenda views.
5278 Given a point or marker POM, returns a cons cell of the timestamp
5279 and the timestamp type relevant for the sorting strategy in
5280 `org-agenda-sorting-strategy-selected'."
5281   (let (ts ts-date-type)
5282     (save-match-data
5283       (cond ((org-em 'scheduled-up 'scheduled-down
5284              org-agenda-sorting-strategy-selected)
5285          (setq ts (org-entry-get pom "SCHEDULED")
5286            ts-date-type " scheduled"))
5287         ((org-em 'deadline-up 'deadline-down
5288              org-agenda-sorting-strategy-selected)
5289          (setq ts (org-entry-get pom "DEADLINE")
5290            ts-date-type " deadline"))
5291         ((org-em 'ts-up 'ts-down
5292              org-agenda-sorting-strategy-selected)
5293          (setq ts (org-entry-get pom "TIMESTAMP")
5294            ts-date-type " timestamp"))
5295         ((org-em 'tsia-up 'tsia-down
5296              org-agenda-sorting-strategy-selected)
5297          (setq ts (org-entry-get pom "TIMESTAMP_IA")
5298            ts-date-type " timestamp_ia"))
5299         ((org-em 'timestamp-up 'timestamp-down
5300              org-agenda-sorting-strategy-selected)
5301          (setq ts (or (org-entry-get pom "SCHEDULED")
5302               (org-entry-get pom "DEADLINE")
5303               (org-entry-get pom "TIMESTAMP")
5304               (org-entry-get pom "TIMESTAMP_IA"))
5305            ts-date-type ""))
5306         (t (setq ts-date-type "")))
5307       (cons (when ts (ignore-errors (org-time-string-to-absolute ts)))
5308         ts-date-type))))
5309
5310 (defun org-agenda-get-todos ()
5311   "Return the TODO information for agenda display."
5312   (let* ((props (list 'face nil
5313               'done-face 'org-agenda-done
5314               'org-not-done-regexp org-not-done-regexp
5315               'org-todo-regexp org-todo-regexp
5316               'org-complex-heading-regexp org-complex-heading-regexp
5317               'mouse-face 'highlight
5318               'help-echo
5319               (format "mouse-2 or RET jump to org file %s"
5320                   (abbreviate-file-name buffer-file-name))))
5321      (case-fold-search nil)
5322      (regexp (format org-heading-keyword-regexp-format
5323              (cond
5324               ((and org-select-this-todo-keyword
5325                 (equal org-select-this-todo-keyword "*"))
5326                org-todo-regexp)
5327               (org-select-this-todo-keyword
5328                (concat "\\("
5329                    (mapconcat 'identity
5330                           (org-split-string
5331                            org-select-this-todo-keyword
5332                            "|")
5333                           "\\|") "\\)"))
5334               (t org-not-done-regexp))))
5335      marker priority category level tags todo-state
5336      ts-date ts-date-type ts-date-pair
5337      ee txt beg end inherited-tags todo-state-end-pos)
5338     (goto-char (point-min))
5339     (while (re-search-forward regexp nil t)
5340       (catch :skip
5341     (save-match-data
5342       (beginning-of-line)
5343       (org-agenda-skip)
5344       (setq beg (point) end (save-excursion (outline-next-heading) (point)))
5345       (unless (and (setq todo-state (org-get-todo-state))
5346                (setq todo-state-end-pos (match-end 2)))
5347         (goto-char end)
5348         (throw :skip nil))
5349       (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
5350         (goto-char (1+ beg))
5351         (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
5352         (throw :skip nil)))
5353     (goto-char (match-beginning 2))
5354     (setq marker (org-agenda-new-marker (match-beginning 0))
5355           category (org-get-category)
5356           ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
5357           ts-date (car ts-date-pair)
5358           ts-date-type (cdr ts-date-pair)
5359           txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
5360           inherited-tags
5361           (or (eq org-agenda-show-inherited-tags 'always)
5362           (and (listp org-agenda-show-inherited-tags)
5363                (memq 'todo org-agenda-show-inherited-tags))
5364           (and (eq org-agenda-show-inherited-tags t)
5365                (or (eq org-agenda-use-tag-inheritance t)
5366                (memq 'todo org-agenda-use-tag-inheritance))))
5367           tags (org-get-tags-at nil (not inherited-tags))
5368           level (make-string (org-reduced-level (org-outline-level)) ? )
5369           txt (org-agenda-format-item "" txt level category tags t)
5370           priority (1+ (org-get-priority txt)))
5371     (org-add-props txt props
5372       'org-marker marker 'org-hd-marker marker
5373       'priority priority
5374       'level level
5375       'ts-date ts-date
5376       'type (concat "todo" ts-date-type) 'todo-state todo-state)
5377     (push txt ee)
5378     (if org-agenda-todo-list-sublevels
5379         (goto-char todo-state-end-pos)
5380       (org-end-of-subtree 'invisible))))
5381     (nreverse ee)))
5382
5383 (defun org-agenda-todo-custom-ignore-p (time n)
5384   "Check whether timestamp is farther away than n number of days.
5385 This function is invoked if `org-agenda-todo-ignore-deadlines',
5386 `org-agenda-todo-ignore-scheduled' or
5387 `org-agenda-todo-ignore-timestamp' is set to an integer."
5388   (let ((days (org-time-stamp-to-now
5389            time org-agenda-todo-ignore-time-comparison-use-seconds)))
5390     (if (>= n 0)
5391     (>= days n)
5392       (<= days n))))
5393
5394 ;;;###autoload
5395 (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
5396     (&optional end)
5397   "Do we have a reason to ignore this TODO entry because it has a time stamp?"
5398   (when (or org-agenda-todo-ignore-with-date
5399         org-agenda-todo-ignore-scheduled
5400         org-agenda-todo-ignore-deadlines
5401         org-agenda-todo-ignore-timestamp)
5402     (setq end (or end (save-excursion (outline-next-heading) (point))))
5403     (save-excursion
5404       (or (and org-agenda-todo-ignore-with-date
5405            (re-search-forward org-ts-regexp end t))
5406       (and org-agenda-todo-ignore-scheduled
5407            (re-search-forward org-scheduled-time-regexp end t)
5408            (cond
5409         ((eq org-agenda-todo-ignore-scheduled 'future)
5410          (> (org-time-stamp-to-now
5411              (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5412         ((eq org-agenda-todo-ignore-scheduled 'past)
5413          (<= (org-time-stamp-to-now
5414               (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5415         ((numberp org-agenda-todo-ignore-scheduled)
5416          (org-agenda-todo-custom-ignore-p
5417           (match-string 1) org-agenda-todo-ignore-scheduled))
5418         (t)))
5419       (and org-agenda-todo-ignore-deadlines
5420            (re-search-forward org-deadline-time-regexp end t)
5421            (cond
5422         ((memq org-agenda-todo-ignore-deadlines '(t all)) t)
5423         ((eq org-agenda-todo-ignore-deadlines 'far)
5424          (not (org-deadline-close-p (match-string 1))))
5425         ((eq org-agenda-todo-ignore-deadlines 'future)
5426          (> (org-time-stamp-to-now
5427              (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5428         ((eq org-agenda-todo-ignore-deadlines 'past)
5429          (<= (org-time-stamp-to-now
5430               (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5431         ((numberp org-agenda-todo-ignore-deadlines)
5432          (org-agenda-todo-custom-ignore-p
5433           (match-string 1) org-agenda-todo-ignore-deadlines))
5434         (t (org-deadline-close-p (match-string 1)))))
5435       (and org-agenda-todo-ignore-timestamp
5436            (let ((buffer (current-buffer))
5437              (regexp
5438               (concat
5439                org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
5440              (start (point)))
5441          ;; Copy current buffer into a temporary one
5442          (with-temp-buffer
5443            (insert-buffer-substring buffer start end)
5444            (goto-char (point-min))
5445            ;; Delete SCHEDULED and DEADLINE items
5446            (while (re-search-forward regexp end t)
5447              (delete-region (match-beginning 0) (match-end 0)))
5448            (goto-char (point-min))
5449            ;; No search for timestamp left
5450            (when (re-search-forward org-ts-regexp nil t)
5451              (cond
5452               ((eq org-agenda-todo-ignore-timestamp 'future)
5453                (> (org-time-stamp-to-now
5454                (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5455               ((eq org-agenda-todo-ignore-timestamp 'past)
5456                (<= (org-time-stamp-to-now
5457                 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5458               ((numberp org-agenda-todo-ignore-timestamp)
5459                (org-agenda-todo-custom-ignore-p
5460             (match-string 1) org-agenda-todo-ignore-timestamp))
5461               (t))))))))))
5462
5463 (defun org-agenda-get-timestamps (&optional deadlines)
5464   "Return the date stamp information for agenda display.
5465 Optional argument DEADLINES is a list of deadline items to be
5466 displayed in agenda view."
5467   (let* ((props (list 'face 'org-agenda-calendar-event
5468               'org-not-done-regexp org-not-done-regexp
5469               'org-todo-regexp org-todo-regexp
5470               'org-complex-heading-regexp org-complex-heading-regexp
5471               'mouse-face 'highlight
5472               'help-echo
5473               (format "mouse-2 or RET jump to Org file %s"
5474                   (abbreviate-file-name buffer-file-name))))
5475      (current (calendar-absolute-from-gregorian date))
5476      (today (org-today))
5477      (deadline-position-alist
5478       (mapcar (lambda (d)
5479             (let ((m (get-text-property 0 'org-hd-marker d)))
5480               (and m (marker-position m))))
5481           deadlines))
5482      ;; Match time-stamps set to current date, time-stamps with
5483      ;; a repeater, and S-exp time-stamps.
5484      (regexp
5485       (concat
5486        (if org-agenda-include-inactive-timestamps "[[<]" "<")
5487        (regexp-quote
5488         (substring
5489          (format-time-string
5490           (car org-time-stamp-formats)
5491           (apply #'encode-time    ; DATE bound by calendar
5492              (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
5493          1 11))
5494        "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
5495        "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
5496      timestamp-items)
5497     (goto-char (point-min))
5498     (while (re-search-forward regexp nil t)
5499       ;; Skip date ranges, scheduled and deadlines, which are handled
5500       ;; specially.  Also skip time-stamps before first headline as
5501       ;; there would be no entry to add to the agenda.  Eventually,
5502       ;; ignore clock entries.
5503       (catch :skip
5504     (save-match-data
5505       (when (or (org-at-date-range-p)
5506             (org-at-planning-p)
5507             (org-before-first-heading-p)
5508             (and org-agenda-include-inactive-timestamps
5509              (org-at-clock-log-p)))
5510         (throw :skip nil))
5511       (org-agenda-skip))
5512     (let* ((pos (match-beginning 0))
5513            (repeat (match-string 1))
5514            (sexp-entry (match-string 3))
5515            (time-stamp (if (or repeat sexp-entry) (match-string 0)
5516                  (save-excursion
5517                    (goto-char pos)
5518                    (looking-at org-ts-regexp-both)
5519                    (match-string 0))))
5520            (todo-state (org-get-todo-state))
5521            (warntime (get-text-property (point) 'org-appt-warntime))
5522            (done? (member todo-state org-done-keywords)))
5523       ;; Possibly skip done tasks.
5524       (when (and done? org-agenda-skip-timestamp-if-done)
5525         (throw :skip t))
5526       ;; S-exp entry doesn't match current day: skip it.
5527       (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
5528         (throw :skip nil))
5529       (when repeat
5530         (let* ((past
5531             ;; A repeating time stamp is shown at its base
5532             ;; date and every repeated date up to TODAY.  If
5533             ;; `org-agenda-prefer-last-repeat' is non-nil,
5534             ;; however, only the last repeat before today
5535             ;; (inclusive) is shown.
5536             (org-agenda--timestamp-to-absolute
5537              repeat
5538              (if (or (> current today)
5539                  (eq org-agenda-prefer-last-repeat t)
5540                  (member todo-state org-agenda-prefer-last-repeat))
5541              today
5542                current)
5543              'past (current-buffer) pos))
5544            (future
5545             ;;  Display every repeated date past TODAY
5546             ;;  (exclusive) unless
5547             ;;  `org-agenda-show-future-repeats' is nil.  If
5548             ;;  this variable is set to `next', only display
5549             ;;  the first repeated date after TODAY
5550             ;;  (exclusive).
5551             (cond
5552              ((<= current today) past)
5553              ((not org-agenda-show-future-repeats) past)
5554              (t
5555               (let ((base (if (eq org-agenda-show-future-repeats 'next)
5556                       (1+ today)
5557                     current)))
5558             (org-agenda--timestamp-to-absolute
5559              repeat base 'future (current-buffer) pos))))))
5560           (when (and (/= current past) (/= current future))
5561         (throw :skip nil))))
5562       (save-excursion
5563         (re-search-backward org-outline-regexp-bol nil t)
5564         ;; Possibly skip time-stamp when a deadline is set.
5565         (when (and org-agenda-skip-timestamp-if-deadline-is-shown
5566                (assq (point) deadline-position-alist))
5567           (throw :skip nil))
5568         (let* ((category (org-get-category pos))
5569            (inherited-tags
5570             (or (eq org-agenda-show-inherited-tags 'always)
5571             (and (consp org-agenda-show-inherited-tags)
5572                  (memq 'agenda org-agenda-show-inherited-tags))
5573             (and (eq org-agenda-show-inherited-tags t)
5574                  (or (eq org-agenda-use-tag-inheritance t)
5575                  (memq 'agenda
5576                        org-agenda-use-tag-inheritance)))))
5577            (tags (org-get-tags-at nil (not inherited-tags)))
5578            (level (make-string (org-reduced-level (org-outline-level))
5579                        ?\s))
5580            (head (and (looking-at "\\*+[ \t]+\\(.*\\)")
5581                   (match-string 1)))
5582            (inactive? (= (char-after pos) ?\[))
5583            (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
5584            (item
5585             (org-agenda-format-item
5586              (and inactive? org-agenda-inactive-leader)
5587              head level category tags time-stamp org-ts-regexp habit?)))
5588           (org-add-props item props
5589         'priority (if habit?
5590                   (org-habit-get-priority (org-habit-parse-todo))
5591                 (org-get-priority item))
5592         'org-marker (org-agenda-new-marker pos)
5593         'org-hd-marker (org-agenda-new-marker)
5594         'date date
5595         'level level
5596         'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat)
5597                current)
5598         'todo-state todo-state
5599         'warntime warntime
5600         'type "timestamp")
5601           (push item timestamp-items))))
5602     (when org-agenda-skip-additional-timestamps-same-entry
5603       (outline-next-heading))))
5604     (nreverse timestamp-items)))
5605
5606 (defun org-agenda-get-sexps ()
5607   "Return the sexp information for agenda display."
5608   (require 'diary-lib)
5609   (let* ((props (list 'face 'org-agenda-calendar-sexp
5610               'mouse-face 'highlight
5611               'help-echo
5612               (format "mouse-2 or RET jump to org file %s"
5613                   (abbreviate-file-name buffer-file-name))))
5614      (regexp "^&?%%(")
5615      marker category extra level ee txt tags entry
5616      result beg b sexp sexp-entry todo-state warntime inherited-tags)
5617     (goto-char (point-min))
5618     (while (re-search-forward regexp nil t)
5619       (catch :skip
5620     (org-agenda-skip)
5621     (setq beg (match-beginning 0))
5622     (goto-char (1- (match-end 0)))
5623     (setq b (point))
5624     (forward-sexp 1)
5625     (setq sexp (buffer-substring b (point)))
5626     (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
5627                  (org-trim (match-string 1))
5628                ""))
5629     (setq result (org-diary-sexp-entry sexp sexp-entry date))
5630     (when result
5631       (setq marker (org-agenda-new-marker beg)
5632         level (make-string (org-reduced-level (org-outline-level)) ? )
5633         category (org-get-category beg)
5634         inherited-tags
5635         (or (eq org-agenda-show-inherited-tags 'always)
5636             (and (listp org-agenda-show-inherited-tags)
5637              (memq 'agenda org-agenda-show-inherited-tags))
5638             (and (eq org-agenda-show-inherited-tags t)
5639              (or (eq org-agenda-use-tag-inheritance t)
5640                  (memq 'agenda org-agenda-use-tag-inheritance))))
5641         tags (org-get-tags-at nil (not inherited-tags))
5642         todo-state (org-get-todo-state)
5643         warntime (get-text-property (point) 'org-appt-warntime)
5644         extra nil)
5645
5646       (dolist (r (if (stringp result)
5647              (list result)
5648                result)) ;; we expect a list here
5649         (when (and org-agenda-diary-sexp-prefix
5650                (string-match org-agenda-diary-sexp-prefix r))
5651           (setq extra (match-string 0 r)
5652             r (replace-match "" nil nil r)))
5653         (if (string-match "\\S-" r)
5654         (setq txt r)
5655           (setq txt "SEXP entry returned empty string"))
5656         (setq txt (org-agenda-format-item extra txt level category tags 'time))
5657         (org-add-props txt props 'org-marker marker
5658                'date date 'todo-state todo-state
5659                'level level 'type "sexp" 'warntime warntime)
5660         (push txt ee)))))
5661     (nreverse ee)))
5662
5663 ;; Calendar sanity: define some functions that are independent of
5664 ;; `calendar-date-style'.
5665 (defun org-anniversary (year month day &optional mark)
5666   "Like `diary-anniversary', but with fixed (ISO) order of arguments."
5667   (with-no-warnings
5668     (let ((calendar-date-style 'iso))
5669       (diary-anniversary year month day mark))))
5670 (defun org-cyclic (N year month day &optional mark)
5671   "Like `diary-cyclic', but with fixed (ISO) order of arguments."
5672   (with-no-warnings
5673     (let ((calendar-date-style 'iso))
5674       (diary-cyclic N year month day mark))))
5675 (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
5676   "Like `diary-block', but with fixed (ISO) order of arguments."
5677   (with-no-warnings
5678     (let ((calendar-date-style 'iso))
5679       (diary-block Y1 M1 D1 Y2 M2 D2 mark))))
5680 (defun org-date (year month day &optional mark)
5681   "Like `diary-date', but with fixed (ISO) order of arguments."
5682   (with-no-warnings
5683     (let ((calendar-date-style 'iso))
5684       (diary-date year month day mark))))
5685
5686 ;; Define the `org-class' function
5687 (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
5688   "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
5689 DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
5690 SKIP-WEEKS is any number of ISO weeks in the block period for which the
5691 item should be skipped.  If any of the SKIP-WEEKS arguments is the symbol
5692 `holidays', then any date that is known by the Emacs calendar to be a
5693 holiday will also be skipped.  If SKIP-WEEKS arguments are holiday strings,
5694 then those holidays will be skipped."
5695   (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
5696      (date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
5697      (d (calendar-absolute-from-gregorian date))
5698      (h (when skip-weeks (calendar-check-holidays date))))
5699     (and
5700      (<= date1 d)
5701      (<= d date2)
5702      (= (calendar-day-of-week date) dayname)
5703      (or (not skip-weeks)
5704      (progn
5705        (require 'cal-iso)
5706        (not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
5707      (not (or (and h (memq 'holidays skip-weeks))
5708           (delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
5709      entry)))
5710
5711 (defalias 'org-get-closed 'org-agenda-get-progress)
5712 (defun org-agenda-get-progress ()
5713   "Return the logged TODO entries for agenda display."
5714   (let* ((props (list 'mouse-face 'highlight
5715               'org-not-done-regexp org-not-done-regexp
5716               'org-todo-regexp org-todo-regexp
5717               'org-complex-heading-regexp org-complex-heading-regexp
5718               'help-echo
5719               (format "mouse-2 or RET jump to org file %s"
5720                   (abbreviate-file-name buffer-file-name))))
5721      (items (if (consp org-agenda-show-log-scoped)
5722             org-agenda-show-log-scoped
5723           (if (eq org-agenda-show-log-scoped 'clockcheck)
5724               '(clock)
5725             org-agenda-log-mode-items)))
5726      (parts
5727       (delq nil
5728         (list
5729          (if (memq 'closed items) (concat "\\<" org-closed-string))
5730          (if (memq 'clock items) (concat "\\<" org-clock-string))
5731          (if (memq 'state items)
5732              (format "- State \"%s\".*?" org-todo-regexp)))))
5733      (parts-re (if parts (mapconcat 'identity parts "\\|")
5734              (error "`org-agenda-log-mode-items' is empty")))
5735      (regexp (concat
5736           "\\(" parts-re "\\)"
5737           " *\\["
5738           (regexp-quote
5739            (substring
5740             (format-time-string
5741              (car org-time-stamp-formats)
5742              (apply 'encode-time  ; DATE bound by calendar
5743                 (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
5744             1 11))))
5745      (org-agenda-search-headline-for-time nil)
5746      marker hdmarker priority category level tags closedp
5747      statep clockp state ee txt extra timestr rest clocked inherited-tags)
5748     (goto-char (point-min))
5749     (while (re-search-forward regexp nil t)
5750       (catch :skip
5751     (org-agenda-skip)
5752     (setq marker (org-agenda-new-marker (match-beginning 0))
5753           closedp (equal (match-string 1) org-closed-string)
5754           statep (equal (string-to-char (match-string 1)) ?-)
5755           clockp (not (or closedp statep))
5756           state (and statep (match-string 2))
5757           category (org-get-category (match-beginning 0))
5758           timestr (buffer-substring (match-beginning 0) (point-at-eol)))
5759     (when (string-match "\\]" timestr)
5760       ;; substring should only run to end of time stamp
5761       (setq rest (substring timestr (match-end 0))
5762         timestr (substring timestr 0 (match-end 0)))
5763       (if (and (not closedp) (not statep)
5764            (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
5765                  rest))
5766           (progn (setq timestr (concat (substring timestr 0 -1)
5767                        "-" (match-string 1 rest) "]"))
5768              (setq clocked (match-string 2 rest)))
5769         (setq clocked "-")))
5770     (save-excursion
5771       (setq extra
5772         (cond
5773          ((not org-agenda-log-mode-add-notes) nil)
5774          (statep
5775           (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
5776                (match-string 1)))
5777          (clockp
5778           (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
5779                (match-string 1)))))
5780       (if (not (re-search-backward org-outline-regexp-bol nil t))
5781           (throw :skip nil)
5782         (goto-char (match-beginning 0))
5783         (setq hdmarker (org-agenda-new-marker)
5784           inherited-tags
5785           (or (eq org-agenda-show-inherited-tags 'always)
5786               (and (listp org-agenda-show-inherited-tags)
5787                (memq 'todo org-agenda-show-inherited-tags))
5788               (and (eq org-agenda-show-inherited-tags t)
5789                (or (eq org-agenda-use-tag-inheritance t)
5790                    (memq 'todo org-agenda-use-tag-inheritance))))
5791           tags (org-get-tags-at nil (not inherited-tags))
5792           level (make-string (org-reduced-level (org-outline-level)) ? ))
5793         (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
5794         (setq txt (match-string 1))
5795         (when extra
5796           (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
5797           (setq txt (concat (substring txt 0 (match-beginning 1))
5798                     " - " extra " " (match-string 2 txt)))
5799         (setq txt (concat txt " - " extra))))
5800         (setq txt (org-agenda-format-item
5801                (cond
5802             (closedp "Closed:    ")
5803             (statep (concat "State:     (" state ")"))
5804             (t (concat "Clocked:   (" clocked  ")")))
5805                txt level category tags timestr)))
5806       (setq priority 100000)
5807       (org-add-props txt props
5808         'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
5809         'priority priority 'level level
5810         'type "closed" 'date date
5811         'undone-face 'org-warning 'done-face 'org-agenda-done)
5812       (push txt ee))
5813     (goto-char (point-at-eol))))
5814     (nreverse ee)))
5815
5816 (defun org-agenda-show-clocking-issues ()
5817   "Add overlays, showing issues with clocking.
5818 See also the user option `org-agenda-clock-consistency-checks'."
5819   (interactive)
5820   (let* ((pl org-agenda-clock-consistency-checks)
5821      (re (concat "^[ \t]*"
5822              org-clock-string
5823              "[ \t]+"
5824              "\\(\\[.*?\\]\\)"    ; group 1 is first stamp
5825              "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
5826      (tlstart 0.)
5827      (tlend 0.)
5828      (maxtime (org-duration-to-minutes
5829            (or (plist-get pl :max-duration) "24:00")))
5830      (mintime (org-duration-to-minutes
5831            (or (plist-get pl :min-duration) 0)))
5832      (maxgap  (org-duration-to-minutes
5833            ;; default 30:00 means never complain
5834            (or (plist-get pl :max-gap) "30:00")))
5835      (gapok (mapcar #'org-duration-to-minutes
5836             (plist-get pl :gap-ok-around)))
5837      (def-face (or (plist-get pl :default-face)
5838                '((:background "DarkRed") (:foreground "white"))))
5839      issue face m te ts dt ov)
5840     (goto-char (point-min))
5841     (while (re-search-forward " Clocked: +(-\\|\\([0-9]+:[0-9]+\\))" nil t)
5842       (setq issue nil face def-face)
5843       (catch 'next
5844     (setq m (org-get-at-bol 'org-marker)
5845           te nil ts nil)
5846     (unless (and m (markerp m))
5847       (setq issue "No valid clock line") (throw 'next t))
5848     (org-with-point-at m
5849       (save-excursion
5850         (goto-char (point-at-bol))
5851         (unless (looking-at re)
5852           (error "No valid Clock line")
5853           (throw 'next t))
5854         (unless (match-end 3)
5855           (setq issue "No end time"
5856             face (or (plist-get pl :no-end-time-face) face))
5857           (throw 'next t))
5858         (setq ts (match-string 1)
5859           te (match-string 3)
5860           ts (float-time
5861               (apply #'encode-time (org-parse-time-string ts)))
5862           te (float-time
5863               (apply #'encode-time (org-parse-time-string te)))
5864           dt (- te ts))))
5865     (cond
5866      ((> dt (* 60 maxtime))
5867       ;; a very long clocking chunk
5868       (setq issue (format "Clocking interval is very long: %s"
5869                   (org-duration-from-minutes (floor (/ dt 60.))))
5870         face (or (plist-get pl :long-face) face)))
5871      ((< dt (* 60 mintime))
5872       ;; a very short clocking chunk
5873       (setq issue (format "Clocking interval is very short: %s"
5874                   (org-duration-from-minutes (floor (/ dt 60.))))
5875         face (or (plist-get pl :short-face) face)))
5876      ((and (> tlend 0) (< ts tlend))
5877       ;; Two clock entries are overlapping
5878       (setq issue (format "Clocking overlap: %d minutes"
5879                   (/ (- tlend ts) 60))
5880         face (or (plist-get pl :overlap-face) face)))
5881      ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap))))
5882       ;; There is a gap, lets see if we need to report it
5883       (unless (org-agenda-check-clock-gap tlend ts gapok)
5884         (setq issue (format "Clocking gap: %d minutes"
5885                 (/ (- ts tlend) 60))
5886           face (or (plist-get pl :gap-face) face))))
5887      (t nil)))
5888       (setq tlend (or te tlend) tlstart (or ts tlstart))
5889       (when issue
5890     ;; OK, there was some issue, add an overlay to show the issue
5891     (setq ov (make-overlay (point-at-bol) (point-at-eol)))
5892     (overlay-put ov 'before-string
5893              (concat
5894               (org-add-props
5895               (format "%-43s" (concat " " issue))
5896               nil
5897             'face face)
5898               "\n"))
5899     (overlay-put ov 'evaporate t)))))
5900
5901 (defun org-agenda-check-clock-gap (t1 t2 ok-list)
5902   "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values."
5903   (catch 'exit
5904     (unless ok-list
5905       ;; there are no OK times for gaps...
5906       (throw 'exit nil))
5907     (if (> (- (/ t2 36000) (/ t1 36000)) 24)
5908     ;; This is more than 24 hours, so it is OK.
5909     ;; because we have at least one OK time, that must be in the
5910     ;; 24 hour interval.
5911     (throw 'exit t))
5912     ;; We have a shorter gap.
5913     ;; Now we have to get the minute of the day when these times are
5914     (let* ((t1dec (decode-time (seconds-to-time t1)))
5915        (t2dec (decode-time (seconds-to-time t2)))
5916        ;; compute the minute on the day
5917        (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec))))
5918        (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec)))))
5919       (when (< min2 min1)
5920     ;; if min2 is smaller than min1, this means it is on the next day.
5921     ;; Wrap it to after midnight.
5922     (setq min2 (+ min2 1440)))
5923       ;; Now check if any of the OK times is in the gap
5924       (mapc (lambda (x)
5925           ;; Wrap the time to after midnight if necessary
5926           (if (< x min1) (setq x (+ x 1440)))
5927           ;; Check if in interval
5928           (and (<= min1 x) (>= min2 x) (throw 'exit t)))
5929         ok-list)
5930       ;; Nope, this gap is not OK
5931       nil)))
5932
5933 (defun org-agenda-get-deadlines (&optional with-hour)
5934   "Return the deadline information for agenda display.
5935 When WITH-HOUR is non-nil, only return deadlines with an hour
5936 specification like [h]h:mm."
5937   (let* ((props (list 'mouse-face 'highlight
5938               'org-not-done-regexp org-not-done-regexp
5939               'org-todo-regexp org-todo-regexp
5940               'org-complex-heading-regexp org-complex-heading-regexp
5941               'help-echo
5942               (format "mouse-2 or RET jump to org file %s"
5943                   (abbreviate-file-name buffer-file-name))))
5944      (regexp (if with-hour
5945              org-deadline-time-hour-regexp
5946            org-deadline-time-regexp))
5947      (today (org-today))
5948      (today? (org-agenda-today-p date)) ; DATE bound by calendar.
5949      (current (calendar-absolute-from-gregorian date))
5950      deadline-items)
5951     (goto-char (point-min))
5952     (while (re-search-forward regexp nil t)
5953       (catch :skip
5954     (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
5955     (org-agenda-skip)
5956     (let* ((s (match-string 1))
5957            (pos (1- (match-beginning 1)))
5958            (todo-state (save-match-data (org-get-todo-state)))
5959            (done? (member todo-state org-done-keywords))
5960                (sexp? (string-prefix-p "%%" s))
5961            ;; DEADLINE is the deadline date for the entry.  It is
5962            ;; either the base date or the last repeat, according
5963            ;; to `org-agenda-prefer-last-repeat'.
5964            (deadline
5965         (cond
5966          (sexp? (org-agenda--timestamp-to-absolute s current))
5967          ((or (eq org-agenda-prefer-last-repeat t)
5968               (member todo-state org-agenda-prefer-last-repeat))
5969           (org-agenda--timestamp-to-absolute
5970            s today 'past (current-buffer) pos))
5971          (t (org-agenda--timestamp-to-absolute s))))
5972            ;; REPEAT is the future repeat closest from CURRENT,
5973            ;; according to `org-agenda-show-future-repeats'. If
5974            ;; the latter is nil, or if the time stamp has no
5975            ;; repeat part, default to DEADLINE.
5976            (repeat
5977         (cond
5978          (sexp? deadline)
5979          ((<= current today) deadline)
5980          ((not org-agenda-show-future-repeats) deadline)
5981          (t
5982           (let ((base (if (eq org-agenda-show-future-repeats 'next)
5983                   (1+ today)
5984                 current)))
5985             (org-agenda--timestamp-to-absolute
5986              s base 'future (current-buffer) pos)))))
5987            (diff (- deadline current))
5988            (suppress-prewarning
5989         (let ((scheduled
5990                (and org-agenda-skip-deadline-prewarning-if-scheduled
5991                 (org-entry-get nil "SCHEDULED"))))
5992           (cond
5993            ((not scheduled) nil)
5994            ;; The current item has a scheduled date, so
5995            ;; evaluate its prewarning lead time.
5996            ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
5997             ;; Use global prewarning-restart lead time.
5998             org-agenda-skip-deadline-prewarning-if-scheduled)
5999            ((eq org-agenda-skip-deadline-prewarning-if-scheduled
6000             'pre-scheduled)
6001             ;; Set pre-warning to no earlier than SCHEDULED.
6002             (min (- deadline
6003                 (org-agenda--timestamp-to-absolute scheduled))
6004              org-deadline-warning-days))
6005            ;; Set pre-warning to deadline.
6006            (t 0))))
6007            (wdays (or suppress-prewarning (org-get-wdays s))))
6008       (cond
6009        ;; Only display deadlines at their base date, at future
6010        ;; repeat occurrences or in today agenda.
6011        ((= current deadline) nil)
6012        ((= current repeat) nil)
6013        ((not today?) (throw :skip nil))
6014        ;; Upcoming deadline: display within warning period WDAYS.
6015        ((> deadline current) (when (> diff wdays) (throw :skip nil)))
6016        ;; Overdue deadline: warn about it for
6017        ;; `org-deadline-past-days' duration.
6018        (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
6019       ;; Possibly skip done tasks.
6020       (when (and done?
6021              (or org-agenda-skip-deadline-if-done
6022              (/= deadline current)))
6023         (throw :skip nil))
6024       (save-excursion
6025         (re-search-backward "^\\*+[ \t]+" nil t)
6026         (goto-char (match-end 0))
6027         (let* ((category (org-get-category))
6028            (level (make-string (org-reduced-level (org-outline-level))
6029                        ?\s))
6030            (head (buffer-substring (point) (line-end-position)))
6031            (inherited-tags
6032             (or (eq org-agenda-show-inherited-tags 'always)
6033             (and (listp org-agenda-show-inherited-tags)
6034                  (memq 'agenda org-agenda-show-inherited-tags))
6035             (and (eq org-agenda-show-inherited-tags t)
6036                  (or (eq org-agenda-use-tag-inheritance t)
6037                  (memq 'agenda
6038                        org-agenda-use-tag-inheritance)))))
6039            (tags (org-get-tags-at nil (not inherited-tags)))
6040            (time
6041             (cond
6042              ;; No time of day designation if it is only
6043              ;; a reminder.
6044              ((and (/= current deadline) (/= current repeat)) nil)
6045              ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
6046               (concat (substring s (match-beginning 1)) " "))
6047              (t 'time)))
6048            (item
6049             (org-agenda-format-item
6050              ;; Insert appropriate suffixes before deadlines.
6051              ;; Those only apply to today agenda.
6052              (pcase-let ((`(,now ,future ,past)
6053                   org-agenda-deadline-leaders))
6054                (cond
6055             ((and today? (< deadline today)) (format past (- diff)))
6056             ((and today? (> deadline today)) (format future diff))
6057             (t now)))
6058              head level category tags time))
6059            (face (org-agenda-deadline-face
6060               (- 1 (/ (float diff) (max wdays 1)))))
6061            (upcoming? (and today? (> deadline today)))
6062            (warntime (get-text-property (point) 'org-appt-warntime)))
6063           (org-add-props item props
6064         'org-marker (org-agenda-new-marker pos)
6065         'org-hd-marker (org-agenda-new-marker (line-beginning-position))
6066         'warntime warntime
6067         'level level
6068         'ts-date deadline
6069         'priority
6070         ;; Adjust priority to today reminders about deadlines.
6071         ;; Overdue deadlines get the highest priority
6072         ;; increase, then imminent deadlines and eventually
6073         ;; more distant deadlines.
6074         (let ((adjust (if today? (- diff) 0)))
6075           (+ adjust (org-get-priority item)))
6076         'todo-state todo-state
6077         'type (if upcoming? "upcoming-deadline" "deadline")
6078         'date (if upcoming? date deadline)
6079         'face (if done? 'org-agenda-done face)
6080         'undone-face face
6081         'done-face 'org-agenda-done)
6082           (push item deadline-items))))))
6083     (nreverse deadline-items)))
6084
6085 (defun org-agenda-deadline-face (fraction)
6086   "Return the face to displaying a deadline item.
6087 FRACTION is what fraction of the head-warning time has passed."
6088   (assoc-default fraction org-agenda-deadline-faces #'<=))
6089
6090 (defun org-agenda-get-scheduled (&optional deadlines with-hour)
6091   "Return the scheduled information for agenda display.
6092 Optional argument DEADLINES is a list of deadline items to be
6093 displayed in agenda view.  When WITH-HOUR is non-nil, only return
6094 scheduled items with an hour specification like [h]h:mm."
6095   (let* ((props (list 'org-not-done-regexp org-not-done-regexp
6096               'org-todo-regexp org-todo-regexp
6097               'org-complex-heading-regexp org-complex-heading-regexp
6098               'done-face 'org-agenda-done
6099               'mouse-face 'highlight
6100               'help-echo
6101               (format "mouse-2 or RET jump to Org file %s"
6102                   (abbreviate-file-name buffer-file-name))))
6103      (regexp (if with-hour
6104              org-scheduled-time-hour-regexp
6105            org-scheduled-time-regexp))
6106      (today (org-today))
6107      (todayp (org-agenda-today-p date)) ; DATE bound by calendar.
6108      (current (calendar-absolute-from-gregorian date))
6109      (deadline-pos
6110       (mapcar (lambda (d)
6111             (let ((m (get-text-property 0 'org-hd-marker d)))
6112               (and m (marker-position m))))
6113           deadlines))
6114      scheduled-items)
6115     (goto-char (point-min))
6116     (while (re-search-forward regexp nil t)
6117       (catch :skip
6118     (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
6119     (org-agenda-skip)
6120     (let* ((s (match-string 1))
6121            (pos (1- (match-beginning 1)))
6122            (todo-state (save-match-data (org-get-todo-state)))
6123            (donep (member todo-state org-done-keywords))
6124            (sexp? (string-prefix-p "%%" s))
6125            ;; SCHEDULE is the scheduled date for the entry.  It is
6126            ;; either the bare date or the last repeat, according
6127            ;; to `org-agenda-prefer-last-repeat'.
6128            (schedule
6129         (cond
6130          (sexp? (org-agenda--timestamp-to-absolute s current))
6131          ((or (eq org-agenda-prefer-last-repeat t)
6132               (member todo-state org-agenda-prefer-last-repeat))
6133           (org-agenda--timestamp-to-absolute
6134            s today 'past (current-buffer) pos))
6135          (t (org-agenda--timestamp-to-absolute s))))
6136            ;; REPEAT is the future repeat closest from CURRENT,
6137            ;; according to `org-agenda-show-future-repeats'. If
6138            ;; the latter is nil, or if the time stamp has no
6139            ;; repeat part, default to SCHEDULE.
6140            (repeat
6141         (cond
6142          (sexp? schedule)
6143          ((<= current today) schedule)
6144          ((not org-agenda-show-future-repeats) schedule)
6145          (t
6146           (let ((base (if (eq org-agenda-show-future-repeats 'next)
6147                   (1+ today)
6148                 current)))
6149             (org-agenda--timestamp-to-absolute
6150              s base 'future (current-buffer) pos)))))
6151            (diff (- current schedule))
6152            (warntime (get-text-property (point) 'org-appt-warntime))
6153            (pastschedp (< schedule today))
6154            (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
6155            (suppress-delay
6156         (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
6157                      (org-entry-get nil "DEADLINE"))))
6158           (cond
6159            ((not deadline) nil)
6160            ;; The current item has a deadline date, so
6161            ;; evaluate its delay time.
6162            ((integerp org-agenda-skip-scheduled-delay-if-deadline)
6163             ;; Use global delay time.
6164             (- org-agenda-skip-scheduled-delay-if-deadline))
6165            ((eq org-agenda-skip-scheduled-delay-if-deadline
6166             'post-deadline)
6167             ;; Set delay to no later than DEADLINE.
6168             (min (- schedule
6169                 (org-agenda--timestamp-to-absolute deadline))
6170              org-scheduled-delay-days))
6171            (t 0))))
6172            (ddays
6173         (cond
6174          ;; Nullify delay when a repeater triggered already
6175          ;; and the delay is of the form --Xd.
6176          ((and (string-match-p "--[0-9]+[hdwmy]" s)
6177                (> schedule (org-agenda--timestamp-to-absolute s)))
6178           0)
6179          (suppress-delay
6180           (let ((org-scheduled-delay-days suppress-delay))
6181             (org-get-wdays s t t)))
6182          (t (org-get-wdays s t)))))
6183       ;; Display scheduled items at base date (SCHEDULE), today if
6184       ;; scheduled before the current date, and at any repeat past
6185       ;; today.  However, skip delayed items and items that have
6186       ;; been displayed for more than `org-scheduled-past-days'.
6187       (unless (and todayp
6188                habitp
6189                (bound-and-true-p org-habit-show-all-today))
6190         (when (or (and (> ddays 0) (< diff ddays))
6191               (> diff org-scheduled-past-days)
6192               (> schedule current)
6193               (and (/= current schedule)
6194                (/= current today)
6195                (/= current repeat)))
6196           (throw :skip nil)))
6197       ;; Possibly skip done tasks.
6198       (when (and donep
6199              (or org-agenda-skip-scheduled-if-done
6200              (/= schedule current)))
6201         (throw :skip nil))
6202       ;; Skip entry if it already appears as a deadline, per
6203       ;; `org-agenda-skip-scheduled-if-deadline-is-shown'.  This
6204       ;; doesn't apply to habits.
6205       (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
6206           ((guard
6207             (or (not (memq (line-beginning-position 0) deadline-pos))
6208             habitp))
6209            nil)
6210           (`repeated-after-deadline
6211            (let ((deadline (time-to-days
6212                     (org-get-deadline-time (point)))))
6213              (and (<= schedule deadline) (> current deadline))))
6214           (`not-today pastschedp)
6215           (`t t)
6216           (_ nil))
6217         (throw :skip nil))
6218       ;; Skip habits if `org-habit-show-habits' is nil, or if we
6219       ;; only show them for today.  Also skip done habits.
6220       (when (and habitp
6221              (or donep
6222              (not (bound-and-true-p org-habit-show-habits))
6223              (and (not todayp)
6224                   (bound-and-true-p
6225                    org-habit-show-habits-only-for-today))))
6226         (throw :skip nil))
6227       (save-excursion
6228         (re-search-backward "^\\*+[ \t]+" nil t)
6229         (goto-char (match-end 0))
6230         (let* ((category (org-get-category))
6231            (inherited-tags
6232             (or (eq org-agenda-show-inherited-tags 'always)
6233             (and (listp org-agenda-show-inherited-tags)
6234                  (memq 'agenda org-agenda-show-inherited-tags))
6235             (and (eq org-agenda-show-inherited-tags t)
6236                  (or (eq org-agenda-use-tag-inheritance t)
6237                  (memq 'agenda
6238                        org-agenda-use-tag-inheritance)))))
6239            (tags (org-get-tags-at nil (not inherited-tags)))
6240            (level (make-string (org-reduced-level (org-outline-level))
6241                        ?\s))
6242            (head (buffer-substring (point) (line-end-position)))
6243            (time
6244             (cond
6245              ;; No time of day designation if it is only
6246              ;; a reminder.
6247              ((and (/= current schedule) (/= current repeat)) nil)
6248              ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
6249               (concat (substring s (match-beginning 1)) " "))
6250              (t 'time)))
6251            (item
6252             (org-agenda-format-item
6253              (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
6254                ;; Show a reminder of a past scheduled today.
6255                (if (and todayp pastschedp)
6256                (format past diff)
6257              first))
6258              head level category tags time nil habitp))
6259            (face (cond ((and (not habitp) pastschedp)
6260                 'org-scheduled-previously)
6261                    (todayp 'org-scheduled-today)
6262                    (t 'org-scheduled)))
6263            (habitp (and habitp (org-habit-parse-todo))))
6264           (org-add-props item props
6265         'undone-face face
6266         'face (if donep 'org-agenda-done face)
6267         'org-marker (org-agenda-new-marker pos)
6268         'org-hd-marker (org-agenda-new-marker (line-beginning-position))
6269         'type (if pastschedp "past-scheduled" "scheduled")
6270         'date (if pastschedp schedule date)
6271         'ts-date schedule
6272         'warntime warntime
6273         'level level
6274         'priority (if habitp (org-habit-get-priority habitp)
6275                 (+ 99 diff (org-get-priority item)))
6276         'org-habit-p habitp
6277         'todo-state todo-state)
6278           (push item scheduled-items))))))
6279     (nreverse scheduled-items)))
6280
6281 (defun org-agenda-get-blocks ()
6282   "Return the date-range information for agenda display."
6283   (let* ((props (list 'face nil
6284               'org-not-done-regexp org-not-done-regexp
6285               'org-todo-regexp org-todo-regexp
6286               'org-complex-heading-regexp org-complex-heading-regexp
6287               'mouse-face 'highlight
6288               'help-echo
6289               (format "mouse-2 or RET jump to org file %s"
6290                   (abbreviate-file-name buffer-file-name))))
6291      (regexp org-tr-regexp)
6292      (d0 (calendar-absolute-from-gregorian date))
6293      marker hdmarker ee txt d1 d2 s1 s2 category
6294      level todo-state tags pos head donep inherited-tags)
6295     (goto-char (point-min))
6296     (while (re-search-forward regexp nil t)
6297       (catch :skip
6298     (org-agenda-skip)
6299     (setq pos (point))
6300     (let ((start-time (match-string 1))
6301           (end-time (match-string 2)))
6302       (setq s1 (match-string 1)
6303         s2 (match-string 2)
6304         d1 (time-to-days
6305             (condition-case err
6306             (org-time-string-to-time s1)
6307               (error
6308                (error
6309             "Bad timestamp %S at %d in buffer %S\nError was: %s"
6310             s1
6311             pos
6312             (current-buffer)
6313             (error-message-string err)))))
6314         d2 (time-to-days
6315             (condition-case err
6316             (org-time-string-to-time s2)
6317               (error
6318                (error
6319             "Bad timestamp %S at %d in buffer %S\nError was: %s"
6320             s2
6321             pos
6322             (current-buffer)
6323             (error-message-string err))))))
6324       (if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
6325           ;; Only allow days between the limits, because the normal
6326           ;; date stamps will catch the limits.
6327           (save-excursion
6328         (setq todo-state (org-get-todo-state))
6329         (setq donep (member todo-state org-done-keywords))
6330         (if (and donep org-agenda-skip-timestamp-if-done)
6331             (throw :skip t))
6332         (setq marker (org-agenda-new-marker (point))
6333               category (org-get-category))
6334         (if (not (re-search-backward org-outline-regexp-bol nil t))
6335             (throw :skip nil)
6336           (goto-char (match-beginning 0))
6337           (setq hdmarker (org-agenda-new-marker (point))
6338             inherited-tags
6339             (or (eq org-agenda-show-inherited-tags 'always)
6340                 (and (listp org-agenda-show-inherited-tags)
6341                  (memq 'agenda org-agenda-show-inherited-tags))
6342                 (and (eq org-agenda-show-inherited-tags t)
6343                  (or (eq org-agenda-use-tag-inheritance t)
6344                      (memq 'agenda org-agenda-use-tag-inheritance))))
6345
6346             tags (org-get-tags-at nil (not inherited-tags)))
6347           (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
6348           (looking-at "\\*+[ \t]+\\(.*\\)")
6349           (setq head (match-string 1))
6350           (let ((remove-re
6351              (if org-agenda-remove-timeranges-from-blocks
6352                  (concat
6353                   "<" (regexp-quote s1) ".*?>"
6354                   "--"
6355                   "<" (regexp-quote s2) ".*?>")
6356                nil)))
6357             (setq txt (org-agenda-format-item
6358                    (format
6359                 (nth (if (= d1 d2) 0 1)
6360                      org-agenda-timerange-leaders)
6361                 (1+ (- d0 d1)) (1+ (- d2 d1)))
6362                    head level category tags
6363                    (cond ((and (= d1 d0) (= d2 d0))
6364                       (concat "<" start-time ">--<" end-time ">"))
6365                                      ((= d1 d0)
6366                       (concat "<" start-time ">"))
6367                      ((= d2 d0)
6368                       (concat "<" end-time ">")))
6369                    remove-re))))
6370         (org-add-props txt props
6371           'org-marker marker 'org-hd-marker hdmarker
6372           'type "block" 'date date
6373           'level level
6374           'todo-state todo-state
6375           'priority (org-get-priority txt))
6376         (push txt ee))))
6377     (goto-char pos)))
6378     ;; Sort the entries by expiration date.
6379     (nreverse ee)))
6380
6381 ;;; Agenda presentation and sorting
6382
6383 (defvar org-prefix-has-time nil
6384   "A flag, set by `org-compile-prefix-format'.
6385 The flag is set if the currently compiled format contains a `%t'.")
6386 (defvar org-prefix-has-tag nil
6387   "A flag, set by `org-compile-prefix-format'.
6388 The flag is set if the currently compiled format contains a `%T'.")
6389 (defvar org-prefix-has-effort nil
6390   "A flag, set by `org-compile-prefix-format'.
6391 The flag is set if the currently compiled format contains a `%e'.")
6392 (defvar org-prefix-has-breadcrumbs nil
6393   "A flag, set by `org-compile-prefix-format'.
6394 The flag is set if the currently compiled format contains a `%b'.")
6395 (defvar org-prefix-category-length nil
6396   "Used by `org-compile-prefix-format' to remember the category field width.")
6397 (defvar org-prefix-category-max-length nil
6398   "Used by `org-compile-prefix-format' to remember the category field width.")
6399
6400 (defun org-agenda-get-category-icon (category)
6401   "Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
6402   (cl-dolist (entry org-agenda-category-icon-alist)
6403     (when (string-match-p (car entry) category)
6404       (if (listp (cadr entry))
6405       (cl-return (cadr entry))
6406     (cl-return (apply #'create-image (cdr entry)))))))
6407
6408 (defun org-agenda-format-item (extra txt &optional level category tags dotime
6409                      remove-re habitp)
6410   "Format TXT to be inserted into the agenda buffer.
6411 In particular, add the prefix and corresponding text properties.
6412
6413 EXTRA must be a string to replace the `%s' specifier in the prefix format.
6414 LEVEL may be a string to replace the `%l' specifier.
6415 CATEGORY (a string, a symbol or nil) may be used to overrule the default
6416 category taken from local variable or file name.  It will replace the `%c'
6417 specifier in the format.
6418 DOTIME, when non-nil, indicates that a time-of-day should be extracted from
6419 TXT for sorting of this entry, and for the `%t' specifier in the format.
6420 When DOTIME is a string, this string is searched for a time before TXT is.
6421 TAGS can be the tags of the headline.
6422 Any match of REMOVE-RE will be removed from TXT."
6423   ;; We keep the org-prefix-* variable values along with a compiled
6424   ;; formatter, so that multiple agendas existing at the same time do
6425   ;; not step on each other toes.
6426   ;;
6427   ;; It was inconvenient to make these variables buffer local in
6428   ;; Agenda buffers, because this function expects to be called with
6429   ;; the buffer where item comes from being current, and not agenda
6430   ;; buffer
6431   (let* ((bindings (car org-prefix-format-compiled))
6432      (formatter (cadr org-prefix-format-compiled)))
6433     (cl-loop for (var value) in bindings
6434          do (set var value))
6435     (save-match-data
6436       ;; Diary entries sometimes have extra whitespace at the beginning
6437       (setq txt (org-trim txt))
6438
6439       ;; Fix the tags part in txt
6440       (setq txt (org-agenda-fix-displayed-tags
6441          txt tags
6442          org-agenda-show-inherited-tags
6443          org-agenda-hide-tags-regexp))
6444
6445       (let* ((category (or category
6446                (if buffer-file-name
6447                    (file-name-sans-extension
6448                 (file-name-nondirectory buffer-file-name))
6449                  "")))
6450          (category-icon (org-agenda-get-category-icon category))
6451          (category-icon (if category-icon
6452                 (propertize " " 'display category-icon)
6453                   ""))
6454          (effort (and (not (string= txt ""))
6455               (get-text-property 1 'effort txt)))
6456          ;; time, tag, effort are needed for the eval of the prefix format
6457          (tag (if tags (nth (1- (length tags)) tags) ""))
6458          (time-grid-trailing-characters (nth 2 org-agenda-time-grid))
6459          time
6460          (ts (if dotime (concat
6461                  (if (stringp dotime) dotime "")
6462                  (and org-agenda-search-headline-for-time txt))))
6463          (time-of-day (and dotime (org-get-time-of-day ts)))
6464          stamp plain s0 s1 s2 rtn srp l
6465          duration breadcrumbs)
6466     (and (derived-mode-p 'org-mode) buffer-file-name
6467          (add-to-list 'org-agenda-contributing-files buffer-file-name))
6468     (when (and dotime time-of-day)
6469       ;; Extract starting and ending time and move them to prefix
6470       (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
6471             (setq plain (string-match org-plain-time-of-day-regexp ts)))
6472         (setq s0 (match-string 0 ts)
6473           srp (and stamp (match-end 3))
6474           s1 (match-string (if plain 1 2) ts)
6475           s2 (match-string (if plain 8 (if srp 4 6)) ts))
6476
6477         ;; If the times are in TXT (not in DOTIMES), and the prefix will list
6478         ;; them, we might want to remove them there to avoid duplication.
6479         ;; The user can turn this off with a variable.
6480         (if (and org-prefix-has-time
6481              org-agenda-remove-times-when-in-prefix (or stamp plain)
6482              (string-match (concat (regexp-quote s0) " *") txt)
6483              (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
6484              (if (eq org-agenda-remove-times-when-in-prefix 'beg)
6485              (= (match-beginning 0) 0)
6486                t))
6487         (setq txt (replace-match "" nil nil txt))))
6488       ;; Normalize the time(s) to 24 hour
6489       (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
6490       (if s2 (setq s2 (org-get-time-of-day s2 'string t)))
6491
6492       ;; Try to set s2 if s1 and
6493       ;; `org-agenda-default-appointment-duration' are set
6494       (when (and s1 (not s2) org-agenda-default-appointment-duration)
6495         (setq s2
6496           (org-duration-from-minutes
6497            (+ (org-duration-to-minutes s1 t)
6498               org-agenda-default-appointment-duration)
6499            nil t)))
6500
6501       ;; Compute the duration
6502       (when s2
6503         (setq duration (- (org-duration-to-minutes s2)
6504                   (org-duration-to-minutes s1)))))
6505
6506     (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
6507       ;; Tags are in the string
6508       (if (or (eq org-agenda-remove-tags t)
6509           (and org-agenda-remove-tags
6510                org-prefix-has-tag))
6511           (setq txt (replace-match "" t t txt))
6512         (setq txt (replace-match
6513                (concat (make-string (max (- 50 (length txt)) 1) ?\ )
6514                    (match-string 2 txt))
6515                t t txt))))
6516
6517     (when remove-re
6518       (while (string-match remove-re txt)
6519         (setq txt (replace-match "" t t txt))))
6520
6521     ;; Set org-heading property on `txt' to mark the start of the
6522     ;; heading.
6523     (add-text-properties 0 (length txt) '(org-heading t) txt)
6524
6525     ;; Prepare the variables needed in the eval of the compiled format
6526     (if org-prefix-has-breadcrumbs
6527         (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker)
6528                 (let ((s (org-display-outline-path nil nil "->" t)))
6529                   (if (eq "" s) "" (concat s "->"))))))
6530     (setq time (cond (s2 (concat
6531                   (org-agenda-time-of-day-to-ampm-maybe s1)
6532                   "-" (org-agenda-time-of-day-to-ampm-maybe s2)
6533                   (if org-agenda-timegrid-use-ampm " ")))
6534              (s1 (concat
6535                   (org-agenda-time-of-day-to-ampm-maybe s1)
6536                   (if org-agenda-timegrid-use-ampm
6537                                   (concat time-grid-trailing-characters " ")
6538                                 time-grid-trailing-characters)))
6539              (t ""))
6540           extra (or (and (not habitp) extra) "")
6541           category (if (symbolp category) (symbol-name category) category)
6542           level (or level ""))
6543     (if (string-match org-bracket-link-regexp category)
6544         (progn
6545           (setq l (if (match-end 3)
6546               (- (match-end 3) (match-beginning 3))
6547             (- (match-end 1) (match-beginning 1))))
6548           (when (< l (or org-prefix-category-length 0))
6549         (setq category (copy-sequence category))
6550         (org-add-props category nil
6551           'extra-space (make-string
6552                 (- org-prefix-category-length l 1) ?\ ))))
6553       (if (and org-prefix-category-max-length
6554            (>= (length category) org-prefix-category-max-length))
6555           (setq category (substring category 0 (1- org-prefix-category-max-length)))))
6556     ;; Evaluate the compiled format
6557     (setq rtn (concat (eval formatter) txt))
6558
6559     ;; And finally add the text properties
6560     (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
6561     (org-add-props rtn nil
6562       'org-category category
6563       'tags (mapcar 'org-downcase-keep-props tags)
6564       'org-highest-priority org-highest-priority
6565       'org-lowest-priority org-lowest-priority
6566       'time-of-day time-of-day
6567       'duration duration
6568       'breadcrumbs breadcrumbs
6569       'txt txt
6570       'level level
6571       'time time
6572       'extra extra
6573       'format org-prefix-format-compiled
6574       'dotime dotime)))))
6575
6576 (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
6577   "Remove tags string from TXT, and add a modified list of tags.
6578 The modified list may contain inherited tags, and tags matched by
6579 `org-agenda-hide-tags-regexp' will be removed."
6580   (when (or add-inherited hide-re)
6581     (if (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
6582     (setq txt (substring txt 0 (match-beginning 0))))
6583     (setq tags
6584       (delq nil
6585         (mapcar (lambda (tg)
6586               (if (or (and hide-re (string-match hide-re tg))
6587                   (and (not add-inherited)
6588                        (get-text-property 0 'inherited tg)))
6589                   nil
6590                 tg))
6591             tags)))
6592     (when tags
6593       (let ((have-i (get-text-property 0 'inherited (car tags)))
6594         i)
6595     (setq txt (concat txt " :"
6596               (mapconcat
6597                (lambda (x)
6598                  (setq i (get-text-property 0 'inherited x))
6599                  (if (and have-i (not i))
6600                  (progn
6601                    (setq have-i nil)
6602                    (concat ":" x))
6603                    x))
6604                tags ":")
6605               (if have-i "::" ":"))))))
6606   txt)
6607
6608 (defun org-downcase-keep-props (s)
6609   (let ((props (text-properties-at 0 s)))
6610     (setq s (downcase s))
6611     (add-text-properties 0 (length s) props s)
6612     s))
6613
6614 (defvar org-agenda-sorting-strategy) ;; because the def is in a let form
6615
6616 (defun org-agenda-add-time-grid-maybe (list ndays todayp)
6617   "Add a time-grid for agenda items which need it.
6618
6619 LIST is the list of agenda items formatted by `org-agenda-list'.
6620 NDAYS is the span of the current agenda view.
6621 TODAYP is t when the current agenda view is on today."
6622   (catch 'exit
6623     (cond ((not org-agenda-use-time-grid) (throw 'exit list))
6624       ((and todayp (member 'today (car org-agenda-time-grid))))
6625       ((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
6626       ((member 'weekly (car org-agenda-time-grid)))
6627       (t (throw 'exit list)))
6628     (let* ((have (delq nil (mapcar
6629                 (lambda (x) (get-text-property 1 'time-of-day x))
6630                 list)))
6631        (string (nth 3 org-agenda-time-grid))
6632        (gridtimes (nth 1 org-agenda-time-grid))
6633        (req (car org-agenda-time-grid))
6634        (remove (member 'remove-match req))
6635        new time)
6636       (if (and (member 'require-timed req) (not have))
6637       ;; don't show empty grid
6638       (throw 'exit list))
6639       (while (setq time (pop gridtimes))
6640     (unless (and remove (member time have))
6641       (setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
6642       (push (org-agenda-format-item
6643          nil string nil "" nil
6644          (concat (substring time 0 -2) ":" (substring time -2)))
6645         new)
6646       (put-text-property
6647        2 (length (car new)) 'face 'org-time-grid (car new))))
6648       (when (and todayp org-agenda-show-current-time-in-grid)
6649     (push (org-agenda-format-item
6650            nil org-agenda-current-time-string nil "" nil
6651            (format-time-string "%H:%M "))
6652           new)
6653     (put-text-property
6654      2 (length (car new)) 'face 'org-agenda-current-time (car new)))
6655
6656       (if (member 'time-up org-agenda-sorting-strategy-selected)
6657       (append new list)
6658     (append list new)))))
6659
6660 (defun org-compile-prefix-format (key)
6661   "Compile the prefix format into a Lisp form that can be evaluated.
6662 The resulting form and associated variable bindings is returned
6663 and stored in the variable `org-prefix-format-compiled'."
6664   (setq org-prefix-has-time nil
6665     org-prefix-has-tag nil
6666     org-prefix-category-length nil
6667     org-prefix-has-effort nil
6668     org-prefix-has-breadcrumbs nil)
6669   (let ((s (cond
6670         ((stringp org-agenda-prefix-format)
6671          org-agenda-prefix-format)
6672         ((assq key org-agenda-prefix-format)
6673          (cdr (assq key org-agenda-prefix-format)))
6674         (t "  %-12:c%?-12t% s")))
6675     (start 0)
6676     varform vars var e c f opt)
6677     (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)"
6678              s start)
6679       (setq var (or (cdr (assoc (match-string 4 s)
6680                 '(("c" . category) ("t" . time) ("l" . level) ("s" . extra)
6681                   ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs))))
6682             'eval)
6683         c (or (match-string 3 s) "")
6684         opt (match-beginning 1)
6685         start (1+ (match-beginning 0)))
6686       (if (eq var 'time) (setq org-prefix-has-time t))
6687       (if (eq var 'tag)  (setq org-prefix-has-tag  t))
6688       (if (eq var 'effort) (setq org-prefix-has-effort t))
6689       (if (eq var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t))
6690       (setq f (concat "%" (match-string 2 s) "s"))
6691       (when (eq var 'category)
6692     (setq org-prefix-category-length
6693           (floor (abs (string-to-number (match-string 2 s)))))
6694     (setq org-prefix-category-max-length
6695           (let ((x (match-string 2 s)))
6696         (save-match-data
6697           (if (string-match "\\.[0-9]+" x)
6698               (string-to-number (substring (match-string 0 x) 1)))))))
6699       (if (eq var 'eval)
6700       (setq varform `(format ,f (org-eval ,(read (match-string 4 s)))))
6701     (if opt
6702         (setq varform
6703           `(if (or (equal "" ,var) (equal nil ,var))
6704                ""
6705              (format ,f (concat ,var ,c))))
6706       (setq varform
6707         `(format ,f (if (or (equal ,var "")
6708                     (equal ,var nil)) ""
6709                   (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
6710       (setq s (replace-match "%s" t nil s))
6711       (push varform vars))
6712     (setq vars (nreverse vars))
6713     (with-current-buffer (or org-agenda-buffer (current-buffer))
6714       (setq org-prefix-format-compiled
6715         (list
6716          `((org-prefix-has-time ,org-prefix-has-time)
6717            (org-prefix-has-tag ,org-prefix-has-tag)
6718            (org-prefix-category-length ,org-prefix-category-length)
6719            (org-prefix-has-effort ,org-prefix-has-effort)
6720            (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs))
6721          `(format ,s ,@vars))))))
6722
6723 (defun org-set-sorting-strategy (key)
6724   (if (symbolp (car org-agenda-sorting-strategy))
6725       ;; the old format
6726       (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy)
6727     (setq org-agenda-sorting-strategy-selected
6728       (or (cdr (assq key org-agenda-sorting-strategy))
6729           (cdr (assq 'agenda org-agenda-sorting-strategy))
6730           '(time-up category-keep priority-down)))))
6731
6732 (defun org-get-time-of-day (s &optional string mod24)
6733   "Check string S for a time of day.
6734 If found, return it as a military time number between 0 and 2400.
6735 If not found, return nil.
6736 The optional STRING argument forces conversion into a 5 character wide string
6737 HH:MM."
6738   (save-match-data
6739     (when
6740     (and
6741      (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
6742          (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
6743      (not (eq (get-text-property 1 'face s) 'org-link)))
6744       (let* ((h (string-to-number (match-string 1 s)))
6745          (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
6746          (ampm (if (match-end 4) (downcase (match-string 4 s))))
6747          (am-p (equal ampm "am"))
6748          (h1   (cond ((not ampm) h)
6749              ((= h 12) (if am-p 0 12))
6750              (t (+ h (if am-p 0 12)))))
6751          (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
6752              (mod h1 24) h1))
6753          (t0 (+ (* 100 h2) m))
6754          (t1 (concat (if (>= h1 24) "+" " ")
6755              (if (and org-agenda-time-leading-zero
6756                   (< t0 1000)) "0" "")
6757              (if (< t0 100) "0" "")
6758              (if (< t0 10)  "0" "")
6759              (int-to-string t0))))
6760     (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
6761
6762 (defvar org-agenda-before-sorting-filter-function nil
6763   "Function to be applied to agenda items prior to sorting.
6764 Prior to sorting also means just before they are inserted into the agenda.
6765
6766 To aid sorting, you may revisit the original entries and add more text
6767 properties which will later be used by the sorting functions.
6768
6769 The function should take a string argument, an agenda line.
6770 It has access to the text properties in that line, which contain among
6771 other things, the property `org-hd-marker' that points to the entry
6772 where the line comes from.  Note that not all lines going into the agenda
6773 have this property, only most.
6774
6775 The function should return the modified string.  It is probably best
6776 to ONLY change text properties.
6777
6778 You can also use this function as a filter, by returning nil for lines
6779 you don't want to have in the agenda at all.  For this application, you
6780 could bind the variable in the options section of a custom command.")
6781
6782 (defun org-agenda-finalize-entries (list &optional type)
6783   "Sort, limit and concatenate the LIST of agenda items.
6784 The optional argument TYPE tells the agenda type."
6785   (let ((max-effort (cond ((listp org-agenda-max-effort)
6786                (cdr (assoc type org-agenda-max-effort)))
6787               (t org-agenda-max-effort)))
6788     (max-todo (cond ((listp org-agenda-max-todos)
6789              (cdr (assoc type org-agenda-max-todos)))
6790             (t org-agenda-max-todos)))
6791     (max-tags (cond ((listp org-agenda-max-tags)
6792              (cdr (assoc type org-agenda-max-tags)))
6793             (t org-agenda-max-tags)))
6794     (max-entries (cond ((listp org-agenda-max-entries)
6795                 (cdr (assoc type org-agenda-max-entries)))
6796                (t org-agenda-max-entries))))
6797     (when org-agenda-before-sorting-filter-function
6798       (setq list
6799         (delq nil
6800           (mapcar
6801            org-agenda-before-sorting-filter-function list))))
6802     (setq list (mapcar 'org-agenda-highlight-todo list)
6803       list (mapcar 'identity (sort list 'org-entries-lessp)))
6804     (when max-effort
6805       (setq list (org-agenda-limit-entries
6806           list 'effort-minutes max-effort
6807           (lambda (e) (or e (if org-sort-agenda-noeffort-is-high
6808                     32767 -1))))))
6809     (when max-todo
6810       (setq list (org-agenda-limit-entries list 'todo-state max-todo)))
6811     (when max-tags
6812       (setq list (org-agenda-limit-entries list 'tags max-tags)))
6813     (when max-entries
6814       (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
6815     (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
6816       (setq list (mapcar #'org-agenda--mark-blocked-entry list)))
6817     (mapconcat 'identity list "\n")))
6818
6819 (defun org-agenda-limit-entries (list prop limit &optional fn)
6820   "Limit the number of agenda entries."
6821   (let ((include (and limit (< limit 0))))
6822     (if limit
6823     (let ((fun (or fn (lambda (p) (if p 1))))
6824           (lim 0))
6825       (delq nil
6826         (mapcar
6827          (lambda (e)
6828            (let ((pval (funcall
6829                 fun (get-text-property (1- (length e))
6830                                prop e))))
6831              (if pval (setq lim (+ lim pval)))
6832              (cond ((and pval (<= lim (abs limit))) e)
6833                ((and include (not pval)) e))))
6834          list)))
6835       list)))
6836
6837 (defun org-agenda-limit-interactively (remove)
6838   "In agenda, interactively limit entries to various maximums."
6839   (interactive "P")
6840   (if remove
6841       (progn (setq org-agenda-max-entries nil
6842            org-agenda-max-todos nil
6843            org-agenda-max-tags nil
6844            org-agenda-max-effort nil)
6845          (org-agenda-redo))
6846     (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
6847        (msg (cond ((= max ?E) "How many minutes? ")
6848               ((= max ?e) "How many entries? ")
6849               ((= max ?t) "How many TODO entries? ")
6850               ((= max ?T) "How many tagged entries? ")
6851               (t (user-error "Wrong input"))))
6852        (num (string-to-number (read-from-minibuffer msg))))
6853       (cond ((equal max ?e)
6854          (let ((org-agenda-max-entries num)) (org-agenda-redo)))
6855         ((equal max ?t)
6856          (let ((org-agenda-max-todos num)) (org-agenda-redo)))
6857         ((equal max ?T)
6858          (let ((org-agenda-max-tags num)) (org-agenda-redo)))
6859         ((equal max ?E)
6860          (let ((org-agenda-max-effort num)) (org-agenda-redo))))))
6861   (org-agenda-fit-window-to-buffer))
6862
6863 (defun org-agenda-highlight-todo (x)
6864   (let ((org-done-keywords org-done-keywords-for-agenda)
6865     (case-fold-search nil)
6866     re)
6867     (if (eq x 'line)
6868     (save-excursion
6869       (beginning-of-line 1)
6870       (setq re (org-get-at-bol 'org-todo-regexp))
6871       (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point)))
6872       (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
6873         (add-text-properties (match-beginning 0) (match-end 1)
6874                  (list 'face (org-get-todo-face 1)))
6875         (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
6876           (delete-region (match-beginning 1) (1- (match-end 0)))
6877           (goto-char (match-beginning 1))
6878           (insert (format org-agenda-todo-keyword-format s)))))
6879       (let ((pl (text-property-any 0 (length x) 'org-heading t x)))
6880     (setq re (get-text-property 0 'org-todo-regexp x))
6881     (when (and re
6882            ;; Test `pl' because if there's no heading content,
6883            ;; there's no point matching to highlight.  Note
6884            ;; that if we didn't test `pl' first, and there
6885            ;; happened to be no keyword from `org-todo-regexp'
6886            ;; on this heading line, then the `equal' comparison
6887            ;; afterwards would spuriously succeed in the case
6888            ;; where `pl' is nil -- causing an args-out-of-range
6889            ;; error when we try to add text properties to text
6890            ;; that isn't there.
6891            pl
6892            (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
6893                     x pl) pl))
6894       (add-text-properties
6895        (or (match-end 1) (match-end 0)) (match-end 0)
6896        (list 'face (org-get-todo-face (match-string 2 x)))
6897        x)
6898       (when (match-end 1)
6899         (setq x
6900           (concat
6901            (substring x 0 (match-end 1))
6902            (format org-agenda-todo-keyword-format
6903                (match-string 2 x))
6904            ;; Remove `display' property as the icon could leak
6905            ;; on the white space.
6906            (org-add-props " " (org-plist-delete (text-properties-at 0 x)
6907                             'display))
6908            (substring x (match-end 3)))))))
6909       x)))
6910
6911 (defsubst org-cmp-values (a b property)
6912   "Compare the numeric value of text PROPERTY for string A and B."
6913   (let ((pa (or (get-text-property (1- (length a)) property a) 0))
6914     (pb (or (get-text-property (1- (length b)) property b) 0)))
6915     (cond ((> pa pb) +1)
6916       ((< pa pb) -1))))
6917
6918 (defsubst org-cmp-effort (a b)
6919   "Compare the effort values of string A and B."
6920   (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
6921      ;; `effort-minutes' property is not directly accessible from
6922      ;; the strings, but is stored as a property in `txt'.
6923      (ea (or (get-text-property
6924           0 'effort-minutes (get-text-property 0 'txt a))
6925          def))
6926      (eb (or (get-text-property
6927           0 'effort-minutes (get-text-property 0 'txt b))
6928          def)))
6929     (cond ((> ea eb) +1)
6930       ((< ea eb) -1))))
6931
6932 (defsubst org-cmp-category (a b)
6933   "Compare the string values of categories of strings A and B."
6934   (let ((ca (or (get-text-property (1- (length a)) 'org-category a) ""))
6935     (cb (or (get-text-property (1- (length b)) 'org-category b) "")))
6936     (cond ((string-lessp ca cb) -1)
6937       ((string-lessp cb ca) +1))))
6938
6939 (defsubst org-cmp-todo-state (a b)
6940   "Compare the todo states of strings A and B."
6941   (let* ((ma (or (get-text-property 1 'org-marker a)
6942          (get-text-property 1 'org-hd-marker a)))
6943      (mb (or (get-text-property 1 'org-marker b)
6944          (get-text-property 1 'org-hd-marker b)))
6945      (fa (and ma (marker-buffer ma)))
6946      (fb (and mb (marker-buffer mb)))
6947      (todo-kwds
6948       (or (and fa (with-current-buffer fa org-todo-keywords-1))
6949           (and fb (with-current-buffer fb org-todo-keywords-1))))
6950      (ta (or (get-text-property 1 'todo-state a) ""))
6951      (tb (or (get-text-property 1 'todo-state b) ""))
6952      (la (- (length (member ta todo-kwds))))
6953      (lb (- (length (member tb todo-kwds))))
6954      (donepa (member ta org-done-keywords-for-agenda))
6955      (donepb (member tb org-done-keywords-for-agenda)))
6956     (cond ((and donepa (not donepb)) -1)
6957       ((and (not donepa) donepb) +1)
6958       ((< la lb) -1)
6959       ((< lb la) +1))))
6960
6961 (defsubst org-cmp-alpha (a b)
6962   "Compare the headlines, alphabetically."
6963   (let* ((pla (text-property-any 0 (length a) 'org-heading t a))
6964      (plb (text-property-any 0 (length b) 'org-heading t b))
6965      (ta (and pla (substring a pla)))
6966      (tb (and plb (substring b plb)))
6967      (case-fold-search nil))
6968     (when pla
6969       (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
6970                 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta)
6971       (setq ta (substring ta (match-end 0))))
6972       (setq ta (downcase ta)))
6973     (when plb
6974       (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "")
6975                 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb)
6976       (setq tb (substring tb (match-end 0))))
6977       (setq tb (downcase tb)))
6978     (cond ((not ta) +1)
6979       ((not tb) -1)
6980       ((string-lessp ta tb) -1)
6981       ((string-lessp tb ta) +1))))
6982
6983 (defsubst org-cmp-tag (a b)
6984   "Compare the string values of the first tags of A and B."
6985   (let ((ta (car (last (get-text-property 1 'tags a))))
6986     (tb (car (last (get-text-property 1 'tags b)))))
6987     (cond ((not ta) +1)
6988       ((not tb) -1)
6989       ((string-lessp ta tb) -1)
6990       ((string-lessp tb ta) +1))))
6991
6992 (defsubst org-cmp-time (a b)
6993   "Compare the time-of-day values of strings A and B."
6994   (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
6995      (ta (or (get-text-property 1 'time-of-day a) def))
6996      (tb (or (get-text-property 1 'time-of-day b) def)))
6997     (cond ((< ta tb) -1)
6998       ((< tb ta) +1))))
6999
7000 (defsubst org-cmp-ts (a b type)
7001   "Compare the timestamps values of entries A and B.
7002 When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
7003 \"timestamp_ia\", compare within each of these type.  When TYPE
7004 is the empty string, compare all timestamps without respect of
7005 their type."
7006   (let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1))
7007      (ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
7008               (get-text-property 1 'ts-date a))
7009          def))
7010      (tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
7011               (get-text-property 1 'ts-date b))
7012          def)))
7013     (cond ((< ta tb) -1)
7014       ((< tb ta) +1))))
7015
7016 (defsubst org-cmp-habit-p (a b)
7017   "Compare the todo states of strings A and B."
7018   (let ((ha (get-text-property 1 'org-habit-p a))
7019     (hb (get-text-property 1 'org-habit-p b)))
7020     (cond ((and ha (not hb)) -1)
7021       ((and (not ha) hb) +1))))
7022
7023 (defun org-entries-lessp (a b)
7024   "Predicate for sorting agenda entries."
7025   ;; The following variables will be used when the form is evaluated.
7026   ;; So even though the compiler complains, keep them.
7027   (let* ((ss org-agenda-sorting-strategy-selected)
7028      (timestamp-up    (and (org-em 'timestamp-up 'timestamp-down ss)
7029                    (org-cmp-ts a b "")))
7030      (timestamp-down  (if timestamp-up (- timestamp-up) nil))
7031      (scheduled-up    (and (org-em 'scheduled-up 'scheduled-down ss)
7032                    (org-cmp-ts a b "scheduled")))
7033      (scheduled-down  (if scheduled-up (- scheduled-up) nil))
7034      (deadline-up     (and (org-em 'deadline-up 'deadline-down ss)
7035                    (org-cmp-ts a b "deadline")))
7036      (deadline-down   (if deadline-up (- deadline-up) nil))
7037      (tsia-up         (and (org-em 'tsia-up 'tsia-down ss)
7038                    (org-cmp-ts a b "timestamp_ia")))
7039      (tsia-down       (if tsia-up (- tsia-up) nil))
7040      (ts-up           (and (org-em 'ts-up 'ts-down ss)
7041                    (org-cmp-ts a b "timestamp")))
7042      (ts-down         (if ts-up (- ts-up) nil))
7043      (time-up         (and (org-em 'time-up 'time-down ss)
7044                    (org-cmp-time a b)))
7045      (time-down       (if time-up (- time-up) nil))
7046      (stats-up        (and (org-em 'stats-up 'stats-down ss)
7047                    (org-cmp-values a b 'org-stats)))
7048      (stats-down      (if stats-up (- stats-up) nil))
7049      (priority-up     (and (org-em 'priority-up 'priority-down ss)
7050                    (org-cmp-values a b 'priority)))
7051      (priority-down   (if priority-up (- priority-up) nil))
7052      (effort-up       (and (org-em 'effort-up 'effort-down ss)
7053                    (org-cmp-effort a b)))
7054      (effort-down     (if effort-up (- effort-up) nil))
7055      (category-up     (and (or (org-em 'category-up 'category-down ss)
7056                    (memq 'category-keep ss))
7057                    (org-cmp-category a b)))
7058      (category-down   (if category-up (- category-up) nil))
7059      (category-keep   (if category-up +1 nil))
7060      (tag-up          (and (org-em 'tag-up 'tag-down ss)
7061                    (org-cmp-tag a b)))
7062      (tag-down        (if tag-up (- tag-up) nil))
7063      (todo-state-up   (and (org-em 'todo-state-up 'todo-state-down ss)
7064                    (org-cmp-todo-state a b)))
7065      (todo-state-down (if todo-state-up (- todo-state-up) nil))
7066      (habit-up        (and (org-em 'habit-up 'habit-down ss)
7067                    (org-cmp-habit-p a b)))
7068      (habit-down      (if habit-up (- habit-up) nil))
7069      (alpha-up        (and (org-em 'alpha-up 'alpha-down ss)
7070                    (org-cmp-alpha a b)))
7071      (alpha-down      (if alpha-up (- alpha-up) nil))
7072      (need-user-cmp   (org-em 'user-defined-up 'user-defined-down ss))
7073      user-defined-up user-defined-down)
7074     (if (and need-user-cmp org-agenda-cmp-user-defined
7075          (functionp org-agenda-cmp-user-defined))
7076     (setq user-defined-up
7077           (funcall org-agenda-cmp-user-defined a b)
7078           user-defined-down (if user-defined-up (- user-defined-up) nil)))
7079     (cdr (assoc
7080       (eval (cons 'or org-agenda-sorting-strategy-selected))
7081       '((-1 . t) (1 . nil) (nil . nil))))))
7082
7083 ;;; Agenda restriction lock
7084
7085 (defvar org-agenda-restriction-lock-overlay (make-overlay 1 1)
7086   "Overlay to mark the headline to which agenda commands are restricted.")
7087 (overlay-put org-agenda-restriction-lock-overlay
7088          'face 'org-agenda-restriction-lock)
7089 (overlay-put org-agenda-restriction-lock-overlay
7090          'help-echo "Agendas are currently limited to this subtree.")
7091 (delete-overlay org-agenda-restriction-lock-overlay)
7092
7093 (defun org-agenda-set-restriction-lock-from-agenda (arg)
7094   "Set the restriction lock to the agenda item at point from within the agenda.
7095 When called with a `\\[universal-argument]' prefix, restrict to
7096 the file which contains the item.
7097 Argument ARG is the prefix argument."
7098   (interactive "P")
7099   (unless  (derived-mode-p 'org-agenda-mode)
7100     (user-error "Not in an Org agenda buffer"))
7101   (let* ((marker (or (org-get-at-bol 'org-marker)
7102                      (org-agenda-error)))
7103          (buffer (marker-buffer marker))
7104          (pos (marker-position marker)))
7105     (with-current-buffer buffer
7106       (goto-char pos)
7107       (org-agenda-set-restriction-lock arg))))
7108
7109 ;;;###autoload
7110 (defun org-agenda-set-restriction-lock (&optional type)
7111   "Set restriction lock for agenda, to current subtree or file.
7112 Restriction will be the file if TYPE is `file', or if type is the
7113 universal prefix \\='(4), or if the cursor is before the first headline
7114 in the file.  Otherwise, restriction will be to the current subtree."
7115   (interactive "P")
7116   (org-agenda-remove-restriction-lock 'noupdate)
7117   (and (equal type '(4)) (setq type 'file))
7118   (setq type (cond
7119           (type type)
7120           ((org-at-heading-p) 'subtree)
7121           ((condition-case nil (org-back-to-heading t) (error nil))
7122            'subtree)
7123           (t 'file)))
7124   (if (eq type 'subtree)
7125       (progn
7126     (setq org-agenda-restrict (current-buffer))
7127     (setq org-agenda-overriding-restriction 'subtree)
7128     (put 'org-agenda-files 'org-restrict
7129          (list (buffer-file-name (buffer-base-buffer))))
7130     (org-back-to-heading t)
7131     (move-overlay org-agenda-restriction-lock-overlay
7132               (point)
7133               (if org-agenda-restriction-lock-highlight-subtree
7134               (save-excursion (org-end-of-subtree t t) (point))
7135             (point-at-eol)))
7136     (move-marker org-agenda-restrict-begin (point))
7137     (move-marker org-agenda-restrict-end
7138              (save-excursion (org-end-of-subtree t t)))
7139     (message "Locking agenda restriction to subtree"))
7140     (put 'org-agenda-files 'org-restrict
7141      (list (buffer-file-name (buffer-base-buffer))))
7142     (setq org-agenda-restrict nil)
7143     (setq org-agenda-overriding-restriction 'file)
7144     (move-marker org-agenda-restrict-begin nil)
7145     (move-marker org-agenda-restrict-end nil)
7146     (message "Locking agenda restriction to file"))
7147   (setq current-prefix-arg nil)
7148   (org-agenda-maybe-redo))
7149
7150 (defun org-agenda-remove-restriction-lock (&optional noupdate)
7151   "Remove the agenda restriction lock."
7152   (interactive "P")
7153   (delete-overlay org-agenda-restriction-lock-overlay)
7154   (delete-overlay org-speedbar-restriction-lock-overlay)
7155   (setq org-agenda-overriding-restriction nil)
7156   (setq org-agenda-restrict nil)
7157   (put 'org-agenda-files 'org-restrict nil)
7158   (move-marker org-agenda-restrict-begin nil)
7159   (move-marker org-agenda-restrict-end nil)
7160   (setq current-prefix-arg nil)
7161   (message "Agenda restriction lock removed")
7162   (or noupdate (org-agenda-maybe-redo)))
7163
7164 (defun org-agenda-maybe-redo ()
7165   "If there is any window showing the agenda view, update it."
7166   (let ((w (get-buffer-window (or org-agenda-this-buffer-name
7167                   org-agenda-buffer-name)
7168                   t))
7169     (w0 (selected-window)))
7170     (when w
7171       (select-window w)
7172       (org-agenda-redo)
7173       (select-window w0)
7174       (if org-agenda-overriding-restriction
7175       (message "Agenda view shifted to new %s restriction"
7176            org-agenda-overriding-restriction)
7177     (message "Agenda restriction lock removed")))))
7178
7179 ;;; Agenda commands
7180
7181 (defun org-agenda-check-type (error &rest types)
7182   "Check if agenda buffer is of allowed type.
7183 If ERROR is non-nil, throw an error, otherwise just return nil.
7184 Allowed types are `agenda' `todo' `tags' `search'."
7185   (cond ((not org-agenda-type)
7186      (error "No Org agenda currently displayed"))
7187     ((memq org-agenda-type types) t)
7188     (error
7189      (error "Not allowed in %s-type agenda buffers" org-agenda-type))
7190     (t nil)))
7191
7192 (defun org-agenda-Quit ()
7193   "Exit the agenda, killing the agenda buffer.
7194 Like `org-agenda-quit', but kill the buffer even when
7195 `org-agenda-sticky' is non-nil."
7196   (interactive)
7197   (org-agenda--quit))
7198
7199 (defun org-agenda-quit ()
7200   "Exit the agenda.
7201
7202 When `org-agenda-sticky' is non-nil, bury the agenda buffer
7203 instead of killing it.
7204
7205 When `org-agenda-restore-windows-after-quit' is non-nil, restore
7206 the pre-agenda window configuration.
7207
7208 When column view is active, exit column view instead of the
7209 agenda."
7210   (interactive)
7211   (org-agenda--quit org-agenda-sticky))
7212
7213 (defun org-agenda--quit (&optional bury)
7214   (if org-agenda-columns-active
7215       (org-columns-quit)
7216     (let ((wconf org-agenda-pre-window-conf)
7217       (buf (current-buffer))
7218       (org-agenda-last-indirect-window
7219        (and (eq org-indirect-buffer-display 'other-window)
7220         org-agenda-last-indirect-buffer
7221         (get-buffer-window org-agenda-last-indirect-buffer))))
7222       (cond
7223        ((eq org-agenda-window-setup 'other-frame)
7224     (delete-frame))
7225        ((and org-agenda-restore-windows-after-quit
7226          wconf)
7227     ;; Maybe restore the pre-agenda window configuration.  Reset
7228     ;; `org-agenda-pre-window-conf' before running
7229     ;; `set-window-configuration', which loses the current buffer.
7230     (setq org-agenda-pre-window-conf nil)
7231     (set-window-configuration wconf))
7232        (t
7233     (when org-agenda-last-indirect-window
7234       (delete-window org-agenda-last-indirect-window))
7235     (and (not (eq org-agenda-window-setup 'current-window))
7236          (not (one-window-p))
7237          (delete-window))))
7238       (if bury
7239       ;; Set the agenda buffer as the current buffer instead of
7240       ;; passing it as an argument to `bury-buffer' so that
7241       ;; `bury-buffer' removes it from the window.
7242       (with-current-buffer buf
7243         (bury-buffer))
7244     (kill-buffer buf)
7245     (setq org-agenda-archives-mode nil
7246           org-agenda-buffer nil)))))
7247
7248 (defun org-agenda-exit ()
7249   "Exit the agenda, killing Org buffers loaded by the agenda.
7250 Like `org-agenda-Quit', but kill any buffers that were created by
7251 the agenda.  Org buffers visited directly by the user will not be
7252 touched.  Also, exit the agenda even if it is in column view."
7253   (interactive)
7254   (when org-agenda-columns-active
7255     (org-columns-quit))
7256   (org-release-buffers org-agenda-new-buffers)
7257   (setq org-agenda-new-buffers nil)
7258   (org-agenda-Quit))
7259
7260 (defun org-agenda-kill-all-agenda-buffers ()
7261   "Kill all buffers in `org-agenda-mode'.
7262 This is used when toggling sticky agendas."
7263   (interactive)
7264   (let (blist)
7265     (dolist (buf (buffer-list))
7266       (when (with-current-buffer buf (eq major-mode 'org-agenda-mode))
7267     (push buf blist)))
7268     (mapc 'kill-buffer blist)))
7269
7270 (defun org-agenda-execute (arg)
7271   "Execute another agenda command, keeping same window.
7272 So this is just a shortcut for \\<global-map>`\\[org-agenda]', available
7273 in the agenda."
7274   (interactive "P")
7275   (let ((org-agenda-window-setup 'current-window))
7276     (org-agenda arg)))
7277
7278 (defun org-agenda-redo (&optional all)
7279   "Rebuild possibly ALL agenda view(s) in the current buffer."
7280   (interactive "P")
7281   (let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
7282      (cpa (unless (eq all t) current-prefix-arg))
7283      (org-agenda-doing-sticky-redo org-agenda-sticky)
7284      (org-agenda-sticky nil)
7285      (org-agenda-buffer-name (or org-agenda-this-buffer-name
7286                      org-agenda-buffer-name))
7287      (org-agenda-keep-modes t)
7288      (tag-filter org-agenda-tag-filter)
7289      (tag-preset (get 'org-agenda-tag-filter :preset-filter))
7290      (top-hl-filter org-agenda-top-headline-filter)
7291      (cat-filter org-agenda-category-filter)
7292      (cat-preset (get 'org-agenda-category-filter :preset-filter))
7293      (re-filter org-agenda-regexp-filter)
7294      (re-preset (get 'org-agenda-regexp-filter :preset-filter))
7295      (effort-filter org-agenda-effort-filter)
7296      (effort-preset (get 'org-agenda-effort-filter :preset-filter))
7297      (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
7298      (cols org-agenda-columns-active)
7299      (line (org-current-line))
7300      (window-line (- line (org-current-line (window-start))))
7301      (lprops (get 'org-agenda-redo-command 'org-lprops))
7302      (redo-cmd (get-text-property p 'org-redo-cmd))
7303      (last-args (get-text-property p 'org-last-args))
7304      (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd))
7305      (org-agenda-overriding-cmd-arguments
7306       (unless (eq all t)
7307         (cond ((listp last-args)
7308            (cons (or cpa (car last-args)) (cdr last-args)))
7309           ((stringp last-args)
7310            last-args))))
7311      (series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
7312     (put 'org-agenda-tag-filter :preset-filter nil)
7313     (put 'org-agenda-category-filter :preset-filter nil)
7314     (put 'org-agenda-regexp-filter :preset-filter nil)
7315     (put 'org-agenda-effort-filter :preset-filter nil)
7316     (and cols (org-columns-quit))
7317     (message "Rebuilding agenda buffer...")
7318     (if series-redo-cmd
7319     (eval series-redo-cmd)
7320       (org-let lprops redo-cmd))
7321     (setq org-agenda-undo-list nil
7322       org-agenda-pending-undo-list nil
7323       org-agenda-tag-filter tag-filter
7324       org-agenda-category-filter cat-filter
7325       org-agenda-regexp-filter re-filter
7326       org-agenda-effort-filter effort-filter
7327       org-agenda-top-headline-filter top-hl-filter)
7328     (message "Rebuilding agenda buffer...done")
7329     (put 'org-agenda-tag-filter :preset-filter tag-preset)
7330     (put 'org-agenda-category-filter :preset-filter cat-preset)
7331     (put 'org-agenda-regexp-filter :preset-filter re-preset)
7332     (put 'org-agenda-effort-filter :preset-filter effort-preset)
7333     (let ((tag (or tag-filter tag-preset))
7334       (cat (or cat-filter cat-preset))
7335       (effort (or effort-filter effort-preset))
7336       (re (or re-filter re-preset)))
7337       (when tag (org-agenda-filter-apply tag 'tag t))
7338       (when cat (org-agenda-filter-apply cat 'category))
7339       (when effort (org-agenda-filter-apply effort 'effort))
7340       (when re  (org-agenda-filter-apply re 'regexp)))
7341     (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
7342     (and cols (called-interactively-p 'any) (org-agenda-columns))
7343     (org-goto-line line)
7344     (recenter window-line)))
7345
7346 (defun org-agenda-redo-all (&optional exhaustive)
7347   "Rebuild all agenda views in the current buffer.
7348 With a prefix argument, do so in all agenda buffers."
7349   (interactive "P")
7350   (if exhaustive
7351       (dolist (buffer (buffer-list))
7352         (with-current-buffer buffer
7353           (when (derived-mode-p 'org-agenda-mode)
7354             (org-agenda-redo t))))
7355     (org-agenda-redo t)))
7356
7357 (defvar org-global-tags-completion-table nil)
7358 (defvar org-agenda-filter-form nil)
7359 (defvar org-agenda-filtered-by-category nil)
7360
7361 (defun org-agenda-filter-by-category (strip)
7362   "Filter lines in the agenda buffer that have a specific category.
7363 The category is that of the current line.
7364 Without prefix argument, keep only the lines of that category.
7365 With a prefix argument, exclude the lines of that category.
7366 "
7367   (interactive "P")
7368   (if (and org-agenda-filtered-by-category
7369        org-agenda-category-filter)
7370       (org-agenda-filter-show-all-cat)
7371     (let ((cat (org-no-properties (org-get-at-eol 'org-category 1))))
7372       (cond
7373        ((and cat strip)
7374         (org-agenda-filter-apply
7375          (push (concat "-" cat) org-agenda-category-filter) 'category))
7376        (cat
7377         (org-agenda-filter-apply
7378          (setq org-agenda-category-filter
7379            (list (concat "+" cat))) 'category))
7380        (t (error "No category at point"))))))
7381
7382 (defun org-find-top-headline (&optional pos)
7383   "Find the topmost parent headline and return it.
7384 POS when non-nil is the marker or buffer position to start the
7385 search from."
7386   (save-excursion
7387     (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
7388       (when pos (goto-char pos))
7389       ;; Skip up to the topmost parent.
7390       (while (org-up-heading-safe))
7391       (ignore-errors (nth 4 (org-heading-components))))))
7392
7393 (defvar org-agenda-filtered-by-top-headline nil)
7394 (defun org-agenda-filter-by-top-headline (strip)
7395   "Keep only those lines that are descendants from the same top headline.
7396 The top headline is that of the current line."
7397   (interactive "P")
7398   (if org-agenda-filtered-by-top-headline
7399       (progn
7400         (setq org-agenda-filtered-by-top-headline nil
7401           org-agenda-top-headline-filter nil)
7402         (org-agenda-filter-show-all-top-filter))
7403     (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
7404       (if toph (org-agenda-filter-top-headline-apply toph strip)
7405         (error "No top-level headline at point")))))
7406
7407 (defvar org-agenda-regexp-filter nil)
7408 (defun org-agenda-filter-by-regexp (strip)
7409   "Filter agenda entries by a regular expression.
7410 Regexp filters are cumulative.
7411 With no prefix argument, keep entries matching the regexp.
7412 With one prefix argument, filter out entries matching the regexp.
7413 With two prefix arguments, remove the regexp filters."
7414   (interactive "P")
7415   (if (not (equal strip '(16)))
7416       (let ((flt (concat (if (equal strip '(4)) "-" "+")
7417              (read-from-minibuffer
7418               (if (equal strip '(4))
7419                   "Filter out entries matching regexp: "
7420                 "Narrow to entries matching regexp: ")))))
7421     (push flt org-agenda-regexp-filter)
7422     (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
7423     (org-agenda-filter-show-all-re)
7424     (message "Regexp filter removed")))
7425
7426 (defvar org-agenda-effort-filter nil)
7427 (defun org-agenda-filter-by-effort (strip)
7428   "Filter agenda entries by effort.
7429 With no prefix argument, keep entries matching the effort condition.
7430 With one prefix argument, filter out entries matching the condition.
7431 With two prefix arguments, remove the effort filters."
7432   (interactive "P")
7433   (cond
7434    ((member strip '(nil 4))
7435     (let* ((efforts (split-string
7436              (or (cdr (assoc (concat org-effort-property "_ALL")
7437                      org-global-properties))
7438              "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")))
7439        ;; XXX: the following handles only up to 10 different
7440        ;; effort values.
7441        (allowed-keys (if (null efforts) nil
7442                (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0
7443                    (number-sequence 1 (length efforts)))))
7444        (op nil))
7445       (while (not (memq op '(?< ?> ?=)))
7446     (setq op (read-char-exclusive "Effort operator? (> = or <)")))
7447       ;; Select appropriate duration.  Ignore non-digit characters.
7448       (let ((prompt
7449          (apply #'format
7450             (concat "Effort %c "
7451                 (mapconcat (lambda (s) (concat "[%d]" s))
7452                        efforts
7453                        " "))
7454             op allowed-keys))
7455         (eff -1))
7456     (while (not (memq eff allowed-keys))
7457       (message prompt)
7458       (setq eff (- (read-char-exclusive) 48)))
7459     (setq org-agenda-effort-filter
7460           (list (concat (if strip "-" "+")
7461                 (char-to-string op)
7462                 ;; Numbering is 1 2 3 ... 9 0, but we want
7463                 ;; 0 1 2 ... 8 9.
7464                 (nth (mod (1- eff) 10) efforts)))))
7465       (org-agenda-filter-apply org-agenda-effort-filter 'effort)))
7466    (t (org-agenda-filter-show-all-effort)
7467       (message "Effort filter removed"))))
7468
7469 (defun org-agenda-filter-remove-all ()
7470   "Remove all filters from the current agenda buffer."
7471   (interactive)
7472   (when org-agenda-tag-filter
7473     (org-agenda-filter-show-all-tag))
7474   (when org-agenda-category-filter
7475     (org-agenda-filter-show-all-cat))
7476   (when org-agenda-regexp-filter
7477     (org-agenda-filter-show-all-re))
7478   (when org-agenda-top-headline-filter
7479     (org-agenda-filter-show-all-top-filter))
7480   (when org-agenda-effort-filter
7481     (org-agenda-filter-show-all-effort))
7482   (org-agenda-finalize))
7483
7484 (defun org-agenda-filter-by-tag (arg &optional char exclude)
7485   "Keep only those lines in the agenda buffer that have a specific tag.
7486
7487 The tag is selected with its fast selection letter, as configured.
7488
7489 With a `\\[universal-argument]' prefix, exclude the agenda search.
7490
7491 With a `\\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \
7492 i.e. don't
7493 filter on all its group members.
7494
7495 A lisp caller can specify CHAR.  EXCLUDE means that the new tag
7496 should be used to exclude the search - the interactive user can
7497 also press `-' or `+' to switch between filtering and excluding."
7498   (interactive "P")
7499   (let* ((alist org-tag-alist-for-agenda)
7500      (tag-chars (mapconcat
7501              (lambda (x) (if (and (not (symbolp (car x)))
7502                       (cdr x))
7503                      (char-to-string (cdr x))
7504                    ""))
7505              org-tag-alist-for-agenda ""))
7506      (valid-char-list (append '(?\t ?\r ?/ ?. ?\s ?q)
7507                   (string-to-list tag-chars)))
7508      (exclude (or exclude (equal arg '(4))))
7509      (expand (not (equal arg '(16))))
7510      (inhibit-read-only t)
7511      (current org-agenda-tag-filter)
7512      a n tag)
7513     (unless char
7514       (while (not (memq char valid-char-list))
7515     (message
7516      "%s by tag [%s ]:tag-char, [TAB]:tag, %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
7517      (if exclude "Exclude" "Filter")
7518      tag-chars
7519      (if org-agenda-auto-exclude-function "[RET], " "")
7520      (if expand "" ", no grouptag expand"))
7521     (setq char (read-char-exclusive))
7522     ;; Excluding or filtering down
7523     (cond ((eq char ?-) (setq exclude t))
7524           ((eq char ?+) (setq exclude nil)))))
7525     (when (eq char ?\t)
7526       (unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
7527     (setq-local org-global-tags-completion-table
7528             (org-global-tags-completion-table)))
7529       (let ((completion-ignore-case t))
7530     (setq tag (completing-read
7531            "Tag: " org-global-tags-completion-table nil t))))
7532     (cond
7533      ((eq char ?\r)
7534       (org-agenda-filter-show-all-tag)
7535       (when org-agenda-auto-exclude-function
7536     (setq org-agenda-tag-filter nil)
7537     (dolist (tag (org-agenda-get-represented-tags))
7538       (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
7539         (if modifier
7540         (push modifier org-agenda-tag-filter))))
7541     (if (not (null org-agenda-tag-filter))
7542         (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
7543      ((eq char ?/)
7544       (org-agenda-filter-show-all-tag)
7545       (when (get 'org-agenda-tag-filter :preset-filter)
7546     (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
7547      ((eq char ?.)
7548       (setq org-agenda-tag-filter
7549         (mapcar (lambda(tag) (concat "+" tag))
7550             (org-get-at-bol 'tags)))
7551       (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
7552      ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
7553      ((or (eq char ?\s)
7554       (setq a (rassoc char alist))
7555       (and tag (setq a (cons tag nil))))
7556       (org-agenda-filter-show-all-tag)
7557       (setq tag (car a))
7558       (setq org-agenda-tag-filter
7559         (cons (concat (if exclude "-" "+") tag)
7560           current))
7561       (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
7562      (t (error "Invalid tag selection character %c" char)))))
7563
7564 (defun org-agenda-get-represented-tags ()
7565   "Get a list of all tags currently represented in the agenda."
7566   (let (p tags)
7567     (save-excursion
7568       (goto-char (point-min))
7569       (while (setq p (next-single-property-change (point) 'tags))
7570     (goto-char p)
7571     (mapc (lambda (x) (add-to-list 'tags x))
7572           (get-text-property (point) 'tags))))
7573     tags))
7574
7575
7576 (defun org-agenda-filter-make-matcher (filter type &optional expand)
7577   "Create the form that tests a line for agenda filter.  Optional
7578 argument EXPAND can be used for the TYPE tag and will expand the
7579 tags in the FILTER if any of the tags in FILTER are grouptags."
7580   (let (f f1)
7581     (cond
7582      ;; Tag filter
7583      ((eq type 'tag)
7584       (setq filter
7585         (delete-dups
7586          (append (get 'org-agenda-tag-filter :preset-filter)
7587              filter)))
7588       (dolist (x filter)
7589     (let ((op (string-to-char x)))
7590       (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
7591         (setq x (list x)))
7592       (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
7593       (push f1 f))))
7594      ;; Category filter
7595      ((eq type 'category)
7596       (setq filter
7597         (delete-dups
7598          (append (get 'org-agenda-category-filter :preset-filter)
7599              filter)))
7600       (dolist (x filter)
7601     (if (equal "-" (substring x 0 1))
7602         (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
7603       (setq f1 (list 'equal (substring x 1) 'cat)))
7604     (push f1 f)))
7605      ;; Regexp filter
7606      ((eq type 'regexp)
7607       (setq filter
7608         (delete-dups
7609          (append (get 'org-agenda-regexp-filter :preset-filter)
7610              filter)))
7611       (dolist (x filter)
7612     (if (equal "-" (substring x 0 1))
7613         (setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
7614       (setq f1 (list 'string-match (substring x 1) 'txt)))
7615     (push f1 f)))
7616      ;; Effort filter
7617      ((eq type 'effort)
7618       (setq filter
7619         (delete-dups
7620          (append (get 'org-agenda-effort-filter :preset-filter)
7621              filter)))
7622       (dolist (x filter)
7623     (push (org-agenda-filter-effort-form x) f))))
7624     (cons 'and (nreverse f))))
7625
7626 (defun org-agenda-filter-make-matcher-tag-exp (tags op)
7627   "Return a form associated to tag-expression TAGS.
7628 Build a form testing a line for agenda filter for
7629 tag-expressions.  OP is an operator of type CHAR that allows the
7630 function to set the right switches in the returned form."
7631   (let (form)
7632     ;; Any of the expressions can match if OP is +, all must match if
7633     ;; the operator is -.
7634     (dolist (x tags (cons (if (eq op ?-) 'and 'or) form))
7635       (let* ((tag (substring x 1))
7636          (f (cond
7637          ((string= "" tag) '(not tags))
7638          ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag))
7639           ;; TAG is a regexp.
7640           (list 'org-match-any-p (substring tag 1 -1) 'tags))
7641          (t (list 'member (downcase tag) 'tags)))))
7642     (push (if (eq op ?-) (list 'not f) f) form)))))
7643
7644 (defun org-agenda-filter-effort-form (e)
7645   "Return the form to compare the effort of the current line with what E says.
7646 E looks like \"+<2:25\"."
7647   (let (op)
7648     (setq e (substring e 1))
7649     (setq op (string-to-char e) e (substring e 1))
7650     (setq op (cond ((equal op ?<) '<=)
7651            ((equal op ?>) '>=)
7652            ((equal op ??) op)
7653            (t '=)))
7654     (list 'org-agenda-compare-effort (list 'quote op)
7655       (org-duration-to-minutes e))))
7656
7657 (defun org-agenda-compare-effort (op value)
7658   "Compare the effort of the current line with VALUE, using OP.
7659 If the line does not have an effort defined, return nil."
7660   ;; `effort-minutes' property cannot be extracted directly from
7661   ;; current line but is stored as a property in `txt'.
7662   (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt))))
7663     (funcall op
7664          (or effort (if org-sort-agenda-noeffort-is-high 32767 -1))
7665          value)))
7666
7667 (defun org-agenda-filter-expand-tags (filter &optional no-operator)
7668   "Expand group tags in FILTER for the agenda.
7669 When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
7670   (if org-group-tags
7671       (let ((case-fold-search t) rtn)
7672     (mapc
7673      (lambda (f)
7674        (let (f0 dir)
7675          (if (string-match "^\\([+-]\\)\\(.+\\)" f)
7676          (setq dir (match-string 1 f) f0 (match-string 2 f))
7677            (setq dir (if no-operator "" "+") f0 f))
7678          (setq rtn (append (mapcar (lambda(f1) (concat dir f1))
7679                        (org-tags-expand f0 t t))
7680                    rtn))))
7681      filter)
7682     (reverse rtn))
7683     filter))
7684
7685 (defun org-agenda-filter-apply (filter type &optional expand)
7686   "Set FILTER as the new agenda filter and apply it.  Optional
7687 argument EXPAND can be used for the TYPE tag and will expand the
7688 tags in the FILTER if any of the tags in FILTER are grouptags."
7689   ;; Deactivate `org-agenda-entry-text-mode' when filtering
7690   (if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
7691   (let (tags cat txt)
7692     (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type expand))
7693     ;; Only set `org-agenda-filtered-by-category' to t when a unique
7694     ;; category is used as the filter:
7695     (setq org-agenda-filtered-by-category
7696       (and (eq type 'category)
7697            (not (equal (substring (car filter) 0 1) "-"))))
7698     (org-agenda-set-mode-name)
7699     (save-excursion
7700       (goto-char (point-min))
7701       (while (not (eobp))
7702     (if (org-get-at-bol 'org-marker)
7703         (progn
7704           (setq tags (org-get-at-bol 'tags)
7705             cat (org-get-at-eol 'org-category 1)
7706             txt (org-get-at-bol 'txt))
7707           (if (not (eval org-agenda-filter-form))
7708           (org-agenda-filter-hide-line type))
7709           (beginning-of-line 2))
7710       (beginning-of-line 2))))
7711     (if (get-char-property (point) 'invisible)
7712     (ignore-errors (org-agenda-previous-line)))))
7713
7714 (defun org-agenda-filter-top-headline-apply (hl &optional negative)
7715   "Filter by top headline HL."
7716   (org-agenda-set-mode-name)
7717   (save-excursion
7718     (goto-char (point-min))
7719     (while (not (eobp))
7720       (let* ((pos (org-get-at-bol 'org-hd-marker))
7721              (tophl (and pos (org-find-top-headline pos))))
7722         (if (and tophl (funcall (if negative 'identity 'not)
7723                 (string= hl tophl)))
7724             (org-agenda-filter-hide-line 'top-headline)))
7725       (beginning-of-line 2)))
7726   (if (get-char-property (point) 'invisible)
7727       (org-agenda-previous-line))
7728   (setq org-agenda-top-headline-filter hl
7729     org-agenda-filtered-by-top-headline t))
7730
7731 (defun org-agenda-filter-hide-line (type)
7732   "Hide lines with TYPE in the agenda buffer."
7733   (let* ((b (max (point-min) (1- (point-at-bol))))
7734      (e (point-at-eol)))
7735     (let ((inhibit-read-only t))
7736       (add-text-properties
7737        b e `(invisible org-filtered org-filter-type ,type)))))
7738
7739 (defun org-agenda-remove-filter (type)
7740   (interactive)
7741   "Remove filter of type TYPE from the agenda buffer."
7742   (save-excursion
7743     (goto-char (point-min))
7744     (let ((inhibit-read-only t) pos)
7745       (while (setq pos (text-property-any (point) (point-max) 'org-filter-type type))
7746     (goto-char pos)
7747     (remove-text-properties
7748      (point) (next-single-property-change (point) 'org-filter-type)
7749      `(invisible org-filtered org-filter-type ,type))))
7750     (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil)
7751     (setq org-agenda-filter-form nil)
7752     (org-agenda-set-mode-name)
7753     (org-agenda-finalize)))
7754
7755 (defun org-agenda-filter-show-all-tag nil
7756   (org-agenda-remove-filter 'tag))
7757 (defun org-agenda-filter-show-all-re nil
7758   (org-agenda-remove-filter 'regexp))
7759 (defun org-agenda-filter-show-all-effort nil
7760   (org-agenda-remove-filter 'effort))
7761 (defun org-agenda-filter-show-all-cat nil
7762   (org-agenda-remove-filter 'category))
7763 (defun org-agenda-filter-show-all-top-filter nil
7764   (org-agenda-remove-filter 'top-headline))
7765
7766 (defun org-agenda-manipulate-query-add ()
7767   "Manipulate the query by adding a search term with positive selection.
7768 Positive selection means the term must be matched for selection of an entry."
7769   (interactive)
7770   (org-agenda-manipulate-query ?\[))
7771 (defun org-agenda-manipulate-query-subtract ()
7772   "Manipulate the query by adding a search term with negative selection.
7773 Negative selection means term must not be matched for selection of an entry."
7774   (interactive)
7775   (org-agenda-manipulate-query ?\]))
7776 (defun org-agenda-manipulate-query-add-re ()
7777   "Manipulate the query by adding a search regexp with positive selection.
7778 Positive selection means the regexp must match for selection of an entry."
7779   (interactive)
7780   (org-agenda-manipulate-query ?\{))
7781 (defun org-agenda-manipulate-query-subtract-re ()
7782   "Manipulate the query by adding a search regexp with negative selection.
7783 Negative selection means regexp must not match for selection of an entry."
7784   (interactive)
7785   (org-agenda-manipulate-query ?\}))
7786 (defun org-agenda-manipulate-query (char)
7787   (cond
7788    ((eq org-agenda-type 'agenda)
7789     (let ((org-agenda-include-inactive-timestamps t))
7790       (org-agenda-redo))
7791     (message "Display now includes inactive timestamps as well"))
7792    ((eq org-agenda-type 'search)
7793     (org-add-to-string
7794      'org-agenda-query-string
7795      (if org-agenda-last-search-view-search-was-boolean
7796      (cdr (assoc char '((?\[ . " +") (?\] . " -")
7797                 (?\{ . " +{}") (?\} . " -{}"))))
7798        " "))
7799     (setq org-agenda-redo-command
7800       (list 'org-search-view
7801         (car (get-text-property (min (1- (point-max)) (point))
7802                     'org-last-args))
7803         org-agenda-query-string
7804         (+ (length org-agenda-query-string)
7805            (if (member char '(?\{ ?\})) 0 1))))
7806     (set-register org-agenda-query-register org-agenda-query-string)
7807     (let ((org-agenda-overriding-arguments
7808        (cdr org-agenda-redo-command)))
7809       (org-agenda-redo)))
7810    (t (error "Cannot manipulate query for %s-type agenda buffers"
7811          org-agenda-type))))
7812
7813 (defun org-add-to-string (var string)
7814   (set var (concat (symbol-value var) string)))
7815
7816 (defun org-agenda-goto-date (span)
7817   "Jump to DATE in agenda."
7818   (interactive "P")
7819   (let* ((org-read-date-prefer-future
7820       (eval org-agenda-jump-prefer-future))
7821      (date (org-read-date))
7822      (day (time-to-days (org-time-string-to-time date)))
7823      (org-agenda-sticky-orig org-agenda-sticky)
7824      (org-agenda-buffer-tmp-name (buffer-name))
7825      (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
7826      (0-arg (or current-prefix-arg (car args)))
7827      (2-arg (nth 2 args))
7828      (with-hour-p (nth 4 org-agenda-redo-command))
7829      (newcmd (list 'org-agenda-list 0-arg date
7830                (org-agenda-span-to-ndays
7831             2-arg (org-time-string-to-absolute date))
7832                with-hour-p))
7833      (newargs (cdr newcmd))
7834      (inhibit-read-only t)
7835      org-agenda-sticky)
7836     (if (not (org-agenda-check-type t 'agenda))
7837     (error "Not available in non-agenda views")
7838       (add-text-properties (point-min) (point-max)
7839                `(org-redo-cmd ,newcmd org-last-args ,newargs))
7840       (org-agenda-redo)
7841       (goto-char (point-min))
7842       (while (not (or (= (or (get-text-property (point) 'day) 0) day)
7843               (save-excursion (move-beginning-of-line 2) (eobp))))
7844     (move-beginning-of-line 2))
7845       (setq org-agenda-sticky org-agenda-sticky-orig
7846         org-agenda-this-buffer-is-sticky org-agenda-sticky))))
7847
7848 (defun org-agenda-goto-today ()
7849   "Go to today."
7850   (interactive)
7851   (org-agenda-check-type t 'agenda)
7852   (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
7853      (curspan (nth 2 args))
7854      (tdpos (text-property-any (point-min) (point-max) 'org-today t)))
7855     (cond
7856      (tdpos (goto-char tdpos))
7857      ((eq org-agenda-type 'agenda)
7858       (let* ((sd (org-agenda-compute-starting-span
7859           (org-today) (or curspan org-agenda-span)))
7860          (org-agenda-overriding-arguments args))
7861     (setf (nth 1 org-agenda-overriding-arguments) sd)
7862     (org-agenda-redo)
7863     (org-agenda-find-same-or-today-or-agenda)))
7864      (t (error "Cannot find today")))))
7865
7866 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
7867   (goto-char
7868    (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
7869        (text-property-any (point-min) (point-max) 'org-today t)
7870        (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
7871        (and (get-text-property (min (1- (point-max)) (point)) 'org-series)
7872         (org-agenda-backward-block))
7873        (point-min))))
7874
7875 (defun org-agenda-backward-block ()
7876   "Move backward by one agenda block."
7877   (interactive)
7878   (org-agenda-forward-block 'backward))
7879
7880 (defun org-agenda-forward-block (&optional backward)
7881   "Move forward by one agenda block.
7882 When optional argument BACKWARD is set, go backward"
7883   (interactive)
7884   (cond ((not (derived-mode-p 'org-agenda-mode))
7885      (user-error
7886       "Cannot execute this command outside of org-agenda-mode buffers"))
7887     ((looking-at (if backward "\\`" "\\'"))
7888      (message "Already at the %s block" (if backward "first" "last")))
7889     (t (let ((pos (prog1 (point)
7890             (ignore-errors (if backward (backward-char 1)
7891                      (move-end-of-line 1)))))
7892          (f (if backward
7893             'previous-single-property-change
7894               'next-single-property-change))
7895          moved dest)
7896          (while (and (setq dest (funcall
7897                      f (point) 'org-agenda-structural-header))
7898              (not (get-text-property
7899                    (point) 'org-agenda-structural-header)))
7900            (setq moved t)
7901            (goto-char dest))
7902          (if moved (move-beginning-of-line 1)
7903            (goto-char (if backward (point-min) (point-max)))
7904            (move-beginning-of-line 1)
7905            (message "No %s block" (if backward "previous" "further")))))))
7906
7907 (defun org-agenda-later (arg)
7908   "Go forward in time by the current span.
7909 With prefix ARG, go forward that many times the current span."
7910   (interactive "p")
7911   (org-agenda-check-type t 'agenda)
7912   (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
7913      (span (or (nth 2 args) org-agenda-current-span))
7914      (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day))
7915      (greg (calendar-gregorian-from-absolute sd))
7916      (cnt (org-get-at-bol 'org-day-cnt))
7917      greg2)
7918     (cond
7919      ((numberp span)
7920       (setq sd (+ (* span arg) sd)))
7921      ((eq span 'day)
7922       (setq sd (+ arg sd)))
7923      ((eq span 'week)
7924       (setq sd (+ (* 7 arg) sd)))
7925      ((eq span 'fortnight)
7926       (setq sd (+ (* 14 arg) sd)))
7927      ((eq span 'month)
7928       (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
7929         sd (calendar-absolute-from-gregorian greg2))
7930       (setcar greg2 (1+ (car greg2))))
7931      ((eq span 'year)
7932       (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
7933         sd (calendar-absolute-from-gregorian greg2))
7934       (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
7935      (t
7936       (setq sd (+ (* span arg) sd))))
7937     (let ((org-agenda-overriding-cmd
7938        ;; `cmd' may have been set by `org-agenda-run-series' which
7939        ;; uses `org-agenda-overriding-cmd' to decide whether
7940        ;; overriding is allowed for `cmd'
7941        (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
7942       (org-agenda-overriding-arguments
7943        (list (car args) sd span)))
7944       (org-agenda-redo)
7945       (org-agenda-find-same-or-today-or-agenda cnt))))
7946
7947 (defun org-agenda-earlier (arg)
7948   "Go backward in time by the current span.
7949 With prefix ARG, go backward that many times the current span."
7950   (interactive "p")
7951   (org-agenda-later (- arg)))
7952
7953 (defun org-agenda-view-mode-dispatch ()
7954   "Call one of the view mode commands."
7955   (interactive)
7956   (message "View: [d]ay  [w]eek  for[t]night  [m]onth  [y]ear  [SPC]reset  [q]uit/abort
7957       time[G]rid   [[]inactive  [f]ollow      [l]og    [L]og-all   [c]lockcheck
7958       [a]rch-trees [A]rch-files clock[R]eport include[D]iary       [E]ntryText")
7959   (pcase (read-char-exclusive)
7960     (?\ (call-interactively 'org-agenda-reset-view))
7961     (?d (call-interactively 'org-agenda-day-view))
7962     (?w (call-interactively 'org-agenda-week-view))
7963     (?t (call-interactively 'org-agenda-fortnight-view))
7964     (?m (call-interactively 'org-agenda-month-view))
7965     (?y (call-interactively 'org-agenda-year-view))
7966     (?l (call-interactively 'org-agenda-log-mode))
7967     (?L (org-agenda-log-mode '(4)))
7968     (?c (org-agenda-log-mode 'clockcheck))
7969     ((or ?F ?f) (call-interactively 'org-agenda-follow-mode))
7970     (?a (call-interactively 'org-agenda-archives-mode))
7971     (?A (org-agenda-archives-mode 'files))
7972     ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode))
7973     ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode))
7974     (?G (call-interactively 'org-agenda-toggle-time-grid))
7975     (?D (call-interactively 'org-agenda-toggle-diary))
7976     (?\! (call-interactively 'org-agenda-toggle-deadlines))
7977     (?\[ (let ((org-agenda-include-inactive-timestamps t))
7978        (org-agenda-check-type t 'agenda)
7979        (org-agenda-redo))
7980      (message "Display now includes inactive timestamps as well"))
7981     (?q (message "Abort"))
7982     (key (user-error "Invalid key: %s" key))))
7983
7984 (defun org-agenda-reset-view ()
7985   "Switch to default view for agenda."
7986   (interactive)
7987   (org-agenda-change-time-span org-agenda-span))
7988
7989 (defun org-agenda-day-view (&optional day-of-month)
7990   "Switch to daily view for agenda.
7991 With argument DAY-OF-MONTH, switch to that day of the month."
7992   (interactive "P")
7993   (org-agenda-change-time-span 'day day-of-month))
7994
7995 (defun org-agenda-week-view (&optional iso-week)
7996   "Switch to weekly view for agenda.
7997 With argument ISO-WEEK, switch to the corresponding ISO week.
7998 If ISO-WEEK has more then 2 digits, only the last two encode
7999 the week.  Any digits before this encode a year.  So 200712
8000 means week 12 of year 2007.  Years ranging from 70 years ago
8001 to 30 years in the future can also be written as 2-digit years."
8002   (interactive "P")
8003   (org-agenda-change-time-span 'week iso-week))
8004
8005 (defun org-agenda-fortnight-view (&optional iso-week)
8006   "Switch to fortnightly view for agenda.
8007 With argument ISO-WEEK, switch to the corresponding ISO week.
8008 If ISO-WEEK has more then 2 digits, only the last two encode
8009 the week.  Any digits before this encode a year.  So 200712
8010 means week 12 of year 2007.  Years ranging from 70 years ago
8011 to 30 years in the future can also be written as 2-digit years."
8012   (interactive "P")
8013   (org-agenda-change-time-span 'fortnight iso-week))
8014
8015 (defun org-agenda-month-view (&optional month)
8016   "Switch to monthly view for agenda.
8017 With argument MONTH, switch to that month.  If MONTH has more
8018 then 2 digits, only the last two encode the month.  Any digits
8019 before this encode a year.  So 200712 means December year 2007.
8020 Years ranging from 70 years ago to 30 years in the future can
8021 also be written as 2-digit years."
8022   (interactive "P")
8023   (org-agenda-change-time-span 'month month))
8024
8025 (defun org-agenda-year-view (&optional year)
8026   "Switch to yearly view for agenda.
8027 With argument YEAR, switch to that year.  Years ranging from 70
8028 years ago to 30 years in the future can also be written as
8029 2-digit years."
8030   (interactive "P")
8031   (when year
8032     (setq year (org-small-year-to-year year)))
8033   (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ")
8034       (org-agenda-change-time-span 'year year)
8035     (error "Abort")))
8036
8037 (defun org-agenda-change-time-span (span &optional n)
8038   "Change the agenda view to SPAN.
8039 SPAN may be `day', `week', `fortnight', `month', `year'."
8040   (org-agenda-check-type t 'agenda)
8041   (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
8042      (curspan (nth 2 args)))
8043     (if (and (not n) (equal curspan span))
8044     (error "Viewing span is already \"%s\"" span))
8045     (let* ((sd (or (org-get-at-bol 'day)
8046            (nth 1 args)
8047            org-starting-day))
8048        (sd (org-agenda-compute-starting-span sd span n))
8049        (org-agenda-overriding-cmd
8050         (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
8051        (org-agenda-overriding-arguments
8052         (list (car args) sd span)))
8053       (org-agenda-redo)
8054       (org-agenda-find-same-or-today-or-agenda))
8055     (org-agenda-set-mode-name)
8056     (message "Switched to %s view" span)))
8057
8058 (defun org-agenda-compute-starting-span (sd span &optional n)
8059   "Compute starting date for agenda.
8060 SPAN may be `day', `week', `fortnight', `month', `year'.  The return value
8061 is a cons cell with the starting date and the number of days,
8062 so that the date SD will be in that range."
8063   (let* ((greg (calendar-gregorian-from-absolute sd))
8064      (dg (nth 1 greg))
8065      (mg (car greg))
8066      (yg (nth 2 greg)))
8067     (cond
8068      ((eq span 'day)
8069       (when n
8070     (setq sd (+ (calendar-absolute-from-gregorian
8071              (list mg 1 yg))
8072             n -1))))
8073      ((or (eq span 'week) (eq span 'fortnight))
8074       (let* ((nt (calendar-day-of-week
8075           (calendar-gregorian-from-absolute sd)))
8076          (d (if org-agenda-start-on-weekday
8077             (- nt org-agenda-start-on-weekday)
8078           0))
8079          y1)
8080     (setq sd (- sd (+ (if (< d 0) 7 0) d)))
8081     (when n
8082       (require 'cal-iso)
8083       (when (> n 99)
8084         (setq y1 (org-small-year-to-year (/ n 100))
8085           n (mod n 100)))
8086       (setq sd
8087         (calendar-iso-to-absolute
8088          (list n 1
8089                (or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
8090      ((eq span 'month)
8091       (let (y1)
8092     (when (and n (> n 99))
8093       (setq y1 (org-small-year-to-year (/ n 100))
8094         n (mod n 100)))
8095     (setq sd (calendar-absolute-from-gregorian
8096           (list (or n mg) 1 (or y1 yg))))))
8097      ((eq span 'year)
8098       (setq sd (calendar-absolute-from-gregorian
8099         (list 1 1 (or n yg))))))
8100     sd))
8101
8102 (defun org-agenda-next-date-line (&optional arg)
8103   "Jump to the next line indicating a date in agenda buffer."
8104   (interactive "p")
8105   (org-agenda-check-type t 'agenda)
8106   (beginning-of-line 1)
8107   ;; This does not work if user makes date format that starts with a blank
8108   (if (looking-at "^\\S-") (forward-char 1))
8109   (if (not (re-search-forward "^\\S-" nil t arg))
8110       (progn
8111     (backward-char 1)
8112     (error "No next date after this line in this buffer")))
8113   (goto-char (match-beginning 0)))
8114
8115 (defun org-agenda-previous-date-line (&optional arg)
8116   "Jump to the previous line indicating a date in agenda buffer."
8117   (interactive "p")
8118   (org-agenda-check-type t 'agenda)
8119   (beginning-of-line 1)
8120   (if (not (re-search-backward "^\\S-" nil t arg))
8121       (error "No previous date before this line in this buffer")))
8122
8123 ;; Initialize the highlight
8124 (defvar org-hl (make-overlay 1 1))
8125 (overlay-put org-hl 'face 'highlight)
8126
8127 (defun org-highlight (begin end &optional buffer)
8128   "Highlight a region with overlay."
8129   (move-overlay org-hl begin end (or buffer (current-buffer))))
8130
8131 (defun org-unhighlight ()
8132   "Detach overlay INDEX."
8133   (delete-overlay org-hl))
8134
8135 (defun org-unhighlight-once ()
8136   "Remove the highlight from its position, and this function from the hook."
8137   (remove-hook 'pre-command-hook 'org-unhighlight-once)
8138   (org-unhighlight))
8139
8140 (defvar org-agenda-pre-follow-window-conf nil)
8141 (defun org-agenda-follow-mode ()
8142   "Toggle follow mode in an agenda buffer."
8143   (interactive)
8144   (unless org-agenda-follow-mode
8145     (setq org-agenda-pre-follow-window-conf
8146       (current-window-configuration)))
8147   (setq org-agenda-follow-mode (not org-agenda-follow-mode))
8148   (unless org-agenda-follow-mode
8149     (set-window-configuration org-agenda-pre-follow-window-conf))
8150   (org-agenda-set-mode-name)
8151   (org-agenda-do-context-action)
8152   (message "Follow mode is %s"
8153        (if org-agenda-follow-mode "on" "off")))
8154
8155 (defun org-agenda-entry-text-mode (&optional arg)
8156   "Toggle entry text mode in an agenda buffer."
8157   (interactive "P")
8158   (if (or org-agenda-tag-filter
8159       org-agenda-category-filter
8160       org-agenda-regexp-filter
8161       org-agenda-top-headline-filter)
8162       (user-error "Can't show entry text in filtered views")
8163     (setq org-agenda-entry-text-mode (or (integerp arg)
8164                      (not org-agenda-entry-text-mode)))
8165     (org-agenda-entry-text-hide)
8166     (and org-agenda-entry-text-mode
8167      (let ((org-agenda-entry-text-maxlines
8168         (if (integerp arg) arg org-agenda-entry-text-maxlines)))
8169        (org-agenda-entry-text-show)))
8170     (org-agenda-set-mode-name)
8171     (message "Entry text mode is %s%s"
8172          (if org-agenda-entry-text-mode "on" "off")
8173          (if (not org-agenda-entry-text-mode) ""
8174            (format " (maximum number of lines is %d)"
8175                (if (integerp arg) arg org-agenda-entry-text-maxlines))))))
8176
8177 (defun org-agenda-clockreport-mode ()
8178   "Toggle clocktable mode in an agenda buffer."
8179   (interactive)
8180   (org-agenda-check-type t 'agenda)
8181   (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))
8182   (org-agenda-set-mode-name)
8183   (org-agenda-redo)
8184   (message "Clocktable mode is %s"
8185        (if org-agenda-clockreport-mode "on" "off")))
8186
8187 (defun org-agenda-log-mode (&optional special)
8188   "Toggle log mode in an agenda buffer.
8189
8190 With argument SPECIAL, show all possible log items, not only the ones
8191 configured in `org-agenda-log-mode-items'.
8192
8193 With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
8194 log items, nothing else."
8195   (interactive "P")
8196   (org-agenda-check-type t 'agenda)
8197   (setq org-agenda-show-log
8198     (cond
8199      ((equal special '(16)) 'only)
8200      ((eq special 'clockcheck)
8201       (if (eq org-agenda-show-log 'clockcheck)
8202           nil 'clockcheck))
8203      (special '(closed clock state))
8204      (t (not org-agenda-show-log))))
8205   (org-agenda-set-mode-name)
8206   (org-agenda-redo)
8207   (message "Log mode is %s" (if org-agenda-show-log "on" "off")))
8208
8209 (defun org-agenda-archives-mode (&optional with-files)
8210   "Toggle inclusion of items in trees marked with :ARCHIVE:.
8211 When called with a prefix argument, include all archive files as well."
8212   (interactive "P")
8213   (setq org-agenda-archives-mode
8214     (if with-files t (if org-agenda-archives-mode nil 'trees)))
8215   (org-agenda-set-mode-name)
8216   (org-agenda-redo)
8217   (message
8218    "%s"
8219    (cond
8220     ((eq org-agenda-archives-mode nil)
8221      "No archives are included")
8222     ((eq org-agenda-archives-mode 'trees)
8223      (format "Trees with :%s: tag are included" org-archive-tag))
8224     ((eq org-agenda-archives-mode t)
8225      (format "Trees with :%s: tag and all active archive files are included"
8226          org-archive-tag)))))
8227
8228 (defun org-agenda-toggle-diary ()
8229   "Toggle diary inclusion in an agenda buffer."
8230   (interactive)
8231   (org-agenda-check-type t 'agenda)
8232   (setq org-agenda-include-diary (not org-agenda-include-diary))
8233   (org-agenda-redo)
8234   (org-agenda-set-mode-name)
8235   (message "Diary inclusion turned %s"
8236        (if org-agenda-include-diary "on" "off")))
8237
8238 (defun org-agenda-toggle-deadlines ()
8239   "Toggle inclusion of entries with a deadline in an agenda buffer."
8240   (interactive)
8241   (org-agenda-check-type t 'agenda)
8242   (setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
8243   (org-agenda-redo)
8244   (org-agenda-set-mode-name)
8245   (message "Deadlines inclusion turned %s"
8246        (if org-agenda-include-deadlines "on" "off")))
8247
8248 (defun org-agenda-toggle-time-grid ()
8249   "Toggle time grid in an agenda buffer."
8250   (interactive)
8251   (org-agenda-check-type t 'agenda)
8252   (setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
8253   (org-agenda-redo)
8254   (org-agenda-set-mode-name)
8255   (message "Time-grid turned %s"
8256        (if org-agenda-use-time-grid "on" "off")))
8257
8258 (defun org-agenda-set-mode-name ()
8259   "Set the mode name to indicate all the small mode settings."
8260   (setq mode-name
8261     (list "Org-Agenda"
8262           (if (get 'org-agenda-files 'org-restrict) " []" "")
8263           " "
8264           '(:eval (org-agenda-span-name org-agenda-current-span))
8265           (if org-agenda-follow-mode     " Follow" "")
8266           (if org-agenda-entry-text-mode " ETxt"   "")
8267           (if org-agenda-include-diary   " Diary"  "")
8268           (if org-agenda-include-deadlines " Ddl"  "")
8269           (if org-agenda-use-time-grid   " Grid"   "")
8270           (if (and (boundp 'org-habit-show-habits)
8271                org-habit-show-habits) " Habit"   "")
8272           (cond
8273            ((consp org-agenda-show-log) " LogAll")
8274            ((eq org-agenda-show-log 'clockcheck) " ClkCk")
8275            (org-agenda-show-log " Log")
8276            (t ""))
8277           (if (or org-agenda-category-filter
8278               (get 'org-agenda-category-filter :preset-filter))
8279           '(:eval (propertize
8280                      (concat " <"
8281                          (mapconcat
8282                           'identity
8283                           (append
8284                            (get 'org-agenda-category-filter :preset-filter)
8285                            org-agenda-category-filter)
8286                           "")
8287                          ">")
8288                      'face 'org-agenda-filter-category
8289                      'help-echo "Category used in filtering")) "")
8290           (if (or org-agenda-tag-filter
8291               (get 'org-agenda-tag-filter :preset-filter))
8292           '(:eval (propertize
8293                (concat " {"
8294                    (mapconcat
8295                     'identity
8296                     (append
8297                      (get 'org-agenda-tag-filter :preset-filter)
8298                      org-agenda-tag-filter)
8299                     "")
8300                    "}")
8301                'face 'org-agenda-filter-tags
8302                'help-echo "Tags used in filtering")) "")
8303           (if (or org-agenda-effort-filter
8304               (get 'org-agenda-effort-filter :preset-filter))
8305           '(:eval (propertize
8306                (concat " {"
8307                    (mapconcat
8308                     'identity
8309                     (append
8310                      (get 'org-agenda-effort-filter :preset-filter)
8311                      org-agenda-effort-filter)
8312                     "")
8313                    "}")
8314                'face 'org-agenda-filter-effort
8315                'help-echo "Effort conditions used in filtering")) "")
8316           (if (or org-agenda-regexp-filter
8317               (get 'org-agenda-regexp-filter :preset-filter))
8318           '(:eval (propertize
8319                (concat " ["
8320                    (mapconcat
8321                     'identity
8322                     (append
8323                      (get 'org-agenda-regexp-filter :preset-filter)
8324                      org-agenda-regexp-filter)
8325                     "")
8326                    "]")
8327                'face 'org-agenda-filter-regexp
8328                'help-echo "Regexp used in filtering")) "")
8329           (if org-agenda-archives-mode
8330           (if (eq org-agenda-archives-mode t)
8331               " Archives"
8332             (format " :%s:" org-archive-tag))
8333         "")
8334           (if org-agenda-clockreport-mode " Clock" "")))
8335   (force-mode-line-update))
8336
8337 (defun org-agenda-update-agenda-type ()
8338   "Update the agenda type after each command."
8339   (setq org-agenda-type
8340     (or (get-text-property (point) 'org-agenda-type)
8341         (get-text-property (max (point-min) (1- (point))) 'org-agenda-type))))
8342
8343 (defun org-agenda-next-line ()
8344   "Move cursor to the next line, and show if follow mode is active."
8345   (interactive)
8346   (call-interactively 'next-line)
8347   (org-agenda-do-context-action))
8348
8349 (defun org-agenda-previous-line ()
8350   "Move cursor to the previous line, and show if follow-mode is active."
8351   (interactive)
8352   (call-interactively 'previous-line)
8353   (org-agenda-do-context-action))
8354
8355 (defun org-agenda-next-item (n)
8356   "Move cursor to next agenda item."
8357   (interactive "p")
8358   (let ((col (current-column)))
8359     (dotimes (c n)
8360       (when (next-single-property-change (point-at-eol) 'org-marker)
8361     (move-end-of-line 1)
8362     (goto-char (next-single-property-change (point) 'org-marker))))
8363     (org-move-to-column col))
8364   (org-agenda-do-context-action))
8365
8366 (defun org-agenda-previous-item (n)
8367   "Move cursor to next agenda item."
8368   (interactive "p")
8369   (dotimes (c n)
8370     (let ((col (current-column))
8371       (goto (save-excursion
8372           (move-end-of-line 0)
8373           (previous-single-property-change (point) 'org-marker))))
8374       (if goto (goto-char goto))
8375       (org-move-to-column col)))
8376   (org-agenda-do-context-action))
8377
8378 (defun org-agenda-do-context-action ()
8379   "Show outline path and, maybe, follow mode window."
8380   (let ((m (org-get-at-bol 'org-marker)))
8381     (when (and (markerp m) (marker-buffer m))
8382       (and org-agenda-follow-mode
8383        (if org-agenda-follow-indirect
8384            (org-agenda-tree-to-indirect-buffer nil)
8385          (org-agenda-show)))
8386       (and org-agenda-show-outline-path
8387        (org-with-point-at m (org-display-outline-path t))))))
8388
8389 (defun org-agenda-show-tags ()
8390   "Show the tags applicable to the current item."
8391   (interactive)
8392   (let* ((tags (org-get-at-bol 'tags)))
8393     (if tags
8394     (message "Tags are :%s:"
8395          (org-no-properties (mapconcat 'identity tags ":")))
8396       (message "No tags associated with this line"))))
8397
8398 (defun org-agenda-goto (&optional highlight)
8399   "Go to the entry at point in the corresponding Org file."
8400   (interactive)
8401   (let* ((marker (or (org-get-at-bol 'org-marker)
8402              (org-agenda-error)))
8403      (buffer (marker-buffer marker))
8404      (pos (marker-position marker)))
8405     (switch-to-buffer-other-window buffer)
8406     (widen)
8407     (push-mark)
8408     (goto-char pos)
8409     (when (derived-mode-p 'org-mode)
8410       (org-show-context 'agenda)
8411       (recenter (/ (window-height) 2))
8412       (org-back-to-heading t)
8413       (let ((case-fold-search nil))
8414     (when (re-search-forward org-complex-heading-regexp nil t)
8415       (goto-char (match-beginning 4)))))
8416     (run-hooks 'org-agenda-after-show-hook)
8417     (and highlight (org-highlight (point-at-bol) (point-at-eol)))))
8418
8419 (defvar org-agenda-after-show-hook nil
8420   "Normal hook run after an item has been shown from the agenda.
8421 Point is in the buffer where the item originated.")
8422
8423 (defun org-agenda-kill ()
8424   "Kill the entry or subtree belonging to the current agenda entry."
8425   (interactive)
8426   (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
8427   (let* ((bufname-orig (buffer-name))
8428      (marker (or (org-get-at-bol 'org-marker)
8429              (org-agenda-error)))
8430      (buffer (marker-buffer marker))
8431      (pos (marker-position marker))
8432      (type (org-get-at-bol 'type))
8433      dbeg dend (n 0) conf)
8434     (org-with-remote-undo buffer
8435       (with-current-buffer buffer
8436     (save-excursion
8437       (goto-char pos)
8438       (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
8439           (setq dbeg (progn (org-back-to-heading t) (point))
8440             dend (org-end-of-subtree t t))
8441         (setq dbeg (point-at-bol)
8442           dend (min (point-max) (1+ (point-at-eol)))))
8443       (goto-char dbeg)
8444       (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
8445       (setq conf (or (eq t org-agenda-confirm-kill)
8446              (and (numberp org-agenda-confirm-kill)
8447               (> n org-agenda-confirm-kill))))
8448       (and conf
8449        (not (y-or-n-p
8450          (format "Delete entry with %d lines in buffer \"%s\"? "
8451              n (buffer-name buffer))))
8452        (error "Abort"))
8453       (let ((org-agenda-buffer-name bufname-orig))
8454     (org-remove-subtree-entries-from-agenda buffer dbeg dend))
8455       (with-current-buffer buffer (delete-region dbeg dend))
8456       (message "Agenda item and source killed"))))
8457
8458 (defvar org-archive-default-command) ; defined in org-archive.el
8459 (defun org-agenda-archive-default ()
8460   "Archive the entry or subtree belonging to the current agenda entry."
8461   (interactive)
8462   (require 'org-archive)
8463   (org-agenda-archive-with org-archive-default-command))
8464
8465 (defun org-agenda-archive-default-with-confirmation ()
8466   "Archive the entry or subtree belonging to the current agenda entry."
8467   (interactive)
8468   (require 'org-archive)
8469   (org-agenda-archive-with org-archive-default-command 'confirm))
8470
8471 (defun org-agenda-archive ()
8472   "Archive the entry or subtree belonging to the current agenda entry."
8473   (interactive)
8474   (org-agenda-archive-with 'org-archive-subtree))
8475
8476 (defun org-agenda-archive-to-archive-sibling ()
8477   "Move the entry to the archive sibling."
8478   (interactive)
8479   (org-agenda-archive-with 'org-archive-to-archive-sibling))
8480
8481 (defun org-agenda-archive-with (cmd &optional confirm)
8482   "Move the entry to the archive sibling."
8483   (interactive)
8484   (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
8485   (let* ((bufname-orig (buffer-name))
8486      (marker (or (org-get-at-bol 'org-marker)
8487              (org-agenda-error)))
8488      (buffer (marker-buffer marker))
8489      (pos (marker-position marker)))
8490     (org-with-remote-undo buffer
8491       (with-current-buffer buffer
8492     (if (derived-mode-p 'org-mode)
8493         (if (and confirm
8494              (not (y-or-n-p "Archive this subtree or entry? ")))
8495         (error "Abort")
8496           (save-window-excursion
8497         (goto-char pos)
8498         (let ((org-agenda-buffer-name bufname-orig))
8499           (org-remove-subtree-entries-from-agenda))
8500         (org-back-to-heading t)
8501         (funcall cmd)))
8502       (error "Archiving works only in Org files"))))))
8503
8504 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
8505   "Remove all lines in the agenda that correspond to a given subtree.
8506 The subtree is the one in buffer BUF, starting at BEG and ending at END.
8507 If this information is not given, the function uses the tree at point."
8508   (let ((buf (or buf (current-buffer))) m p)
8509     (save-excursion
8510       (unless (and beg end)
8511     (org-back-to-heading t)
8512     (setq beg (point))
8513     (org-end-of-subtree t)
8514     (setq end (point)))
8515       (set-buffer (get-buffer org-agenda-buffer-name))
8516       (save-excursion
8517     (goto-char (point-max))
8518     (beginning-of-line 1)
8519     (while (not (bobp))
8520       (when (and (setq m (org-get-at-bol 'org-marker))
8521              (equal buf (marker-buffer m))
8522              (setq p (marker-position m))
8523              (>= p beg)
8524              (< p end))
8525         (let ((inhibit-read-only t))
8526           (delete-region (point-at-bol) (1+ (point-at-eol)))))
8527       (beginning-of-line 0))))))
8528
8529 (defun org-agenda-refile (&optional goto rfloc no-update)
8530   "Refile the item at point.
8531
8532 When called with `\\[universal-argument] \\[universal-argument]', \
8533 go to the location of the last
8534 refiled item.
8535
8536 When called with `\\[universal-argument] \\[universal-argument] \
8537 \\[universal-argument]' prefix or when GOTO is 0, clear
8538 the refile cache.
8539
8540 RFLOC can be a refile location obtained in a different way.
8541
8542 When NO-UPDATE is non-nil, don't redo the agenda buffer."
8543   (interactive "P")
8544   (cond
8545    ((member goto '(0 (64)))
8546     (org-refile-cache-clear))
8547    ((equal goto '(16))
8548     (org-refile-goto-last-stored))
8549    (t
8550     (let* ((buffer-orig (buffer-name))
8551        (marker (or (org-get-at-bol 'org-hd-marker)
8552                (org-agenda-error)))
8553        (buffer (marker-buffer marker))
8554        (pos (marker-position marker))
8555        (rfloc (or rfloc
8556               (org-refile-get-location
8557                (if goto "Goto" "Refile to") buffer
8558                org-refile-allow-creating-parent-nodes))))
8559       (with-current-buffer buffer
8560     (org-with-wide-buffer
8561      (goto-char marker)
8562      (let ((org-agenda-buffer-name buffer-orig))
8563        (org-remove-subtree-entries-from-agenda))
8564      (org-refile goto buffer rfloc))))
8565     (unless no-update (org-agenda-redo)))))
8566
8567 (defun org-agenda-open-link (&optional arg)
8568   "Open the link(s) in the current entry, if any.
8569 This looks for a link in the displayed line in the agenda.
8570 It also looks at the text of the entry itself."
8571   (interactive "P")
8572   (let* ((marker (or (org-get-at-bol 'org-hd-marker)
8573              (org-get-at-bol 'org-marker)))
8574      (buffer (and marker (marker-buffer marker)))
8575      (prefix (buffer-substring (point-at-bol) (point-at-eol)))
8576      (lkall (and buffer (org-offer-links-in-entry
8577                  buffer marker arg prefix)))
8578      (lk0 (car lkall))
8579      (lk (if (stringp lk0) (list lk0) lk0))
8580      (lkend (cdr lkall))
8581      trg)
8582     (cond
8583      ((and buffer lk)
8584       (mapcar (lambda(l)
8585         (with-current-buffer buffer
8586           (setq trg (and (string-match org-bracket-link-regexp l)
8587                  (match-string 1 l)))
8588           (if (or (not trg) (string-match org-any-link-re trg))
8589               (org-with-wide-buffer
8590                (goto-char marker)
8591                (when (search-forward l nil lkend)
8592              (goto-char (match-beginning 0))
8593              (org-open-at-point)))
8594             ;; This is an internal link, widen the buffer
8595             (switch-to-buffer-other-window buffer)
8596             (widen)
8597             (goto-char marker)
8598             (when (search-forward l nil lkend)
8599               (goto-char (match-beginning 0))
8600               (org-open-at-point)))))
8601           lk))
8602      ((or (org-in-regexp (concat "\\(" org-bracket-link-regexp "\\)"))
8603       (save-excursion
8604         (beginning-of-line 1)
8605         (looking-at (concat ".*?\\(" org-bracket-link-regexp "\\)"))))
8606       (org-open-link-from-string (match-string 1)))
8607      (t (message "No link to open here")))))
8608
8609 (defun org-agenda-copy-local-variable (var)
8610   "Get a variable from a referenced buffer and install it here."
8611   (let ((m (org-get-at-bol 'org-marker)))
8612     (when (and m (buffer-live-p (marker-buffer m)))
8613       (set (make-local-variable var)
8614        (with-current-buffer (marker-buffer m)
8615          (symbol-value var))))))
8616
8617 (defun org-agenda-switch-to (&optional delete-other-windows)
8618   "Go to the Org mode file which contains the item at point.
8619 When optional argument DELETE-OTHER-WINDOWS is non-nil, the
8620 displayed Org file fills the frame."
8621   (interactive)
8622   (if (and org-return-follows-link
8623        (not (org-get-at-bol 'org-marker))
8624        (org-in-regexp org-bracket-link-regexp))
8625       (org-open-link-from-string (match-string 0))
8626     (let* ((marker (or (org-get-at-bol 'org-marker)
8627                (org-agenda-error)))
8628        (buffer (marker-buffer marker))
8629        (pos (marker-position marker)))
8630       (unless buffer (user-error "Trying to switch to non-existent buffer"))
8631       (pop-to-buffer-same-window buffer)
8632       (when delete-other-windows (delete-other-windows))
8633       (widen)
8634       (goto-char pos)
8635       (when (derived-mode-p 'org-mode)
8636     (org-show-context 'agenda)
8637     (run-hooks 'org-agenda-after-show-hook)))))
8638
8639 (defun org-agenda-goto-mouse (ev)
8640   "Go to the Org file which contains the item at the mouse click."
8641   (interactive "e")
8642   (mouse-set-point ev)
8643   (org-agenda-goto))
8644
8645 (defun org-agenda-show (&optional full-entry)
8646   "Display the Org file which contains the item at point.
8647 With prefix argument FULL-ENTRY, make the entire entry visible
8648 if it was hidden in the outline."
8649   (interactive "P")
8650   (let ((win (selected-window)))
8651     (org-agenda-goto t)
8652     (when full-entry (org-show-entry))
8653     (select-window win)))
8654
8655 (defvar org-agenda-show-window nil)
8656 (defun org-agenda-show-and-scroll-up (&optional arg)
8657   "Display the Org file which contains the item at point.
8658
8659 When called repeatedly, scroll the window that is displaying the buffer.
8660
8661 With a `\\[universal-argument]' prefix, use `org-show-entry' instead of \
8662 `outline-show-subtree'
8663 to display the item, so that drawers and logbooks stay folded."
8664   (interactive "P")
8665   (let ((win (selected-window)))
8666     (if (and (window-live-p org-agenda-show-window)
8667          (eq this-command last-command))
8668     (progn
8669       (select-window org-agenda-show-window)
8670       (ignore-errors (scroll-up)))
8671       (org-agenda-goto t)
8672       (if arg (org-show-entry) (outline-show-subtree))
8673       (setq org-agenda-show-window (selected-window)))
8674     (select-window win)))
8675
8676 (defun org-agenda-show-scroll-down ()
8677   "Scroll down the window showing the agenda."
8678   (interactive)
8679   (let ((win (selected-window)))
8680     (when (window-live-p org-agenda-show-window)
8681       (select-window org-agenda-show-window)
8682       (ignore-errors (scroll-down))
8683       (select-window win))))
8684
8685 (defun org-agenda-show-1 (&optional more)
8686   "Display the Org file which contains the item at point.
8687 The prefix arg selects the amount of information to display:
8688
8689 0   hide the subtree
8690 1   just show the entry according to defaults.
8691 2   show the children view
8692 3   show the subtree view
8693 4   show the entire subtree and any LOGBOOK drawers
8694 5   show the entire subtree and any drawers
8695 With prefix argument FULL-ENTRY, make the entire entry visible
8696 if it was hidden in the outline."
8697   (interactive "p")
8698   (let ((win (selected-window)))
8699     (org-agenda-goto t)
8700     (org-back-to-heading)
8701     (set-window-start (selected-window) (point-at-bol))
8702     (cond
8703      ((= more 0)
8704       (outline-hide-subtree)
8705       (save-excursion
8706     (org-back-to-heading)
8707     (run-hook-with-args 'org-cycle-hook 'folded))
8708       (message "Remote: FOLDED"))
8709      ((and (called-interactively-p 'any) (= more 1))
8710       (message "Remote: show with default settings"))
8711      ((= more 2)
8712       (outline-show-entry)
8713       (org-show-children)
8714       (save-excursion
8715     (org-back-to-heading)
8716     (run-hook-with-args 'org-cycle-hook 'children))
8717       (message "Remote: CHILDREN"))
8718      ((= more 3)
8719       (outline-show-subtree)
8720       (save-excursion
8721     (org-back-to-heading)
8722     (run-hook-with-args 'org-cycle-hook 'subtree))
8723       (message "Remote: SUBTREE"))
8724      ((= more 4)
8725       (outline-show-subtree)
8726       (save-excursion
8727     (org-back-to-heading)
8728     (org-cycle-hide-drawers 'subtree '("LOGBOOK")))
8729       (message "Remote: SUBTREE AND LOGBOOK"))
8730      ((> more 4)
8731       (outline-show-subtree)
8732       (message "Remote: SUBTREE AND ALL DRAWERS")))
8733     (select-window win)))
8734
8735 (defvar org-agenda-cycle-counter nil)
8736 (defun org-agenda-cycle-show (&optional n)
8737   "Show the current entry in another window, with default settings.
8738
8739 Default settings are taken from `org-show-context-detail'.  When
8740 use repeatedly in immediate succession, the remote entry will
8741 cycle through visibility
8742
8743   children -> subtree -> folded
8744
8745 When called with a numeric prefix arg, that arg will be passed through to
8746 `org-agenda-show-1'.  For the interpretation of that argument, see the
8747 docstring of `org-agenda-show-1'."
8748   (interactive "P")
8749   (if (integerp n)
8750       (setq org-agenda-cycle-counter n)
8751     (if (not (eq last-command this-command))
8752     (setq org-agenda-cycle-counter 1)
8753       (if (equal org-agenda-cycle-counter 0)
8754       (setq org-agenda-cycle-counter 2)
8755     (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter))
8756     (if (> org-agenda-cycle-counter 3)
8757         (setq org-agenda-cycle-counter 0)))))
8758   (org-agenda-show-1 org-agenda-cycle-counter))
8759
8760 (defun org-agenda-recenter (arg)
8761   "Display the Org file which contains the item at point and recenter."
8762   (interactive "P")
8763   (let ((win (selected-window)))
8764     (org-agenda-goto t)
8765     (recenter arg)
8766     (select-window win)))
8767
8768 (defun org-agenda-show-mouse (ev)
8769   "Display the Org file which contains the item at the mouse click."
8770   (interactive "e")
8771   (mouse-set-point ev)
8772   (org-agenda-show))
8773
8774 (defun org-agenda-check-no-diary ()
8775   "Check if the entry is a diary link and abort if yes."
8776   (if (org-get-at-bol 'org-agenda-diary-link)
8777       (org-agenda-error)))
8778
8779 (defun org-agenda-error ()
8780   "Throw an error when a command is not allowed in the agenda."
8781   (user-error "Command not allowed in this line"))
8782
8783 (defun org-agenda-tree-to-indirect-buffer (arg)
8784   "Show the subtree corresponding to the current entry in an indirect buffer.
8785 This calls the command `org-tree-to-indirect-buffer' from the original buffer.
8786
8787 With a numerical prefix ARG, go up to this level and then take that tree.
8788 With a negative numeric ARG, go up by this number of levels.
8789
8790 With a `\\[universal-argument]' prefix, make a separate frame for this tree, \
8791 i.e. don't use
8792 the dedicated frame."
8793   (interactive "P")
8794   (if current-prefix-arg
8795       (org-agenda-do-tree-to-indirect-buffer arg)
8796     (let ((agenda-buffer (buffer-name))
8797       (agenda-window (selected-window))
8798           (indirect-window
8799        (and org-last-indirect-buffer
8800         (get-buffer-window org-last-indirect-buffer))))
8801       (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg))
8802       (unless (or (eq org-indirect-buffer-display 'new-frame)
8803           (eq org-indirect-buffer-display 'dedicated-frame))
8804     (unwind-protect
8805         (unless (and indirect-window (window-live-p indirect-window))
8806           (setq indirect-window (split-window agenda-window)))
8807       (and indirect-window (select-window indirect-window))
8808       (switch-to-buffer org-last-indirect-buffer :norecord)
8809       (fit-window-to-buffer indirect-window)))
8810       (select-window (get-buffer-window agenda-buffer))
8811       (setq org-agenda-last-indirect-buffer org-last-indirect-buffer))))
8812
8813 (defun org-agenda-do-tree-to-indirect-buffer (arg)
8814   "Same as `org-agenda-tree-to-indirect-buffer' without saving window."
8815   (org-agenda-check-no-diary)
8816   (let* ((marker (or (org-get-at-bol 'org-marker)
8817              (org-agenda-error)))
8818      (buffer (marker-buffer marker))
8819      (pos (marker-position marker)))
8820     (with-current-buffer buffer
8821       (save-excursion
8822     (goto-char pos)
8823     (funcall 'org-tree-to-indirect-buffer arg)))))
8824
8825 (defvar org-last-heading-marker (make-marker)
8826   "Marker pointing to the headline that last changed its TODO state
8827 by a remote command from the agenda.")
8828
8829 (defun org-agenda-todo-nextset ()
8830   "Switch TODO entry to next sequence."
8831   (interactive)
8832   (org-agenda-todo 'nextset))
8833
8834 (defun org-agenda-todo-previousset ()
8835   "Switch TODO entry to previous sequence."
8836   (interactive)
8837   (org-agenda-todo 'previousset))
8838
8839 (defun org-agenda-todo (&optional arg)
8840   "Cycle TODO state of line at point, also in Org file.
8841 This changes the line at point, all other lines in the agenda referring to
8842 the same tree node, and the headline of the tree node in the Org file."
8843   (interactive "P")
8844   (org-agenda-check-no-diary)
8845   (let* ((col (current-column))
8846      (marker (or (org-get-at-bol 'org-marker)
8847              (org-agenda-error)))
8848      (buffer (marker-buffer marker))
8849      (pos (marker-position marker))
8850      (hdmarker (org-get-at-bol 'org-hd-marker))
8851      (todayp (org-agenda-today-p (org-get-at-bol 'day)))
8852      (inhibit-read-only t)
8853      org-agenda-headline-snapshot-before-repeat newhead just-one)
8854     (org-with-remote-undo buffer
8855       (with-current-buffer buffer
8856     (widen)
8857     (goto-char pos)
8858     (org-show-context 'agenda)
8859     (let ((current-prefix-arg arg))
8860       (call-interactively 'org-todo))
8861     (and (bolp) (forward-char 1))
8862     (setq newhead (org-get-heading))
8863     (when (and (bound-and-true-p
8864             org-agenda-headline-snapshot-before-repeat)
8865            (not (equal org-agenda-headline-snapshot-before-repeat
8866                    newhead))
8867            todayp)
8868       (setq newhead org-agenda-headline-snapshot-before-repeat
8869         just-one t))
8870     (save-excursion
8871       (org-back-to-heading)
8872       (move-marker org-last-heading-marker (point))))
8873       (beginning-of-line 1)
8874       (save-window-excursion
8875     (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
8876       (when (bound-and-true-p org-clock-out-when-done)
8877           (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
8878               newhead)
8879     (org-agenda-unmark-clocking-task))
8880       (org-move-to-column col)
8881       (org-agenda-mark-clocking-task))))
8882
8883 (defun org-agenda-add-note (&optional arg)
8884   "Add a time-stamped note to the entry at point."
8885   (interactive "P")
8886   (org-agenda-check-no-diary)
8887   (let* ((marker (or (org-get-at-bol 'org-marker)
8888              (org-agenda-error)))
8889      (buffer (marker-buffer marker))
8890      (pos (marker-position marker))
8891      (hdmarker (org-get-at-bol 'org-hd-marker))
8892      (inhibit-read-only t))
8893     (with-current-buffer buffer
8894       (widen)
8895       (goto-char pos)
8896       (org-show-context 'agenda)
8897       (org-add-note))))
8898
8899 (defun org-agenda-change-all-lines (newhead hdmarker
8900                         &optional fixface just-this)
8901   "Change all lines in the agenda buffer which match HDMARKER.
8902 The new content of the line will be NEWHEAD (as modified by
8903 `org-agenda-format-item').  HDMARKER is checked with
8904 `equal' against all `org-hd-marker' text properties in the file.
8905 If FIXFACE is non-nil, the face of each item is modified according to
8906 the new TODO state.
8907 If JUST-THIS is non-nil, change just the current line, not all.
8908 If FORCE-TAGS is non nil, the car of it returns the new tags."
8909   (let* ((inhibit-read-only t)
8910      (line (org-current-line))
8911      (org-agenda-buffer (current-buffer))
8912      (thetags (with-current-buffer (marker-buffer hdmarker)
8913             (org-with-wide-buffer
8914              (goto-char hdmarker)
8915              (org-get-tags-at))))
8916      props m pl undone-face done-face finish new dotime level cat tags)
8917     (save-excursion
8918       (goto-char (point-max))
8919       (beginning-of-line 1)
8920       (while (not finish)
8921     (setq finish (bobp))
8922     (when (and (setq m (org-get-at-bol 'org-hd-marker))
8923            (or (not just-this) (= (org-current-line) line))
8924            (equal m hdmarker))
8925       (setq props (text-properties-at (point))
8926         dotime (org-get-at-bol 'dotime)
8927         cat (org-get-at-eol 'org-category 1)
8928         level (org-get-at-bol 'level)
8929         tags thetags
8930         new
8931         (let ((org-prefix-format-compiled
8932                (or (get-text-property (min (1- (point-max)) (point)) 'format)
8933                org-prefix-format-compiled))
8934               (extra (org-get-at-bol 'extra)))
8935           (with-current-buffer (marker-buffer hdmarker)
8936             (org-with-wide-buffer
8937              (org-agenda-format-item extra newhead level cat tags dotime))))
8938         pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
8939         undone-face (org-get-at-bol 'undone-face)
8940         done-face (org-get-at-bol 'done-face))
8941       (beginning-of-line 1)
8942       (cond
8943        ((equal new "") (delete-region (point) (line-beginning-position 2)))
8944        ((looking-at ".*")
8945         ;; When replacing the whole line, preserve bulk mark
8946         ;; overlay, if any.
8947         (let ((mark (catch :overlay
8948               (dolist (o (overlays-in (point) (+ 2 (point))))
8949                 (when (eq (overlay-get o 'type)
8950                       'org-marked-entry-overlay)
8951                   (throw :overlay o))))))
8952           (replace-match new t t)
8953           (beginning-of-line)
8954           (when mark (move-overlay mark (point) (+ 2 (point)))))
8955         (add-text-properties (point-at-bol) (point-at-eol) props)
8956         (when fixface
8957           (add-text-properties
8958            (point-at-bol) (point-at-eol)
8959            (list 'face
8960              (if org-last-todo-state-is-todo
8961              undone-face done-face))))
8962         (org-agenda-highlight-todo 'line)
8963         (beginning-of-line 1))
8964        (t (error "Line update did not work")))
8965       (save-restriction
8966         (narrow-to-region (point-at-bol) (point-at-eol))
8967         (org-agenda-finalize)))
8968     (beginning-of-line 0)))))
8969
8970 (defun org-agenda-align-tags (&optional line)
8971   "Align all tags in agenda items to `org-agenda-tags-column'."
8972   (let ((inhibit-read-only t)
8973     (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
8974                     (- (window-text-width))
8975                   org-agenda-tags-column))
8976     l c)
8977     (save-excursion
8978       (goto-char (if line (point-at-bol) (point-min)))
8979       (while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
8980                 (if line (point-at-eol) nil) t)
8981     (add-text-properties
8982      (match-beginning 2) (match-end 2)
8983      (list 'face (delq nil (let ((prop (get-text-property
8984                         (match-beginning 2) 'face)))
8985                  (or (listp prop) (setq prop (list prop)))
8986                  (if (memq 'org-tag prop)
8987                      prop
8988                    (cons 'org-tag prop))))))
8989     (setq l (- (match-end 2) (match-beginning 2))
8990           c (if (< org-agenda-tags-column 0)
8991             (- (abs org-agenda-tags-column) l)
8992           org-agenda-tags-column))
8993     (delete-region (match-beginning 1) (match-end 1))
8994     (goto-char (match-beginning 1))
8995     (insert (org-add-props
8996             (make-string (max 1 (- c (current-column))) ?\ )
8997             (plist-put (copy-sequence (text-properties-at (point)))
8998                    'face nil))))
8999       (goto-char (point-min))
9000       (org-font-lock-add-tag-faces (point-max)))))
9001
9002 (defun org-agenda-priority-up ()
9003   "Increase the priority of line at point, also in Org file."
9004   (interactive)
9005   (org-agenda-priority 'up))
9006
9007 (defun org-agenda-priority-down ()
9008   "Decrease the priority of line at point, also in Org file."
9009   (interactive)
9010   (org-agenda-priority 'down))
9011
9012 (defun org-agenda-priority (&optional force-direction)
9013   "Set the priority of line at point, also in Org file.
9014 This changes the line at point, all other lines in the agenda referring to
9015 the same tree node, and the headline of the tree node in the Org file.
9016 Called with a universal prefix arg, show the priority instead of setting it."
9017   (interactive "P")
9018   (if (equal force-direction '(4))
9019       (org-show-priority)
9020     (unless org-enable-priority-commands
9021       (error "Priority commands are disabled"))
9022     (org-agenda-check-no-diary)
9023     (let* ((col (current-column))
9024        (marker (or (org-get-at-bol 'org-marker)
9025                (org-agenda-error)))
9026        (hdmarker (org-get-at-bol 'org-hd-marker))
9027        (buffer (marker-buffer hdmarker))
9028        (pos (marker-position hdmarker))
9029        (inhibit-read-only t)
9030        newhead)
9031       (org-with-remote-undo buffer
9032     (with-current-buffer buffer
9033       (widen)
9034       (goto-char pos)
9035       (org-show-context 'agenda)
9036       (funcall 'org-priority force-direction)
9037       (end-of-line 1)
9038       (setq newhead (org-get-heading)))
9039     (org-agenda-change-all-lines newhead hdmarker)
9040     (org-move-to-column col)))))
9041
9042 ;; FIXME: should fix the tags property of the agenda line.
9043 (defun org-agenda-set-tags (&optional tag onoff)
9044   "Set tags for the current headline."
9045   (interactive)
9046   (org-agenda-check-no-diary)
9047   (if (and (org-region-active-p) (called-interactively-p 'any))
9048       (call-interactively 'org-change-tag-in-region)
9049     (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
9050              (org-agenda-error)))
9051        (buffer (marker-buffer hdmarker))
9052        (pos (marker-position hdmarker))
9053        (inhibit-read-only t)
9054        newhead)
9055       (org-with-remote-undo buffer
9056     (with-current-buffer buffer
9057       (widen)
9058       (goto-char pos)
9059       (org-show-context 'agenda)
9060       (if tag
9061           (org-toggle-tag tag onoff)
9062         (call-interactively 'org-set-tags))
9063       (end-of-line 1)
9064       (setq newhead (org-get-heading)))
9065     (org-agenda-change-all-lines newhead hdmarker)
9066     (beginning-of-line 1)))))
9067
9068 (defun org-agenda-set-property ()
9069   "Set a property for the current headline."
9070   (interactive)
9071   (org-agenda-check-no-diary)
9072   (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
9073                (org-agenda-error)))
9074      (buffer (marker-buffer hdmarker))
9075      (pos (marker-position hdmarker))
9076      (inhibit-read-only t)
9077      newhead)
9078     (org-with-remote-undo buffer
9079       (with-current-buffer buffer
9080     (widen)
9081     (goto-char pos)
9082     (org-show-context 'agenda)
9083     (call-interactively 'org-set-property)))))
9084
9085 (defun org-agenda-set-effort ()
9086   "Set the effort property for the current headline."
9087   (interactive)
9088   (org-agenda-check-no-diary)
9089   (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
9090                (org-agenda-error)))
9091      (buffer (marker-buffer hdmarker))
9092      (pos (marker-position hdmarker))
9093      (inhibit-read-only t)
9094      newhead)
9095     (org-with-remote-undo buffer
9096       (with-current-buffer buffer
9097     (widen)
9098     (goto-char pos)
9099     (org-show-context 'agenda)
9100     (call-interactively 'org-set-effort)
9101     (end-of-line 1)
9102     (setq newhead (org-get-heading)))
9103       (org-agenda-change-all-lines newhead hdmarker))))
9104
9105 (defun org-agenda-toggle-archive-tag ()
9106   "Toggle the archive tag for the current entry."
9107   (interactive)
9108   (org-agenda-check-no-diary)
9109   (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
9110                        (org-agenda-error)))
9111      (buffer (marker-buffer hdmarker))
9112      (pos (marker-position hdmarker))
9113      (inhibit-read-only t)
9114      newhead)
9115     (org-with-remote-undo buffer
9116       (with-current-buffer buffer
9117     (widen)
9118     (goto-char pos)
9119     (org-show-context 'agenda)
9120     (call-interactively 'org-toggle-archive-tag)
9121     (end-of-line 1)
9122     (setq newhead (org-get-heading)))
9123       (org-agenda-change-all-lines newhead hdmarker)
9124       (beginning-of-line 1))))
9125
9126 (defun org-agenda-do-date-later (arg)
9127   (interactive "P")
9128   (cond
9129    ((or (equal arg '(16))
9130     (memq last-command
9131           '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
9132     (setq this-command 'org-agenda-date-later-minutes)
9133     (org-agenda-date-later-minutes 1))
9134    ((or (equal arg '(4))
9135     (memq last-command
9136           '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
9137     (setq this-command 'org-agenda-date-later-hours)
9138     (org-agenda-date-later-hours 1))
9139    (t
9140     (org-agenda-date-later (prefix-numeric-value arg)))))
9141
9142 (defun org-agenda-do-date-earlier (arg)
9143   (interactive "P")
9144   (cond
9145    ((or (equal arg '(16))
9146     (memq last-command
9147           '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
9148     (setq this-command 'org-agenda-date-earlier-minutes)
9149     (org-agenda-date-earlier-minutes 1))
9150    ((or (equal arg '(4))
9151     (memq last-command
9152           '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
9153     (setq this-command 'org-agenda-date-earlier-hours)
9154     (org-agenda-date-earlier-hours 1))
9155    (t
9156     (org-agenda-date-earlier (prefix-numeric-value arg)))))
9157
9158 (defun org-agenda-date-later (arg &optional what)
9159   "Change the date of this item to ARG day(s) later."
9160   (interactive "p")
9161   (org-agenda-check-type t 'agenda)
9162   (org-agenda-check-no-diary)
9163   (let* ((marker (or (org-get-at-bol 'org-marker)
9164              (org-agenda-error)))
9165      (buffer (marker-buffer marker))
9166      (pos (marker-position marker))
9167      cdate today)
9168     (org-with-remote-undo buffer
9169       (with-current-buffer buffer
9170     (widen)
9171     (goto-char pos)
9172     (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
9173     (when (and org-agenda-move-date-from-past-immediately-to-today
9174            (equal arg 1)
9175            (or (not what) (eq what 'day))
9176            (not (save-match-data (org-at-date-range-p))))
9177       (setq cdate (org-parse-time-string (match-string 0) 'nodefault)
9178         cdate (calendar-absolute-from-gregorian
9179                (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
9180         today (org-today))
9181       (if (> today cdate)
9182           ;; immediately shift to today
9183           (setq arg (- today cdate))))
9184     (org-timestamp-change arg (or what 'day))
9185     (when (and (org-at-date-range-p)
9186            (re-search-backward org-tr-regexp-both (point-at-bol)))
9187       (let ((end org-last-changed-timestamp))
9188         (org-timestamp-change arg (or what 'day))
9189         (setq org-last-changed-timestamp
9190           (concat org-last-changed-timestamp "--" end)))))
9191       (org-agenda-show-new-time marker org-last-changed-timestamp))
9192     (message "Time stamp changed to %s" org-last-changed-timestamp)))
9193
9194 (defun org-agenda-date-earlier (arg &optional what)
9195   "Change the date of this item to ARG day(s) earlier."
9196   (interactive "p")
9197   (org-agenda-date-later (- arg) what))
9198
9199 (defun org-agenda-date-later-minutes (arg)
9200   "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
9201   (interactive "p")
9202   (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
9203   (org-agenda-date-later arg 'minute))
9204
9205 (defun org-agenda-date-earlier-minutes (arg)
9206   "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
9207   (interactive "p")
9208   (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
9209   (org-agenda-date-earlier arg 'minute))
9210
9211 (defun org-agenda-date-later-hours (arg)
9212   "Change the time of this item, in hour steps."
9213   (interactive "p")
9214   (org-agenda-date-later arg 'hour))
9215
9216 (defun org-agenda-date-earlier-hours (arg)
9217   "Change the time of this item, in hour steps."
9218   (interactive "p")
9219   (org-agenda-date-earlier arg 'hour))
9220
9221 (defun org-agenda-show-new-time (marker stamp &optional prefix)
9222   "Show new date stamp via text properties."
9223   ;; We use text properties to make this undoable
9224   (let ((inhibit-read-only t))
9225     (setq stamp (concat prefix " => " stamp " "))
9226     (save-excursion
9227       (goto-char (point-max))
9228       (while (not (bobp))
9229     (when (equal marker (org-get-at-bol 'org-marker))
9230       (remove-text-properties (point-at-bol) (point-at-eol) '(display))
9231       (org-move-to-column (- (window-width) (length stamp)) t)
9232           (add-text-properties
9233        (1- (point)) (point-at-eol)
9234        (list 'display (org-add-props stamp nil
9235                 'face '(secondary-selection default))))
9236       (beginning-of-line 1))
9237     (beginning-of-line 0)))))
9238
9239 (defun org-agenda-date-prompt (arg)
9240   "Change the date of this item.  Date is prompted for, with default today.
9241 The prefix ARG is passed to the `org-time-stamp' command and can therefore
9242 be used to request time specification in the time stamp."
9243   (interactive "P")
9244   (org-agenda-check-type t 'agenda)
9245   (org-agenda-check-no-diary)
9246   (let* ((marker (or (org-get-at-bol 'org-marker)
9247              (org-agenda-error)))
9248      (buffer (marker-buffer marker))
9249      (pos (marker-position marker)))
9250     (org-with-remote-undo buffer
9251       (with-current-buffer buffer
9252     (widen)
9253     (goto-char pos)
9254     (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
9255     (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
9256       (org-agenda-show-new-time marker org-last-changed-timestamp))
9257     (message "Time stamp changed to %s" org-last-changed-timestamp)))
9258
9259 (defun org-agenda-schedule (arg &optional time)
9260   "Schedule the item at point.
9261 ARG is passed through to `org-schedule'."
9262   (interactive "P")
9263   (org-agenda-check-type t 'agenda 'todo 'tags 'search)
9264   (org-agenda-check-no-diary)
9265   (let* ((marker (or (org-get-at-bol 'org-marker)
9266              (org-agenda-error)))
9267      (type (marker-insertion-type marker))
9268      (buffer (marker-buffer marker))
9269      (pos (marker-position marker))
9270      ts)
9271     (set-marker-insertion-type marker t)
9272     (org-with-remote-undo buffer
9273       (with-current-buffer buffer
9274     (widen)
9275     (goto-char pos)
9276     (setq ts (org-schedule arg time)))
9277       (org-agenda-show-new-time marker ts " S"))
9278     (message "%s" ts)))
9279
9280 (defun org-agenda-deadline (arg &optional time)
9281   "Schedule the item at point.
9282 ARG is passed through to `org-deadline'."
9283   (interactive "P")
9284   (org-agenda-check-type t 'agenda 'todo 'tags 'search)
9285   (org-agenda-check-no-diary)
9286   (let* ((marker (or (org-get-at-bol 'org-marker)
9287              (org-agenda-error)))
9288      (buffer (marker-buffer marker))
9289      (pos (marker-position marker))
9290      ts)
9291     (org-with-remote-undo buffer
9292       (with-current-buffer buffer
9293     (widen)
9294     (goto-char pos)
9295     (setq ts (org-deadline arg time)))
9296       (org-agenda-show-new-time marker ts " D"))
9297     (message "%s" ts)))
9298
9299 (defun org-agenda-clock-in (&optional arg)
9300   "Start the clock on the currently selected item."
9301   (interactive "P")
9302   (org-agenda-check-no-diary)
9303   (if (equal arg '(4))
9304       (org-clock-in arg)
9305     (let* ((marker (or (org-get-at-bol 'org-marker)
9306                (org-agenda-error)))
9307        (hdmarker (or (org-get-at-bol 'org-hd-marker) marker))
9308        (pos (marker-position marker))
9309        (col (current-column))
9310        newhead)
9311       (org-with-remote-undo (marker-buffer marker)
9312         (with-current-buffer (marker-buffer marker)
9313       (widen)
9314       (goto-char pos)
9315       (org-show-context 'agenda)
9316       (org-cycle-hide-drawers 'children)
9317       (org-clock-in arg)
9318       (setq newhead (org-get-heading)))
9319     (org-agenda-change-all-lines newhead hdmarker))
9320       (org-move-to-column col))))
9321
9322 (defun org-agenda-clock-out ()
9323   "Stop the currently running clock."
9324   (interactive)
9325   (unless (marker-buffer org-clock-marker)
9326     (error "No running clock"))
9327   (let ((marker (make-marker)) (col (current-column)) newhead)
9328     (org-with-remote-undo (marker-buffer org-clock-marker)
9329       (with-current-buffer (marker-buffer org-clock-marker)
9330     (org-with-wide-buffer
9331      (goto-char org-clock-marker)
9332      (org-back-to-heading t)
9333      (move-marker marker (point))
9334      (org-clock-out)
9335      (setq newhead (org-get-heading)))))
9336     (org-agenda-change-all-lines newhead marker)
9337     (move-marker marker nil)
9338     (org-move-to-column col)
9339     (org-agenda-unmark-clocking-task)))
9340
9341 (defun org-agenda-clock-cancel (&optional arg)
9342   "Cancel the currently running clock."
9343   (interactive "P")
9344   (unless (marker-buffer org-clock-marker)
9345     (user-error "No running clock"))
9346   (org-with-remote-undo (marker-buffer org-clock-marker)
9347     (org-clock-cancel)))
9348
9349 (defun org-agenda-clock-goto ()
9350   "Jump to the currently clocked in task within the agenda.
9351 If the currently clocked in task is not listed in the agenda
9352 buffer, display it in another window."
9353   (interactive)
9354   (let (pos)
9355     (mapc (lambda (o)
9356         (if (eq (overlay-get o 'type) 'org-agenda-clocking)
9357         (setq pos (overlay-start o))))
9358       (overlays-in (point-min) (point-max)))
9359     (cond (pos (goto-char pos))
9360       ;; If the currently clocked entry is not in the agenda
9361       ;; buffer, we visit it in another window:
9362       ((bound-and-true-p org-clock-current-task)
9363        (org-switch-to-buffer-other-window (org-clock-goto)))
9364       (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
9365
9366 (defun org-agenda-diary-entry-in-org-file ()
9367   "Make a diary entry in the file `org-agenda-diary-file'."
9368   (let (d1 d2 char (text "") dp1 dp2)
9369     (if (equal (buffer-name) "*Calendar*")
9370     (setq d1 (calendar-cursor-to-date t)
9371           d2 (car calendar-mark-ring))
9372       (setq dp1 (get-text-property (point-at-bol) 'day))
9373       (unless dp1 (user-error "No date defined in current line"))
9374       (setq d1 (calendar-gregorian-from-absolute dp1)
9375         d2 (and (ignore-errors (mark))
9376             (save-excursion
9377               (goto-char (mark))
9378               (setq dp2 (get-text-property (point-at-bol) 'day)))
9379             (calendar-gregorian-from-absolute dp2))))
9380     (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree")
9381     (setq char (read-char-exclusive))
9382     (cond
9383      ((equal char ?d)
9384       (setq text (read-string "Day entry: "))
9385       (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1)
9386       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
9387      ((equal char ?a)
9388       (setq d1 (list (car d1) (nth 1 d1)
9389              (read-number (format "Reference year [%d]: " (nth 2 d1))
9390                   (nth 2 d1))))
9391       (setq text (read-string "Anniversary (use %d to show years): "))
9392       (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1)
9393       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
9394      ((equal char ?b)
9395       (setq text (read-string "Block entry: "))
9396       (unless (and d1 d2 (not (equal d1 d2)))
9397     (user-error "No block of days selected"))
9398       (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2)
9399       (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
9400      ((equal char ?j)
9401       (org-switch-to-buffer-other-window
9402        (find-file-noselect org-agenda-diary-file))
9403       (require 'org-datetree)
9404       (org-datetree-find-date-create d1)
9405       (org-reveal t))
9406      (t (user-error "Invalid selection character `%c'" char)))))
9407
9408 (defcustom org-agenda-insert-diary-strategy 'date-tree
9409   "Where in `org-agenda-diary-file' should new entries be added?
9410 Valid values:
9411
9412 date-tree         in the date tree, as first child of the date
9413 date-tree-last    in the date tree, as last child of the date
9414 top-level         as top-level entries at the end of the file."
9415   :group 'org-agenda
9416   :type '(choice
9417       (const :tag "first in a date tree" date-tree)
9418       (const :tag "last in a date tree" date-tree-last)
9419       (const :tag "as top level at end of file" top-level)))
9420
9421 (defcustom org-agenda-insert-diary-extract-time nil
9422   "Non-nil means extract any time specification from the diary entry."
9423   :group 'org-agenda
9424   :version "24.1"
9425   :type 'boolean)
9426
9427 (defcustom org-agenda-bulk-mark-char ">"
9428   "A single-character string to be used as the bulk mark."
9429   :group 'org-agenda
9430   :version "24.1"
9431   :type 'string)
9432
9433 (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
9434   "Add a diary entry with TYPE to `org-agenda-diary-file'.
9435 If TEXT is not empty, it will become the headline of the new entry, and
9436 the resulting entry will not be shown.  When TEXT is empty, switch to
9437 `org-agenda-diary-file' and let the user finish the entry there."
9438   (let ((cw (current-window-configuration)))
9439     (org-switch-to-buffer-other-window
9440      (find-file-noselect org-agenda-diary-file))
9441     (widen)
9442     (goto-char (point-min))
9443     (cond
9444      ((eq type 'anniversary)
9445       (or (re-search-forward "^*[ \t]+Anniversaries" nil t)
9446       (progn
9447         (or (org-at-heading-p t)
9448         (progn
9449           (outline-next-heading)
9450           (insert "* Anniversaries\n\n")
9451           (beginning-of-line -1)))))
9452       (outline-next-heading)
9453       (org-back-over-empty-lines)
9454       (backward-char 1)
9455       (insert "\n")
9456       (insert (format "%%%%(org-anniversary %d %2d %2d) %s"
9457               (nth 2 d1) (car d1) (nth 1 d1) text)))
9458      ((eq type 'day)
9459       (let ((org-prefix-has-time t)
9460         (org-agenda-time-leading-zero t)
9461         fmt time time2)
9462     (if org-agenda-insert-diary-extract-time
9463         ;; Use org-agenda-format-item to parse text for a time-range and
9464         ;; remove it.  FIXME: This is a hack, we should refactor
9465         ;; that function to make time extraction available separately
9466         (setq fmt (org-agenda-format-item nil text nil nil nil t)
9467           time (get-text-property 0 'time fmt)
9468           time2 (if (> (length time) 0)
9469                 ;; split-string removes trailing ...... if
9470                 ;; no end time given.  First space
9471                 ;; separates time from date.
9472                 (concat " " (car (split-string time "\\.")))
9473               nil)
9474           text (get-text-property 0 'txt fmt)))
9475     (if (eq org-agenda-insert-diary-strategy 'top-level)
9476         (org-agenda-insert-diary-as-top-level text)
9477       (require 'org-datetree)
9478       (org-datetree-find-date-create d1)
9479       (org-agenda-insert-diary-make-new-entry text))
9480     (org-insert-time-stamp (org-time-from-absolute
9481                 (calendar-absolute-from-gregorian d1))
9482                    nil nil nil nil time2))
9483       (end-of-line 0))
9484      ((eq type 'block)
9485       (if (> (calendar-absolute-from-gregorian d1)
9486          (calendar-absolute-from-gregorian d2))
9487       (setq d1 (prog1 d2 (setq d2 d1))))
9488       (if (eq org-agenda-insert-diary-strategy 'top-level)
9489       (org-agenda-insert-diary-as-top-level text)
9490     (require 'org-datetree)
9491     (org-datetree-find-date-create d1)
9492     (org-agenda-insert-diary-make-new-entry text))
9493       (org-insert-time-stamp (org-time-from-absolute
9494                   (calendar-absolute-from-gregorian d1)))
9495       (insert "--")
9496       (org-insert-time-stamp (org-time-from-absolute
9497                   (calendar-absolute-from-gregorian d2)))
9498       (end-of-line 0)))
9499     (if (string-match "\\S-" text)
9500     (progn
9501       (set-window-configuration cw)
9502       (message "%s entry added to %s"
9503            (capitalize (symbol-name type))
9504            (abbreviate-file-name org-agenda-diary-file)))
9505       (org-reveal t)
9506       (message "Please finish entry here"))))
9507
9508 (defun org-agenda-insert-diary-as-top-level (text)
9509   "Make new entry as a top-level entry at the end of the file.
9510 Add TEXT as headline, and position the cursor in the second line so that
9511 a timestamp can be added there."
9512   (widen)
9513   (goto-char (point-max))
9514   (unless (bolp) (insert "\n"))
9515   (org-insert-heading nil t t)
9516   (insert text)
9517   (org-end-of-meta-data)
9518   (unless (bolp) (insert "\n"))
9519   (when org-adapt-indentation (indent-to-column 2)))
9520
9521 (defun org-agenda-insert-diary-make-new-entry (text)
9522   "Make a new entry with TEXT as a child of the current subtree.
9523 Position the point in the heading's first body line so that
9524 a timestamp can be added there."
9525   (cond
9526    ((eq org-agenda-insert-diary-strategy 'date-tree-last)
9527     (end-of-line)
9528     (org-insert-heading '(4) t)
9529     (org-do-demote))
9530    (t
9531     (outline-next-heading)
9532     (org-back-over-empty-lines)
9533     (unless (looking-at "[ \t]*$") (save-excursion (insert "\n")))
9534     (org-insert-heading nil t)
9535     (org-do-demote)))
9536   (let ((col (current-column)))
9537     (insert text)
9538     (org-end-of-meta-data)
9539     ;; Ensure point is left on a blank line, at proper indentation.
9540     (unless (bolp) (insert "\n"))
9541     (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
9542     (when org-adapt-indentation (indent-to-column col)))
9543   (org-show-set-visibility 'lineage))
9544
9545 (defun org-agenda-diary-entry ()
9546   "Make a diary entry, like the `i' command from the calendar.
9547 All the standard commands work: block, weekly etc.
9548 When `org-agenda-diary-file' points to a file,
9549 `org-agenda-diary-entry-in-org-file' is called instead to create
9550 entries in that Org file."
9551   (interactive)
9552   (if (not (eq org-agenda-diary-file 'diary-file))
9553       (org-agenda-diary-entry-in-org-file)
9554     (require 'diary-lib)
9555     (let* ((char (progn
9556            (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
9557            (read-char-exclusive)))
9558        (cmd (cdr (assoc char
9559                 '((?d . diary-insert-entry)
9560                   (?w . diary-insert-weekly-entry)
9561                   (?m . diary-insert-monthly-entry)
9562                   (?y . diary-insert-yearly-entry)
9563                   (?a . diary-insert-anniversary-entry)
9564                   (?b . diary-insert-block-entry)
9565                   (?c . diary-insert-cyclic-entry)))))
9566        (oldf (symbol-function 'calendar-cursor-to-date))
9567        ;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
9568        (point (point))
9569        (mark (or (mark t) (point))))
9570       (unless cmd
9571     (user-error "No command associated with <%c>" char))
9572       (unless (and (get-text-property point 'day)
9573            (or (not (equal ?b char))
9574                (get-text-property mark 'day)))
9575     (user-error "Don't know which date to use for diary entry"))
9576       ;; We implement this by hacking the `calendar-cursor-to-date' function
9577       ;; and the `calendar-mark-ring' variable.  Saves a lot of code.
9578       (let ((calendar-mark-ring
9579          (list (calendar-gregorian-from-absolute
9580             (or (get-text-property mark 'day)
9581             (get-text-property point 'day))))))
9582     (unwind-protect
9583         (progn
9584           (fset 'calendar-cursor-to-date
9585             (lambda (&optional error dummy)
9586               (calendar-gregorian-from-absolute
9587                (get-text-property point 'day))))
9588           (call-interactively cmd))
9589       (fset 'calendar-cursor-to-date oldf))))))
9590
9591 (defun org-agenda-execute-calendar-command (cmd)
9592   "Execute a calendar command from the agenda with date from cursor."
9593   (org-agenda-check-type t 'agenda)
9594   (require 'diary-lib)
9595   (unless (get-text-property (min (1- (point-max)) (point)) 'day)
9596     (user-error "Don't know which date to use for the calendar command"))
9597   (let* ((oldf (symbol-function 'calendar-cursor-to-date))
9598      (point (point))
9599      (date (calendar-gregorian-from-absolute
9600         (get-text-property point 'day)))
9601          ;; the following 2 vars are needed in the calendar
9602      (displayed-month (car date))
9603      (displayed-year (nth 2 date)))
9604     (unwind-protect
9605     (progn
9606       (fset 'calendar-cursor-to-date
9607         (lambda (&optional error dummy)
9608           (calendar-gregorian-from-absolute
9609            (get-text-property point 'day))))
9610       (call-interactively cmd))
9611       (fset 'calendar-cursor-to-date oldf))))
9612
9613 (defun org-agenda-phases-of-moon ()
9614   "Display the phases of the moon for the 3 months around the cursor date."
9615   (interactive)
9616   (org-agenda-execute-calendar-command 'calendar-lunar-phases))
9617
9618 (defun org-agenda-holidays ()
9619   "Display the holidays for the 3 months around the cursor date."
9620   (interactive)
9621   (org-agenda-execute-calendar-command 'calendar-list-holidays))
9622
9623 (defvar calendar-longitude)      ; defined in calendar.el
9624 (defvar calendar-latitude)       ; defined in calendar.el
9625 (defvar calendar-location-name)  ; defined in calendar.el
9626
9627 (defun org-agenda-sunrise-sunset (arg)
9628   "Display sunrise and sunset for the cursor date.
9629 Latitude and longitude can be specified with the variables
9630 `calendar-latitude' and `calendar-longitude'.  When called with prefix
9631 argument, latitude and longitude will be prompted for."
9632   (interactive "P")
9633   (require 'solar)
9634   (let ((calendar-longitude (if arg nil calendar-longitude))
9635     (calendar-latitude  (if arg nil calendar-latitude))
9636     (calendar-location-name
9637      (if arg "the given coordinates" calendar-location-name)))
9638     (org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
9639
9640 (defun org-agenda-goto-calendar ()
9641   "Open the Emacs calendar with the date at the cursor."
9642   (interactive)
9643   (org-agenda-check-type t 'agenda)
9644   (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
9645           (user-error "Don't know which date to open in calendar")))
9646      (date (calendar-gregorian-from-absolute day))
9647      (calendar-move-hook nil)
9648      (calendar-view-holidays-initially-flag nil)
9649      (calendar-view-diary-initially-flag nil))
9650     (calendar)
9651     (calendar-goto-date date)))
9652
9653 ;;;###autoload
9654 (defun org-calendar-goto-agenda ()
9655   "Compute the Org agenda for the calendar date displayed at the cursor.
9656 This is a command that has to be installed in `calendar-mode-map'."
9657   (interactive)
9658   ;; Temporarily disable sticky agenda since user clearly wants to
9659   ;; refresh view anyway.
9660   (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*")
9661     (org-agenda-sticky nil))
9662     (org-agenda-list nil (calendar-absolute-from-gregorian
9663               (calendar-cursor-to-date))
9664              nil)))
9665
9666 (defun org-agenda-convert-date ()
9667   (interactive)
9668   (org-agenda-check-type t 'agenda)
9669   (let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
9670     date s)
9671     (unless day
9672       (user-error "Don't know which date to convert"))
9673     (setq date (calendar-gregorian-from-absolute day))
9674     (setq s (concat
9675          "Gregorian:  " (calendar-date-string date) "\n"
9676          "ISO:        " (calendar-iso-date-string date) "\n"
9677          "Day of Yr:  " (calendar-day-of-year-string date) "\n"
9678          "Julian:     " (calendar-julian-date-string date) "\n"
9679          "Astron. JD: " (calendar-astro-date-string date)
9680          " (Julian date number at noon UTC)\n"
9681          "Hebrew:     " (calendar-hebrew-date-string date) " (until sunset)\n"
9682          "Islamic:    " (calendar-islamic-date-string date) " (until sunset)\n"
9683          "French:     " (calendar-french-date-string date) "\n"
9684          "Bahá’í:     " (calendar-bahai-date-string date) " (until sunset)\n"
9685          "Mayan:      " (calendar-mayan-date-string date) "\n"
9686          "Coptic:     " (calendar-coptic-date-string date) "\n"
9687          "Ethiopic:   " (calendar-ethiopic-date-string date) "\n"
9688          "Persian:    " (calendar-persian-date-string date) "\n"
9689          "Chinese:    " (calendar-chinese-date-string date) "\n"))
9690     (with-output-to-temp-buffer "*Dates*"
9691       (princ s))
9692     (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
9693
9694 ;;; Bulk commands
9695
9696 (defun org-agenda-bulk-marked-p ()
9697   "Non-nil when current entry is marked for bulk action."
9698   (eq (get-char-property (point-at-bol) 'type)
9699       'org-marked-entry-overlay))
9700
9701 (defun org-agenda-bulk-mark (&optional arg)
9702   "Mark the entry at point for future bulk action."
9703   (interactive "p")
9704   (dotimes (i (or arg 1))
9705     (unless (org-get-at-bol 'org-agenda-diary-link)
9706       (let* ((m (org-get-at-bol 'org-hd-marker))
9707          ov)
9708     (unless (org-agenda-bulk-marked-p)
9709       (unless m (user-error "Nothing to mark at point"))
9710       (push m org-agenda-bulk-marked-entries)
9711       (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol))))
9712       (org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
9713                    (org-get-todo-face "TODO")
9714                    'evaporate)
9715       (overlay-put ov 'type 'org-marked-entry-overlay))
9716     (end-of-line 1)
9717     (or (ignore-errors
9718           (goto-char (next-single-property-change (point) 'org-hd-marker)))
9719         (beginning-of-line 2))
9720     (while (and (get-char-property (point) 'invisible) (not (eobp)))
9721       (beginning-of-line 2))
9722     (message "%d entries marked for bulk action"
9723          (length org-agenda-bulk-marked-entries))))))
9724
9725 (defun org-agenda-bulk-mark-all ()
9726   "Mark all entries for future agenda bulk action."
9727   (interactive)
9728   (org-agenda-bulk-mark-regexp "."))
9729
9730 (defun org-agenda-bulk-mark-regexp (regexp)
9731   "Mark entries matching REGEXP for future agenda bulk action."
9732   (interactive "sMark entries matching regexp: ")
9733   (let ((entries-marked 0) txt-at-point)
9734     (save-excursion
9735       (goto-char (point-min))
9736       (goto-char (next-single-property-change (point) 'org-hd-marker))
9737       (while (and (re-search-forward regexp nil t)
9738           (setq txt-at-point (get-text-property (point) 'txt)))
9739     (if (get-char-property (point) 'invisible)
9740         (beginning-of-line 2)
9741       (when (string-match regexp txt-at-point)
9742         (setq entries-marked (1+ entries-marked))
9743         (call-interactively 'org-agenda-bulk-mark)))))
9744
9745     (if (not entries-marked)
9746     (message "No entry matching this regexp."))))
9747
9748 (defun org-agenda-bulk-unmark (&optional arg)
9749   "Unmark the entry at point for future bulk action."
9750   (interactive "P")
9751   (if arg
9752       (org-agenda-bulk-unmark-all)
9753     (cond ((org-agenda-bulk-marked-p)
9754        (org-agenda-bulk-remove-overlays
9755         (point-at-bol) (+ 2 (point-at-bol)))
9756        (setq org-agenda-bulk-marked-entries
9757          (delete (org-get-at-bol 'org-hd-marker)
9758              org-agenda-bulk-marked-entries))
9759        (end-of-line 1)
9760        (or (ignore-errors
9761          (goto-char (next-single-property-change (point) 'txt)))
9762            (beginning-of-line 2))
9763        (while (and (get-char-property (point) 'invisible) (not (eobp)))
9764          (beginning-of-line 2))
9765        (message "%d entries left marked for bulk action"
9766             (length org-agenda-bulk-marked-entries)))
9767       (t (message "No entry to unmark here")))))
9768
9769 (defun org-agenda-bulk-toggle-all ()
9770   "Toggle all marks for bulk action."
9771   (interactive)
9772   (save-excursion
9773     (goto-char (point-min))
9774     (while (ignore-errors
9775          (goto-char (next-single-property-change (point) 'org-hd-marker)))
9776       (org-agenda-bulk-toggle))))
9777
9778 (defun org-agenda-bulk-toggle ()
9779   "Toggle the mark at point for bulk action."
9780   (interactive)
9781   (if (org-agenda-bulk-marked-p)
9782       (org-agenda-bulk-unmark)
9783     (org-agenda-bulk-mark)))
9784
9785 (defun org-agenda-bulk-remove-overlays (&optional beg end)
9786   "Remove the mark overlays between BEG and END in the agenda buffer.
9787 BEG and END default to the buffer limits.
9788
9789 This only removes the overlays, it does not remove the markers
9790 from the list in `org-agenda-bulk-marked-entries'."
9791   (interactive)
9792   (mapc (lambda (ov)
9793       (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay)
9794            (delete-overlay ov)))
9795     (overlays-in (or beg (point-min)) (or end (point-max)))))
9796
9797 (defun org-agenda-bulk-unmark-all ()
9798   "Remove all marks in the agenda buffer.
9799 This will remove the markers and the overlays."
9800   (interactive)
9801   (if (null org-agenda-bulk-marked-entries)
9802       (message "No entry to unmark")
9803     (setq org-agenda-bulk-marked-entries nil)
9804     (org-agenda-bulk-remove-overlays (point-min) (point-max))))
9805
9806 (defcustom org-agenda-persistent-marks nil
9807   "Non-nil means marked items will stay marked after a bulk action.
9808 You can toggle this interactively by typing `p' when prompted for a
9809 bulk action."
9810   :group 'org-agenda
9811   :version "24.1"
9812   :type 'boolean)
9813
9814 (defun org-agenda-bulk-action (&optional arg)
9815   "Execute an remote-editing action on all marked entries.
9816 The prefix arg is passed through to the command if possible."
9817   (interactive "P")
9818   ;; Make sure we have markers, and only valid ones.
9819   (unless org-agenda-bulk-marked-entries (user-error "No entries are marked"))
9820   (dolist (m org-agenda-bulk-marked-entries)
9821     (unless (and (markerp m)
9822          (marker-buffer m)
9823          (buffer-live-p (marker-buffer m))
9824          (marker-position m))
9825       (user-error "Marker %s for bulk command is invalid" m)))
9826
9827   ;; Prompt for the bulk command.
9828   (message
9829    (concat (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")
9830        "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
9831        "[S]catter [f]unction    "
9832        (and org-agenda-bulk-custom-functions
9833         (format " Custom: [%s]"
9834             (mapconcat (lambda (f) (char-to-string (car f)))
9835                    org-agenda-bulk-custom-functions
9836                    "")))))
9837   (catch 'exit
9838     (let* ((org-log-refile (if org-log-refile 'time nil))
9839        (entries (reverse org-agenda-bulk-marked-entries))
9840        (org-overriding-default-time
9841         (and (get-text-property (point) 'org-agenda-date-header)
9842          (org-get-cursor-date)))
9843        redo-at-end
9844        cmd)
9845       (pcase (read-char-exclusive)
9846     (?p
9847      (let ((org-agenda-persistent-marks
9848         (not org-agenda-persistent-marks)))
9849        (org-agenda-bulk-action)
9850        (throw 'exit nil)))
9851
9852     (?$
9853      (setq cmd #'org-agenda-archive))
9854
9855     (?A
9856      (setq cmd #'org-agenda-archive-to-archive-sibling))
9857
9858     ((or ?r ?w)
9859      (let ((refile-location
9860         (org-refile-get-location
9861          "Refile to"
9862          (marker-buffer (car entries))
9863          org-refile-allow-creating-parent-nodes)))
9864        (when (nth 3 refile-location)
9865          (setcar (nthcdr 3 refile-location)
9866              (move-marker
9867               (make-marker)
9868               (nth 3 refile-location)
9869               (or (get-file-buffer (nth 1 refile-location))
9870               (find-buffer-visiting (nth 1 refile-location))
9871               (error "This should not happen")))))
9872
9873        (setq cmd `(lambda () (org-agenda-refile nil ',refile-location t)))
9874        (setq redo-at-end t)))
9875
9876     (?t
9877      (let ((state (completing-read
9878                "Todo state: "
9879                (with-current-buffer (marker-buffer (car entries))
9880              (mapcar #'list org-todo-keywords-1)))))
9881        (setq cmd `(lambda ()
9882             (let ((org-inhibit-blocking t)
9883                   (org-inhibit-logging 'note))
9884               (org-agenda-todo ,state))))))
9885
9886     ((and (or ?- ?+) action)
9887      (let ((tag (completing-read
9888              (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
9889              (with-current-buffer (marker-buffer (car entries))
9890                (delq nil
9891                  (mapcar (lambda (x) (and (stringp (car x)) x))
9892                      org-current-tag-alist))))))
9893        (setq cmd
9894          `(lambda ()
9895             (org-agenda-set-tags ,tag
9896                      ,(if (eq action ?+) ''on ''off))))))
9897
9898     ((and (or ?s ?d) c)
9899      (let* ((schedule? (eq c ?s))
9900         (prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to"))
9901         (time
9902          (and (not arg)
9903               (let ((new (org-read-date
9904                   nil nil nil prompt org-overriding-default-time)))
9905             ;; A "double plus" answer applies to every
9906             ;; scheduled time.  Do not turn it into
9907             ;; a fixed date yet.
9908             (if (string-match-p "\\`[ \t]*\\+\\+"
9909                         org-read-date-final-answer)
9910                 org-read-date-final-answer
9911               new)))))
9912        ;; Make sure to not prompt for a note when bulk
9913        ;; rescheduling/resetting deadline as Org cannot cope with
9914        ;; simultaneous notes.  Besides, it could be annoying
9915        ;; depending on the number of marked items.
9916        (setq cmd
9917          (if schedule?
9918              `(lambda ()
9919             (let ((org-log-reschedule
9920                    (and org-log-reschedule 'time)))
9921               (org-agenda-schedule arg ,time)))
9922            `(lambda ()
9923               (let ((org-log-redeadline (and org-log-redeadline 'time)))
9924             (org-agenda-deadline arg ,time)))))))
9925
9926     (?S
9927      (unless (org-agenda-check-type nil 'agenda 'todo)
9928        (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type))
9929      (let ((days (read-number
9930               (format "Scatter tasks across how many %sdays: "
9931                   (if arg "week" ""))
9932               7)))
9933        (setq cmd
9934          `(lambda ()
9935             (let ((distance (1+ (random ,days))))
9936               (when arg
9937             (let ((dist distance)
9938                   (day-of-week
9939                    (calendar-day-of-week
9940                 (calendar-gregorian-from-absolute (org-today)))))
9941               (dotimes (i (1+ dist))
9942                 (while (member day-of-week org-agenda-weekend-days)
9943                   (cl-incf distance)
9944                   (cl-incf day-of-week)
9945                   (when (= day-of-week 7)
9946                 (setq day-of-week 0)))
9947                 (cl-incf day-of-week)
9948                 (when (= day-of-week 7)
9949                   (setq day-of-week 0)))))
9950               ;; Silently fail when try to replan a sexp entry.
9951               (ignore-errors
9952             (let* ((date (calendar-gregorian-from-absolute
9953                       (+ (org-today) distance)))
9954                    (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
9955                           (nth 2 date))))
9956               (org-agenda-schedule nil time))))))))
9957
9958     (?f
9959      (setq cmd
9960            (intern
9961         (completing-read "Function: " obarray #'fboundp t nil nil))))
9962
9963     (action
9964      (pcase (assoc action org-agenda-bulk-custom-functions)
9965        (`(,_ ,f) (setq cmd f) (setq redo-at-end t))
9966        (_ (user-error "Invalid bulk action: %c" action)))))
9967
9968       ;; Sort the markers, to make sure that parents are handled
9969       ;; before children.
9970       (setq entries (sort entries
9971               (lambda (a b)
9972                 (cond
9973                  ((eq (marker-buffer a) (marker-buffer b))
9974                   (< (marker-position a) (marker-position b)))
9975                  (t
9976                   (string< (buffer-name (marker-buffer a))
9977                        (buffer-name (marker-buffer b))))))))
9978
9979       ;; Now loop over all markers and apply CMD.
9980       (let ((processed 0)
9981         (skipped 0))
9982     (dolist (e entries)
9983       (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
9984         (if (not pos)
9985         (progn (message "Skipping removed entry at %s" e)
9986                (cl-incf skipped))
9987           (goto-char pos)
9988           (let (org-loop-over-headlines-in-active-region) (funcall cmd))
9989           ;; `post-command-hook' is not run yet.  We make sure any
9990           ;; pending log note is processed.
9991           (when (or (memq 'org-add-log-note (default-value 'post-command-hook))
9992             (memq 'org-add-log-note post-command-hook))
9993         (org-add-log-note))
9994           (cl-incf processed))))
9995     (when redo-at-end (org-agenda-redo))
9996     (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
9997     (message "Acted on %d entries%s%s"
9998          processed
9999          (if (= skipped 0)
10000              ""
10001            (format ", skipped %d (disappeared before their turn)"
10002                skipped))
10003          (if (not org-agenda-persistent-marks) "" " (kept marked)"))))))
10004
10005 (defun org-agenda-capture (&optional with-time)
10006   "Call `org-capture' with the date at point.
10007 With a `C-1' prefix, use the HH:MM value at point (if any) or the
10008 current HH:MM time."
10009   (interactive "P")
10010   (if (not (eq major-mode 'org-agenda-mode))
10011       (user-error "You cannot do this outside of agenda buffers")
10012     (let ((org-overriding-default-time
10013        (org-get-cursor-date (equal with-time 1))))
10014       (call-interactively 'org-capture))))
10015
10016 ;;; Dragging agenda lines forward/backward
10017
10018 (defun org-agenda-reapply-filters ()
10019   "Re-apply all agenda filters."
10020   (mapcar
10021    (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
10022    `((,org-agenda-tag-filter tag)
10023      (,org-agenda-category-filter category)
10024      (,org-agenda-regexp-filter regexp)
10025      (,org-agenda-effort-filter effort)
10026      (,(get 'org-agenda-tag-filter :preset-filter) tag)
10027      (,(get 'org-agenda-category-filter :preset-filter) category)
10028      (,(get 'org-agenda-effort-filter :preset-filter) effort)
10029      (,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
10030
10031 (defun org-agenda-drag-line-forward (arg &optional backward)
10032   "Drag an agenda line forward by ARG lines.
10033 When the optional argument `backward' is non-nil, move backward."
10034   (interactive "p")
10035   (let ((inhibit-read-only t) lst line)
10036     (if (or (not (get-text-property (point) 'txt))
10037         (save-excursion
10038           (dotimes (n arg)
10039         (move-beginning-of-line (if backward 0 2))
10040         (push (not (get-text-property (point) 'txt)) lst))
10041           (delq nil lst)))
10042     (message "Cannot move line forward")
10043       (let ((end (save-excursion (move-beginning-of-line 2) (point))))
10044     (move-beginning-of-line 1)
10045     (setq line (buffer-substring (point) end))
10046     (delete-region (point) end)
10047     (move-beginning-of-line (funcall (if backward '1- '1+) arg))
10048     (insert line)
10049     (org-agenda-reapply-filters)
10050     (org-agenda-mark-clocking-task)
10051     (move-beginning-of-line 0)))))
10052
10053 (defun org-agenda-drag-line-backward (arg)
10054   "Drag an agenda line backward by ARG lines."
10055   (interactive "p")
10056   (org-agenda-drag-line-forward arg t))
10057
10058 ;;; Flagging notes
10059
10060 (defun org-agenda-show-the-flagging-note ()
10061   "Display the flagging note in the other window.
10062 When called a second time in direct sequence, offer to remove the FLAGGING
10063 tag and (if present) the flagging note."
10064   (interactive)
10065   (let ((hdmarker (org-get-at-bol 'org-hd-marker))
10066     (win (selected-window))
10067     note heading newhead)
10068     (unless hdmarker
10069       (user-error "No linked entry at point"))
10070     (if (and (eq this-command last-command)
10071          (y-or-n-p "Unflag and remove any flagging note? "))
10072     (progn
10073       (org-agenda-remove-flag hdmarker)
10074       (let ((win (get-buffer-window "*Flagging Note*")))
10075         (and win (delete-window win)))
10076       (message "Entry unflagged"))
10077       (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
10078       (unless note
10079     (user-error "No flagging note"))
10080       (org-kill-new note)
10081       (org-switch-to-buffer-other-window "*Flagging Note*")
10082       (erase-buffer)
10083       (insert note)
10084       (goto-char (point-min))
10085       (while (re-search-forward "\\\\n" nil t)
10086     (replace-match "\n" t t))
10087       (goto-char (point-min))
10088       (select-window win)
10089       (message "%s" (substitute-command-keys "Flagging note pushed to \
10090 kill ring.  Press `\\[org-agenda-show-the-flagging-note]' again to remove \
10091 tag and note")))))
10092
10093 (defun org-agenda-remove-flag (marker)
10094   "Remove the FLAGGED tag and any flagging note in the entry."
10095   (let (newhead)
10096     (org-with-point-at marker
10097       (org-toggle-tag "FLAGGED" 'off)
10098       (org-entry-delete nil "THEFLAGGINGNOTE")
10099       (setq newhead (org-get-heading)))
10100     (org-agenda-change-all-lines newhead marker)
10101     (message "Entry unflagged")))
10102
10103 (defun org-agenda-get-any-marker (&optional pos)
10104   (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker)
10105       (get-text-property (or pos (point-at-bol)) 'org-marker)))
10106
10107 ;;; Appointment reminders
10108
10109 (defvar appt-time-msg-list) ; defined in appt.el
10110
10111 ;;;###autoload
10112 (defun org-agenda-to-appt (&optional refresh filter &rest args)
10113   "Activate appointments found in `org-agenda-files'.
10114
10115 With a `\\[universal-argument]' prefix, refresh the list of \
10116 appointments.
10117
10118 If FILTER is t, interactively prompt the user for a regular
10119 expression, and filter out entries that don't match it.
10120
10121 If FILTER is a string, use this string as a regular expression
10122 for filtering entries out.
10123
10124 If FILTER is a function, filter out entries against which
10125 calling the function returns nil.  This function takes one
10126 argument: an entry from `org-agenda-get-day-entries'.
10127
10128 FILTER can also be an alist with the car of each cell being
10129 either `headline' or `category'.  For example:
10130
10131   \\='((headline \"IMPORTANT\")
10132     (category \"Work\"))
10133
10134 will only add headlines containing IMPORTANT or headlines
10135 belonging to the \"Work\" category.
10136
10137 ARGS are symbols indicating what kind of entries to consider.
10138 By default `org-agenda-to-appt' will use :deadline*, :scheduled*
10139 \(i.e., deadlines and scheduled items with a hh:mm specification)
10140 and :timestamp entries.  See the docstring of `org-diary' for
10141 details and examples.
10142
10143 If an entry has a APPT_WARNTIME property, its value will be used
10144 to override `appt-message-warning-time'."
10145   (interactive "P")
10146   (if refresh (setq appt-time-msg-list nil))
10147   (if (eq filter t)
10148       (setq filter (read-from-minibuffer "Regexp filter: ")))
10149   (let* ((cnt 0)                        ; count added events
10150          (scope (or args '(:deadline* :scheduled* :timestamp)))
10151          (org-agenda-new-buffers nil)
10152          (org-deadline-warning-days 0)
10153          ;; Do not use `org-today' here because appt only takes
10154          ;; time and without date as argument, so it may pass wrong
10155          ;; information otherwise
10156          (today (org-date-to-gregorian
10157                  (time-to-days (current-time))))
10158          (org-agenda-restrict nil)
10159          (files (org-agenda-files 'unrestricted)) entries file
10160          (org-agenda-buffer nil))
10161     ;; Get all entries which may contain an appt
10162     (org-agenda-prepare-buffers files)
10163     (while (setq file (pop files))
10164       (setq entries
10165             (delq nil
10166                   (append entries
10167                           (apply 'org-agenda-get-day-entries
10168                                  file today scope)))))
10169     ;; Map thru entries and find if we should filter them out
10170     (mapc
10171      (lambda (x)
10172        (let* ((evt (org-trim
10173                     (replace-regexp-in-string
10174                      org-bracket-link-regexp "\\3"
10175                      (or (get-text-property 1 'txt x) ""))))
10176               (cat (get-text-property (1- (length x)) 'org-category x))
10177               (tod (get-text-property 1 'time-of-day x))
10178               (ok (or (null filter)
10179                       (and (stringp filter) (string-match filter evt))
10180                       (and (functionp filter) (funcall filter x))
10181                       (and (listp filter)
10182                            (let ((cat-filter (cadr (assq 'category filter)))
10183                                  (evt-filter (cadr (assq 'headline filter))))
10184                              (or (and (stringp cat-filter)
10185                                       (string-match cat-filter cat))
10186                                  (and (stringp evt-filter)
10187                                       (string-match evt-filter evt)))))))
10188               (wrn (get-text-property 1 'warntime x)))
10189          ;; FIXME: Shall we remove text-properties for the appt text?
10190          ;; (setq evt (set-text-properties 0 (length evt) nil evt))
10191          (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt)))
10192            (setq tod (concat "00" (number-to-string tod)))
10193            (setq tod (when (string-match
10194                             "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
10195                        (concat (match-string 1 tod) ":"
10196                                (match-string 2 tod))))
10197            (when (appt-add tod evt wrn)
10198              (setq cnt (1+ cnt))))))
10199      entries)
10200     (org-release-buffers org-agenda-new-buffers)
10201     (if (eq cnt 0)
10202         (message "No event to add")
10203       (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
10204
10205 (defun org-agenda-today-p (date)
10206   "Non nil when DATE means today.
10207 DATE is either a list of the form (month day year) or a number of
10208 days as returned by `calendar-absolute-from-gregorian' or
10209 `org-today'.  This function considers `org-extend-today-until'
10210 when defining today."
10211   (eq (org-today)
10212       (if (consp date) (calendar-absolute-from-gregorian date) date)))
10213
10214 (defun org-agenda-todo-yesterday (&optional arg)
10215   "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
10216   (interactive "P")
10217   (let* ((org-use-effective-time t)
10218      (hour (nth 2 (decode-time (org-current-time))))
10219          (org-extend-today-until (1+ hour)))
10220     (org-agenda-todo arg)))
10221
10222 (provide 'org-agenda)
10223
10224 ;;; org-agenda.el ends here