1 ;;; org-agenda.el --- Dynamic task and appointment lists for Org
3 ;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
6 ;; Keywords: outlines, hypermedia, calendar, wp
7 ;; Homepage: http://orgmode.org
9 ;; This file is part of GNU Emacs.
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.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;; This file contains the code for creating and using the Agenda for Org.
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:
36 ;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)'
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.
43 ;; This is a hack, but it works even when running Org byte-compiled.
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))
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
))
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
)
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
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.")
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."
113 (const :tag
"Never" nil
)
114 (const :tag
"Always" t
)
115 (integer :tag
"When more than N lines")))
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."
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."
132 (const :tag
"Disabled" nil
)
136 (defgroup org-agenda-export nil
137 "Options concerning exporting agenda views in Org mode."
138 :tag
"Org Agenda Export"
141 (defcustom org-agenda-with-colors t
142 "Non-nil means use colors in agenda views."
143 :group
'org-agenda-export
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
153 (setq org-agenda-exporter-settings
154 \\='((ps-print-color-p \\='black-white)))"
155 :group
'org-agenda-export
159 (sexp :tag
"Value"))))
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
166 :options
'(org-agenda-add-entry-text))
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.
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'."
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."
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:
199 <style type=\"text/css\">
200 p { font-weight: normal; color: gray; }
201 .org-agenda-structure {
216 .title { text-align: center; }
217 .todo, .deadline { color: red; }
218 .done { color: green; }
221 or, if you want to keep the style in a file,
223 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
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
233 (defcustom org-agenda-persistent-filter nil
234 "When set, keep filters from one agenda view to the next."
238 (defgroup org-agenda-custom-commands nil
239 "Options concerning agenda views in Org mode."
240 :tag
"Org Agenda Custom Commands"
243 (defconst org-sorting-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
))
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
)
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
272 :timestamp List items containing a date stamp or date range matching
273 the selected date. This includes sexp entries in angular
276 :sexp List entries resulting from plain diary-like sexps.
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'. `:deadline' must appear before
281 `:scheduled' if the setting of
282 `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
285 :deadline* Same as above, but only include the deadline if it has an
286 hour specification as [h]h:mm.
288 :scheduled List all items which are scheduled for the given date.
289 The diary for *today* also contains items which were
290 scheduled earlier and are not yet marked DONE.
292 :scheduled* Same as above, but only include the scheduled item if it
293 has an hour specification as [h]h:mm.
295 By default, all four non-starred types are turned on.
297 When :scheduled* or :deadline* are included, :schedule or :deadline
300 Never set this variable globally using `setq', because then it
301 will apply to all future agenda commands. Instead, bind it with
302 `let' to scope it dynamically into the agenda-constructing
303 command. A good way to set it is through options in
304 `org-agenda-custom-commands'. For a more flexible (though
305 somewhat less efficient) way of determining what is included in
306 the daily/weekly agenda, see `org-agenda-skip-function'.")
308 (defconst org-agenda-custom-commands-local-options
309 `(repeat :tag
"Local settings for this command. Remember to quote values"
310 (choice :tag
"Setting"
311 (list :tag
"Heading for this block"
312 (const org-agenda-overriding-header
)
313 (string :tag
"Headline"))
314 (list :tag
"Files to be searched"
315 (const org-agenda-files
)
317 (const :format
"" quote
)
319 (list :tag
"Sorting strategy"
320 (const org-agenda-sorting-strategy
)
322 (const :format
"" quote
)
324 ,org-sorting-choice
)))
325 (list :tag
"Prefix format"
326 (const org-agenda-prefix-format
:value
" %-12:c%?-12t% s")
328 (list :tag
"Number of days in agenda"
329 (const org-agenda-span
)
330 (choice (const :tag
"Day" day
)
331 (const :tag
"Week" week
)
332 (const :tag
"Fortnight" fortnight
)
333 (const :tag
"Month" month
)
334 (const :tag
"Year" year
)
335 (integer :tag
"Custom")))
336 (list :tag
"Fixed starting date"
337 (const org-agenda-start-day
)
338 (string :value
"2007-11-01"))
339 (list :tag
"Start on day of week"
340 (const org-agenda-start-on-weekday
)
342 (const :tag
"Today" nil
)
343 (integer :tag
"Weekday No.")))
344 (list :tag
"Include data from diary"
345 (const org-agenda-include-diary
)
347 (list :tag
"Deadline Warning days"
348 (const org-deadline-warning-days
)
350 (list :tag
"Category filter preset"
351 (const org-agenda-category-filter-preset
)
353 (const :format
"" quote
)
355 (string :tag
"+category or -category"))))
356 (list :tag
"Tags filter preset"
357 (const org-agenda-tag-filter-preset
)
359 (const :format
"" quote
)
361 (string :tag
"+tag or -tag"))))
362 (list :tag
"Effort filter preset"
363 (const org-agenda-effort-filter-preset
)
365 (const :format
"" quote
)
367 (string :tag
"+=10 or -=10 or +<10 or ->10"))))
368 (list :tag
"Regexp filter preset"
369 (const org-agenda-regexp-filter-preset
)
371 (const :format
"" quote
)
373 (string :tag
"+regexp or -regexp"))))
374 (list :tag
"Set daily/weekly entry types"
375 (const org-agenda-entry-types
)
377 (const :format
"" quote
)
378 (set :greedy t
:value
,org-agenda-entry-types
385 (list :tag
"Standard skipping condition"
386 :value
(org-agenda-skip-function '(org-agenda-skip-entry-if))
387 (const org-agenda-skip-function
)
389 (const :format
"" quote
)
392 :tag
"Skipping range"
393 (const :tag
"Skip entry" org-agenda-skip-entry-if
)
394 (const :tag
"Skip subtree" org-agenda-skip-subtree-if
))
395 (repeat :inline t
:tag
"Conditions for skipping"
397 :tag
"Condition type"
398 (list :tag
"Regexp matches" :inline t
399 (const :format
"" 'regexp
)
401 (list :tag
"Regexp does not match" :inline t
402 (const :format
"" 'notregexp
)
404 (list :tag
"TODO state is" :inline t
407 (const :tag
"Any not-done state" 'todo
)
408 (const :tag
"Any done state" 'done
)
409 (const :tag
"Any state" 'any
)
410 (list :tag
"Keyword list"
411 (const :format
"" quote
)
412 (repeat (string :tag
"Keyword")))))
413 (list :tag
"TODO state is not" :inline t
416 (const :tag
"Any not-done state" 'todo
)
417 (const :tag
"Any done state" 'done
)
418 (const :tag
"Any state" 'any
)
419 (list :tag
"Keyword list"
420 (const :format
"" quote
)
421 (repeat (string :tag
"Keyword")))))
422 (const :tag
"scheduled" 'scheduled
)
423 (const :tag
"not scheduled" 'notscheduled
)
424 (const :tag
"deadline" 'deadline
)
425 (const :tag
"no deadline" 'notdeadline
)
426 (const :tag
"timestamp" 'timestamp
)
427 (const :tag
"no timestamp" 'nottimestamp
))))))
428 (list :tag
"Non-standard skipping condition"
429 :value
(org-agenda-skip-function)
430 (const org-agenda-skip-function
)
431 (sexp :tag
"Function or form (quoted!)"))
432 (list :tag
"Any variable"
433 (variable :tag
"Variable")
434 (sexp :tag
"Value (sexp)"))))
435 "Selection of examples for agenda command settings.
436 This will be spliced into the custom type of
437 `org-agenda-custom-commands'.")
440 (defcustom org-agenda-custom-commands
441 '(("n" "Agenda and all TODOs" ((agenda "") (alltodo ""))))
442 "Custom commands for the agenda.
444 These commands will be offered on the splash screen displayed by the
445 agenda dispatcher `\\[org-agenda]'. Each entry is a list like this:
447 (key desc type match settings files)
449 key The key (one or more characters as a string) to be associated
451 desc A description of the command, when omitted or nil, a default
452 description is built using MATCH.
453 type The command type, any of the following symbols:
454 agenda The daily/weekly agenda.
455 todo Entries with a specific TODO keyword, in all agenda files.
456 search Entries containing search words entry or headline.
457 tags Tags/Property/TODO match in all agenda files.
458 tags-todo Tags/P/T match in all agenda files, TODO entries only.
459 todo-tree Sparse tree of specific TODO keyword in *current* file.
460 tags-tree Sparse tree with all tags matches in *current* file.
461 occur-tree Occur sparse tree for *current* file.
462 ... A user-defined function.
463 match What to search for:
464 - a single keyword for TODO keyword searches
465 - a tags match expression for tags searches
466 - a word search expression for text searches.
467 - a regular expression for occur searches
468 For all other commands, this should be the empty string.
469 settings A list of option settings, similar to that in a let form, so like
470 this: ((opt1 val1) (opt2 val2) ...). The values will be
471 evaluated at the moment of execution, so quote them when needed.
472 files A list of files to write the produced agenda buffer to with
473 the command `org-store-agenda-views'.
474 If a file name ends in \".html\", an HTML version of the buffer
475 is written out. If it ends in \".ps\", a postscript version is
476 produced. Otherwise, only the plain text is written to the file.
478 You can also define a set of commands, to create a composite agenda buffer.
479 In this case, an entry looks like this:
481 (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files)
485 desc A description string to be displayed in the dispatcher menu.
486 cmd An agenda command, similar to the above. However, tree commands
487 are not allowed, but instead you can get agenda and global todo list.
488 So valid commands for a set are:
489 (agenda \"\" settings)
490 (alltodo \"\" settings)
491 (stuck \"\" settings)
492 (todo \"match\" settings files)
493 (search \"match\" settings files)
494 (tags \"match\" settings files)
495 (tags-todo \"match\" settings files)
497 Each command can carry a list of options, and another set of options can be
498 given for the whole set of commands. Individual command options take
499 precedence over the general options.
501 When using several characters as key to a command, the first characters
502 are prefix commands. For the dispatcher to display useful information, you
503 should provide a description for the prefix, like
505 (setq org-agenda-custom-commands
506 \\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
507 (\"hl\" tags \"+HOME+Lisa\")
508 (\"hp\" tags \"+HOME+Peter\")
509 (\"hk\" tags \"+HOME+Kim\")))"
510 :group
'org-agenda-custom-commands
512 (choice :value
("x" "Describe command here" tags
"" nil
)
513 (list :tag
"Single command"
514 (string :tag
"Access Key(s) ")
515 (option (string :tag
"Description"))
517 (const :tag
"Agenda" agenda
)
518 (const :tag
"TODO list" alltodo
)
519 (const :tag
"Search words" search
)
520 (const :tag
"Stuck projects" stuck
)
521 (const :tag
"Tags/Property match (all agenda files)" tags
)
522 (const :tag
"Tags/Property match of TODO entries (all agenda files)" tags-todo
)
523 (const :tag
"TODO keyword search (all agenda files)" todo
)
524 (const :tag
"Tags sparse tree (current buffer)" tags-tree
)
525 (const :tag
"TODO keyword tree (current buffer)" todo-tree
)
526 (const :tag
"Occur tree (current buffer)" occur-tree
)
527 (sexp :tag
"Other, user-defined function"))
528 (string :tag
"Match (only for some commands)")
529 ,org-agenda-custom-commands-local-options
530 (option (repeat :tag
"Export" (file :tag
"Export to"))))
531 (list :tag
"Command series, all agenda files"
532 (string :tag
"Access Key(s)")
533 (string :tag
"Description ")
534 (repeat :tag
"Component"
537 (const :format
"" agenda
)
538 (const :tag
"" :format
"" "")
539 ,org-agenda-custom-commands-local-options
)
540 (list :tag
"TODO list (all keywords)"
541 (const :format
"" alltodo
)
542 (const :tag
"" :format
"" "")
543 ,org-agenda-custom-commands-local-options
)
544 (list :tag
"Search words"
545 (const :format
"" search
)
546 (string :tag
"Match")
547 ,org-agenda-custom-commands-local-options
)
548 (list :tag
"Stuck projects"
549 (const :format
"" stuck
)
550 (const :tag
"" :format
"" "")
551 ,org-agenda-custom-commands-local-options
)
552 (list :tag
"Tags search"
553 (const :format
"" tags
)
554 (string :tag
"Match")
555 ,org-agenda-custom-commands-local-options
)
556 (list :tag
"Tags search, TODO entries only"
557 (const :format
"" tags-todo
)
558 (string :tag
"Match")
559 ,org-agenda-custom-commands-local-options
)
560 (list :tag
"TODO keyword search"
561 (const :format
"" todo
)
562 (string :tag
"Match")
563 ,org-agenda-custom-commands-local-options
)
564 (list :tag
"Other, user-defined function"
565 (symbol :tag
"function")
566 (string :tag
"Match")
567 ,org-agenda-custom-commands-local-options
)))
569 (repeat :tag
"Settings for entire command set"
570 (list (variable :tag
"Any variable")
571 (sexp :tag
"Value")))
572 (option (repeat :tag
"Export" (file :tag
"Export to"))))
573 (cons :tag
"Prefix key documentation"
574 (string :tag
"Access Key(s)")
575 (string :tag
"Description ")))))
577 (defcustom org-agenda-query-register ?o
578 "The register holding the current query string.
579 The purpose of this is that if you construct a query string interactively,
580 you can then use it to define a custom command."
581 :group
'org-agenda-custom-commands
584 (defcustom org-stuck-projects
585 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil
"")
586 "How to identify stuck projects.
587 This is a list of four items:
588 1. A tags/todo/property matcher string that is used to identify a project.
589 See the manual for a description of tag and property searches.
590 The entire tree below a headline matched by this is considered one project.
591 2. A list of TODO keywords identifying non-stuck projects.
592 If the project subtree contains any headline with one of these todo
593 keywords, the project is considered to be not stuck. If you specify
594 \"*\" as a keyword, any TODO keyword will mark the project unstuck.
595 3. A list of tags identifying non-stuck projects.
596 If the project subtree contains any headline with one of these tags,
597 the project is considered to be not stuck. If you specify \"*\" as
598 a tag, any tag will mark the project unstuck. Note that this is about
599 the explicit presence of a tag somewhere in the subtree, inherited
600 tags do not count here. If inherited tags make a project not stuck,
601 use \"-TAG\" in the tags part of the matcher under (1.) above.
602 4. An arbitrary regular expression matching non-stuck projects.
604 If the project turns out to be not stuck, search continues also in the
605 subtree to see if any of the subtasks have project status.
607 See also the variable `org-tags-match-list-sublevels' which applies
608 to projects matched by this search as well.
610 After defining this variable, you may use `\\[org-agenda-list-stuck-projects]'
611 \(bound to `C-c a #') to produce the list."
612 :group
'org-agenda-custom-commands
614 (string :tag
"Tags/TODO match to identify a project")
615 (repeat :tag
"Projects are *not* stuck if they have an entry with \
616 TODO keyword any of" (string))
617 (repeat :tag
"Projects are *not* stuck if they have an entry with \
618 TAG being any of" (string))
619 (regexp :tag
"Projects are *not* stuck if this regexp matches inside \
622 (defgroup org-agenda-skip nil
623 "Options concerning skipping parts of agenda files."
624 :tag
"Org Agenda Skip"
627 (defcustom org-agenda-skip-function-global nil
628 "Function to be called at each match during agenda construction.
629 If this function returns nil, the current match should not be skipped.
630 If the function decided to skip an agenda match, is must return the
631 buffer position from which the search should be continued.
632 This may also be a Lisp form, which will be evaluated.
634 This variable will be applied to every agenda match, including
635 tags/property searches and TODO lists. So try to make the test function
636 do its checking as efficiently as possible. To implement a skipping
637 condition just for specific agenda commands, use the variable
638 `org-agenda-skip-function' which can be set in the options section
639 of custom agenda commands."
640 :group
'org-agenda-skip
643 (defgroup org-agenda-daily
/weekly nil
644 "Options concerning the daily/weekly agenda."
645 :tag
"Org Agenda Daily/Weekly"
647 (defgroup org-agenda-todo-list nil
648 "Options concerning the global todo list agenda view."
649 :tag
"Org Agenda Todo List"
651 (defgroup org-agenda-match-view nil
652 "Options concerning the general tags/property/todo match agenda view."
653 :tag
"Org Agenda Match View"
655 (defgroup org-agenda-search-view nil
656 "Options concerning the search agenda view."
657 :tag
"Org Agenda Search View"
660 (defvar org-agenda-archives-mode nil
661 "Non-nil means the agenda will include archived items.
662 If this is the symbol `trees', trees in the selected agenda scope
663 that are marked with the ARCHIVE tag will be included anyway. When this is
664 t, also all archive files associated with the current selection of agenda
665 files will be included.")
667 (defcustom org-agenda-restriction-lock-highlight-subtree t
668 "Non-nil means highlight the whole subtree when restriction is active.
669 Otherwise only highlight the headline. Highlighting the whole subtree is
670 useful to ensure no edits happen beyond the restricted region."
674 (defcustom org-agenda-skip-comment-trees t
675 "Non-nil means skip trees that start with the COMMENT keyword.
676 When nil, these trees are also scanned by agenda commands."
677 :group
'org-agenda-skip
680 (defcustom org-agenda-todo-list-sublevels t
681 "Non-nil means check also the sublevels of a TODO entry for TODO entries.
682 When nil, the sublevels of a TODO entry are not checked, resulting in
683 potentially much shorter TODO lists."
684 :group
'org-agenda-skip
685 :group
'org-agenda-todo-list
688 (defcustom org-agenda-todo-ignore-with-date nil
689 "Non-nil means don't show entries with a date in the global todo list.
690 You can use this if you prefer to mark mere appointments with a TODO keyword,
691 but don't want them to show up in the TODO list.
692 When this is set, it also covers deadlines and scheduled items, the settings
693 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
695 See also the variable `org-agenda-tags-todo-honor-ignore-options'."
696 :group
'org-agenda-skip
697 :group
'org-agenda-todo-list
700 (defcustom org-agenda-todo-ignore-timestamp nil
701 "Non-nil means don't show entries with a timestamp.
702 This applies when creating the global todo list.
705 past Don't show entries for today or in the past.
707 future Don't show entries with a timestamp in the future.
708 The idea behind this is that if it has a future
709 timestamp, you don't want to think about it until the
712 all Don't show any entries with a timestamp in the global todo list.
713 The idea behind this is that by setting a timestamp, you
714 have already \"taken care\" of this item.
716 This variable can also have an integer as a value. If positive (N),
717 todos with a timestamp N or more days in the future will be ignored. If
718 negative (-N), todos with a timestamp N or more days in the past will be
719 ignored. If 0, todos with a timestamp either today or in the future will
720 be ignored. For example, a value of -1 will exclude todos with a
721 timestamp in the past (yesterday or earlier), while a value of 7 will
722 exclude todos with a timestamp a week or more in the future.
724 See also `org-agenda-todo-ignore-with-date'.
725 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
726 to make his option also apply to the tags-todo list."
727 :group
'org-agenda-skip
728 :group
'org-agenda-todo-list
731 (const :tag
"Ignore future timestamp todos" future
)
732 (const :tag
"Ignore past or present timestamp todos" past
)
733 (const :tag
"Ignore all timestamp todos" all
)
734 (const :tag
"Show timestamp todos" nil
)
735 (integer :tag
"Ignore if N or more days in past(-) or future(+).")))
737 (defcustom org-agenda-todo-ignore-scheduled nil
738 "Non-nil means, ignore some scheduled TODO items when making TODO list.
739 This applies when creating the global todo list.
742 past Don't show entries scheduled today or in the past.
744 future Don't show entries scheduled in the future.
745 The idea behind this is that by scheduling it, you don't want to
746 think about it until the scheduled date.
748 all Don't show any scheduled entries in the global todo list.
749 The idea behind this is that by scheduling it, you have already
750 \"taken care\" of this item.
752 t Same as `all', for backward compatibility.
754 This variable can also have an integer as a value. See
755 `org-agenda-todo-ignore-timestamp' for more details.
757 See also `org-agenda-todo-ignore-with-date'.
758 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
759 to make his option also apply to the tags-todo list."
760 :group
'org-agenda-skip
761 :group
'org-agenda-todo-list
763 (const :tag
"Ignore future-scheduled todos" future
)
764 (const :tag
"Ignore past- or present-scheduled todos" past
)
765 (const :tag
"Ignore all scheduled todos" all
)
766 (const :tag
"Ignore all scheduled todos (compatibility)" t
)
767 (const :tag
"Show scheduled todos" nil
)
768 (integer :tag
"Ignore if N or more days in past(-) or future(+).")))
770 (defcustom org-agenda-todo-ignore-deadlines nil
771 "Non-nil means ignore some deadline TODO items when making TODO list.
773 There are different motivations for using different values, please think
774 carefully when configuring this variable.
776 This applies when creating the global TODO list.
780 near Don't show near deadline entries. A deadline is near when it is
781 closer than `org-deadline-warning-days' days. The idea behind this
782 is that such items will appear in the agenda anyway.
784 far Don't show TODO entries where a deadline has been defined, but
785 is not going to happen anytime soon. This is useful if you want to use
786 the TODO list to figure out what to do now.
788 past Don't show entries with a deadline timestamp for today or in the past.
790 future Don't show entries with a deadline timestamp in the future, not even
791 when they become `near' ones. Use it with caution.
793 all Ignore all TODO entries that do have a deadline.
795 t Same as `near', for backward compatibility.
797 This variable can also have an integer as a value. See
798 `org-agenda-todo-ignore-timestamp' for more details.
800 See also `org-agenda-todo-ignore-with-date'.
801 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
802 to make his option also apply to the tags-todo list."
803 :group
'org-agenda-skip
804 :group
'org-agenda-todo-list
806 (const :tag
"Ignore near deadlines" near
)
807 (const :tag
"Ignore near deadlines (compatibility)" t
)
808 (const :tag
"Ignore far deadlines" far
)
809 (const :tag
"Ignore all TODOs with a deadlines" all
)
810 (const :tag
"Show all TODOs, even if they have a deadline" nil
)
811 (integer :tag
"Ignore if N or more days in past(-) or future(+).")))
813 (defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil
814 "Time unit to use when possibly ignoring an agenda item.
816 See the docstring of various `org-agenda-todo-ignore-*' options.
817 The default is to compare time stamps using days. An item is thus
818 considered to be in the future if it is at least one day after today.
819 Non-nil means to compare time stamps using seconds. An item is then
820 considered future if it has a time value later than current time."
821 :group
'org-agenda-skip
822 :group
'org-agenda-todo-list
824 :package-version
'(Org .
"8.0")
826 (const :tag
"Compare time with days" nil
)
827 (const :tag
"Compare time with seconds" t
)))
829 (defcustom org-agenda-tags-todo-honor-ignore-options nil
830 "Non-nil means honor todo-list ignores options also in tags-todo search.
832 `org-agenda-todo-ignore-with-date',
833 `org-agenda-todo-ignore-timestamp',
834 `org-agenda-todo-ignore-scheduled',
835 `org-agenda-todo-ignore-deadlines'
836 make the global TODO list skip entries that have time stamps of certain
837 kinds. If this option is set, the same options will also apply for the
838 tags-todo search, which is the general tags/property matcher
839 restricted to unfinished TODO entries only."
840 :group
'org-agenda-skip
841 :group
'org-agenda-todo-list
842 :group
'org-agenda-match-view
845 (defcustom org-agenda-skip-scheduled-if-done nil
846 "Non-nil means don't show scheduled items in agenda when they are done.
847 This is relevant for the daily/weekly agenda, not for the TODO list. It
848 applies only to the actual date of the scheduling. Warnings about an item
849 with a past scheduling dates are always turned off when the item is DONE."
850 :group
'org-agenda-skip
851 :group
'org-agenda-daily
/weekly
854 (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil
855 "Non-nil means skip scheduling line if same entry shows because of deadline.
857 In the agenda of today, an entry can show up multiple times
858 because it is both scheduled and has a nearby deadline, and maybe
859 a plain time stamp as well.
861 When this variable is nil, the entry will be shown several times.
863 When set to t, then only the deadline is shown and the fact that
864 the entry is scheduled today or was scheduled previously is not
867 When set to the symbol `not-today', skip scheduled previously,
868 but not scheduled today.
870 When set to the symbol `repeated-after-deadline', skip scheduled
871 items if they are repeated beyond the current deadline."
872 :group
'org-agenda-skip
873 :group
'org-agenda-daily
/weekly
875 (const :tag
"Never" nil
)
876 (const :tag
"Always" t
)
877 (const :tag
"Not when scheduled today" not-today
)
878 (const :tag
"When repeated past deadline" repeated-after-deadline
)))
880 (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
881 "Non-nil means skip timestamp line if same entry shows because of deadline.
882 In the agenda of today, an entry can show up multiple times
883 because it has both a plain timestamp and has a nearby deadline.
884 When this variable is t, then only the deadline is shown and the
885 fact that the entry has a timestamp for or including today is not
886 shown. When this variable is nil, the entry will be shown
888 :group
'org-agenda-skip
889 :group
'org-agenda-daily
/weekly
892 (const :tag
"Never" nil
)
893 (const :tag
"Always" t
)))
895 (defcustom org-agenda-skip-deadline-if-done nil
896 "Non-nil means don't show deadlines when the corresponding item is done.
897 When nil, the deadline is still shown and should give you a happy feeling.
898 This is relevant for the daily/weekly agenda. It applies only to the
899 actual date of the deadline. Warnings about approaching and past-due
900 deadlines are always turned off when the item is DONE."
901 :group
'org-agenda-skip
902 :group
'org-agenda-daily
/weekly
905 (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil
906 "Non-nil means skip deadline prewarning when entry is also scheduled.
907 This will apply on all days where a prewarning for the deadline would
908 be shown, but not at the day when the entry is actually due. On that day,
909 the deadline will be shown anyway.
910 This variable may be set to nil, t, the symbol `pre-scheduled',
911 or a number which will then give the number of days before the actual
912 deadline when the prewarnings should resume. The symbol `pre-scheduled'
913 eliminates the deadline prewarning only prior to the scheduled date.
914 This can be used in a workflow where the first showing of the deadline will
915 trigger you to schedule it, and then you don't want to be reminded of it
916 because you will take care of it on the day when scheduled."
917 :group
'org-agenda-skip
918 :group
'org-agenda-daily
/weekly
921 (const :tag
"Always show prewarning" nil
)
922 (const :tag
"Remove prewarning prior to scheduled date" pre-scheduled
)
923 (const :tag
"Remove prewarning if entry is scheduled" t
)
924 (integer :tag
"Restart prewarning N days before deadline")))
926 (defcustom org-agenda-skip-scheduled-delay-if-deadline nil
927 "Non-nil means skip scheduled delay when entry also has a deadline.
928 This variable may be set to nil, t, the symbol `post-deadline',
929 or a number which will then give the number of days after the actual
930 scheduled date when the delay should expire. The symbol `post-deadline'
931 eliminates the schedule delay when the date is posterior to the deadline."
932 :group
'org-agenda-skip
933 :group
'org-agenda-daily
/weekly
935 :package-version
'(Org .
"8.0")
937 (const :tag
"Always honor delay" nil
)
938 (const :tag
"Ignore delay if posterior to the deadline" post-deadline
)
939 (const :tag
"Ignore delay if entry has a deadline" t
)
940 (integer :tag
"Honor delay up until N days after the scheduled date")))
942 (defcustom org-agenda-skip-additional-timestamps-same-entry nil
943 "When nil, multiple same-day timestamps in entry make multiple agenda lines.
944 When non-nil, after the search for timestamps has matched once in an
945 entry, the rest of the entry will not be searched."
946 :group
'org-agenda-skip
949 (defcustom org-agenda-skip-timestamp-if-done nil
950 "Non-nil means don't select item by timestamp or -range if it is DONE."
951 :group
'org-agenda-skip
952 :group
'org-agenda-daily
/weekly
955 (defcustom org-agenda-dim-blocked-tasks t
956 "Non-nil means dim blocked tasks in the agenda display.
957 This causes some overhead during agenda construction, but if you
958 have turned on `org-enforce-todo-dependencies',
959 `org-enforce-todo-checkbox-dependencies', or any other blocking
960 mechanism, this will create useful feedback in the agenda.
962 Instead of t, this variable can also have the value `invisible'.
963 Then blocked tasks will be invisible and only become visible when
964 they become unblocked. An exemption to this behavior is when a task is
965 blocked because of unchecked checkboxes below it. Since checkboxes do
966 not show up in the agenda views, making this task invisible you remove any
967 trace from agenda views that there is something to do. Therefore, a task
968 that is blocked because of checkboxes will never be made invisible, it
969 will only be dimmed."
970 :group
'org-agenda-daily
/weekly
971 :group
'org-agenda-todo-list
974 (const :tag
"Do not dim" nil
)
975 (const :tag
"Dim to a gray face" t
)
976 (const :tag
"Make invisible" invisible
)))
978 (defcustom org-timeline-show-empty-dates
3
979 "Non-nil means `org-timeline' also shows dates without an entry.
980 When nil, only the days which actually have entries are shown.
981 When t, all days between the first and the last date are shown.
982 When an integer, show also empty dates, but if there is a gap of more than
983 N days, just insert a special line indicating the size of the gap."
984 :group
'org-agenda-skip
986 (const :tag
"None" nil
)
988 (integer :tag
"at most")))
990 (defgroup org-agenda-startup nil
991 "Options concerning initial settings in the Agenda in Org Mode."
992 :tag
"Org Agenda Startup"
995 (defcustom org-agenda-menu-show-matcher t
996 "Non-nil means show the match string in the agenda dispatcher menu.
997 When nil, the matcher string is not shown, but is put into the help-echo
998 property so than moving the mouse over the command shows it.
999 Setting it to nil is good if matcher strings are very long and/or if
1000 you want to use two-columns display (see `org-agenda-menu-two-columns')."
1005 (defcustom org-agenda-menu-two-columns nil
1006 "Non-nil means, use two columns to show custom commands in the dispatcher.
1007 If you use this, you probably want to set `org-agenda-menu-show-matcher'
1013 (defcustom org-agenda-finalize-hook nil
1014 "Hook run just before displaying an agenda buffer.
1015 The buffer is still writable when the hook is called.
1017 You can modify some of the buffer substrings but you should be
1018 extra careful not to modify the text properties of the agenda
1019 headlines as the agenda display heavily relies on them."
1020 :group
'org-agenda-startup
1023 (defcustom org-agenda-mouse-1-follows-link nil
1024 "Non-nil means mouse-1 on a link will follow the link in the agenda.
1025 A longer mouse click will still set point. Needs to be set
1026 before org.el is loaded."
1027 :group
'org-agenda-startup
1030 (defcustom org-agenda-start-with-follow-mode nil
1031 "The initial value of follow mode in a newly created agenda window."
1032 :group
'org-agenda-startup
1035 (defcustom org-agenda-follow-indirect nil
1036 "Non-nil means `org-agenda-follow-mode' displays only the
1037 current item's tree, in an indirect buffer."
1042 (defcustom org-agenda-show-outline-path t
1043 "Non-nil means show outline path in echo area after line motion."
1044 :group
'org-agenda-startup
1047 (defcustom org-agenda-start-with-entry-text-mode nil
1048 "The initial value of entry-text-mode in a newly created agenda window."
1049 :group
'org-agenda-startup
1052 (defcustom org-agenda-entry-text-maxlines
5
1053 "Number of text lines to be added when `E' is pressed in the agenda.
1055 Note that this variable only used during agenda display. To add entry text
1056 when exporting the agenda, configure the variable
1057 `org-agenda-add-entry-text-maxlines'."
1061 (defcustom org-agenda-entry-text-exclude-regexps nil
1062 "List of regular expressions to clean up entry text.
1063 The complete matches of all regular expressions in this list will be
1064 removed from entry text before it is shown in the agenda."
1066 :type
'(repeat (regexp)))
1068 (defcustom org-agenda-entry-text-leaders
" > "
1069 "Text prepended to the entry text in agenda buffers."
1071 :package-version
'(Org .
"8.0")
1075 (defvar org-agenda-entry-text-cleanup-hook nil
1076 "Hook that is run after basic cleanup of entry text to be shown in agenda.
1077 This cleanup is done in a temporary buffer, so the function may inspect and
1078 change the entire buffer.
1079 Some default stuff like drawers and scheduling/deadline dates will already
1080 have been removed when this is called, as will any matches for regular
1081 expressions listed in `org-agenda-entry-text-exclude-regexps'.")
1083 (defvar org-agenda-include-inactive-timestamps nil
1084 "Non-nil means include inactive time stamps in agenda and timeline.
1085 Dynamically scoped.")
1087 (defgroup org-agenda-windows nil
1088 "Options concerning the windows used by the Agenda in Org Mode."
1089 :tag
"Org Agenda Windows"
1092 (defcustom org-agenda-window-setup
'reorganize-frame
1093 "How the agenda buffer should be displayed.
1094 Possible values for this option are:
1096 current-window Show agenda in the current window, keeping all other windows.
1097 other-window Use `switch-to-buffer-other-window' to display agenda.
1098 only-window Show agenda, deleting all other windows.
1099 reorganize-frame Show only two windows on the current frame, the current
1100 window and the agenda.
1101 other-frame Use `switch-to-buffer-other-frame' to display agenda.
1102 Also, when exiting the agenda, kill that frame.
1103 See also the variable `org-agenda-restore-windows-after-quit'."
1104 :group
'org-agenda-windows
1106 (const current-window
)
1108 (const other-window
)
1110 (const reorganize-frame
)))
1112 (defcustom org-agenda-window-frame-fractions
'(0.5 .
0.75)
1113 "The min and max height of the agenda window as a fraction of frame height.
1114 The value of the variable is a cons cell with two numbers between 0 and 1.
1115 It only matters if `org-agenda-window-setup' is `reorganize-frame'."
1116 :group
'org-agenda-windows
1117 :type
'(cons (number :tag
"Minimum") (number :tag
"Maximum")))
1119 (defcustom org-agenda-restore-windows-after-quit nil
1120 "Non-nil means restore window configuration upon exiting agenda.
1121 Before the window configuration is changed for displaying the agenda,
1122 the current status is recorded. When the agenda is exited with
1123 `q' or `x' and this option is set, the old state is restored. If
1124 `org-agenda-window-setup' is `other-frame', the value of this
1125 option will be ignored."
1126 :group
'org-agenda-windows
1129 (defcustom org-agenda-span
'week
1130 "Number of days to include in overview display.
1131 Can be day, week, month, year, or any number of days.
1132 Custom commands can set this variable in the options section."
1133 :group
'org-agenda-daily
/weekly
1134 :type
'(choice (const :tag
"Day" day
)
1135 (const :tag
"Week" week
)
1136 (const :tag
"Fortnight" fortnight
)
1137 (const :tag
"Month" month
)
1138 (const :tag
"Year" year
)
1139 (integer :tag
"Custom")))
1141 (defcustom org-agenda-start-on-weekday
1
1142 "Non-nil means start the overview always on the specified weekday.
1143 0 denotes Sunday, 1 denotes Monday, etc.
1144 When nil, always start on the current day.
1145 Custom commands can set this variable in the options section."
1146 :group
'org-agenda-daily
/weekly
1147 :type
'(choice (const :tag
"Today" nil
)
1148 (integer :tag
"Weekday No.")))
1150 (defcustom org-agenda-show-all-dates t
1151 "Non-nil means `org-agenda' shows every day in the selected range.
1152 When nil, only the days which actually have entries are shown."
1153 :group
'org-agenda-daily
/weekly
1156 (defcustom org-agenda-format-date
'org-agenda-format-date-aligned
1157 "Format string for displaying dates in the agenda.
1158 Used by the daily/weekly agenda and by the timeline. This should be
1159 a format string understood by `format-time-string', or a function returning
1160 the formatted date as a string. The function must take a single argument,
1161 a calendar-style date list like (month day year)."
1162 :group
'org-agenda-daily
/weekly
1164 (string :tag
"Format string")
1165 (function :tag
"Function")))
1167 (defun org-agenda-format-date-aligned (date)
1168 "Format a DATE string for display in the daily/weekly agenda, or timeline.
1169 This function makes sure that dates are aligned for easy reading."
1171 (let* ((dayname (calendar-day-name date
))
1173 (day-of-week (calendar-day-of-week date
))
1175 (monthname (calendar-month-name month
))
1177 (iso-week (org-days-to-iso-week
1178 (calendar-absolute-from-gregorian date
)))
1179 (weekyear (cond ((and (= month
1) (>= iso-week
52))
1181 ((and (= month
12) (<= iso-week
1))
1184 (weekstring (if (= day-of-week
1)
1185 (format " W%02d" iso-week
)
1187 (format "%-10s %2d %s %4d%s"
1188 dayname day monthname year weekstring
)))
1190 (defcustom org-agenda-time-leading-zero nil
1191 "Non-nil means use leading zero for military times in agenda.
1192 For example, 9:30am would become 09:30 rather than 9:30."
1193 :group
'org-agenda-daily
/weekly
1197 (defcustom org-agenda-timegrid-use-ampm nil
1198 "When set, show AM/PM style timestamps on the timegrid."
1203 (defun org-agenda-time-of-day-to-ampm (time)
1204 "Convert TIME of a string like \"13:45\" to an AM/PM style time string."
1205 (let* ((hour-number (string-to-number (substring time
0 -
3)))
1206 (minute (substring time -
2))
1209 ((equal hour-number
12)
1213 (setq hour-number
(- hour-number
12))))
1215 (if org-agenda-time-leading-zero
1216 (format "%02d" hour-number
)
1217 (format "%02s" (number-to-string hour-number
)))
1220 (defun org-agenda-time-of-day-to-ampm-maybe (time)
1221 "Conditionally convert TIME to AM/PM format based on `org-agenda-timegrid-use-ampm'."
1222 (if org-agenda-timegrid-use-ampm
1223 (org-agenda-time-of-day-to-ampm time
)
1226 (defcustom org-agenda-weekend-days
'(6 0)
1227 "Which days are weekend?
1228 These days get the special face `org-agenda-date-weekend' in the agenda
1229 and timeline buffers."
1230 :group
'org-agenda-daily
/weekly
1231 :type
'(set :greedy t
1232 (const :tag
"Monday" 1)
1233 (const :tag
"Tuesday" 2)
1234 (const :tag
"Wednesday" 3)
1235 (const :tag
"Thursday" 4)
1236 (const :tag
"Friday" 5)
1237 (const :tag
"Saturday" 6)
1238 (const :tag
"Sunday" 0)))
1240 (defcustom org-agenda-move-date-from-past-immediately-to-today t
1241 "Non-nil means jump to today when moving a past date forward in time.
1242 When using S-right in the agenda to move a a date forward, and the date
1243 stamp currently points to the past, the first key press will move it
1244 to today. WHen nil, just move one day forward even if the date stays
1246 :group
'org-agenda-daily
/weekly
1250 (defcustom org-agenda-include-diary nil
1251 "If non-nil, include in the agenda entries from the Emacs Calendar's diary.
1252 Custom commands can set this variable in the options section."
1253 :group
'org-agenda-daily
/weekly
1256 (defcustom org-agenda-include-deadlines t
1257 "If non-nil, include entries within their deadline warning period.
1258 Custom commands can set this variable in the options section."
1259 :group
'org-agenda-daily
/weekly
1263 (defcustom org-agenda-repeating-timestamp-show-all t
1264 "Non-nil means show all occurrences of a repeating stamp in the agenda.
1265 When set to a list of strings, only show occurrences of repeating
1266 stamps for these TODO keywords. When nil, only one occurrence is
1267 shown, either today or the nearest into the future."
1268 :group
'org-agenda-daily
/weekly
1270 (const :tag
"Show repeating stamps" t
)
1271 (repeat :tag
"Show repeating stamps for these TODO keywords"
1272 (string :tag
"TODO Keyword"))
1273 (const :tag
"Don't show repeating stamps" nil
)))
1275 (defcustom org-scheduled-past-days
10000
1276 "Number of days to continue listing scheduled items not marked DONE.
1277 When an item is scheduled on a date, it shows up in the agenda on
1278 this day and will be listed until it is marked done or for the
1279 number of days given here."
1280 :group
'org-agenda-daily
/weekly
1283 (defcustom org-agenda-log-mode-items
'(closed clock
)
1284 "List of items that should be shown in agenda log mode.
1285 \\<org-agenda-mode-map>\
1286 This list may contain the following symbols:
1288 closed Show entries that have been closed on that day.
1289 clock Show entries that have received clocked time on that day.
1290 state Show all logged state changes.
1291 Note that instead of changing this variable, you can also press \
1292 `\\[universal-argument] \\[org-agenda-log-mode]' in
1293 the agenda to display all available LOG items temporarily."
1294 :group
'org-agenda-daily
/weekly
1295 :type
'(set :greedy t
(const closed
) (const clock
) (const state
)))
1297 (defcustom org-agenda-clock-consistency-checks
1298 '(:max-duration
"10:00" :min-duration
0 :max-gap
"0:05"
1299 :gap-ok-around
("4:00")
1300 :default-face
((:background
"DarkRed") (:foreground
"white"))
1301 :overlap-face nil
:gap-face nil
:no-end-time-face nil
1302 :long-face nil
:short-face nil
)
1303 "This is a property list, with the following keys:
1305 :max-duration Mark clocking chunks that are longer than this time.
1306 This is a time string like \"HH:MM\", or the number
1307 of minutes as an integer.
1309 :min-duration Mark clocking chunks that are shorter that this.
1310 This is a time string like \"HH:MM\", or the number
1311 of minutes as an integer.
1313 :max-gap Mark gaps between clocking chunks that are longer than
1314 this duration. A number of minutes, or a string
1317 :gap-ok-around List of times during the day which are usually not working
1318 times. When a gap is detected, but the gap contains any
1319 of these times, the gap is *not* reported. For example,
1320 if this is (\"4:00\" \"13:00\") then gaps that contain
1321 4:00 in the morning (i.e. the night) and 13:00
1322 (i.e. a typical lunch time) do not cause a warning.
1323 You should have at least one time during the night in this
1324 list, or otherwise the first task each morning will trigger
1325 a warning because it follows a long gap.
1327 Furthermore, the following properties can be used to define faces for
1330 :default-face the default face, if the specific face is undefined
1331 :overlap-face face for overlapping clocks
1332 :gap-face face for gaps between clocks
1333 :no-end-time-face face for incomplete clocks
1334 :long-face face for clock intervals that are too long
1335 :short-face face for clock intervals that are too short"
1336 :group
'org-agenda-daily
/weekly
1341 (defcustom org-agenda-log-mode-add-notes t
1342 "Non-nil means add first line of notes to log entries in agenda views.
1343 If a log item like a state change or a clock entry is associated with
1344 notes, the first line of these notes will be added to the entry in the
1346 :group
'org-agenda-daily
/weekly
1349 (defcustom org-agenda-start-with-log-mode nil
1350 "The initial value of log-mode in a newly created agenda window.
1351 See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further
1352 explanations on the possible values."
1353 :group
'org-agenda-startup
1354 :group
'org-agenda-daily
/weekly
1355 :type
'(choice (const :tag
"Don't show log items" nil
)
1356 (const :tag
"Show only log items" only
)
1357 (const :tag
"Show all possible log items" clockcheck
)
1358 (repeat :tag
"Choose among possible values for `org-agenda-log-mode-items'"
1359 (choice (const :tag
"Show closed log items" closed
)
1360 (const :tag
"Show clocked log items" clock
)
1361 (const :tag
"Show all logged state changes" state
)))))
1363 (defcustom org-agenda-start-with-clockreport-mode nil
1364 "The initial value of clockreport-mode in a newly created agenda window."
1365 :group
'org-agenda-startup
1366 :group
'org-agenda-daily
/weekly
1369 (defcustom org-agenda-clockreport-parameter-plist
'(:link t
:maxlevel
2)
1370 "Property list with parameters for the clocktable in clockreport mode.
1371 This is the display mode that shows a clock table in the daily/weekly
1372 agenda, the properties for this dynamic block can be set here.
1373 The usual clocktable parameters are allowed here, but you cannot set
1374 the properties :name, :tstart, :tend, :block, and :scope - these will
1375 be overwritten to make sure the content accurately reflects the
1376 current display in the agenda."
1377 :group
'org-agenda-daily
/weekly
1380 (defcustom org-agenda-search-view-always-boolean nil
1381 "Non-nil means the search string is interpreted as individual parts.
1383 The search string for search view can either be interpreted as a phrase,
1384 or as a list of snippets that define a boolean search for a number of
1387 When this is non-nil, the string will be split on whitespace, and each
1388 snippet will be searched individually, and all must match in order to
1389 select an entry. A snippet is then a single string of non-white
1390 characters, or a string in double quotes, or a regexp in {} braces.
1391 If a snippet is preceded by \"-\", the snippet must *not* match.
1392 \"+\" is syntactic sugar for positive selection. Each snippet may
1393 be found as a full word or a partial word, but see the variable
1394 `org-agenda-search-view-force-full-words'.
1396 When this is nil, search will look for the entire search phrase as one,
1397 with each space character matching any amount of whitespace, including
1400 Even when this is nil, you can still switch to Boolean search dynamically
1401 by preceding the first snippet with \"+\" or \"-\". If the first snippet
1402 is a regexp marked with braces like \"{abc}\", this will also switch to
1404 :group
'org-agenda-search-view
1408 (defvaralias 'org-agenda-search-view-search-words-only
1409 'org-agenda-search-view-always-boolean
)
1411 (defcustom org-agenda-search-view-force-full-words nil
1412 "Non-nil means, search words must be matches as complete words.
1413 When nil, they may also match part of a word."
1414 :group
'org-agenda-search-view
1418 (defcustom org-agenda-search-view-max-outline-level
0
1419 "Maximum outline level to display in search view.
1420 E.g. when this is set to 1, the search view will only
1421 show headlines of level 1. When set to 0, the default
1422 value, don't limit agenda view by outline level."
1423 :group
'org-agenda-search-view
1425 :package-version
'(Org .
"8.3")
1428 (defgroup org-agenda-time-grid nil
1429 "Options concerning the time grid in the Org Agenda."
1430 :tag
"Org Agenda Time Grid"
1433 (defcustom org-agenda-search-headline-for-time t
1434 "Non-nil means search headline for a time-of-day.
1435 If the headline contains a time-of-day in one format or another, it will
1436 be used to sort the entry into the time sequence of items for a day.
1437 Some people have time stamps in the headline that refer to the creation
1438 time or so, and then this produces an unwanted side effect. If this is
1439 the case for your, use this variable to turn off searching the headline
1441 :group
'org-agenda-time-grid
1444 (defcustom org-agenda-use-time-grid t
1445 "Non-nil means show a time grid in the agenda schedule.
1446 A time grid is a set of lines for specific times (like every two hours between
1447 8:00 and 20:00). The items scheduled for a day at specific times are
1448 sorted in between these lines.
1449 For details about when the grid will be shown, and what it will look like, see
1450 the variable `org-agenda-time-grid'."
1451 :group
'org-agenda-time-grid
1454 (defcustom org-agenda-time-grid
1455 '((daily today require-timed
)
1457 (800 1000 1200 1400 1600 1800 2000))
1459 "The settings for time grid for agenda display.
1460 This is a list of three items. The first item is again a list. It contains
1461 symbols specifying conditions when the grid should be displayed:
1463 daily if the agenda shows a single day
1464 weekly if the agenda shows an entire week
1465 today show grid on current date, independent of daily/weekly display
1466 require-timed show grid only if at least one item has a time specification
1467 remove-match skip grid times already present in an entry
1469 The second item is a string which will be placed behind the grid time.
1471 The third item is a list of integers, indicating the times that should have
1473 :group
'org-agenda-time-grid
1476 (set :greedy t
:tag
"Grid Display Options"
1477 (const :tag
"Show grid in single day agenda display" daily
)
1478 (const :tag
"Show grid in weekly agenda display" weekly
)
1479 (const :tag
"Always show grid for today" today
)
1480 (const :tag
"Show grid only if any timed entries are present"
1482 (const :tag
"Skip grid times already present in an entry"
1484 (string :tag
"Grid String")
1485 (repeat :tag
"Grid Times" (integer :tag
"Time"))))
1487 (defcustom org-agenda-show-current-time-in-grid t
1488 "Non-nil means show the current time in the time grid."
1489 :group
'org-agenda-time-grid
1493 (defcustom org-agenda-current-time-string
1494 "now - - - - - - - - - - - - - - - - - - - - - - - - -"
1495 "The string for the current time marker in the agenda."
1496 :group
'org-agenda-time-grid
1500 (defgroup org-agenda-sorting nil
1501 "Options concerning sorting in the Org Agenda."
1502 :tag
"Org Agenda Sorting"
1505 (defcustom org-agenda-sorting-strategy
1506 '((agenda habit-down time-up priority-down category-keep
)
1507 (todo priority-down category-keep
)
1508 (tags priority-down category-keep
)
1509 (search category-keep
))
1510 "Sorting structure for the agenda items of a single day.
1511 This is a list of symbols which will be used in sequence to determine
1512 if an entry should be listed before another entry. The following
1513 symbols are recognized:
1515 time-up Put entries with time-of-day indications first, early first
1516 time-down Put entries with time-of-day indications first, late first
1517 timestamp-up Sort by any timestamp, early first
1518 timestamp-down Sort by any timestamp, late first
1519 scheduled-up Sort by scheduled timestamp, early first
1520 scheduled-down Sort by scheduled timestamp, late first
1521 deadline-up Sort by deadline timestamp, early first
1522 deadline-down Sort by deadline timestamp, late first
1523 ts-up Sort by active timestamp, early first
1524 ts-down Sort by active timestamp, late first
1525 tsia-up Sort by inactive timestamp, early first
1526 tsia-down Sort by inactive timestamp, late first
1527 category-keep Keep the default order of categories, corresponding to the
1528 sequence in `org-agenda-files'.
1529 category-up Sort alphabetically by category, A-Z.
1530 category-down Sort alphabetically by category, Z-A.
1531 tag-up Sort alphabetically by last tag, A-Z.
1532 tag-down Sort alphabetically by last tag, Z-A.
1533 priority-up Sort numerically by priority, high priority last.
1534 priority-down Sort numerically by priority, high priority first.
1535 todo-state-up Sort by todo state, tasks that are done last.
1536 todo-state-down Sort by todo state, tasks that are done first.
1537 effort-up Sort numerically by estimated effort, high effort last.
1538 effort-down Sort numerically by estimated effort, high effort first.
1539 user-defined-up Sort according to `org-agenda-cmp-user-defined', high last.
1540 user-defined-down Sort according to `org-agenda-cmp-user-defined', high first.
1541 habit-up Put entries that are habits first
1542 habit-down Put entries that are habits last
1543 alpha-up Sort headlines alphabetically
1544 alpha-down Sort headlines alphabetically, reversed
1546 The different possibilities will be tried in sequence, and testing stops
1547 if one comparison returns a \"not-equal\". For example, the default
1548 '(time-up category-keep priority-down)
1549 means: Pull out all entries having a specified time of day and sort them,
1550 in order to make a time schedule for the current day the first thing in the
1551 agenda listing for the day. Of the entries without a time indication, keep
1552 the grouped in categories, don't sort the categories, but keep them in
1553 the sequence given in `org-agenda-files'. Within each category sort by
1556 Leaving out `category-keep' would mean that items will be sorted across
1557 categories by priority.
1559 Instead of a single list, this can also be a set of list for specific
1560 contents, with a context symbol in the car of the list, any of
1561 `agenda', `todo', `tags', `search' for the corresponding agenda views.
1563 Custom commands can bind this variable in the options section."
1564 :group
'org-agenda-sorting
1566 (repeat :tag
"General" ,org-sorting-choice
)
1567 (list :tag
"Individually"
1568 (cons (const :tag
"Strategy for Weekly/Daily agenda" agenda
)
1569 (repeat ,org-sorting-choice
))
1570 (cons (const :tag
"Strategy for TODO lists" todo
)
1571 (repeat ,org-sorting-choice
))
1572 (cons (const :tag
"Strategy for Tags matches" tags
)
1573 (repeat ,org-sorting-choice
))
1574 (cons (const :tag
"Strategy for search matches" search
)
1575 (repeat ,org-sorting-choice
)))))
1577 (defcustom org-agenda-cmp-user-defined nil
1578 "A function to define the comparison `user-defined'.
1579 This function must receive two arguments, agenda entry a and b.
1580 If a>b, return +1. If a<b, return -1. If they are equal as seen by
1581 the user comparison, return nil.
1582 When this is defined, you can make `user-defined-up' and `user-defined-down'
1583 part of an agenda sorting strategy."
1584 :group
'org-agenda-sorting
1587 (defcustom org-sort-agenda-notime-is-late t
1588 "Non-nil means items without time are considered late.
1589 This is only relevant for sorting. When t, items which have no explicit
1590 time like 15:30 will be considered as 99:01, i.e. later than any items which
1591 do have a time. When nil, the default time is before 0:00. You can use this
1592 option to decide if the schedule for today should come before or after timeless
1594 :group
'org-agenda-sorting
1597 (defcustom org-sort-agenda-noeffort-is-high t
1598 "Non-nil means items without effort estimate are sorted as high effort.
1599 This also applies when filtering an agenda view with respect to the
1600 < or > effort operator. Then, tasks with no effort defined will be treated
1601 as tasks with high effort.
1602 When nil, such items are sorted as 0 minutes effort."
1603 :group
'org-agenda-sorting
1606 (defgroup org-agenda-line-format nil
1607 "Options concerning the entry prefix in the Org agenda display."
1608 :tag
"Org Agenda Line Format"
1611 (defcustom org-agenda-prefix-format
1612 '((agenda .
" %i %-12:c%?-12t% s")
1614 (todo .
" %i %-12:c")
1615 (tags .
" %i %-12:c")
1616 (search .
" %i %-12:c"))
1617 "Format specifications for the prefix of items in the agenda views.
1618 An alist with five entries, each for the different agenda types. The
1619 keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.
1620 The values are format strings.
1622 This format works similar to a printf format, with the following meaning:
1624 %c the category of the item, \"Diary\" for entries from the diary,
1625 or as given by the CATEGORY keyword or derived from the file name
1626 %e the effort required by the item
1627 %l the level of the item (insert X space(s) if item is of level X)
1628 %i the icon category of the item, see `org-agenda-category-icon-alist'
1629 %T the last tag of the item (ignore inherited tags, which come first)
1630 %t the HH:MM time-of-day specification if one applies to the entry
1631 %s Scheduling/Deadline information, a short string
1632 %b show breadcrumbs, i.e., the names of the higher levels
1633 %(expression) Eval EXPRESSION and replace the control string
1636 All specifiers work basically like the standard `%s' of printf, but may
1637 contain two additional characters: a question mark just after the `%'
1638 and a whitespace/punctuation character just before the final letter.
1640 If the first character after `%' is a question mark, the entire field
1641 will only be included if the corresponding value applies to the current
1642 entry. This is useful for fields which should have fixed width when
1643 present, but zero width when absent. For example, \"%?-12t\" will
1644 result in a 12 character time field if a time of the day is specified,
1645 but will completely disappear in entries which do not contain a time.
1647 If there is punctuation or whitespace character just before the
1648 final format letter, this character will be appended to the field
1649 value if the value is not empty. For example, the format
1650 \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If
1651 the category is empty, no additional colon is inserted.
1653 The default value for the agenda sublist is \" %-12:c%?-12t% s\",
1656 - Indent the line with two space characters
1657 - Give the category a 12 chars wide field, padded with whitespace on
1658 the right (because of `-'). Append a colon if there is a category
1660 - If there is a time-of-day, put it into a 12 chars wide field. If no
1661 time, don't put in an empty field, just skip it (because of '?').
1662 - Finally, put the scheduling information.
1664 See also the variables `org-agenda-remove-times-when-in-prefix' and
1665 `org-agenda-remove-tags'.
1667 Custom commands can set this variable in the options section."
1669 (string :tag
"General format")
1670 (list :greedy t
:tag
"View dependent"
1671 (cons (const agenda
) (string :tag
"Format"))
1672 (cons (const timeline
) (string :tag
"Format"))
1673 (cons (const todo
) (string :tag
"Format"))
1674 (cons (const tags
) (string :tag
"Format"))
1675 (cons (const search
) (string :tag
"Format"))))
1676 :group
'org-agenda-line-format
)
1678 (defvar org-prefix-format-compiled nil
1679 "The compiled prefix format and associated variables.
1680 This is a list where first element is a list of variable bindings, and second
1681 element is the compiled format expression. See the variable
1682 `org-agenda-prefix-format'.")
1684 (defcustom org-agenda-todo-keyword-format
"%-1s"
1685 "Format for the TODO keyword in agenda lines.
1686 Set this to something like \"%-12s\" if you want all TODO keywords
1687 to occupy a fixed space in the agenda display."
1688 :group
'org-agenda-line-format
1691 (defcustom org-agenda-diary-sexp-prefix nil
1692 "A regexp that matches part of a diary sexp entry
1693 which should be treated as scheduling/deadline information in
1696 For example, you can use this to extract the `diary-remind-message' from
1697 `diary-remind' entries."
1698 :group
'org-agenda-line-format
1699 :type
'(choice (const :tag
"None" nil
) (regexp :tag
"Regexp")))
1701 (defcustom org-agenda-timerange-leaders
'("" "(%d/%d): ")
1702 "Text preceding timerange entries in the agenda view.
1703 This is a list with two strings. The first applies when the range
1704 is entirely on one day. The second applies if the range spans several days.
1705 The strings may have two \"%d\" format specifiers which will be filled
1706 with the sequence number of the days, and the total number of days in the
1707 range, respectively."
1708 :group
'org-agenda-line-format
1710 (string :tag
"Deadline today ")
1711 (choice :tag
"Deadline relative"
1712 (string :tag
"Format string")
1715 (defcustom org-agenda-scheduled-leaders
'("Scheduled: " "Sched.%2dx: ")
1716 "Text preceding scheduled items in the agenda view.
1717 This is a list with two strings. The first applies when the item is
1718 scheduled on the current day. The second applies when it has been scheduled
1719 previously, it may contain a %d indicating that this is the nth time that
1720 this item is scheduled, due to automatic rescheduling of unfinished items
1721 for the following day. So this number is one larger than the number of days
1722 that passed since this item was scheduled first."
1723 :group
'org-agenda-line-format
1725 :package-version
'(Org .
"8.0")
1727 (string :tag
"Scheduled today ")
1728 (string :tag
"Scheduled previously")))
1730 (defcustom org-agenda-inactive-leader
"["
1731 "Text preceding item pulled into the agenda by inactive time stamps.
1732 These entries are added to the agenda when pressing \"[\"."
1733 :group
'org-agenda-line-format
1737 (defcustom org-agenda-deadline-leaders
'("Deadline: " "In %3d d.: " "%2d d. ago: ")
1738 "Text preceding deadline items in the agenda view.
1739 This is a list with three strings. The first applies when the item has its
1740 deadline on the current day. The second applies when the deadline is in the
1741 future, the third one when it is in the past. The strings may contain %d
1742 to capture the number of days."
1743 :group
'org-agenda-line-format
1745 :package-version
'(Org .
"8.0")
1747 (string :tag
"Deadline today ")
1748 (string :tag
"Deadline in the future ")
1749 (string :tag
"Deadline in the past ")))
1751 (defcustom org-agenda-remove-times-when-in-prefix t
1752 "Non-nil means remove duplicate time specifications in agenda items.
1753 When the format `org-agenda-prefix-format' contains a `%t' specifier, a
1754 time-of-day specification in a headline or diary entry is extracted and
1755 placed into the prefix. If this option is non-nil, the original specification
1756 \(a timestamp or -range, or just a plain time(range) specification like
1757 11:30-4pm) will be removed for agenda display. This makes the agenda less
1759 The option can be t or nil. It may also be the symbol `beg', indicating
1760 that the time should only be removed when it is located at the beginning of
1761 the headline/diary entry."
1762 :group
'org-agenda-line-format
1764 (const :tag
"Always" t
)
1765 (const :tag
"Never" nil
)
1766 (const :tag
"When at beginning of entry" beg
)))
1768 (defcustom org-agenda-remove-timeranges-from-blocks nil
1769 "Non-nil means remove time ranges specifications in agenda
1770 items that span on several days."
1771 :group
'org-agenda-line-format
1775 (defcustom org-agenda-default-appointment-duration nil
1776 "Default duration for appointments that only have a starting time.
1777 When nil, no duration is specified in such cases.
1778 When non-nil, this must be the number of minutes, e.g. 60 for one hour."
1779 :group
'org-agenda-line-format
1781 (integer :tag
"Minutes")
1782 (const :tag
"No default duration")))
1784 (defcustom org-agenda-show-inherited-tags t
1785 "Non-nil means show inherited tags in each agenda line.
1787 When this option is set to `always', it take precedences over
1788 `org-agenda-use-tag-inheritance' and inherited tags are shown
1791 When this option is set to t (the default), inherited tags are
1792 shown when they are available, i.e. when the value of
1793 `org-agenda-use-tag-inheritance' enables tag inheritance for the
1796 This can be set to a list of agenda types in which the agenda
1797 must display the inherited tags. Available types are `todo',
1798 `agenda', `search' and `timeline'.
1800 When set to nil, never show inherited tags in agenda lines."
1801 :group
'org-agenda-line-format
1805 (const :tag
"Show inherited tags when available" t
)
1806 (const :tag
"Always show inherited tags" always
)
1807 (repeat :tag
"Show inherited tags only in selected agenda types"
1808 (symbol :tag
"Agenda type"))))
1810 (defcustom org-agenda-use-tag-inheritance
'(todo search timeline agenda
)
1811 "List of agenda view types where to use tag inheritance.
1813 In tags/tags-todo/tags-tree agenda views, tag inheritance is
1814 controlled by `org-use-tag-inheritance'. In other agenda types,
1815 `org-use-tag-inheritance' is not used for the selection of the
1816 agenda entries. Still, you may want the agenda to be aware of
1817 the inherited tags anyway, e.g. for later tag filtering.
1819 Allowed value are `todo', `search', `timeline' and `agenda'.
1821 This variable has no effect if `org-agenda-show-inherited-tags'
1822 is set to `always'. In that case, the agenda is aware of those
1825 The default value sets tags in every agenda type. Setting this
1826 option to nil will speed up non-tags agenda view a lot."
1830 (const :tag
"Use tag inheritance in all agenda types" t
)
1831 (repeat :tag
"Use tag inheritance in selected agenda types"
1832 (symbol :tag
"Agenda type"))))
1834 (defcustom org-agenda-hide-tags-regexp nil
1835 "Regular expression used to filter away specific tags in agenda views.
1836 This means that these tags will be present, but not be shown in the agenda
1837 line. Secondary filtering will still work on the hidden tags.
1838 Nil means don't hide any tags."
1839 :group
'org-agenda-line-format
1841 (const :tag
"Hide none" nil
)
1842 (string :tag
"Regexp ")))
1844 (defcustom org-agenda-remove-tags nil
1845 "Non-nil means remove the tags from the headline copy in the agenda.
1846 When this is the symbol `prefix', only remove tags when
1847 `org-agenda-prefix-format' contains a `%T' specifier."
1848 :group
'org-agenda-line-format
1850 (const :tag
"Always" t
)
1851 (const :tag
"Never" nil
)
1852 (const :tag
"When prefix format contains %T" prefix
)))
1854 (defvaralias 'org-agenda-remove-tags-when-in-prefix
1855 'org-agenda-remove-tags
)
1857 (defcustom org-agenda-tags-column -
80
1858 "Shift tags in agenda items to this column.
1859 If this number is positive, it specifies the column. If it is negative,
1860 it means that the tags should be flushright to that column. For example,
1861 -80 works well for a normal 80 character screen."
1862 :group
'org-agenda-line-format
1865 (defvaralias 'org-agenda-align-tags-to-column
'org-agenda-tags-column
)
1867 (defcustom org-agenda-fontify-priorities
'cookies
1868 "Non-nil means highlight low and high priorities in agenda.
1869 When t, the highest priority entries are bold, lowest priority italic.
1870 However, settings in `org-priority-faces' will overrule these faces.
1871 When this variable is the symbol `cookies', only fontify the
1872 cookies, not the entire task.
1873 This may also be an association list of priority faces, whose
1874 keys are the character values of `org-highest-priority',
1875 `org-default-priority', and `org-lowest-priority' (the default values
1876 are ?A, ?B, and ?C, respectively). The face may be a named face, a
1877 color as a string, or a list like `(:background \"Red\")'.
1878 If it is a color, the variable `org-faces-easy-properties'
1879 determines if it is a foreground or a background color."
1880 :group
'org-agenda-line-format
1882 (const :tag
"Never" nil
)
1883 (const :tag
"Defaults" t
)
1884 (const :tag
"Cookies only" cookies
)
1885 (repeat :tag
"Specify"
1886 (list (character :tag
"Priority" :value ?A
)
1887 (choice :tag
"Face "
1888 (string :tag
"Color")
1889 (sexp :tag
"Face"))))))
1891 (defcustom org-agenda-day-face-function nil
1892 "Function called to determine what face should be used to display a day.
1893 The only argument passed to that function is the day. It should
1894 returns a face, or nil if does not want to specify a face and let
1895 the normal rules apply."
1896 :group
'org-agenda-line-format
1898 :type
'(choice (const nil
) (function)))
1900 (defcustom org-agenda-category-icon-alist nil
1901 "Alist of category icon to be displayed in agenda views.
1903 Each entry should have the following format:
1905 (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS)
1907 Where CATEGORY-REGEXP is a regexp matching the categories where
1908 the icon should be displayed.
1909 FILE-OR-DATA either a file path or a string containing image data.
1911 The other fields can be omitted safely if not needed:
1912 TYPE indicates the image type.
1913 DATA-P is a boolean indicating whether the FILE-OR-DATA string is
1915 PROPS are additional image attributes to assign to the image,
1916 like, e.g. `:ascent center'.
1918 (\"Org\" \"/path/to/icon.png\" nil nil :ascent center)
1920 If you want to set the display properties yourself, just put a
1921 list as second element:
1923 (CATEGORY-REGEXP (MY PROPERTY LIST))
1925 For example, to display a 16px horizontal space for Emacs
1926 category, you can use:
1928 (\"Emacs\" \\='(space . (:width (16))))"
1929 :group
'org-agenda-line-format
1931 :type
'(alist :key-type
(string :tag
"Regexp matching category")
1932 :value-type
(choice (list :tag
"Icon"
1933 (string :tag
"File or data")
1934 (symbol :tag
"Type")
1935 (boolean :tag
"Data?")
1936 (repeat :tag
"Extra image properties" :inline t symbol
))
1937 (list :tag
"Display properties" sexp
))))
1939 (defgroup org-agenda-column-view nil
1940 "Options concerning column view in the agenda."
1941 :tag
"Org Agenda Column View"
1944 (defcustom org-agenda-view-columns-initially nil
1945 "When non-nil, switch to columns view right after creating the agenda."
1946 :group
'org-agenda-column-view
1949 :package-version
'(Org .
"9.0")
1952 (defcustom org-agenda-columns-show-summaries t
1953 "Non-nil means show summaries for columns displayed in the agenda view."
1954 :group
'org-agenda-column-view
1957 (defcustom org-agenda-columns-compute-summary-properties t
1958 "Non-nil means recompute all summary properties before column view.
1959 When column view in the agenda is listing properties that have a summary
1960 operator, it can go to all relevant buffers and recompute the summaries
1961 there. This can mean overhead for the agenda column view, but is necessary
1962 to have thing up to date.
1963 As a special case, a CLOCKSUM property also makes sure that the clock
1964 computations are current."
1965 :group
'org-agenda-column-view
1968 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil
1969 "Non-nil means the duration of an appointment will add to day effort.
1970 The property to which appointment durations will be added is the one given
1971 in the option `org-effort-property'. If an appointment does not have
1972 an end time, `org-agenda-default-appointment-duration' will be used. If that
1973 is not set, an appointment without end time will not contribute to the time
1975 :group
'org-agenda-column-view
1978 (defcustom org-agenda-auto-exclude-function nil
1979 "A function called with a tag to decide if it is filtered on \
1980 \\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] RET'.
1981 The sole argument to the function, which is called once for each
1982 possible tag, is a string giving the name of the tag. The
1983 function should return either nil if the tag should be included
1984 as normal, or \"-<TAG>\" to exclude the tag.
1985 Note that for the purpose of tag filtering, only the lower-case version of
1986 all tags will be considered, so that this function will only ever see
1987 the lower-case version of all tags."
1989 :type
'(choice (const nil
) (function)))
1991 (defcustom org-agenda-bulk-custom-functions nil
1992 "Alist of characters and custom functions for bulk actions.
1993 For example, this value makes those two functions available:
1995 \\='((?R set-category)
1998 With selected entries in an agenda buffer, `B R' will call
1999 the custom function `set-category' on the selected entries.
2000 Note that functions in this alist don't need to be quoted."
2001 :type
'(alist :key-type character
:value-type
(group function
))
2005 (defmacro org-agenda-with-point-at-orig-entry
(string &rest body
)
2006 "Execute BODY with point at location given by `org-hd-marker' property.
2007 If STRING is non-nil, the text property will be fetched from position 0
2008 in that string. If STRING is nil, it will be fetched from the beginning
2009 of the current line."
2010 (org-with-gensyms (marker)
2011 `(let ((,marker
(get-text-property (if ,string
0 (point-at-bol))
2012 'org-hd-marker
,string
)))
2013 (with-current-buffer (marker-buffer ,marker
)
2017 (def-edebug-spec org-agenda-with-point-at-orig-entry
(form body
))
2019 (defun org-add-agenda-custom-command (entry)
2020 "Replace or add a command in `org-agenda-custom-commands'.
2021 This is mostly for hacking and trying a new command - once the command
2022 works you probably want to add it to `org-agenda-custom-commands' for good."
2023 (let ((ass (assoc (car entry
) org-agenda-custom-commands
)))
2025 (setcdr ass
(cdr entry
))
2026 (push entry org-agenda-custom-commands
))))
2028 ;;; Define the org-agenda-mode
2030 (defvar org-agenda-mode-map
(make-sparse-keymap)
2031 "Keymap for `org-agenda-mode'.")
2032 (defvaralias 'org-agenda-keymap
'org-agenda-mode-map
)
2034 (defvar org-agenda-menu
) ; defined later in this file.
2035 (defvar org-agenda-restrict nil
) ; defined later in this file.
2036 (defvar org-agenda-follow-mode nil
)
2037 (defvar org-agenda-entry-text-mode nil
)
2038 (defvar org-agenda-clockreport-mode nil
)
2039 (defvar org-agenda-show-log nil
)
2040 (defvar org-agenda-redo-command nil
)
2041 (defvar org-agenda-query-string nil
)
2042 (defvar org-agenda-mode-hook nil
2043 "Hook run after `org-agenda-mode' is turned on.
2044 The buffer is still writable when this hook is called.")
2045 (defvar org-agenda-type nil
)
2046 (defvar org-agenda-force-single-file nil
)
2047 (defvar org-agenda-bulk-marked-entries nil
2048 "List of markers that refer to marked entries in the agenda.")
2049 (defvar org-agenda-current-date nil
2050 "Active date when building the agenda.")
2052 ;;; Multiple agenda buffers support
2054 (defcustom org-agenda-sticky nil
2055 "Non-nil means agenda q key will bury agenda buffers.
2056 Agenda commands will then show existing buffer instead of generating new ones.
2057 When nil, `q' will kill the single agenda buffer."
2064 (defun org-toggle-sticky-agenda (&optional arg
)
2065 "Toggle `org-agenda-sticky'."
2067 (let ((new-value (if arg
2068 (> (prefix-numeric-value arg
) 0)
2069 (not org-agenda-sticky
))))
2070 (if (equal new-value org-agenda-sticky
)
2071 (and (called-interactively-p 'interactive
)
2072 (message "Sticky agenda was already %s"
2073 (if org-agenda-sticky
"enabled" "disabled")))
2074 (setq org-agenda-sticky new-value
)
2075 (org-agenda-kill-all-agenda-buffers)
2076 (and (called-interactively-p 'interactive
)
2077 (message "Sticky agenda %s"
2078 (if org-agenda-sticky
"enabled" "disabled"))))))
2080 (defvar org-agenda-buffer nil
2081 "Agenda buffer currently being generated.")
2083 (defvar org-agenda-last-prefix-arg nil
)
2084 (defvar org-agenda-this-buffer-name nil
)
2085 (defvar org-agenda-doing-sticky-redo nil
)
2086 (defvar org-agenda-this-buffer-is-sticky nil
)
2087 (defvar org-agenda-last-indirect-buffer nil
2088 "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.")
2090 (defconst org-agenda-local-vars
2091 '(org-agenda-this-buffer-name
2092 org-agenda-undo-list
2093 org-agenda-pending-undo-list
2094 org-agenda-follow-mode
2095 org-agenda-entry-text-mode
2096 org-agenda-clockreport-mode
2098 org-agenda-redo-command
2099 org-agenda-query-string
2101 org-agenda-bulk-marked-entries
2102 org-agenda-undo-has-started-in
2104 org-agenda-pre-window-conf
2105 org-agenda-columns-active
2106 org-agenda-tag-filter
2107 org-agenda-category-filter
2108 org-agenda-top-headline-filter
2109 org-agenda-regexp-filter
2110 org-agenda-effort-filter
2112 org-agenda-last-search-view-search-was-boolean
2113 org-agenda-last-indirect-buffer
2114 org-agenda-filtered-by-category
2115 org-agenda-filter-form
2116 org-agenda-cycle-counter
2117 org-agenda-last-prefix-arg
)
2118 "Variables that must be local in agenda buffers to allow multiple buffers.")
2120 (defun org-agenda-mode ()
2121 "Mode for time-sorted view on action items in Org files.
2123 The following commands are available:
2125 \\{org-agenda-mode-map}"
2127 (cond (org-agenda-doing-sticky-redo
2128 ;; Refreshing sticky agenda-buffer
2130 ;; Preserve the value of `org-agenda-local-vars' variables,
2131 ;; while letting `kill-all-local-variables' kill the rest
2132 (let ((save (buffer-local-variables)))
2133 (kill-all-local-variables)
2134 (mapc 'make-local-variable org-agenda-local-vars
)
2136 (let ((var (car elem
))
2139 (member var org-agenda-local-vars
))
2141 (setq-local org-agenda-this-buffer-is-sticky t
))
2143 ;; Creating a sticky Agenda buffer for the first time
2144 (kill-all-local-variables)
2145 (mapc 'make-local-variable org-agenda-local-vars
)
2146 (setq-local org-agenda-this-buffer-is-sticky t
))
2148 ;; Creating a non-sticky agenda buffer
2149 (kill-all-local-variables)
2150 (setq-local org-agenda-this-buffer-is-sticky nil
)))
2151 (setq org-agenda-undo-list nil
2152 org-agenda-pending-undo-list nil
2153 org-agenda-bulk-marked-entries nil
)
2154 (setq major-mode
'org-agenda-mode
)
2155 ;; Keep global-font-lock-mode from turning on font-lock-mode
2156 (setq-local font-lock-global-modes
(list 'not major-mode
))
2157 (setq mode-name
"Org-Agenda")
2158 (setq indent-tabs-mode nil
)
2159 (use-local-map org-agenda-mode-map
)
2160 (easy-menu-add org-agenda-menu
)
2161 (if org-startup-truncated
(setq truncate-lines t
))
2162 (setq-local line-move-visual nil
)
2163 (add-hook 'post-command-hook
'org-agenda-update-agenda-type nil
'local
)
2164 (add-hook 'pre-command-hook
'org-unhighlight nil
'local
)
2165 ;; Make sure properties are removed when copying text
2166 (add-hook 'filter-buffer-substring-functions
2167 (lambda (fun start end delete
)
2168 (substring-no-properties (funcall fun start end delete
)))
2170 (unless org-agenda-keep-modes
2171 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
2172 org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
))
2173 (setq org-agenda-show-log org-agenda-start-with-log-mode
)
2174 (setq org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
)
2175 (add-to-invisibility-spec '(org-filtered))
2176 (add-to-invisibility-spec '(org-link))
2178 '("Agenda") "Agenda Files"
2182 (if (get 'org-agenda-files
'org-restrict
)
2183 "Restricted to single file"
2185 '(org-edit-agenda-file-list)
2186 (not (get 'org-agenda-files
'org-restrict
)))
2188 (mapcar 'org-file-menu-entry
(org-agenda-files))))
2189 (org-agenda-set-mode-name)
2191 (if (fboundp 'run-mode-hooks
) 'run-mode-hooks
'run-hooks
)
2192 (list 'org-agenda-mode-hook
)))
2194 (substitute-key-definition 'undo
'org-agenda-undo
2195 org-agenda-mode-map global-map
)
2196 (org-defkey org-agenda-mode-map
"\C-i" 'org-agenda-goto
)
2197 (org-defkey org-agenda-mode-map
[(tab)] 'org-agenda-goto
)
2198 (org-defkey org-agenda-mode-map
"\C-m" 'org-agenda-switch-to
)
2199 (org-defkey org-agenda-mode-map
"\C-k" 'org-agenda-kill
)
2200 (org-defkey org-agenda-mode-map
"\C-c\C-w" 'org-agenda-refile
)
2201 (org-defkey org-agenda-mode-map
[(meta down
)] 'org-agenda-drag-line-forward
)
2202 (org-defkey org-agenda-mode-map
[(meta up
)] 'org-agenda-drag-line-backward
)
2203 (org-defkey org-agenda-mode-map
"m" 'org-agenda-bulk-mark
)
2204 (org-defkey org-agenda-mode-map
"\M-m" 'org-agenda-bulk-toggle
)
2205 (org-defkey org-agenda-mode-map
"*" 'org-agenda-bulk-mark-all
)
2206 (org-defkey org-agenda-mode-map
"\M-*" 'org-agenda-bulk-toggle-all
)
2207 (org-defkey org-agenda-mode-map
"#" 'org-agenda-dim-blocked-tasks
)
2208 (org-defkey org-agenda-mode-map
"%" 'org-agenda-bulk-mark-regexp
)
2209 (org-defkey org-agenda-mode-map
"u" 'org-agenda-bulk-unmark
)
2210 (org-defkey org-agenda-mode-map
"U" 'org-agenda-bulk-unmark-all
)
2211 (org-defkey org-agenda-mode-map
"B" 'org-agenda-bulk-action
)
2212 (org-defkey org-agenda-mode-map
"k" 'org-agenda-capture
)
2213 (org-defkey org-agenda-mode-map
"A" 'org-agenda-append-agenda
)
2214 (org-defkey org-agenda-mode-map
"\C-c\C-x!" 'org-reload
)
2215 (org-defkey org-agenda-mode-map
"\C-c\C-x\C-a" 'org-agenda-archive-default
)
2216 (org-defkey org-agenda-mode-map
"\C-c\C-xa" 'org-agenda-toggle-archive-tag
)
2217 (org-defkey org-agenda-mode-map
"\C-c\C-xA" 'org-agenda-archive-to-archive-sibling
)
2218 (org-defkey org-agenda-mode-map
"\C-c\C-x\C-s" 'org-agenda-archive
)
2219 (org-defkey org-agenda-mode-map
"\C-c$" 'org-agenda-archive
)
2220 (org-defkey org-agenda-mode-map
"$" 'org-agenda-archive
)
2221 (org-defkey org-agenda-mode-map
"\C-c\C-o" 'org-agenda-open-link
)
2222 (org-defkey org-agenda-mode-map
" " 'org-agenda-show-and-scroll-up
)
2223 (org-defkey org-agenda-mode-map
[backspace] 'org-agenda-show-scroll-down)
2224 (org-defkey org-agenda-mode-map "\d" 'org-agenda-show-scroll-down)
2225 (org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset)
2226 (org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset)
2227 (org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer)
2228 (org-defkey org-agenda-mode-map "o" 'delete-other-windows)
2229 (org-defkey org-agenda-mode-map "L" 'org-agenda-recenter)
2230 (org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
2231 (org-defkey org-agenda-mode-map "t" 'org-agenda-todo)
2232 (org-defkey org-agenda-mode-map "a" 'org-agenda-archive-default-with-confirmation)
2233 (org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags)
2234 (org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags)
2235 (org-defkey org-agenda-mode-map "." 'org-agenda-goto-today)
2236 (org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date)
2237 (org-defkey org-agenda-mode-map "d" 'org-agenda-day-view)
2238 (org-defkey org-agenda-mode-map "w" 'org-agenda-week-view)
2239 (org-defkey org-agenda-mode-map "y" 'org-agenda-year-view)
2240 (org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note)
2241 (org-defkey org-agenda-mode-map "z" 'org-agenda-add-note)
2242 (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later)
2243 (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier)
2244 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later)
2245 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier)
2247 (org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt)
2248 (org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
2249 (org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
2250 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
2251 (while l (org-defkey org-agenda-mode-map
2252 (int-to-string (pop l)) 'digit-argument)))
2254 (org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode)
2255 (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode)
2256 (org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode)
2257 (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
2258 (org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch)
2259 (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
2260 (org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines)
2261 (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
2262 (org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
2263 (org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t)))
2264 (org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort)
2265 (org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort)
2266 (org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
2267 'org-clock-modify-effort-estimate)
2268 (org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property)
2269 (org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
2270 (org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit)
2271 (org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
2272 (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write)
2273 (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
2274 (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
2275 (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
2276 (org-defkey org-agenda-mode-map "n" 'org-agenda-next-line)
2277 (org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line)
2278 (org-defkey org-agenda-mode-map "N" 'org-agenda-next-item)
2279 (org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item)
2280 (substitute-key-definition 'next-line 'org-agenda-next-line
2281 org-agenda-mode-map global-map)
2282 (substitute-key-definition 'previous-line 'org-agenda-previous-line
2283 org-agenda-mode-map global-map)
2284 (org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach)
2285 (org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line)
2286 (org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line)
2287 (org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority)
2288 (org-defkey org-agenda-mode-map "," 'org-agenda-priority)
2289 (org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry)
2290 (org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar)
2291 (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date)
2292 (org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
2293 (org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
2294 (org-defkey org-agenda-mode-map "h" 'org-agenda-holidays)
2295 (org-defkey org-agenda-mode-map "H" 'org-agenda-holidays)
2296 (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in)
2297 (org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in)
2298 (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out)
2299 (org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out)
2300 (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel)
2301 (org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel)
2302 (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
2303 (org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto)
2304 (org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up)
2305 (org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down)
2306 (org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up)
2307 (org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down)
2308 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up)
2309 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down)
2310 (org-defkey org-agenda-mode-map "f" 'org-agenda-later)
2311 (org-defkey org-agenda-mode-map "b" 'org-agenda-earlier)
2312 (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
2313 (org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
2315 (org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add)
2316 (org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
2317 (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
2318 (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
2319 (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
2320 (org-defkey org-agenda-mode-map "_" 'org-agenda-filter-by-effort)
2321 (org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp)
2322 (org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all)
2323 (org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively)
2324 (org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
2325 (org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline)
2326 (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
2327 (define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
2328 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
2329 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
2331 (org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse)
2332 (org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse)
2334 (define-key org-agenda-mode-map [remap forward-paragraph] 'org-agenda-forward-block)
2335 (define-key org-agenda-mode-map [remap backward-paragraph] 'org-agenda-backward-block)
2337 (when org-agenda-mouse-1-follows-link
2338 (org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
2339 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
2344 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
2345 ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
2346 ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
2347 ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
2350 ["Day View" org-agenda-day-view
2351 :active (org-agenda-check-type nil 'agenda)
2352 :style radio :selected (eq org-agenda-current-span 'day)
2353 :keys "v d (or just d)"]
2354 ["Week View" org-agenda-week-view
2355 :active (org-agenda-check-type nil 'agenda)
2356 :style radio :selected (eq org-agenda-current-span 'week)
2358 ["Fortnight View" org-agenda-fortnight-view
2359 :active (org-agenda-check-type nil 'agenda)
2360 :style radio :selected (eq org-agenda-current-span 'fortnight)
2362 ["Month View" org-agenda-month-view
2363 :active (org-agenda-check-type nil 'agenda)
2364 :style radio :selected (eq org-agenda-current-span 'month)
2366 ["Year View" org-agenda-year-view
2367 :active (org-agenda-check-type nil 'agenda)
2368 :style radio :selected (eq org-agenda-current-span 'year)
2371 ["Include Diary" org-agenda-toggle-diary
2372 :style toggle :selected org-agenda-include-diary
2373 :active (org-agenda-check-type nil 'agenda)]
2374 ["Include Deadlines" org-agenda-toggle-deadlines
2375 :style toggle :selected org-agenda-include-deadlines
2376 :active (org-agenda-check-type nil 'agenda)]
2377 ["Use Time Grid" org-agenda-toggle-time-grid
2378 :style toggle :selected org-agenda-use-time-grid
2379 :active (org-agenda-check-type nil 'agenda)]
2381 ["Show clock report" org-agenda-clockreport-mode
2382 :style toggle :selected org-agenda-clockreport-mode
2383 :active (org-agenda-check-type nil 'agenda)]
2384 ["Show some entry text" org-agenda-entry-text-mode
2385 :style toggle :selected org-agenda-entry-text-mode
2388 ["Show Logbook entries" org-agenda-log-mode
2389 :style toggle :selected org-agenda-show-log
2390 :active (org-agenda-check-type nil 'agenda 'timeline)
2391 :keys "v l (or just l)"]
2392 ["Include archived trees" org-agenda-archives-mode
2393 :style toggle :selected org-agenda-archives-mode :active t
2395 ["Include archive files" (org-agenda-archives-mode t)
2396 :style toggle :selected (eq org-agenda-archives-mode t) :active t
2399 ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
2400 ["Write view to file" org-agenda-write t]
2401 ["Rebuild buffer" org-agenda-redo t]
2402 ["Save all Org buffers" org-save-all-org-buffers t]
2404 ["Show original entry" org-agenda-show t]
2405 ["Go To (other window)" org-agenda-goto t]
2406 ["Go To (this window)" org-agenda-switch-to t]
2407 ["Capture with cursor date" org-agenda-capture t]
2408 ["Follow Mode" org-agenda-follow-mode
2409 :style toggle :selected org-agenda-follow-mode :active t]
2410 ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
2413 ["Cycle TODO" org-agenda-todo t]
2414 ["Next TODO set" org-agenda-todo-nextset t]
2415 ["Previous TODO set" org-agenda-todo-previousset t]
2416 ["Add note" org-agenda-add-note t])
2417 ("Archive/Refile/Delete"
2418 ["Archive default" org-agenda-archive-default t]
2419 ["Archive default" org-agenda-archive-default-with-confirmation t]
2420 ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
2421 ["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
2422 ["Archive subtree" org-agenda-archive t]
2424 ["Refile" org-agenda-refile t]
2426 ["Delete subtree" org-agenda-kill t])
2428 ["Mark entry" org-agenda-bulk-mark t]
2429 ["Mark all" org-agenda-bulk-mark-all t]
2430 ["Unmark entry" org-agenda-bulk-unmark t]
2431 ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"]
2432 ["Toggle mark" org-agenda-bulk-toggle t]
2433 ["Toggle all" org-agenda-bulk-toggle-all t]
2434 ["Mark regexp" org-agenda-bulk-mark-regexp t])
2435 ["Act on all marked" org-agenda-bulk-action t]
2437 ("Tags and Properties"
2438 ["Show all Tags" org-agenda-show-tags t]
2439 ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))]
2440 ["Change tag in region" org-agenda-set-tags (org-region-active-p)]
2442 ["Column View" org-columns t])
2443 ("Deadline/Schedule"
2444 ["Schedule" org-agenda-schedule t]
2445 ["Set Deadline" org-agenda-deadline t]
2447 ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
2448 ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
2449 ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"]
2450 ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"]
2451 ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"]
2452 ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"]
2453 ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
2455 ["Clock in" org-agenda-clock-in t]
2456 ["Clock out" org-agenda-clock-out t]
2457 ["Clock cancel" org-agenda-clock-cancel t]
2458 ["Goto running clock" org-clock-goto t]
2460 ["Set Effort" org-agenda-set-effort t]
2461 ["Change clocked effort" org-clock-modify-effort-estimate
2462 (org-clock-is-active)])
2464 ["Set Priority" org-agenda-priority t]
2465 ["Increase Priority" org-agenda-priority-up t]
2466 ["Decrease Priority" org-agenda-priority-down t]
2467 ["Show Priority" org-show-priority t])
2469 ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
2470 ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)]
2471 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
2472 ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)]
2473 ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
2474 ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)]
2476 ["Create iCalendar File" org-icalendar-combine-agenda-files t])
2478 ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
2481 ["Push Files and Views" org-mobile-push t]
2482 ["Get Captured and Flagged" org-mobile-pull t]
2483 ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"]
2484 ["Show note / unflag" org-agenda-show-the-flagging-note t]
2486 ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
2488 ["Quit" org-agenda-quit t]
2489 ["Exit and Release Buffers" org-agenda-exit t]
2494 (defvar org-agenda-allow-remote-undo t
2495 "Non-nil means allow remote undo from the agenda buffer.")
2496 (defvar org-agenda-undo-has-started-in nil
2497 "Buffers that have already seen `undo-start' in the current undo sequence.")
2499 (defun org-agenda-undo ()
2500 "Undo a remote editing step in the agenda.
2501 This undoes changes both in the agenda buffer and in the remote buffer
2502 that have been changed along."
2504 (or org-agenda-allow-remote-undo
2505 (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
2506 (if (not (eq this-command last-command))
2507 (setq org-agenda-undo-has-started-in nil
2508 org-agenda-pending-undo-list org-agenda-undo-list))
2509 (if (not org-agenda-pending-undo-list)
2510 (user-error "No further undo information"))
2511 (let* ((entry (pop org-agenda-pending-undo-list))
2512 buf line cmd rembuf)
2513 (setq cmd (pop entry) line (pop entry))
2514 (setq rembuf (nth 2 entry))
2515 (org-with-remote-undo rembuf
2516 (while (bufferp (setq buf (pop entry)))
2518 (with-current-buffer buf
2519 (let ((last-undo-buffer buf)
2520 (inhibit-read-only t))
2521 (unless (memq buf org-agenda-undo-has-started-in)
2522 (push buf org-agenda-undo-has-started-in)
2523 (make-local-variable 'pending-undo-list)
2525 (while (and pending-undo-list
2526 (listp pending-undo-list)
2527 (not (car pending-undo-list)))
2528 (pop pending-undo-list))
2530 (org-goto-line line)
2531 (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf))))
2533 (defun org-verify-change-for-undo (l1 l2)
2534 "Verify that a real change occurred between the undo lists L1 and L2."
2535 (while (and l1 (listp l1) (null (car l1))) (pop l1))
2536 (while (and l2 (listp l2) (null (car l2))) (pop l2))
2541 (defvar org-agenda-restrict-begin (make-marker))
2542 (defvar org-agenda-restrict-end (make-marker))
2543 (defvar org-agenda-last-dispatch-buffer nil)
2544 (defvar org-agenda-overriding-restriction nil)
2546 (defcustom org-agenda-custom-commands-contexts nil
2547 "Alist of custom agenda keys and contextual rules.
2549 For example, if you have a custom agenda command \"p\" and you
2550 want this command to be accessible only from plain text files,
2553 \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\"))))
2555 Here are the available contexts definitions:
2557 in-file: command displayed only in matching files
2558 in-mode: command displayed only in matching modes
2559 not-in-file: command not displayed in matching files
2560 not-in-mode: command not displayed in matching modes
2561 in-buffer: command displayed only in matching buffers
2562 not-in-buffer: command not displayed in matching buffers
2563 [function]: a custom function taking no argument
2565 If you define several checks, the agenda command will be
2566 accessible if there is at least one valid check.
2568 You can also bind a key to another agenda custom command
2569 depending on contextual rules.
2571 \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\"))))
2573 Here it means: in .txt files, use \"p\" as the key for the
2574 agenda command otherwise associated with \"q\". (The command
2575 originally associated with \"q\" is not displayed to avoid
2578 :group 'org-agenda-custom-commands
2579 :type '(repeat (list :tag "Rule"
2580 (string :tag " Agenda key")
2581 (string :tag "Replace by command")
2582 (repeat :tag "Available when"
2584 (cons :tag "Condition"
2586 (const :tag "In file" in-file)
2587 (const :tag "Not in file" not-in-file)
2588 (const :tag "In buffer" in-buffer)
2589 (const :tag "Not in buffer" not-in-buffer)
2590 (const :tag "In mode" in-mode)
2591 (const :tag "Not in mode" not-in-mode))
2593 (function :tag "Custom function"))))))
2595 (defcustom org-agenda-max-entries nil
2596 "Maximum number of entries to display in an agenda.
2597 This can be nil (no limit) or an integer or an alist of agenda
2598 types with an associated number of entries to display in this
2601 :package-version '(Org . "8.0")
2602 :group 'org-agenda-custom-commands
2603 :type '(choice (symbol :tag "No limit" nil)
2604 (integer :tag "Max number of entries")
2606 (cons (choice :tag "Agenda type"
2612 (integer :tag "Max number of entries")))))
2614 (defcustom org-agenda-max-todos nil
2615 "Maximum number of TODOs to display in an agenda.
2616 This can be nil (no limit) or an integer or an alist of agenda
2617 types with an associated number of entries to display in this
2620 :package-version '(Org . "8.0")
2621 :group 'org-agenda-custom-commands
2622 :type '(choice (symbol :tag "No limit" nil)
2623 (integer :tag "Max number of TODOs")
2625 (cons (choice :tag "Agenda type"
2631 (integer :tag "Max number of TODOs")))))
2633 (defcustom org-agenda-max-tags nil
2634 "Maximum number of tagged entries to display in an agenda.
2635 This can be nil (no limit) or an integer or an alist of agenda
2636 types with an associated number of entries to display in this
2639 :package-version '(Org . "8.0")
2640 :group 'org-agenda-custom-commands
2641 :type '(choice (symbol :tag "No limit" nil)
2642 (integer :tag "Max number of tagged entries")
2644 (cons (choice :tag "Agenda type"
2650 (integer :tag "Max number of tagged entries")))))
2652 (defcustom org-agenda-max-effort nil
2653 "Maximum cumulated effort duration for the agenda.
2654 This can be nil (no limit) or a number of minutes (as an integer)
2655 or an alist of agenda types with an associated number of minutes
2656 to limit entries to in this type."
2658 :package-version '(Org . "8.0")
2659 :group 'org-agenda-custom-commands
2660 :type '(choice (symbol :tag "No limit" nil)
2661 (integer :tag "Max number of minutes")
2663 (cons (choice :tag "Agenda type"
2669 (integer :tag "Max number of minutes")))))
2671 (defvar org-agenda-keep-restricted-file-list nil)
2672 (defvar org-keys nil)
2673 (defvar org-match nil)
2675 (defun org-agenda (&optional arg org-keys restriction)
2676 "Dispatch agenda commands to collect entries to the agenda buffer.
2677 Prompts for a command to execute. Any prefix arg will be passed
2678 on to the selected command. The default selections are:
2680 a Call `org-agenda-list' to display the agenda for current day or week.
2681 t Call `org-todo-list' to display the global todo list.
2682 T Call `org-todo-list' to display the global todo list, select only
2683 entries with a specific TODO keyword (the user gets a prompt).
2684 m Call `org-tags-view' to display headlines with tags matching
2685 a condition (the user is prompted for the condition).
2686 M Like `m', but select only TODO entries, no ordinary headlines.
2687 L Create a timeline for the current buffer.
2688 e Export views to associated files.
2689 s Search entries for keywords.
2690 S Search entries for keywords, only with TODO keywords.
2691 / Multi occur across all agenda files and also files listed
2692 in `org-agenda-text-search-extra-files'.
2693 < Restrict agenda commands to buffer, subtree, or region.
2694 Press several times to get the desired effect.
2695 > Remove a previous restriction.
2696 # List \"stuck\" projects.
2697 ! Configure what \"stuck\" means.
2698 C Configure custom agenda commands.
2700 More commands can be added by configuring the variable
2701 `org-agenda-custom-commands'. In particular, specific tags and TODO keyword
2702 searches can be pre-defined in this way.
2704 If the current buffer is in Org mode and visiting a file, you can also
2705 first press `<' once to indicate that the agenda should be temporarily
2706 \(until the next use of `\\[org-agenda]') restricted to the current file.
2707 Pressing `<' twice means to restrict to the current subtree or region
2711 (let* ((prefix-descriptions nil)
2712 (org-agenda-buffer-name org-agenda-buffer-name)
2713 (org-agenda-window-setup (if (equal (buffer-name)
2714 org-agenda-buffer-name)
2716 org-agenda-window-setup))
2717 (org-agenda-custom-commands-orig org-agenda-custom-commands)
2718 (org-agenda-custom-commands
2719 ;; normalize different versions
2723 (cond ((stringp (cdr x))
2724 (push x prefix-descriptions)
2726 ((stringp (nth 1 x)) x)
2727 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
2728 (t (cons (car x) (cons "" (cdr x))))))
2729 org-agenda-custom-commands)))
2730 (org-agenda-custom-commands
2731 (org-contextualize-keys
2732 org-agenda-custom-commands org-agenda-custom-commands-contexts))
2733 (buf (current-buffer))
2734 (bfn (buffer-file-name (buffer-base-buffer)))
2735 entry key type org-match lprops ans)
2736 ;; Turn off restriction unless there is an overriding one,
2737 (unless org-agenda-overriding-restriction
2738 (unless org-agenda-keep-restricted-file-list
2739 ;; There is a request to keep the file list in place
2740 (put 'org-agenda-files 'org-restrict nil))
2741 (setq org-agenda-restrict nil)
2742 (move-marker org-agenda-restrict-begin nil)
2743 (move-marker org-agenda-restrict-end nil))
2744 ;; Delete old local properties
2745 (put 'org-agenda-redo-command 'org-lprops nil)
2746 ;; Delete previously set last-arguments
2747 (put 'org-agenda-redo-command 'last-args nil)
2748 ;; Remember where this call originated
2749 (setq org-agenda-last-dispatch-buffer (current-buffer))
2751 (setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
2753 restriction (cdr ans)))
2754 ;; If we have sticky agenda buffers, set a name for the buffer,
2755 ;; depending on the invoking keys. The user may still set this
2756 ;; as a command option, which will overwrite what we do here.
2757 (if org-agenda-sticky
2758 (setq org-agenda-buffer-name
2759 (format "*Org Agenda(%s)*" org-keys)))
2760 ;; Establish the restriction, if any
2761 (when (and (not org-agenda-overriding-restriction) restriction)
2762 (put 'org-agenda-files 'org-restrict (list bfn))
2764 ((eq restriction 'region)
2765 (setq org-agenda-restrict (current-buffer))
2766 (move-marker org-agenda-restrict-begin (region-beginning))
2767 (move-marker org-agenda-restrict-end (region-end)))
2768 ((eq restriction 'subtree)
2770 (setq org-agenda-restrict (current-buffer))
2771 (org-back-to-heading t)
2772 (move-marker org-agenda-restrict-begin (point))
2773 (move-marker org-agenda-restrict-end
2774 (progn (org-end-of-subtree t)))))))
2776 ;; For example the todo list should not need it (but does...)
2778 ((setq entry (assoc org-keys org-agenda-custom-commands))
2779 (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
2781 (setq type (nth 2 entry) org-match (eval (nth 3 entry))
2782 lprops (nth 4 entry))
2783 (if org-agenda-sticky
2784 (setq org-agenda-buffer-name
2785 (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
2786 (format "*Org Agenda(%s)*" org-keys))))
2787 (put 'org-agenda-redo-command 'org-lprops lprops)
2790 (org-let lprops '(org-agenda-list current-prefix-arg)))
2792 (org-let lprops '(org-agenda-list current-prefix-arg nil nil t)))
2794 (org-let lprops '(org-todo-list current-prefix-arg)))
2796 (org-let lprops '(org-search-view current-prefix-arg org-match nil)))
2798 (org-let lprops '(org-agenda-list-stuck-projects
2799 current-prefix-arg)))
2801 (org-let lprops '(org-tags-view current-prefix-arg org-match)))
2802 ((eq type 'tags-todo)
2803 (org-let lprops '(org-tags-view '(4) org-match)))
2805 (org-let lprops '(org-todo-list org-match)))
2806 ((eq type 'tags-tree)
2807 (org-check-for-org-mode)
2808 (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match)))
2809 ((eq type 'todo-tree)
2810 (org-check-for-org-mode)
2812 '(org-occur (concat "^" org-outline-regexp "[ \t]*"
2813 (regexp-quote org-match) "\\>"))))
2814 ((eq type 'occur-tree)
2815 (org-check-for-org-mode)
2816 (org-let lprops '(org-occur org-match)))
2818 (org-let lprops '(funcall type org-match)))
2820 (org-let lprops '(funcall type org-match)))
2821 (t (user-error "Invalid custom agenda command type %s" type))))
2822 (org-agenda-run-series (nth 1 entry) (cddr entry))))
2823 ((equal org-keys "C")
2824 (setq org-agenda-custom-commands org-agenda-custom-commands-orig)
2825 (customize-variable 'org-agenda-custom-commands))
2826 ((equal org-keys "a") (call-interactively 'org-agenda-list))
2827 ((equal org-keys "s") (call-interactively 'org-search-view))
2828 ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4))))
2829 ((equal org-keys "t") (call-interactively 'org-todo-list))
2830 ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
2831 ((equal org-keys "m") (call-interactively 'org-tags-view))
2832 ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
2833 ((equal org-keys "e") (call-interactively 'org-store-agenda-views))
2834 ((equal org-keys "?") (org-tags-view nil "+FLAGGED")
2838 (unless (current-message)
2839 (let* ((m (org-agenda-get-any-marker))
2840 (note (and m (org-entry-get m "THEFLAGGINGNOTE"))))
2843 "FLAGGING-NOTE ([?] for more info): "
2845 (replace-regexp-in-string
2847 (copy-sequence note))
2848 nil 'face 'org-warning)))))))
2850 ((equal org-keys "L")
2851 (unless (derived-mode-p 'org-mode)
2852 (user-error "This is not an Org file"))
2854 (put 'org-agenda-files 'org-restrict (list bfn))
2855 (org-call-with-arg 'org-timeline arg)))
2856 ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
2857 ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
2858 ((equal org-keys "!") (customize-variable 'org-stuck-projects))
2859 (t (user-error "Invalid agenda key"))))))
2861 (defvar org-agenda-multi)
2863 (defun org-agenda-append-agenda ()
2864 "Append another agenda view to the current one.
2865 This function allows interactive building of block agendas.
2866 Agenda views are separated by `org-agenda-block-separator'."
2868 (unless (derived-mode-p 'org-agenda-mode)
2869 (user-error "Can only append from within agenda buffer"))
2870 (let ((org-agenda-multi t))
2873 (org-agenda-finalize)
2874 (setq buffer-read-only t)
2875 (org-agenda-fit-window-to-buffer)))
2877 (defun org-agenda-normalize-custom-commands (cmds)
2878 "Normalize custom commands CMDS."
2882 (cond ((stringp (cdr x)) nil)
2883 ((stringp (nth 1 x)) x)
2884 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
2885 (t (cons (car x) (cons "" (cdr x))))))
2888 (defun org-agenda-get-restriction-and-command (prefix-descriptions)
2889 "The user interface for selecting an agenda command."
2891 (let* ((bfn (buffer-file-name (buffer-base-buffer)))
2892 (restrict-ok (and bfn (derived-mode-p 'org-mode)))
2893 (region-p (org-region-active-p))
2894 (custom org-agenda-custom-commands)
2896 restriction second-time
2897 c entry key type match prefixes rmheader header-end custom1 desc
2898 line lines left right n n1)
2899 (save-window-excursion
2900 (delete-other-windows)
2901 (org-switch-to-buffer-other-window " *Agenda Commands*")
2903 (insert (eval-when-compile
2905 "Press key for an agenda command: < Buffer, subtree/region restriction
2906 -------------------------------- > Remove restriction
2907 a Agenda for current week or day e Export agenda views
2908 t List of all TODO entries T Entries with special TODO kwd
2909 m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
2910 s Search for keywords S Like s, but only TODO entries
2911 L Timeline for current buffer # List stuck projects (!=configure)
2912 / Multi-occur C Configure custom agenda commands
2913 ? Find :FLAGGED: entries * Toggle sticky agenda views
2916 (while (string-match
2917 "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
2919 (setq start (match-end 0))
2920 (add-text-properties (match-beginning 2) (match-end 2)
2921 '(face bold) header))
2923 (setq header-end (point-marker))
2925 (setq custom1 custom)
2926 (when (eq rmheader t)
2928 (re-search-forward ":" nil t)
2929 (delete-region (match-end 0) (point-at-eol))
2932 (delete-region (match-end 0) (point-at-eol))
2933 (move-marker header-end (match-end 0)))
2934 (goto-char header-end)
2935 (delete-region (point) (point-max))
2937 ;; Produce all the lines that describe custom commands and prefixes
2939 (while (setq entry (pop custom1))
2940 (setq key (car entry) desc (nth 1 entry)
2942 match (nth 3 entry))
2943 (if (> (length key) 1)
2944 (cl-pushnew (string-to-char key) prefixes :test #'equal)
2948 (org-add-props (copy-sequence key)
2951 ((string-match "\\S-" desc) desc)
2952 ((eq type 'agenda) "Agenda for current week or day")
2953 ((eq type 'agenda*) "Appointments for current week or day")
2954 ((eq type 'alltodo) "List of all TODO entries")
2955 ((eq type 'search) "Word search")
2956 ((eq type 'stuck) "List of stuck projects")
2957 ((eq type 'todo) "TODO keyword")
2958 ((eq type 'tags) "Tags query")
2959 ((eq type 'tags-todo) "Tags (TODO)")
2960 ((eq type 'tags-tree) "Tags tree")
2961 ((eq type 'todo-tree) "TODO kwd tree")
2962 ((eq type 'occur-tree) "Occur tree")
2963 ((functionp type) (if (symbolp type)
2965 "Lambda expression"))
2967 (if org-agenda-menu-show-matcher
2972 (setq match (copy-sequence match))
2973 (org-add-props match nil 'face 'org-warning))
2975 (format "set of %d commands" (length type))))))
2976 (if (org-string-nw-p match)
2977 (add-text-properties
2978 0 (length line) (list 'help-echo
2979 (concat "Matcher: " match)) line)))
2981 (setq lines (nreverse lines))
2986 (org-add-props (char-to-string x)
2988 (or (cdr (assoc (concat selstring
2990 prefix-descriptions))
2995 ;; Check if we should display in two columns
2996 (if org-agenda-menu-two-columns
2998 (setq n (length lines)
2999 n1 (+ (/ n 2) (mod n 2))
3000 right (nthcdr n1 lines)
3001 left (copy-sequence lines))
3002 (setcdr (nthcdr (1- n1) left) nil))
3003 (setq left lines right nil))
3005 (insert "\n" (pop left))
3007 (if (< (current-column) 40)
3008 (move-to-column 40 t)
3010 (insert (pop right))))
3012 ;; Make the window the right size
3013 (goto-char (point-min))
3015 (if (not (pos-visible-in-window-p (point-max)))
3016 (org-fit-window-to-buffer))
3017 (setq second-time t)
3018 (org-fit-window-to-buffer))
3020 ;; Ask for selection
3021 (message "Press key for agenda command%s:"
3022 (if (or restrict-ok org-agenda-overriding-restriction)
3023 (if org-agenda-overriding-restriction
3024 " (restriction lock active)"
3026 (format " (restricted to %s)" restriction)
3029 (setq c (read-char-exclusive))
3032 ((assoc (char-to-string c) custom)
3033 (setq selstring (concat selstring (char-to-string c)))
3034 (throw 'exit (cons selstring restriction)))
3036 (setq selstring (concat selstring (char-to-string c))
3038 rmheader (or rmheader t)
3039 custom (delq nil (mapcar
3041 (if (or (= (length (car x)) 1)
3042 (/= (string-to-char (car x)) c))
3044 (cons (substring (car x) 1) (cdr x))))
3047 (call-interactively 'org-toggle-sticky-agenda)
3049 ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
3050 (message "Restriction is only possible in Org buffers")
3053 (org-agenda-remove-restriction-lock 'noupdate)
3054 (setq restriction 'buffer))
3056 (org-agenda-remove-restriction-lock 'noupdate)
3057 (setq restriction (if region-p 'region 'subtree)))
3059 (org-agenda-remove-restriction-lock 'noupdate)
3062 ((eq restriction 'buffer)
3063 (if region-p 'region 'subtree))
3064 ((memq restriction '(subtree region))
3068 (org-agenda-remove-restriction-lock 'noupdate)
3069 (setq restriction nil))
3070 ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
3071 (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
3072 ((and (> (length selstring) 0) (eq c ?\d))
3074 (org-agenda-get-restriction-and-command prefix-descriptions))
3076 ((equal c ?q) (error "Abort"))
3077 (t (user-error "Invalid key %c" c))))))))
3079 (defun org-agenda-fit-window-to-buffer ()
3080 "Fit the window to the buffer size."
3081 (and (memq org-agenda-window-setup '(reorganize-frame))
3082 (fboundp 'fit-window-to-buffer)
3083 (if (and (= (cdr org-agenda-window-frame-fractions) 1.0)
3084 (= (car org-agenda-window-frame-fractions) 1.0))
3085 (delete-other-windows)
3086 (org-fit-window-to-buffer
3088 (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
3089 (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))))
3091 (defvar org-cmd nil)
3092 (defvar org-agenda-overriding-cmd nil)
3093 (defvar org-agenda-overriding-arguments nil)
3094 (defvar org-agenda-overriding-cmd-arguments nil)
3095 (defun org-agenda-run-series (name series)
3096 "Run agenda NAME as a SERIES of agenda commands."
3097 (org-let (nth 1 series) '(org-agenda-prepare name))
3098 ;; We need to reset agenda markers here, because when constructing a
3099 ;; block agenda, the individual blocks do not do that.
3100 (org-agenda-reset-markers)
3101 (let* ((org-agenda-multi t)
3102 (redo (list 'org-agenda-run-series name (list 'quote series)))
3104 (gprops (nth 1 series))
3105 match ;; The byte compiler incorrectly complains about this. Keep it!
3106 org-cmd type lprops)
3107 (while (setq org-cmd (pop cmds))
3108 (setq type (car org-cmd))
3109 (setq match (eval (nth 1 org-cmd)))
3110 (setq lprops (nth 2 org-cmd))
3111 (let ((org-agenda-overriding-arguments
3112 (if (eq org-agenda-overriding-cmd org-cmd)
3113 (or org-agenda-overriding-arguments
3114 org-agenda-overriding-cmd-arguments))))
3117 (org-let2 gprops lprops
3118 '(call-interactively 'org-agenda-list)))
3120 (org-let2 gprops lprops
3121 '(funcall 'org-agenda-list nil nil t)))
3123 (org-let2 gprops lprops
3124 '(call-interactively 'org-todo-list)))
3126 (org-let2 gprops lprops
3127 '(org-search-view current-prefix-arg match nil)))
3129 (org-let2 gprops lprops
3130 '(call-interactively 'org-agenda-list-stuck-projects)))
3132 (org-let2 gprops lprops
3133 '(org-tags-view current-prefix-arg match)))
3134 ((eq type 'tags-todo)
3135 (org-let2 gprops lprops
3136 '(org-tags-view '(4) match)))
3138 (org-let2 gprops lprops
3139 '(org-todo-list match)))
3141 (org-let2 gprops lprops
3142 '(funcall type match)))
3143 (t (error "Invalid type in command series")))))
3145 (let ((inhibit-read-only t))
3146 (add-text-properties (point-min) (point-max)
3147 `(org-series t org-series-redo-cmd ,redo)))
3148 (setq org-agenda-redo-command redo)
3149 (goto-char (point-min)))
3150 (org-agenda-fit-window-to-buffer)
3151 (org-let (nth 1 series) '(org-agenda-finalize)))
3154 (defmacro org-batch-agenda (cmd-key &rest parameters)
3155 "Run an agenda command in batch mode and send the result to STDOUT.
3156 If CMD-KEY is a string of length 1, it is used as a key in
3157 `org-agenda-custom-commands' and triggers this command. If it is a
3158 longer string it is used as a tags/todo match string.
3159 Parameters are alternating variable names and values that will be bound
3160 before running the agenda command."
3161 (org-eval-in-environment (org-make-parameter-alist parameters)
3162 (let (org-agenda-sticky)
3163 (if (> (length cmd-key) 1)
3164 (org-tags-view nil cmd-key)
3165 (org-agenda nil cmd-key))))
3166 (set-buffer org-agenda-buffer-name)
3167 (princ (buffer-string)))
3169 (defvar org-agenda-info nil)
3172 (defmacro org-batch-agenda-csv (cmd-key &rest parameters)
3173 "Run an agenda command in batch mode and send the result to STDOUT.
3174 If CMD-KEY is a string of length 1, it is used as a key in
3175 `org-agenda-custom-commands' and triggers this command. If it is a
3176 longer string it is used as a tags/todo match string.
3177 Parameters are alternating variable names and values that will be bound
3178 before running the agenda command.
3180 The output gives a line for each selected agenda item. Each
3181 item is a list of comma-separated values, like this:
3183 category,head,type,todo,tags,date,time,extra,priority-l,priority-n
3185 category The category of the item
3186 head The headline, without TODO kwd, TAGS and PRIORITY
3187 type The type of the agenda entry, can be
3188 todo selected in TODO match
3189 tagsmatch selected in tags match
3190 diary imported from diary
3191 deadline a deadline on given date
3192 scheduled scheduled on given date
3193 timestamp entry has timestamp on given date
3194 closed entry was closed on given date
3195 upcoming-deadline warning about deadline
3196 past-scheduled forwarded scheduled item
3197 block entry has date block including g. date
3198 todo The todo keyword, if any
3199 tags All tags including inherited ones, separated by colons
3200 date The relevant date, like 2007-2-14
3201 time The time, like 15:00-16:50
3202 extra Sting with extra planning info
3203 priority-l The priority letter if any was given
3204 priority-n The computed numerical priority
3205 agenda-day The day in the agenda where this is listed"
3206 (org-eval-in-environment (append '((org-agenda-remove-tags t))
3207 (org-make-parameter-alist parameters))
3208 (if (> (length cmd-key) 2)
3209 (org-tags-view nil cmd-key)
3210 (org-agenda nil cmd-key)))
3211 (set-buffer org-agenda-buffer-name)
3212 (let* ((lines (org-split-string (buffer-string) "\n"))
3214 (while (setq line (pop lines))
3216 (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
3217 (setq org-agenda-info
3218 (org-fix-agenda-info (text-properties-at 0 line)))
3220 (mapconcat 'org-agenda-export-csv-mapper
3221 '(org-category txt type todo tags date time extra
3222 priority-letter priority agenda-day)
3226 (defun org-fix-agenda-info (props)
3227 "Make sure all properties on an agenda item have a canonical form.
3228 This ensures the export commands can easily use it."
3230 (when (setq tmp (plist-get props 'tags))
3231 (setq props (plist-put props 'tags (mapconcat 'identity tmp ":"))))
3232 (when (setq tmp (plist-get props 'date))
3233 (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
3234 (let ((calendar-date-display-form '(year "-" month "-" day)))
3235 '((format "%4d, %9s %2s, %4s" dayname monthname day year))
3237 (setq tmp (calendar-date-string tmp)))
3238 (setq props (plist-put props 'date tmp)))
3239 (when (setq tmp (plist-get props 'day))
3240 (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
3241 (let ((calendar-date-display-form '(year "-" month "-" day)))
3242 (setq tmp (calendar-date-string tmp)))
3243 (setq props (plist-put props 'day tmp))
3244 (setq props (plist-put props 'agenda-day tmp)))
3245 (when (setq tmp (plist-get props 'txt))
3246 (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp)
3247 (plist-put props 'priority-letter (match-string 1 tmp))
3248 (setq tmp (replace-match "" t t tmp)))
3249 (when (and (setq re (plist-get props 'org-todo-regexp))
3250 (setq re (concat "\\`\\.*" re " ?"))
3251 (let ((case-fold-search nil)) (string-match re tmp)))
3252 (plist-put props 'todo (match-string 1 tmp))
3253 (setq tmp (replace-match "" t t tmp)))
3254 (plist-put props 'txt tmp)))
3257 (defun org-agenda-export-csv-mapper (prop)
3258 (let ((res (plist-get org-agenda-info prop)))
3263 (t (prin1-to-string res))))
3264 (org-trim (replace-regexp-in-string "," ";" res nil t))))
3267 (defun org-store-agenda-views (&rest parameters)
3268 "Store agenda views."
3270 (eval (list 'org-batch-store-agenda-views)))
3273 (defmacro org-batch-store-agenda-views (&rest parameters)
3274 "Run all custom agenda commands that have a file argument."
3275 (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
3277 (dir default-directory)
3278 (pars (org-make-parameter-alist parameters))
3279 cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
3280 (save-window-excursion
3282 (setq cmd (pop cmds)
3283 thiscmdkey (car cmd)
3284 thiscmdcmd (cdr cmd)
3285 match (nth 2 thiscmdcmd)
3286 bufname (if org-agenda-sticky
3287 (or (and (stringp match)
3288 (format "*Org Agenda(%s:%s)*" thiscmdkey match))
3289 (format "*Org Agenda(%s)*" thiscmdkey))
3290 org-agenda-buffer-name)
3291 cmd-or-set (nth 2 cmd)
3292 opts (nth (if (listp cmd-or-set) 3 4) cmd)
3293 files (nth (if (listp cmd-or-set) 4 5) cmd))
3294 (if (stringp files) (setq files (list files)))
3296 (org-eval-in-environment (append org-agenda-exporter-settings
3298 (org-agenda nil thiscmdkey))
3299 (set-buffer bufname)
3301 (org-eval-in-environment (append org-agenda-exporter-settings
3303 (org-agenda-write (expand-file-name (pop files) dir) nil t bufname)))
3304 (and (get-buffer bufname)
3305 (kill-buffer bufname)))))))
3307 (defvar org-agenda-current-span nil
3308 "The current span used in the agenda view.") ; local variable in the agenda buffer
3309 (defun org-agenda-mark-header-line (pos)
3310 "Mark the line at POS as an agenda structure header."
3313 (put-text-property (point-at-bol) (point-at-eol)
3314 'org-agenda-structural-header t)
3315 (when org-agenda-title-append
3316 (put-text-property (point-at-bol) (point-at-eol)
3317 'org-agenda-title-append org-agenda-title-append))))
3319 (defvar org-mobile-creating-agendas) ; defined in org-mobile.el
3320 (defvar org-agenda-write-buffer-name "Agenda View")
3321 (defun org-agenda-write (file &optional open nosettings agenda-bufname)
3322 "Write the current buffer (an agenda view) as a file.
3324 Depending on the extension of the file name, plain text (.txt),
3325 HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
3326 If the extension is .ics, translate visible agenda into iCalendar
3327 format. If the extension is .org, collect all subtrees
3328 corresponding to the agenda entries and add them in an .org file.
3330 With prefix argument OPEN, open the new file immediately. If
3331 NOSETTINGS is given, do not scope the settings of
3332 `org-agenda-exporter-settings' into the export commands. This is
3333 used when the settings have already been scoped and we do not
3334 wish to overrule other, higher priority settings. If
3335 AGENDA-BUFFER-NAME is provided, use this as the buffer name for
3336 the agenda to write."
3337 (interactive "FWrite agenda to file: \nP")
3338 (if (or (not (file-writable-p file))
3339 (and (file-exists-p file)
3340 (if (called-interactively-p 'any)
3341 (not (y-or-n-p (format "Overwrite existing file %s? " file))))))
3342 (user-error "Cannot write agenda to file %s" file))
3343 (org-let (if nosettings nil org-agenda-exporter-settings)
3345 (save-window-excursion
3346 (let ((bs (copy-sequence (buffer-string)))
3347 (extension (file-name-extension file))
3350 (rename-buffer org-agenda-write-buffer-name t)
3351 (set-buffer-modified-p nil)
3353 (org-agenda-remove-marked-text 'invisible 'org-filtered)
3354 (run-hooks 'org-agenda-before-write-hook)
3356 ((bound-and-true-p org-mobile-creating-agendas)
3357 (org-mobile-write-agenda-for-mobile file))
3358 ((string= "org" extension)
3359 (let (content p m message-log-max)
3360 (goto-char (point-min))
3361 (while (setq p (next-single-property-change (point) 'org-hd-marker nil))
3363 (setq m (get-text-property (point) 'org-hd-marker))
3365 (push (save-excursion
3366 (set-buffer (marker-buffer m))
3368 (org-copy-subtree 1 nil t t)
3373 (dolist (s content) (org-paste-subtree 1 s))
3375 (kill-buffer (current-buffer))
3376 (message "Org file written to %s" file)))
3377 ((member extension '("html" "htm"))
3379 (set-buffer (htmlize-buffer (current-buffer)))
3380 (when org-agenda-export-html-style
3381 ;; replace <style> section with org-agenda-export-html-style
3382 (goto-char (point-min))
3383 (kill-region (- (search-forward "<style") 6)
3384 (search-forward "</style>"))
3385 (insert org-agenda-export-html-style))
3387 (kill-buffer (current-buffer))
3388 (message "HTML written to %s" file))
3389 ((string= "ps" extension)
3391 (ps-print-buffer-with-faces file)
3392 (message "Postscript written to %s" file))
3393 ((string= "pdf" extension)
3395 (ps-print-buffer-with-faces
3396 (concat (file-name-sans-extension file) ".ps"))
3397 (call-process "ps2pdf" nil nil nil
3399 (concat (file-name-sans-extension file) ".ps"))
3400 (expand-file-name file))
3401 (delete-file (concat (file-name-sans-extension file) ".ps"))
3402 (message "PDF written to %s" file))
3403 ((string= "ics" extension)
3404 (require 'ox-icalendar)
3405 (org-icalendar-export-current-agenda (expand-file-name file)))
3407 (let ((bs (buffer-string)))
3412 (kill-buffer (current-buffer))
3413 (message "Plain text written to %s" file))))))))
3414 (set-buffer (or agenda-bufname
3415 (and (called-interactively-p 'any) (buffer-name))
3416 org-agenda-buffer-name)))
3417 (when open (org-open-file file)))
3419 (defun org-agenda-remove-marked-text (property &optional value)
3420 "Delete all text marked with VALUE of PROPERTY.
3421 VALUE defaults to t."
3423 (setq value (or value t))
3424 (while (setq beg (text-property-any (point-min) (point-max)
3427 beg (or (next-single-property-change beg property)
3430 (defun org-agenda-add-entry-text ()
3431 "Add entry text to agenda lines.
3432 This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
3433 entry text following headings shown in the agenda.
3434 Drawers will be excluded, also the line with scheduling/deadline info."
3435 (when (and (> org-agenda-add-entry-text-maxlines 0)
3436 (not (bound-and-true-p org-mobile-creating-agendas)))
3438 (goto-char (point-min))
3440 (if (not (setq m (org-get-at-bol 'org-hd-marker)))
3441 (beginning-of-line 2)
3442 (setq txt (org-agenda-get-some-entry-text
3443 m org-agenda-add-entry-text-maxlines " > "))
3445 (if (string-match "\\S-" txt)
3447 (or (eobp) (forward-char 1))))))))
3449 (defun org-agenda-get-some-entry-text (marker n-lines &optional indent
3451 "Extract entry text from MARKER, at most N-LINES lines.
3452 This will ignore drawers etc, just get the text.
3453 If INDENT is given, prefix every line with this string. If KEEP is
3454 given, it is a list of symbols, defining stuff that should not be
3455 removed from the entry content. Currently only `planning' is allowed here."
3456 (let (txt drawer-re kwd-time-re ind)
3458 (with-current-buffer (marker-buffer marker)
3459 (if (not (derived-mode-p 'org-mode))
3461 (org-with-wide-buffer
3464 (setq txt (buffer-substring
3465 (min (1+ (point)) (point-max))
3466 (progn (outline-next-heading) (point)))
3467 drawer-re org-drawer-regexp
3468 kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
3472 (when org-agenda-add-entry-text-descriptive-links
3473 (goto-char (point-min))
3474 (while (org-activate-bracket-links (point-max))
3475 (add-text-properties (match-beginning 0) (match-end 0)
3477 (goto-char (point-min))
3478 (while (re-search-forward org-bracket-link-regexp (point-max) t)
3479 (set-text-properties (match-beginning 0) (match-end 0)
3481 (goto-char (point-min))
3482 (while (re-search-forward drawer-re nil t)
3485 (progn (re-search-forward
3486 "^[ \t]*:END:.*\n?" nil 'move)
3488 (unless (member 'planning keep)
3489 (goto-char (point-min))
3490 (while (re-search-forward kwd-time-re nil t)
3491 (replace-match "")))
3492 (goto-char (point-min))
3493 (when org-agenda-entry-text-exclude-regexps
3494 (let ((re-list org-agenda-entry-text-exclude-regexps) re)
3495 (while (setq re (pop re-list))
3496 (goto-char (point-min))
3497 (while (re-search-forward re nil t)
3498 (replace-match "")))))
3499 (goto-char (point-max))
3500 (skip-chars-backward " \t\n")
3501 (if (looking-at "[ \t\n]+\\'") (replace-match ""))
3503 ;; find and remove min common indentation
3504 (goto-char (point-min))
3505 (untabify (point-min) (point-max))
3506 (setq ind (org-get-indentation))
3508 (unless (looking-at "[ \t]*$")
3509 (setq ind (min ind (org-get-indentation))))
3510 (beginning-of-line 2))
3511 (goto-char (point-min))
3513 (unless (looking-at "[ \t]*$")
3514 (move-to-column ind)
3515 (delete-region (point-at-bol) (point)))
3516 (beginning-of-line 2))
3518 (run-hooks 'org-agenda-entry-text-cleanup-hook)
3520 (goto-char (point-min))
3522 (while (and (not (eobp)) (re-search-forward "^" nil t))
3523 (replace-match indent t t)))
3524 (goto-char (point-min))
3525 (while (looking-at "[ \t]*\n") (replace-match ""))
3526 (goto-char (point-max))
3527 (when (> (org-current-line)
3529 (org-goto-line (1+ n-lines))
3531 (setq txt (buffer-substring (point-min) (point))))))))
3534 (defun org-check-for-org-mode ()
3535 "Make sure current buffer is in org-mode. Error if not."
3536 (or (derived-mode-p 'org-mode)
3537 (error "Cannot execute Org agenda command on buffer in %s"
3540 ;;; Agenda prepare and finalize
3542 (defvar org-agenda-multi nil) ; dynamically scoped
3543 (defvar org-agenda-pre-window-conf nil)
3544 (defvar org-agenda-columns-active nil)
3545 (defvar org-agenda-name nil)
3546 (defvar org-agenda-tag-filter nil)
3547 (defvar org-agenda-category-filter nil)
3548 (defvar org-agenda-regexp-filter nil)
3549 (defvar org-agenda-effort-filter nil)
3550 (defvar org-agenda-top-headline-filter nil)
3551 (defvar org-agenda-tag-filter-preset nil
3552 "A preset of the tags filter used for secondary agenda filtering.
3553 This must be a list of strings, each string must be a single tag preceded
3555 This variable should not be set directly, but agenda custom commands can
3556 bind it in the options section. The preset filter is a global property of
3557 the entire agenda view. In a block agenda, it will not work reliably to
3558 define a filter for one of the individual blocks. You need to set it in
3559 the global options and expect it to be applied to the entire view.")
3561 (defvar org-agenda-category-filter-preset nil
3562 "A preset of the category filter used for secondary agenda filtering.
3563 This must be a list of strings, each string must be a single category
3564 preceded by \"+\" or \"-\".
3565 This variable should not be set directly, but agenda custom commands can
3566 bind it in the options section. The preset filter is a global property of
3567 the entire agenda view. In a block agenda, it will not work reliably to
3568 define a filter for one of the individual blocks. You need to set it in
3569 the global options and expect it to be applied to the entire view.")
3571 (defvar org-agenda-regexp-filter-preset nil
3572 "A preset of the regexp filter used for secondary agenda filtering.
3573 This must be a list of strings, each string must be a single regexp
3574 preceded by \"+\" or \"-\".
3575 This variable should not be set directly, but agenda custom commands can
3576 bind it in the options section. The preset filter is a global property of
3577 the entire agenda view. In a block agenda, it will not work reliably to
3578 define a filter for one of the individual blocks. You need to set it in
3579 the global options and expect it to be applied to the entire view.")
3581 (defvar org-agenda-effort-filter-preset nil
3582 "A preset of the effort condition used for secondary agenda filtering.
3583 This must be a list of strings, each string must be a single regexp
3584 preceded by \"+\" or \"-\".
3585 This variable should not be set directly, but agenda custom commands can
3586 bind it in the options section. The preset filter is a global property of
3587 the entire agenda view. In a block agenda, it will not work reliably to
3588 define a filter for one of the individual blocks. You need to set it in
3589 the global options and expect it to be applied to the entire view.")
3591 (defun org-agenda-use-sticky-p ()
3592 "Return non-nil if an agenda buffer named
3593 `org-agenda-buffer-name' exists and should be shown instead of
3594 generating a new one."
3596 ;; turned off by user
3598 ;; For multi-agenda buffer already exists
3599 (not org-agenda-multi)
3601 (get-buffer org-agenda-buffer-name)
3602 ;; C-u parameter is same as last call
3603 (with-current-buffer (get-buffer org-agenda-buffer-name)
3605 (equal current-prefix-arg
3606 org-agenda-last-prefix-arg)
3607 ;; In case user turned stickiness on, while having existing
3608 ;; Agenda buffer active, don't reuse that buffer, because it
3609 ;; does not have org variables local
3610 org-agenda-this-buffer-is-sticky))))
3612 (defun org-agenda-prepare-window (abuf filter-alist)
3613 "Setup agenda buffer in the window.
3614 ABUF is the buffer for the agenda window.
3615 FILTER-ALIST is an alist of filters we need to apply when
3616 `org-agenda-persistent-filter' is non-nil."
3617 (let* ((awin (get-buffer-window abuf)) wconf)
3619 ((equal (current-buffer) abuf) nil)
3620 (awin (select-window awin))
3621 ((not (setq wconf (current-window-configuration))))
3622 ((eq org-agenda-window-setup 'current-window)
3623 (pop-to-buffer-same-window abuf))
3624 ((eq org-agenda-window-setup 'other-window)
3625 (org-switch-to-buffer-other-window abuf))
3626 ((eq org-agenda-window-setup 'other-frame)
3627 (switch-to-buffer-other-frame abuf))
3628 ((eq org-agenda-window-setup 'only-window)
3629 (delete-other-windows)
3630 (pop-to-buffer-same-window abuf))
3631 ((eq org-agenda-window-setup 'reorganize-frame)
3632 (delete-other-windows)
3633 (org-switch-to-buffer-other-window abuf)))
3634 (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist)))
3635 (setq org-agenda-category-filter (cdr (assq 'cat filter-alist)))
3636 (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist)))
3637 (setq org-agenda-regexp-filter (cdr (assq 're filter-alist)))
3638 ;; Additional test in case agenda is invoked from within agenda
3639 ;; buffer via elisp link.
3640 (unless (equal (current-buffer) abuf)
3641 (pop-to-buffer-same-window abuf))
3642 (setq org-agenda-pre-window-conf
3643 (or wconf org-agenda-pre-window-conf))))
3645 (defun org-agenda-prepare (&optional name)
3646 (let ((filter-alist (if org-agenda-persistent-filter
3647 (with-current-buffer
3648 (get-buffer-create org-agenda-buffer-name)
3649 (list `(tag . ,org-agenda-tag-filter)
3650 `(re . ,org-agenda-regexp-filter)
3651 `(effort . ,org-agenda-effort-filter)
3652 `(cat . ,org-agenda-category-filter))))))
3653 (if (org-agenda-use-sticky-p)
3655 (put 'org-agenda-tag-filter :preset-filter nil)
3656 (put 'org-agenda-category-filter :preset-filter nil)
3657 (put 'org-agenda-regexp-filter :preset-filter nil)
3658 ;; Popup existing buffer
3659 (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
3661 (message "Sticky Agenda buffer, use `r' to refresh")
3662 (or org-agenda-multi (org-agenda-fit-window-to-buffer))
3663 (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
3664 (setq org-todo-keywords-for-agenda nil)
3665 (put 'org-agenda-tag-filter :preset-filter
3666 org-agenda-tag-filter-preset)
3667 (put 'org-agenda-category-filter :preset-filter
3668 org-agenda-category-filter-preset)
3669 (put 'org-agenda-regexp-filter :preset-filter
3670 org-agenda-regexp-filter-preset)
3671 (put 'org-agenda-effort-filter :preset-filter
3672 org-agenda-effort-filter-preset)
3673 (if org-agenda-multi
3675 (setq buffer-read-only nil)
3676 (goto-char (point-max))
3677 (unless (or (bobp) org-agenda-compact-blocks
3678 (not org-agenda-block-separator))
3680 (if (stringp org-agenda-block-separator)
3681 org-agenda-block-separator
3682 (make-string (window-width) org-agenda-block-separator))
3684 (narrow-to-region (point) (point-max)))
3685 (setq org-done-keywords-for-agenda nil)
3686 ;; Setting any org variables that are in org-agenda-local-vars
3687 ;; list need to be done after the prepare call
3688 (org-agenda-prepare-window
3689 (get-buffer-create org-agenda-buffer-name) filter-alist)
3690 (setq buffer-read-only nil)
3691 (org-agenda-reset-markers)
3692 (let ((inhibit-read-only t)) (erase-buffer))
3694 (setq org-agenda-buffer (current-buffer))
3695 (setq org-agenda-contributing-files nil)
3696 (setq org-agenda-columns-active nil)
3697 (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
3698 (setq org-todo-keywords-for-agenda
3699 (org-uniquify org-todo-keywords-for-agenda))
3700 (setq org-done-keywords-for-agenda
3701 (org-uniquify org-done-keywords-for-agenda))
3702 (setq org-agenda-last-prefix-arg current-prefix-arg)
3703 (setq org-agenda-this-buffer-name org-agenda-buffer-name)
3704 (and name (not org-agenda-name)
3705 (setq-local org-agenda-name name)))
3706 (setq buffer-read-only nil))))
3708 (defvar org-agenda-overriding-columns-format) ; From org-colview.el
3709 (defun org-agenda-finalize ()
3710 "Finishing touch for the agenda buffer, called just before displaying it."
3711 (unless org-agenda-multi
3713 (let ((inhibit-read-only t))
3714 (goto-char (point-min))
3716 (while (org-activate-bracket-links (point-max))
3717 (add-text-properties (match-beginning 0) (match-end 0)
3720 (while (org-activate-plain-links (point-max))
3721 (add-text-properties (match-beginning 0) (match-end 0)
3723 (unless (eq org-agenda-remove-tags t)
3724 (org-agenda-align-tags))
3725 (unless org-agenda-with-colors
3726 (remove-text-properties (point-min) (point-max) '(face nil)))
3727 (if (and (boundp 'org-agenda-overriding-columns-format)
3728 org-agenda-overriding-columns-format)
3729 (setq-local org-agenda-overriding-columns-format
3730 org-agenda-overriding-columns-format))
3731 (if (and (boundp 'org-agenda-view-columns-initially)
3732 org-agenda-view-columns-initially)
3733 (org-agenda-columns))
3734 (when org-agenda-fontify-priorities
3735 (org-agenda-fontify-priorities))
3736 (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
3737 (org-agenda-dim-blocked-tasks))
3738 (org-agenda-mark-clocking-task)
3739 (when org-agenda-entry-text-mode
3740 (org-agenda-entry-text-hide)
3741 (org-agenda-entry-text-show))
3742 (if (and (functionp 'org-habit-insert-consistency-graphs)
3743 (save-excursion (next-single-property-change (point-min) 'org-habit-p)))
3744 (org-habit-insert-consistency-graphs))
3745 (setq org-agenda-type (org-get-at-bol 'org-agenda-type))
3746 (unless (or (eq org-agenda-show-inherited-tags 'always)
3747 (and (listp org-agenda-show-inherited-tags)
3748 (memq org-agenda-type org-agenda-show-inherited-tags))
3749 (and (eq org-agenda-show-inherited-tags t)
3750 (or (eq org-agenda-use-tag-inheritance t)
3751 (and (listp org-agenda-use-tag-inheritance)
3752 (not (memq org-agenda-type
3753 org-agenda-use-tag-inheritance))))))
3756 (goto-char (point-min))
3757 (while (equal (forward-line) 0)
3758 (when (setq mrk (get-text-property (point) 'org-hd-marker))
3759 (put-text-property (point-at-bol) (point-at-eol)
3760 'tags (org-with-point-at mrk
3762 (mapcar 'downcase (org-get-tags-at))))))))))
3763 (run-hooks 'org-agenda-finalize-hook)
3764 (when org-agenda-top-headline-filter
3765 (org-agenda-filter-top-headline-apply
3766 org-agenda-top-headline-filter))
3767 (when org-agenda-tag-filter
3768 (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
3769 (when (get 'org-agenda-tag-filter :preset-filter)
3770 (org-agenda-filter-apply
3771 (get 'org-agenda-tag-filter :preset-filter) 'tag t))
3772 (when org-agenda-category-filter
3773 (org-agenda-filter-apply org-agenda-category-filter 'category))
3774 (when (get 'org-agenda-category-filter :preset-filter)
3775 (org-agenda-filter-apply
3776 (get 'org-agenda-category-filter :preset-filter) 'category))
3777 (when org-agenda-regexp-filter
3778 (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
3779 (when (get 'org-agenda-regexp-filter :preset-filter)
3780 (org-agenda-filter-apply
3781 (get 'org-agenda-regexp-filter :preset-filter) 'regexp))
3782 (when org-agenda-effort-filter
3783 (org-agenda-filter-apply org-agenda-effort-filter 'effort))
3784 (when (get 'org-agenda-effort-filter :preset-filter)
3785 (org-agenda-filter-apply
3786 (get 'org-agenda-effort-filter :preset-filter) 'effort))
3787 (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
3789 (defun org-agenda-mark-clocking-task ()
3790 "Mark the current clock entry in the agenda if it is present."
3791 ;; We need to widen when `org-agenda-finalize' is called from
3792 ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
3793 (when (bound-and-true-p org-clock-current-task)
3796 (org-agenda-unmark-clocking-task)
3797 (when (marker-buffer org-clock-hd-marker)
3799 (goto-char (point-min))
3801 (while (setq s (next-single-property-change (point) 'org-hd-marker))
3803 (when (equal (org-get-at-bol 'org-hd-marker)
3804 org-clock-hd-marker)
3805 (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
3806 (overlay-put ov 'type 'org-agenda-clocking)
3807 (overlay-put ov 'face 'org-agenda-clocking)
3808 (overlay-put ov 'help-echo
3809 "The clock is running in this item")))))))))
3811 (defun org-agenda-unmark-clocking-task ()
3812 "Unmark the current clocking task."
3814 (if (eq (overlay-get o 'type) 'org-agenda-clocking)
3815 (delete-overlay o)))
3816 (overlays-in (point-min) (point-max))))
3818 (defun org-agenda-fontify-priorities ()
3819 "Make highest priority lines bold, and lowest italic."
3821 (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority)
3822 (delete-overlay o)))
3823 (overlays-in (point-min) (point-max)))
3826 (goto-char (point-min))
3827 (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
3828 (setq h (or (get-char-property (point) 'org-highest-priority)
3829 org-highest-priority)
3830 l (or (get-char-property (point) 'org-lowest-priority)
3831 org-lowest-priority)
3832 p (string-to-char (match-string 1))
3833 b (match-beginning 0)
3834 e (if (eq org-agenda-fontify-priorities 'cookies)
3837 ov (make-overlay b e))
3841 (cond ((org-face-from-face-or-color
3842 'priority 'org-priority
3843 (cdr (assoc p org-priority-faces))))
3844 ((and (listp org-agenda-fontify-priorities)
3845 (org-face-from-face-or-color
3846 'priority 'org-priority
3847 (cdr (assoc p org-agenda-fontify-priorities)))))
3848 ((equal p l) 'italic)
3849 ((equal p h) 'bold))))
3850 (if special-face (list special-face 'org-priority) 'org-priority)))
3851 (overlay-put ov 'org-type 'org-priority)))))
3853 (defvar org-depend-tag-blocked)
3855 (defun org-agenda-dim-blocked-tasks (&optional invisible)
3856 "Dim currently blocked TODOs in the agenda display.
3857 When INVISIBLE is non-nil, hide currently blocked TODO instead of
3860 (when (called-interactively-p 'interactive)
3861 (message "Dim or hide blocked tasks..."))
3862 (dolist (o (overlays-in (point-min) (point-max)))
3863 (when (eq (overlay-get o 'org-type) 'org-blocked-todo)
3864 (delete-overlay o)))
3866 (let ((inhibit-read-only t)
3867 (org-depend-tag-blocked nil)
3868 org-blocked-by-checkboxes)
3869 (goto-char (point-min))
3870 (while (let ((pos (text-property-not-all
3871 (point) (point-max) 'todo-state nil)))
3872 (when pos (goto-char pos)))
3873 (setq org-blocked-by-checkboxes nil)
3874 (let ((marker (org-get-at-bol 'org-hd-marker)))
3875 (when (and (markerp marker)
3876 (with-current-buffer (marker-buffer marker)
3877 (save-excursion (goto-char marker)
3878 (org-entry-blocked-p))))
3879 ;; Entries blocked by checkboxes cannot be made invisible.
3880 ;; See `org-agenda-dim-blocked-tasks' for details.
3881 (let* ((really-invisible
3882 (and (not org-blocked-by-checkboxes)
3883 (or invisible (eq org-agenda-dim-blocked-tasks
3885 (ov (make-overlay (if really-invisible (line-end-position 0)
3886 (line-beginning-position))
3887 (line-end-position))))
3888 (if really-invisible (overlay-put ov 'invisible t)
3889 (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
3890 (overlay-put ov 'org-type 'org-blocked-todo))))
3892 (when (called-interactively-p 'interactive)
3893 (message "Dim or hide blocked tasks...done")))
3895 (defvar org-agenda-skip-function nil
3896 "Function to be called at each match during agenda construction.
3897 If this function returns nil, the current match should not be skipped.
3898 Otherwise, the function must return a position from where the search
3899 should be continued.
3900 This may also be a Lisp form, it will be evaluated.
3901 Never set this variable using `setq' or so, because then it will apply
3902 to all future agenda commands. If you do want a global skipping condition,
3903 use the option `org-agenda-skip-function-global' instead.
3904 The correct usage for `org-agenda-skip-function' is to bind it with
3905 `let' to scope it dynamically into the agenda-constructing command.
3906 A good way to set it is through options in `org-agenda-custom-commands'.")
3908 (defun org-agenda-skip ()
3909 "Throw to `:skip' in places that should be skipped.
3910 Also moves point to the end of the skipped region, so that search can
3911 continue from there."
3912 (let ((p (point-at-bol)) to)
3914 (save-excursion (goto-char p) (looking-at comment-start-skip))
3915 (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
3916 (get-text-property p :org-archived)
3917 (org-end-of-subtree t))
3918 (and org-agenda-skip-comment-trees
3919 (get-text-property p :org-comment)
3920 (org-end-of-subtree t))
3921 (and (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global)
3922 (org-agenda-skip-eval org-agenda-skip-function)))
3924 (org-in-src-block-p t))
3927 (defun org-agenda-skip-eval (form)
3928 "If FORM is a function or a list, call (or eval) it and return the result.
3929 `save-excursion' and `save-match-data' are wrapped around the call, so point
3930 and match data are returned to the previous state no matter what these
3934 (or (setq fp (functionp form))
3942 (defvar org-agenda-markers nil
3943 "List of all currently active markers created by `org-agenda'.")
3944 (defvar org-agenda-last-marker-time (float-time)
3945 "Creation time of the last agenda marker.")
3947 (defun org-agenda-new-marker (&optional pos)
3948 "Return a new agenda marker.
3949 Maker is at point, or at POS if non-nil. Org mode keeps a list of
3950 these markers and resets them when they are no longer in use."
3951 (let ((m (copy-marker (or pos (point)) t)))
3952 (setq org-agenda-last-marker-time (float-time))
3953 (if org-agenda-buffer
3954 (with-current-buffer org-agenda-buffer
3955 (push m org-agenda-markers))
3956 (push m org-agenda-markers))
3959 (defun org-agenda-reset-markers ()
3960 "Reset markers created by `org-agenda'."
3961 (while org-agenda-markers
3962 (move-marker (pop org-agenda-markers) nil)))
3964 (defun org-agenda-save-markers-for-cut-and-paste (beg end)
3965 "Save relative positions of markers in region.
3966 This check for agenda markers in all agenda buffers currently active."
3967 (dolist (buf (buffer-list))
3968 (with-current-buffer buf
3969 (when (eq major-mode 'org-agenda-mode)
3970 (mapc (lambda (m) (org-check-and-save-marker m beg end))
3971 org-agenda-markers)))))
3975 (defun org-agenda-entry-text-show-here ()
3976 "Add some text from the entry as context to the current line."
3978 (setq m (org-get-at-bol 'org-hd-marker))
3979 (unless (marker-buffer m)
3980 (error "No marker points to an entry here"))
3981 (setq txt (concat "\n" (org-no-properties
3982 (org-agenda-get-some-entry-text
3983 m org-agenda-entry-text-maxlines
3984 org-agenda-entry-text-leaders))))
3985 (when (string-match "\\S-" txt)
3986 (setq o (make-overlay (point-at-bol) (point-at-eol)))
3987 (overlay-put o 'evaporate t)
3988 (overlay-put o 'org-overlay-type 'agenda-entry-content)
3989 (overlay-put o 'after-string txt))))
3991 (defun org-agenda-entry-text-show ()
3992 "Add entry context for all agenda lines."
3995 (goto-char (point-max))
3996 (beginning-of-line 1)
3998 (when (org-get-at-bol 'org-hd-marker)
3999 (org-agenda-entry-text-show-here))
4000 (beginning-of-line 0))))
4002 (defun org-agenda-entry-text-hide ()
4003 "Remove any shown entry context."
4006 (if (eq (overlay-get o 'org-overlay-type)
4007 'agenda-entry-content)
4008 (progn (delete-overlay o) t)))
4009 (overlays-in (point-min) (point-max)))))
4011 (defun org-agenda-get-day-face (date)
4012 "Return the face DATE should be displayed with."
4013 (cond ((and (functionp org-agenda-day-face-function)
4014 (funcall org-agenda-day-face-function date)))
4015 ((org-agenda-today-p date) 'org-agenda-date-today)
4016 ((memq (calendar-day-of-week date) org-agenda-weekend-days)
4017 'org-agenda-date-weekend)
4018 (t 'org-agenda-date)))
4022 (defvar org-agenda-only-exact-dates nil) ; dynamically scoped
4023 (defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
4025 (defun org-timeline (&optional dotodo)
4026 "Show a time-sorted view of the entries in the current Org file.
4028 Only entries with a time stamp of today or later will be listed.
4030 With `\\[universal-argument]' prefix, all unfinished TODO items will also be \
4032 under the current date.
4034 If the buffer contains an active region, only check the region
4038 (org-agenda-show-log-scoped org-agenda-show-log)
4039 (org-agenda-show-log org-agenda-show-log-scoped)
4040 (entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
4042 (date (calendar-current-date))
4043 (beg (if (org-region-active-p) (region-beginning) (point-min)))
4044 (end (if (org-region-active-p) (region-end) (point-max)))
4045 (day-numbers (org-get-all-dates
4047 t org-agenda-show-log-scoped ; always include today
4048 org-timeline-show-empty-dates))
4049 (org-deadline-warning-days 0)
4050 (org-agenda-only-exact-dates t)
4055 (setq org-agenda-redo-command
4057 (list (list 'org-agenda-show-log 'org-agenda-show-log))
4058 (list 'org-switch-to-buffer-other-window (current-buffer))
4059 (list 'org-timeline (list 'quote dotodo))))
4060 (put 'org-agenda-redo-command 'org-lprops nil)
4062 ;; Remove past dates from the list of dates.
4063 (setq day-numbers (delq nil (mapcar (lambda(x)
4064 (if (>= x today) x nil))
4066 (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry)))
4067 (org-compile-prefix-format 'timeline)
4068 (org-set-sorting-strategy 'timeline)
4069 (if org-agenda-show-log-scoped (push :closed args))
4070 (push :timestamp args)
4071 (push :deadline args)
4072 (push :scheduled args)
4074 (if dotodo (push :todo args))
4075 (insert "Timeline of file " entry "\n")
4076 (add-text-properties (point-min) (point)
4077 (list 'face 'org-agenda-structure))
4078 (org-agenda-mark-header-line (point-min))
4079 (while (setq d (pop day-numbers))
4080 (if (and (listp d) (eq (car d) :omitted))
4083 (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
4084 (put-text-property s (1- (point)) 'face 'org-agenda-structure))
4085 (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
4086 (if (and (>= d today)
4091 (insert (make-string 79 ?-) "\n")))
4092 (setq date (calendar-gregorian-from-absolute d))
4094 (setq rtn (and (not emptyp)
4095 (apply 'org-agenda-get-day-entries entry
4097 (if (or rtn (equal d today) org-timeline-show-empty-dates)
4100 (if (stringp org-agenda-format-date)
4101 (format-time-string org-agenda-format-date
4102 (org-time-from-absolute date))
4103 (funcall org-agenda-format-date date))
4105 (put-text-property s (1- (point)) 'face
4106 (org-agenda-get-day-face date))
4107 (put-text-property s (1- (point)) 'org-date-line t)
4108 (put-text-property s (1- (point)) 'org-agenda-date-header t)
4110 (put-text-property s (1- (point)) 'org-today t))
4111 (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n"))
4112 (put-text-property s (1- (point)) 'day d)))))
4113 (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
4115 (add-text-properties
4116 (point-min) (point-max)
4117 `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command))
4118 (org-agenda-finalize)
4119 (setq buffer-read-only t)))
4121 (defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re)
4122 "Return a list of all relevant day numbers from BEG to END buffer positions.
4123 If NO-RANGES is non-nil, include only the start and end dates of a range,
4124 not every single day in the range. If FORCE-TODAY is non-nil, make
4125 sure that TODAY is included in the list. If INACTIVE is non-nil, also
4126 inactive time stamps (those in square brackets) are included.
4127 When EMPTY is non-nil, also include days without any entries."
4129 (if pre-re pre-re "")
4130 (if inactive org-ts-regexp-both org-ts-regexp)))
4131 dates dates1 date day day1 day2 ts1 ts2 pos)
4133 (setq dates (list (org-today))))
4136 (while (re-search-forward re end t)
4137 (setq day (time-to-days (org-time-string-to-time
4138 (substring (match-string 1) 0 10)
4139 (current-buffer) (match-beginning 0))))
4140 (or (memq day dates) (push day dates)))
4143 (while (re-search-forward org-tr-regexp end t)
4144 (setq pos (match-beginning 0))
4145 (setq ts1 (substring (match-string 1) 0 10)
4146 ts2 (substring (match-string 2) 0 10)
4147 day1 (time-to-days (org-time-string-to-time
4148 ts1 (current-buffer) pos))
4149 day2 (time-to-days (org-time-string-to-time
4150 ts2 (current-buffer) pos)))
4151 (while (< (setq day1 (1+ day1)) day2)
4152 (or (memq day1 dates) (push day1 dates)))))
4153 (setq dates (sort dates '<))
4155 (while (setq day (pop dates))
4156 (setq day2 (car dates))
4158 (when (and day2 empty)
4159 (if (or (eq empty t)
4160 (and (numberp empty) (<= (- day2 day) empty)))
4161 (while (< (setq day (1+ day)) day2)
4162 (push (list day) dates1))
4163 (push (cons :omitted (- day2 day)) dates1))))
4164 (setq dates (nreverse dates1)))
4167 ;;; Agenda Daily/Weekly
4169 (defvar org-agenda-start-day nil ; dynamically scoped parameter
4170 "Start day for the agenda view.
4171 Custom commands can set this variable in the options section.
4172 This is usually a string like \"2007-11-01\", \"+2d\" or any other
4173 input allowed when reading a date through the Org calendar.
4174 See the docstring of `org-read-date' for details.")
4175 (defvar org-starting-day nil) ; local variable in the agenda buffer
4176 (defvar org-arg-loc nil) ; local variable
4178 (defvar org-agenda-buffer-tmp-name nil)
4180 (defun org-agenda-list (&optional arg start-day span with-hour)
4181 "Produce a daily/weekly view from all files in variable `org-agenda-files'.
4182 The view will be for the current day or week, but from the overview buffer
4183 you will be able to go to other days/weeks.
4185 With a numeric prefix argument in an interactive call, the agenda will
4186 span ARG days. Lisp programs should instead specify SPAN to change
4187 the number of days. SPAN defaults to `org-agenda-span'.
4189 START-DAY defaults to TODAY, or to the most recent match for the weekday
4190 given in `org-agenda-start-on-weekday'.
4192 When WITH-HOUR is non-nil, only include scheduled and deadline
4193 items if they have an hour specification like [h]h:mm."
4195 (if org-agenda-overriding-arguments
4196 (setq arg (car org-agenda-overriding-arguments)
4197 start-day (nth 1 org-agenda-overriding-arguments)
4198 span (nth 2 org-agenda-overriding-arguments)))
4199 (if (and (integerp arg) (> arg 0))
4200 (setq span arg arg nil))
4202 (setq org-agenda-buffer-name
4203 (or org-agenda-buffer-tmp-name
4204 (if org-agenda-sticky
4205 (cond ((and org-keys (stringp org-match))
4206 (format "*Org Agenda(%s:%s)*" org-keys org-match))
4208 (format "*Org Agenda(%s)*" org-keys))
4209 (t "*Org Agenda(a)*")))
4210 org-agenda-buffer-name))
4211 (org-agenda-prepare "Day/Week")
4212 (setq start-day (or start-day org-agenda-start-day))
4213 (if (stringp start-day)
4214 ;; Convert to an absolute day number
4215 (setq start-day (time-to-days (org-read-date nil t start-day))))
4216 (org-compile-prefix-format 'agenda)
4217 (org-set-sorting-strategy 'agenda)
4218 (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span)))
4220 (sd (or start-day today))
4221 (ndays (org-agenda-span-to-ndays span sd))
4222 (org-agenda-start-on-weekday
4223 (if (or (eq ndays 7) (eq ndays 14))
4224 org-agenda-start-on-weekday))
4225 (thefiles (org-agenda-files nil 'ifmode))
4227 (start (if (or (null org-agenda-start-on-weekday)
4230 (let* ((nt (calendar-day-of-week
4231 (calendar-gregorian-from-absolute sd)))
4232 (n1 org-agenda-start-on-weekday)
4234 (- sd (+ (if (< d 0) 7 0) d)))))
4235 (day-numbers (list start))
4237 (inhibit-redisplay (not debug-on-error))
4238 (org-agenda-show-log-scoped org-agenda-show-log)
4239 s e rtn rtnall file date d start-pos end-pos todayp
4240 clocktable-start clocktable-end filter)
4241 (setq org-agenda-redo-command
4242 (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
4243 (dotimes (n (1- ndays))
4244 (push (1+ (car day-numbers)) day-numbers))
4245 (setq day-numbers (nreverse day-numbers))
4246 (setq clocktable-start (car day-numbers)
4247 clocktable-end (1+ (or (org-last day-numbers) 0)))
4248 (setq-local org-starting-day (car day-numbers))
4249 (setq-local org-arg-loc arg)
4250 (setq-local org-agenda-current-span (org-agenda-ndays-to-span span))
4251 (unless org-agenda-compact-blocks
4252 (let* ((d1 (car day-numbers))
4253 (d2 (org-last day-numbers))
4254 (w1 (org-days-to-iso-week d1))
4255 (w2 (org-days-to-iso-week d2)))
4257 (if org-agenda-overriding-header
4258 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
4259 nil 'face 'org-agenda-structure) "\n")
4260 (insert (org-agenda-span-name span)
4262 (if (< (- d2 d1) 350)
4264 (format " (W%02d)" w1)
4265 (format " (W%02d-W%02d)" w1 w2))
4268 (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
4270 (org-agenda-mark-header-line s))
4271 (while (setq d (pop day-numbers))
4272 (setq date (calendar-gregorian-from-absolute d)
4274 (if (or (setq todayp (= d today))
4275 (and (not start-pos) (= d sd)))
4276 (setq start-pos (point))
4277 (if (and start-pos (not end-pos))
4278 (setq end-pos (point))))
4279 (setq files thefiles
4281 (while (setq file (pop files))
4283 (org-check-agenda-file file)
4284 (let ((org-agenda-entry-types org-agenda-entry-types))
4285 ;; Starred types override non-starred equivalents
4286 (when (member :deadline* org-agenda-entry-types)
4287 (setq org-agenda-entry-types
4288 (delq :deadline org-agenda-entry-types)))
4289 (when (member :scheduled* org-agenda-entry-types)
4290 (setq org-agenda-entry-types
4291 (delq :scheduled org-agenda-entry-types)))
4294 (when (member :deadline org-agenda-entry-types)
4295 (setq org-agenda-entry-types
4296 (delq :deadline org-agenda-entry-types))
4297 (push :deadline* org-agenda-entry-types))
4298 (when (member :scheduled org-agenda-entry-types)
4299 (setq org-agenda-entry-types
4300 (delq :scheduled org-agenda-entry-types))
4301 (push :scheduled* org-agenda-entry-types)))
4302 (unless org-agenda-include-deadlines
4303 (setq org-agenda-entry-types
4304 (delq :deadline* (delq :deadline org-agenda-entry-types))))
4306 ((memq org-agenda-show-log-scoped '(only clockcheck))
4307 (setq rtn (org-agenda-get-day-entries
4308 file date :closed)))
4309 (org-agenda-show-log-scoped
4310 (setq rtn (apply 'org-agenda-get-day-entries
4312 (append '(:closed) org-agenda-entry-types))))
4314 (setq rtn (apply 'org-agenda-get-day-entries
4316 org-agenda-entry-types)))))
4317 (setq rtnall (append rtnall rtn)))) ;; all entries
4318 (if org-agenda-include-diary
4319 (let ((org-agenda-search-headline-for-time t))
4320 (require 'diary-lib)
4321 (setq rtn (org-get-entries-from-diary date))
4322 (setq rtnall (append rtnall rtn))))
4323 (if (or rtnall org-agenda-show-all-dates)
4325 (setq day-cnt (1+ day-cnt))
4327 (if (stringp org-agenda-format-date)
4328 (format-time-string org-agenda-format-date
4329 (org-time-from-absolute date))
4330 (funcall org-agenda-format-date date))
4332 (put-text-property s (1- (point)) 'face
4333 (org-agenda-get-day-face date))
4334 (put-text-property s (1- (point)) 'org-date-line t)
4335 (put-text-property s (1- (point)) 'org-agenda-date-header t)
4336 (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
4338 (put-text-property s (1- (point)) 'org-today t))
4340 (org-agenda-add-time-grid-maybe rtnall ndays todayp))
4341 (if rtnall (insert ;; all entries
4342 (org-agenda-finalize-entries rtnall 'agenda)
4344 (put-text-property s (1- (point)) 'day d)
4345 (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
4346 (when (and org-agenda-clockreport-mode clocktable-start)
4347 (let ((org-agenda-files (org-agenda-files nil 'ifmode))
4348 ;; the above line is to ensure the restricted range!
4349 (p (copy-sequence org-agenda-clockreport-parameter-plist))
4351 (setq p (org-plist-delete p :block))
4352 (setq p (plist-put p :tstart clocktable-start))
4353 (setq p (plist-put p :tend clocktable-end))
4354 (setq p (plist-put p :scope 'agenda))
4355 (setq tbl (apply 'org-clock-get-clocktable p))
4357 (goto-char (point-min))
4358 (or org-agenda-multi (org-agenda-fit-window-to-buffer))
4359 (unless (and (pos-visible-in-window-p (point-min))
4360 (pos-visible-in-window-p (point-max)))
4361 (goto-char (1- (point-max)))
4363 (if (not (pos-visible-in-window-p (or start-pos 1)))
4365 (goto-char (or start-pos 1))
4367 (goto-char (or start-pos 1))
4368 (add-text-properties (point-min) (point-max)
4369 `(org-agenda-type agenda
4370 org-last-args (,arg ,start-day ,span)
4371 org-redo-cmd ,org-agenda-redo-command
4372 org-series-cmd ,org-cmd))
4373 (if (eq org-agenda-show-log-scoped 'clockcheck)
4374 (org-agenda-show-clocking-issues))
4375 (org-agenda-finalize)
4376 (setq buffer-read-only t)
4379 (defun org-agenda-ndays-to-span (n)
4380 "Return a span symbol for a span of N days, or N if none matches."
4381 (cond ((symbolp n) n)
4384 ((= n 14) 'fortnight)
4387 (defun org-agenda-span-to-ndays (span &optional start-day)
4388 "Return ndays from SPAN, possibly starting at START-DAY.
4389 START-DAY is an absolute time value."
4390 (cond ((numberp span) span)
4393 ((eq span 'fortnight) 14)
4395 (let ((date (calendar-gregorian-from-absolute start-day)))
4396 (calendar-last-day-of-month (car date) (cl-caddr date))))
4398 (let ((date (calendar-gregorian-from-absolute start-day)))
4399 (if (calendar-leap-year-p (cl-caddr date)) 366 365)))))
4401 (defun org-agenda-span-name (span)
4402 "Return a SPAN name."
4406 (capitalize (symbol-name span))
4407 (format "%d days" span))))
4409 ;;; Agenda word search
4411 (defvar org-agenda-search-history nil)
4413 (defvar org-search-syntax-table nil
4414 "Special syntax table for Org search.
4415 In this table, we have single quotes not as word constituents, to
4416 that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
4418 (defvar org-mode-syntax-table) ; From org.el
4419 (defun org-search-syntax-table ()
4420 (unless org-search-syntax-table
4421 (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table))
4422 (modify-syntax-entry ?' "." org-search-syntax-table)
4423 (modify-syntax-entry ?` "." org-search-syntax-table))
4424 org-search-syntax-table)
4426 (defvar org-agenda-last-search-view-search-was-boolean nil)
4429 (defun org-search-view (&optional todo-only string edit-at)
4430 "Show all entries that contain a phrase or words or regular expressions.
4432 With optional prefix argument TODO-ONLY, only consider entries that are
4433 TODO entries. The argument STRING can be used to pass a default search
4434 string into this function. If EDIT-AT is non-nil, it means that the
4435 user should get a chance to edit this string, with cursor at position
4438 The search string can be viewed either as a phrase that should be found as
4439 is, or it can be broken into a number of snippets, each of which must match
4440 in a Boolean way to select an entry. The default depends on the variable
4441 `org-agenda-search-view-always-boolean'.
4442 Even if this is turned off (the default) you can always switch to
4443 Boolean search dynamically by preceding the first word with \"+\" or \"-\".
4445 The default is a direct search of the whole phrase, where each space in
4446 the search string can expand to an arbitrary amount of whitespace,
4449 If using a Boolean search, the search string is split on whitespace and
4450 each snippet is searched separately, with logical AND to select an entry.
4451 Words prefixed with a minus must *not* occur in the entry. Words without
4452 a prefix or prefixed with a plus must occur in the entry. Matching is
4453 case-insensitive. Words are enclosed by word delimiters (i.e. they must
4454 match whole words, not parts of a word) if
4455 `org-agenda-search-view-force-full-words' is set (default is nil).
4457 Boolean search snippets enclosed by curly braces are interpreted as
4458 regular expressions that must or (when preceded with \"-\") must not
4459 match in the entry. Snippets enclosed into double quotes will be taken
4460 as a whole, to include whitespace.
4462 - If the search string starts with an asterisk, search only in headlines.
4463 - If (possibly after the leading star) the search string starts with an
4464 exclamation mark, this also means to look at TODO entries only, an effect
4465 that can also be achieved with a prefix argument.
4466 - If (possibly after star and exclamation mark) the search string starts
4467 with a colon, this will mean that the (non-regexp) snippets of the
4468 Boolean search must match as full words.
4470 This command searches the agenda files, and in addition the files listed
4471 in `org-agenda-text-search-extra-files'."
4473 (if org-agenda-overriding-arguments
4474 (setq todo-only (car org-agenda-overriding-arguments)
4475 string (nth 1 org-agenda-overriding-arguments)
4476 edit-at (nth 2 org-agenda-overriding-arguments)))
4477 (let* ((props (list 'face nil
4478 'done-face 'org-agenda-done
4479 'org-not-done-regexp org-not-done-regexp
4480 'org-todo-regexp org-todo-regexp
4481 'org-complex-heading-regexp org-complex-heading-regexp
4482 'mouse-face 'highlight
4483 'help-echo (format "mouse-2 or RET jump to location")))
4484 (full-words org-agenda-search-view-force-full-words)
4485 (org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
4486 regexp rtn rtnall files file pos inherited-tags
4487 marker category level tags c neg re boolean
4488 ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
4489 (unless (and (not edit-at)
4491 (string-match "\\S-" string))
4492 (setq string (read-string
4493 (if org-agenda-search-view-always-boolean
4494 "[+-]Word/{Regexp} ...: "
4495 "Phrase or [+-]Word/{Regexp} ...: ")
4497 ((integerp edit-at) (cons string edit-at))
4499 'org-agenda-search-history)))
4501 (if org-agenda-sticky
4502 (setq org-agenda-buffer-name
4503 (if (stringp string)
4504 (format "*Org Agenda(%s:%s)*"
4505 (or org-keys (or (and todo-only "S") "s")) string)
4506 (format "*Org Agenda(%s)*" (or (and todo-only "S") "s")))))
4507 (org-agenda-prepare "SEARCH")
4508 (org-compile-prefix-format 'search)
4509 (org-set-sorting-strategy 'search)
4510 (setq org-agenda-redo-command
4511 (list 'org-search-view (if todo-only t nil)
4512 (list 'if 'current-prefix-arg nil string)))
4513 (setq org-agenda-query-string string)
4514 (if (equal (string-to-char string) ?*)
4516 words (substring string 1))
4517 (setq words string))
4518 (when (equal (string-to-char words) ?!)
4520 words (substring words 1)))
4521 (when (equal (string-to-char words) ?:)
4523 words (substring words 1)))
4524 (if (or org-agenda-search-view-always-boolean
4525 (member (string-to-char words) '(?- ?+ ?\{)))
4527 (setq words (org-split-string words))
4529 (while (setq w (pop words))
4530 (while (and (string-match "\\\\\\'" w) words)
4531 (setq w (concat (substring w 0 -1) " " (pop words))))
4533 (setq words (nreverse www) www nil)
4534 (while (setq w (pop words))
4535 (when (and (string-match "\\`[-+]?{" w)
4536 (not (string-match "}\\'" w)))
4537 (while (and words (not (string-match "}\\'" (car words))))
4538 (setq w (concat w " " (pop words))))
4539 (setq w (concat w " " (pop words))))
4541 (setq words (nreverse www)))
4542 (setq org-agenda-last-search-view-search-was-boolean boolean)
4545 (while (setq w (pop words))
4546 (if (or (equal (substring w 0 1) "\"")
4547 (and (> (length w) 1)
4548 (member (substring w 0 1) '("+" "-"))
4549 (equal (substring w 1 2) "\"")))
4550 (while (and words (not (equal (substring w -1) "\"")))
4551 (setq w (concat w " " (pop words)))))
4552 (and (string-match "\\`\\([-+]?\\)\"" w)
4553 (setq w (replace-match "\\1" nil nil w)))
4554 (and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
4556 (setq words (nreverse wds))))
4559 (setq c (string-to-char w))
4561 (setq neg t w (substring w 1))
4563 (setq neg nil w (substring w 1))
4565 (if (string-match "\\`{.*}\\'" w)
4566 (setq re (substring w 1 -1))
4568 (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
4569 (setq re (regexp-quote (downcase w)))))
4570 (if neg (push re regexps-) (push re regexps+)))
4572 (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+")
4574 (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
4576 (setq regexp org-outline-regexp-bol)
4577 (setq regexp (pop regexps+))
4578 (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
4580 (setq files (org-agenda-files nil 'ifmode))
4581 (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
4582 (pop org-agenda-text-search-extra-files)
4583 (setq files (org-add-archive-files files)))
4584 (setq files (append files org-agenda-text-search-extra-files)
4586 (while (setq file (pop files))
4589 (org-check-agenda-file file)
4590 (setq buffer (if (file-exists-p file)
4591 (org-get-agenda-file-buffer file)
4592 (error "No such file %s" file)))
4594 ;; If file does not exist, make sure an error message is sent
4595 (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
4597 (with-current-buffer buffer
4598 (with-syntax-table (org-search-syntax-table)
4599 (unless (derived-mode-p 'org-mode)
4600 (error "Agenda file %s is not in `org-mode'" file))
4601 (let ((case-fold-search t))
4604 (if (eq buffer org-agenda-restrict)
4605 (narrow-to-region org-agenda-restrict-begin
4606 org-agenda-restrict-end)
4608 (goto-char (point-min))
4609 (unless (or (org-at-heading-p)
4610 (outline-next-heading))
4611 (throw 'nextfile t))
4612 (goto-char (max (point-min) (1- (point))))
4613 (while (re-search-forward regexp nil t)
4614 (org-back-to-heading t)
4615 (while (and (not (zerop org-agenda-search-view-max-outline-level))
4616 (> (org-reduced-level (org-outline-level))
4617 org-agenda-search-view-max-outline-level)
4619 (org-back-to-heading t)))
4620 (skip-chars-forward "* ")
4621 (setq beg (point-at-bol)
4624 (outline-next-heading)
4625 (while (and (not (zerop org-agenda-search-view-max-outline-level))
4626 (> (org-reduced-level (org-outline-level))
4627 org-agenda-search-view-max-outline-level)
4629 (outline-next-heading)))
4635 (setq str (buffer-substring-no-properties
4637 (if hdl-only (point-at-eol) end)))
4638 (mapc (lambda (wr) (when (string-match wr str)
4639 (goto-char (1- end))
4642 (mapc (lambda (wr) (unless (string-match wr str)
4643 (goto-char (1- end))
4646 (cons (concat "^\\*+[ \t]+"
4647 org-not-done-regexp)
4651 (setq marker (org-agenda-new-marker (point))
4652 category (org-get-category)
4653 level (make-string (org-reduced-level (org-outline-level)) ? )
4655 (or (eq org-agenda-show-inherited-tags 'always)
4656 (and (listp org-agenda-show-inherited-tags)
4657 (memq 'todo org-agenda-show-inherited-tags))
4658 (and (eq org-agenda-show-inherited-tags t)
4659 (or (eq org-agenda-use-tag-inheritance t)
4660 (memq 'todo org-agenda-use-tag-inheritance))))
4661 tags (org-get-tags-at nil (not inherited-tags))
4662 txt (org-agenda-format-item
4664 (buffer-substring-no-properties
4665 beg1 (point-at-eol))
4666 level category tags t))
4667 (org-add-props txt props
4668 'org-marker marker 'org-hd-marker marker
4669 'org-todo-regexp org-todo-regexp
4671 'org-complex-heading-regexp org-complex-heading-regexp
4675 (goto-char (1- end))))))))))
4676 (setq rtn (nreverse ee))
4677 (setq rtnall (append rtnall rtn)))
4678 (if org-agenda-overriding-header
4679 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
4680 nil 'face 'org-agenda-structure) "\n")
4681 (insert "Search words: ")
4682 (add-text-properties (point-min) (1- (point))
4683 (list 'face 'org-agenda-structure))
4685 (insert string "\n")
4686 (add-text-properties pos (1- (point)) (list 'face 'org-warning))
4688 (unless org-agenda-multi
4689 (insert (substitute-command-keys "\
4690 Press `\\[org-agenda-manipulate-query-add]', \
4691 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
4692 `\\[org-agenda-manipulate-query-add-re]', \
4693 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
4694 `\\[universal-argument] \\[org-agenda-redo]' to edit\n"))
4695 (add-text-properties pos (1- (point))
4696 (list 'face 'org-agenda-structure))))
4697 (org-agenda-mark-header-line (point-min))
4699 (insert (org-agenda-finalize-entries rtnall 'search) "\n"))
4700 (goto-char (point-min))
4701 (or org-agenda-multi (org-agenda-fit-window-to-buffer))
4702 (add-text-properties (point-min) (point-max)
4703 `(org-agenda-type search
4704 org-last-args (,todo-only ,string ,edit-at)
4705 org-redo-cmd ,org-agenda-redo-command
4706 org-series-cmd ,org-cmd))
4707 (org-agenda-finalize)
4708 (setq buffer-read-only t))))
4710 ;;; Agenda TODO list
4712 (defun org-agenda-propertize-selected-todo-keywords (keywords)
4713 "Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
4715 (if (or (equal keywords "ALL") (not keywords))
4716 (propertize "ALL" 'face 'warning)
4719 (propertize kw 'face (org-get-todo-face kw)))
4720 (org-split-string keywords "|")
4724 (defvar org-select-this-todo-keyword nil)
4725 (defvar org-last-arg nil)
4728 (defun org-todo-list (&optional arg)
4729 "Show all (not done) TODO entries from all agenda file in a single list.
4730 The prefix arg can be used to select a specific TODO keyword and limit
4731 the list to these. When using `\\[universal-argument]', you will be prompted
4732 for a keyword. A numeric prefix directly selects the Nth keyword in
4733 `org-todo-keywords-1'."
4735 (if org-agenda-overriding-arguments
4736 (setq arg org-agenda-overriding-arguments))
4737 (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
4738 (let* ((today (org-today))
4739 (date (calendar-gregorian-from-absolute today))
4740 (kwds org-todo-keywords-for-agenda)
4741 (completion-ignore-case t)
4742 (org-select-this-todo-keyword
4743 (if (stringp arg) arg
4744 (and arg (integerp arg) (> arg 0)
4745 (nth (1- arg) kwds))))
4746 rtn rtnall files file pos)
4747 (when (equal arg '(4))
4748 (setq org-select-this-todo-keyword
4749 (completing-read "Keyword (or KWD1|K2D2|...): "
4750 (mapcar #'list kwds) nil nil)))
4751 (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
4753 (if org-agenda-sticky
4754 (setq org-agenda-buffer-name
4755 (if (stringp org-select-this-todo-keyword)
4756 (format "*Org Agenda(%s:%s)*" (or org-keys "t")
4757 org-select-this-todo-keyword)
4758 (format "*Org Agenda(%s)*" (or org-keys "t")))))
4759 (org-agenda-prepare "TODO")
4760 (org-compile-prefix-format 'todo)
4761 (org-set-sorting-strategy 'todo)
4762 (setq org-agenda-redo-command
4763 `(org-todo-list (or (and (numberp current-prefix-arg)
4765 ,org-select-this-todo-keyword
4766 current-prefix-arg ,arg)))
4767 (setq files (org-agenda-files nil 'ifmode)
4769 (while (setq file (pop files))
4771 (org-check-agenda-file file)
4772 (setq rtn (org-agenda-get-day-entries file date :todo))
4773 (setq rtnall (append rtnall rtn))))
4774 (if org-agenda-overriding-header
4775 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
4776 nil 'face 'org-agenda-structure) "\n")
4777 (insert "Global list of TODO items of type: ")
4778 (add-text-properties (point-min) (1- (point))
4779 (list 'face 'org-agenda-structure
4782 (or org-select-this-todo-keyword "ALL"))))
4783 (org-agenda-mark-header-line (point-min))
4784 (insert (org-agenda-propertize-selected-todo-keywords
4785 org-select-this-todo-keyword))
4787 (unless org-agenda-multi
4788 (insert (substitute-command-keys "Available with \
4789 `N \\[org-agenda-redo]': (0)[ALL]"))
4792 (setq s (format "(%d)%s" (setq n (1+ n)) x))
4793 (if (> (+ (current-column) (string-width s) 1) (frame-width))
4798 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
4799 (org-agenda-mark-header-line (point-min))
4801 (insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
4802 (goto-char (point-min))
4803 (or org-agenda-multi (org-agenda-fit-window-to-buffer))
4804 (add-text-properties (point-min) (point-max)
4805 `(org-agenda-type todo
4807 org-redo-cmd ,org-agenda-redo-command
4808 org-series-cmd ,org-cmd))
4809 (org-agenda-finalize)
4810 (setq buffer-read-only t))))
4812 ;;; Agenda tags match
4815 (defun org-tags-view (&optional todo-only match)
4816 "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
4817 The prefix arg TODO-ONLY limits the search to TODO entries."
4819 (if org-agenda-overriding-arguments
4820 (setq todo-only (car org-agenda-overriding-arguments)
4821 match (nth 1 org-agenda-overriding-arguments)))
4822 (let* ((org-tags-match-list-sublevels
4823 org-tags-match-list-sublevels)
4824 (completion-ignore-case t)
4825 rtn rtnall files file pos matcher
4827 (when (and (stringp match) (not (string-match "\\S-" match)))
4830 (if org-agenda-sticky
4831 (setq org-agenda-buffer-name
4833 (format "*Org Agenda(%s:%s)*"
4834 (or org-keys (or (and todo-only "M") "m")) match)
4835 (format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
4836 ;; Prepare agendas (and `org-tag-alist-for-agenda') before
4837 ;; expanding tags within `org-make-tags-matcher'
4838 (org-agenda-prepare (concat "TAGS " match))
4839 (setq org--matcher-tags-todo-only todo-only
4840 matcher (org-make-tags-matcher match)
4842 matcher (cdr matcher))
4843 (org-compile-prefix-format 'tags)
4844 (org-set-sorting-strategy 'tags)
4845 (setq org-agenda-query-string match)
4846 (setq org-agenda-redo-command
4847 (list 'org-tags-view
4848 `(quote ,org--matcher-tags-todo-only)
4849 `(if current-prefix-arg nil ,org-agenda-query-string)))
4850 (setq files (org-agenda-files nil 'ifmode)
4852 (while (setq file (pop files))
4854 (org-check-agenda-file file)
4855 (setq buffer (if (file-exists-p file)
4856 (org-get-agenda-file-buffer file)
4857 (error "No such file %s" file)))
4859 ;; If file does not exist, error message to agenda
4861 (format "ORG-AGENDA-ERROR: No such org-file %s" file))
4862 rtnall (append rtnall rtn))
4863 (with-current-buffer buffer
4864 (unless (derived-mode-p 'org-mode)
4865 (error "Agenda file %s is not in `org-mode'" file))
4868 (if (eq buffer org-agenda-restrict)
4869 (narrow-to-region org-agenda-restrict-begin
4870 org-agenda-restrict-end)
4872 (setq rtn (org-scan-tags 'agenda
4874 org--matcher-tags-todo-only))
4875 (setq rtnall (append rtnall rtn))))))))
4876 (if org-agenda-overriding-header
4877 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
4878 nil 'face 'org-agenda-structure) "\n")
4879 (insert "Headlines with TAGS match: ")
4880 (add-text-properties (point-min) (1- (point))
4881 (list 'face 'org-agenda-structure
4883 (concat "Match: " match)))
4886 (add-text-properties pos (1- (point)) (list 'face 'org-warning))
4888 (unless org-agenda-multi
4889 (insert (substitute-command-keys
4890 "Press `\\[universal-argument] \\[org-agenda-redo]' \
4891 to search again with new search string\n")))
4892 (add-text-properties pos (1- (point))
4893 (list 'face 'org-agenda-structure)))
4894 (org-agenda-mark-header-line (point-min))
4896 (insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
4897 (goto-char (point-min))
4898 (or org-agenda-multi (org-agenda-fit-window-to-buffer))
4899 (add-text-properties
4900 (point-min) (point-max)
4901 `(org-agenda-type tags
4902 org-last-args (,org--matcher-tags-todo-only ,match)
4903 org-redo-cmd ,org-agenda-redo-command
4904 org-series-cmd ,org-cmd))
4905 (org-agenda-finalize)
4906 (setq buffer-read-only t))))
4908 ;;; Agenda Finding stuck projects
4910 (defvar org-agenda-skip-regexp nil
4911 "Regular expression used in skipping subtrees for the agenda.
4912 This is basically a temporary global variable that can be set and then
4913 used by user-defined selections using `org-agenda-skip-function'.")
4915 (defvar org-agenda-overriding-header nil
4916 "When set during agenda, todo and tags searches it replaces the header.
4917 This variable should not be set directly, but custom commands can bind it
4918 in the options section.")
4920 (defun org-agenda-skip-entry-when-regexp-matches ()
4921 "Check if the current entry contains match for `org-agenda-skip-regexp'.
4922 If yes, it returns the end position of this entry, causing agenda commands
4923 to skip the entry but continuing the search in the subtree. This is a
4924 function that can be put into `org-agenda-skip-function' for the duration
4926 (let ((end (save-excursion (org-end-of-subtree t)))
4929 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
4932 (defun org-agenda-skip-subtree-when-regexp-matches ()
4933 "Check if the current subtree contains match for `org-agenda-skip-regexp'.
4934 If yes, it returns the end position of this tree, causing agenda commands
4935 to skip this subtree. This is a function that can be put into
4936 `org-agenda-skip-function' for the duration of a command."
4937 (let ((end (save-excursion (org-end-of-subtree t)))
4940 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
4943 (defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
4944 "Check if the current subtree contains match for `org-agenda-skip-regexp'.
4945 If yes, it returns the end position of the current entry (NOT the tree),
4946 causing agenda commands to skip the entry but continuing the search in
4947 the subtree. This is a function that can be put into
4948 `org-agenda-skip-function' for the duration of a command. An important
4949 use of this function is for the stuck project list."
4950 (let ((end (save-excursion (org-end-of-subtree t)))
4951 (entry-end (save-excursion (outline-next-heading) (1- (point))))
4954 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
4955 (and skip entry-end)))
4957 (defun org-agenda-skip-entry-if (&rest conditions)
4958 "Skip entry if any of CONDITIONS is true.
4959 See `org-agenda-skip-if' for details."
4960 (org-agenda-skip-if nil conditions))
4962 (defun org-agenda-skip-subtree-if (&rest conditions)
4963 "Skip subtree if any of CONDITIONS is true.
4964 See `org-agenda-skip-if' for details."
4965 (org-agenda-skip-if t conditions))
4967 (defun org-agenda-skip-if (subtree conditions)
4968 "Checks current entity for CONDITIONS.
4969 If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only
4970 the entry (i.e. the text before the next heading) is checked.
4972 CONDITIONS is a list of symbols, boolean OR is used to combine the results
4973 from different tests. Valid conditions are:
4975 scheduled Check if there is a scheduled cookie
4976 notscheduled Check if there is no scheduled cookie
4977 deadline Check if there is a deadline
4978 notdeadline Check if there is no deadline
4979 timestamp Check if there is a timestamp (also deadline or scheduled)
4980 nottimestamp Check if there is no timestamp (also deadline or scheduled)
4981 regexp Check if regexp matches
4982 notregexp Check if regexp does not match.
4983 todo Check if TODO keyword matches
4984 nottodo Check if TODO keyword does not match
4986 The regexp is taken from the conditions list, it must come right after
4987 the `regexp' or `notregexp' element.
4989 `todo' and `nottodo' accept as an argument a list of todo
4990 keywords, which may include \"*\" to match any todo keyword.
4992 (org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\"))
4994 would skip all entries with \"TODO\" or \"WAITING\" keywords.
4996 Instead of a list, a keyword class may be given. For example:
4998 (org-agenda-skip-entry-if \\='nottodo \\='done)
5000 would skip entries that haven't been marked with any of \"DONE\"
5001 keywords. Possible classes are: `todo', `done', `any'.
5003 If any of these conditions is met, this function returns the end point of
5004 the entity, causing the search to continue from there. This is a function
5005 that can be put into `org-agenda-skip-function' for the duration of a command."
5007 (org-back-to-heading t)
5010 (progn (org-end-of-subtree t) (point))
5011 (progn (outline-next-heading) (1- (point)))))
5015 (and (memq 'scheduled conditions)
5016 (re-search-forward org-scheduled-time-regexp end t))
5017 (and (memq 'notscheduled conditions)
5018 (not (re-search-forward org-scheduled-time-regexp end t)))
5019 (and (memq 'deadline conditions)
5020 (re-search-forward org-deadline-time-regexp end t))
5021 (and (memq 'notdeadline conditions)
5022 (not (re-search-forward org-deadline-time-regexp end t)))
5023 (and (memq 'timestamp conditions)
5024 (re-search-forward org-ts-regexp end t))
5025 (and (memq 'nottimestamp conditions)
5026 (not (re-search-forward org-ts-regexp end t)))
5027 (and (setq m (memq 'regexp conditions))
5029 (re-search-forward (nth 1 m) end t))
5030 (and (setq m (memq 'notregexp conditions))
5032 (not (re-search-forward (nth 1 m) end t)))
5034 (setq m (memq 'nottodo conditions))
5035 (setq m (memq 'todo-unblocked conditions))
5036 (setq m (memq 'nottodo-unblocked conditions))
5037 (setq m (memq 'todo conditions)))
5038 (org-agenda-skip-if-todo m end)))
5041 (defun org-agenda-skip-if-todo (args end)
5042 "Helper function for `org-agenda-skip-if', do not use it directly.
5043 ARGS is a list with first element either `todo', `nottodo',
5044 `todo-unblocked' or `nottodo-unblocked'. The remainder is either
5045 a list of TODO keywords, or a state symbol `todo' or `done' or
5047 (let ((kw (car args))
5053 ((listp arg) ;; list of keywords
5054 (if (member "*" arg)
5055 (mapcar 'substring-no-properties org-todo-keywords-1)
5057 ((symbolp arg) ;; keyword class name
5060 (org-delete-all org-done-keywords
5061 (mapcar 'substring-no-properties
5062 org-todo-keywords-1)))
5063 ((eq arg 'done) org-done-keywords)
5065 (mapcar 'substring-no-properties org-todo-keywords-1)))))))
5067 (concat "^\\*+[ \t]+\\<\\("
5068 (mapconcat 'identity todo-wds "\\|")
5071 ((eq kw 'todo) (re-search-forward todo-re end t))
5072 ((eq kw 'nottodo) (not (re-search-forward todo-re end t)))
5073 ((eq kw 'todo-unblocked)
5075 (while (re-search-forward todo-re end t)
5076 (or (org-entry-blocked-p) (throw 'unblocked t)))
5078 ((eq kw 'nottodo-unblocked)
5080 (while (re-search-forward todo-re end t)
5081 (or (org-entry-blocked-p) (throw 'unblocked nil)))
5086 (defun org-agenda-list-stuck-projects (&rest ignore)
5087 "Create agenda view for projects that are stuck.
5088 Stuck projects are project that have no next actions. For the definitions
5089 of what a project is and how to check if it stuck, customize the variable
5090 `org-stuck-projects'."
5092 (let* ((org-agenda-overriding-header
5093 (or org-agenda-overriding-header "List of stuck projects: "))
5094 (matcher (nth 0 org-stuck-projects))
5095 (todo (nth 1 org-stuck-projects))
5096 (tags (nth 2 org-stuck-projects))
5097 (gen-re (org-string-nw-p (nth 3 org-stuck-projects)))
5099 (if (not (member "*" todo)) todo
5100 (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
5101 (org-delete-all org-done-keywords-for-agenda
5102 (copy-sequence org-todo-keywords-for-agenda))))
5104 (format "^\\*+[ \t]+\\(%s\\)\\>"
5105 (mapconcat #'identity todo-wds "\\|"))))
5106 (tags-re (cond ((null tags) nil)
5109 (concat org-outline-regexp-bol
5110 ".*:[[:alnum:]_@#%]+:[ \t]*$")))
5111 (tags (concat org-outline-regexp-bol
5113 (mapconcat #'identity tags "\\|")
5114 "\\):[[:alnum:]_@#%:]*[ \t]*$"))
5116 (re-list (delq nil (list todo-re tags-re gen-re)))
5119 (error "Missing information to identify unstuck projects")
5120 (mapconcat #'identity re-list "\\|")))
5121 (org-agenda-skip-function
5122 ;; Skip entry if `org-agenda-skip-regexp' matches anywhere
5125 (and (save-excursion
5126 (let ((case-fold-search nil))
5128 ,skip-re (save-excursion (org-end-of-subtree t)) t)))
5129 (progn (outline-next-heading) (point))))))
5130 (org-tags-view nil matcher)
5131 (setq org-agenda-buffer-name (buffer-name))
5132 (with-current-buffer org-agenda-buffer-name
5133 (setq org-agenda-redo-command
5134 `(org-agenda-list-stuck-projects ,current-prefix-arg)))))
5136 ;;; Diary integration
5138 (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param.
5139 (defvar diary-list-entries-hook)
5140 (defvar diary-time-regexp)
5141 (defun org-get-entries-from-diary (date)
5142 "Get the (Emacs Calendar) diary entries for DATE."
5143 (require 'diary-lib)
5144 (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
5145 (diary-display-function 'diary-fancy-display)
5147 (diary-list-entries-hook
5148 (cons 'org-diary-default-entry diary-list-entries-hook))
5149 (diary-file-name-prefix nil) ; turn this feature off
5150 (diary-modify-entry-list-string-function 'org-modify-diary-entry-string)
5152 (org-disable-agenda-to-diary t))
5154 (save-window-excursion
5155 (funcall (if (fboundp 'diary-list-entries)
5156 'diary-list-entries 'list-diary-entries)
5158 (if (not (get-buffer diary-fancy-buffer))
5160 (with-current-buffer diary-fancy-buffer
5161 (setq buffer-read-only nil)
5162 (if (zerop (buffer-size))
5165 ;; Omit the date and other unnecessary stuff
5166 (org-agenda-cleanup-fancy-diary)
5167 ;; Add prefix to each line and extend the text properties
5168 (if (zerop (buffer-size))
5170 (setq entries (buffer-substring (point-min) (- (point-max) 1)))
5173 (insert entries) (goto-char (point-min))
5174 (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t)
5175 (unless (save-match-data (string-match diary-time-regexp (match-string 1)))
5176 (replace-match (concat "; " (match-string 1)))))
5178 (set-buffer-modified-p nil)
5179 (kill-buffer diary-fancy-buffer)))
5181 (setq entries (org-split-string entries "\n"))
5185 (setq x (org-agenda-format-item "" x nil "Diary" nil 'time))
5186 ;; Extend the text properties to the beginning of the line
5187 (org-add-props x (text-properties-at (1- (length x)) x)
5188 'type "diary" 'date date 'face 'org-agenda-diary))
5191 (defvar org-agenda-cleanup-fancy-diary-hook nil
5192 "Hook run when the fancy diary buffer is cleaned up.")
5194 (defun org-agenda-cleanup-fancy-diary ()
5195 "Remove unwanted stuff in buffer created by `fancy-diary-display'.
5196 This gets rid of the date, the underline under the date, and
5197 the dummy entry installed by `org-mode' to ensure non-empty diary for each
5198 date. It also removes lines that contain only whitespace."
5199 (goto-char (point-min))
5200 (if (looking-at ".*?:[ \t]*")
5203 (re-search-forward "\n=+$" nil t)
5205 (while (re-search-backward "^ +\n?" nil t) (replace-match "")))
5206 (re-search-forward "\n=+$" nil t)
5207 (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
5208 (goto-char (point-min))
5209 (while (re-search-forward "^ +\n" nil t)
5211 (goto-char (point-min))
5212 (if (re-search-forward "^Org mode dummy\n?" nil t)
5214 (run-hooks 'org-agenda-cleanup-fancy-diary-hook))
5216 ;; Make sure entries from the diary have the right text properties.
5217 (eval-after-load "diary-lib"
5218 '(if (boundp 'diary-modify-entry-list-string-function)
5219 ;; We can rely on the hook, nothing to do
5221 ;; Hook not available, must use advice to make this work
5222 (defadvice add-to-diary-list (before org-mark-diary-entry activate)
5223 "Make the position visible."
5224 (if (and org-disable-agenda-to-diary ;; called from org-agenda
5227 (setq string (org-modify-diary-entry-string string))))))
5229 (defun org-modify-diary-entry-string (string)
5230 "Add text properties to string, allowing Org to act on it."
5231 (org-add-props string nil
5232 'mouse-face 'highlight
5233 'help-echo (if buffer-file-name
5234 (format "mouse-2 or RET jump to diary file %s"
5235 (abbreviate-file-name buffer-file-name))
5237 'org-agenda-diary-link t
5238 'org-marker (org-agenda-new-marker (point-at-bol))))
5240 (defun org-diary-default-entry ()
5241 "Add a dummy entry to the diary.
5242 Needed to avoid empty dates which mess up holiday display."
5243 ;; Catch the error if dealing with the new add-to-diary-alist
5244 (when org-disable-agenda-to-diary
5246 (org-add-to-diary-list original-date "Org mode dummy" "")
5248 (org-add-to-diary-list original-date "Org mode dummy" "" nil)))))
5250 (defun org-add-to-diary-list (&rest args)
5251 (if (fboundp 'diary-add-to-list)
5252 (apply 'diary-add-to-list args)
5253 (apply 'add-to-diary-list args)))
5255 (defvar org-diary-last-run-time nil)
5258 (defun org-diary (&rest args)
5259 "Return diary information from org files.
5260 This function can be used in a \"sexp\" diary entry in the Emacs calendar.
5261 It accesses org files and extracts information from those files to be
5262 listed in the diary. The function accepts arguments specifying what
5263 items should be listed. For a list of arguments allowed here, see the
5264 variable `org-agenda-entry-types'.
5266 The call in the diary file should look like this:
5268 &%%(org-diary) ~/path/to/some/orgfile.org
5270 Use a separate line for each org file to check. Or, if you omit the file name,
5271 all files listed in `org-agenda-files' will be checked automatically:
5275 If you don't give any arguments (as in the example above), the default value
5276 of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
5277 So the example above may also be written as
5279 &%%(org-diary :deadline :timestamp :sexp :scheduled)
5281 The function expects the lisp variables `entry' and `date' to be provided
5282 by the caller, because this is how the calendar works. Don't use this
5283 function from a program - use `org-agenda-get-day-entries' instead."
5284 (when (> (- (float-time)
5285 org-agenda-last-marker-time)
5287 ;; I am not sure if this works with sticky agendas, because the marker
5288 ;; list is then no longer a global variable.
5289 (org-agenda-reset-markers))
5290 (org-compile-prefix-format 'agenda)
5291 (org-set-sorting-strategy 'agenda)
5292 (setq args (or args org-agenda-entry-types))
5293 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
5295 (org-agenda-files t)))
5298 (when (or (not org-diary-last-run-time)
5300 org-diary-last-run-time)
5302 (org-agenda-prepare-buffers files))
5303 (setq org-diary-last-run-time time)
5304 ;; If this is called during org-agenda, don't return any entries to
5305 ;; the calendar. Org Agenda will list these entries itself.
5306 (if org-disable-agenda-to-diary (setq files nil))
5307 (while (setq file (pop files))
5308 (setq rtn (apply 'org-agenda-get-day-entries file date args))
5309 (setq results (append results rtn)))
5312 (mapcar (lambda (i) (replace-regexp-in-string
5313 org-bracket-link-regexp "\\3" i)) results))
5314 (concat (org-agenda-finalize-entries results) "\n"))))
5316 ;;; Agenda entry finders
5318 (defun org-agenda--timestamp-to-absolute (&rest args)
5319 "Call `org-time-string-to-absolute' with ARGS.
5320 However, throw `:skip' whenever an error is raised."
5322 (apply #'org-time-string-to-absolute args)
5323 (org-diary-sexp-no-match (throw :skip nil))
5325 (message "%s; Skipping entry" (error-message-string e))
5326 (throw :skip nil))))
5328 (defun org-agenda-get-day-entries (file date &rest args)
5329 "Does the work for `org-diary' and `org-agenda'.
5330 FILE is the path to a file to be checked for entries. DATE is date like
5331 the one returned by `calendar-current-date'. ARGS are symbols indicating
5332 which kind of entries should be extracted. For details about these, see
5333 the documentation of `org-diary'."
5334 (let* ((org-startup-folded nil)
5335 (org-startup-align-all-tables nil)
5336 (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file)
5337 (error "No such file %s" file))))
5339 ;; If file does not exist, signal it in diary nonetheless.
5340 (list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
5341 (with-current-buffer buffer
5342 (unless (derived-mode-p 'org-mode)
5343 (error "Agenda file %s is not in `org-mode'" file))
5344 (setq org-agenda-buffer (or org-agenda-buffer buffer))
5345 (setf org-agenda-current-date date)
5348 (if (eq buffer org-agenda-restrict)
5349 (narrow-to-region org-agenda-restrict-begin
5350 org-agenda-restrict-end)
5352 ;; Rationalize ARGS. Also make sure `:deadline' comes
5353 ;; first in order to populate DEADLINES before passing it.
5355 ;; We use `delq' since `org-uniquify' duplicates ARGS,
5356 ;; guarding us from modifying `org-agenda-entry-types'.
5357 (setf args (org-uniquify (or args org-agenda-entry-types)))
5358 (when (and (memq :scheduled args) (memq :scheduled* args))
5359 (setf args (delq :scheduled* args)))
5361 ((memq :deadline args)
5362 (setf args (cons :deadline
5363 (delq :deadline (delq :deadline* args)))))
5364 ((memq :deadline* args)
5365 (setf args (cons :deadline* (delq :deadline* args)))))
5366 ;; Collect list of headlines. Return them flattened.
5367 (let ((case-fold-search nil) results deadlines)
5368 (dolist (arg args (apply #'nconc (nreverse results)))
5370 ((and :todo (guard (org-agenda-today-p date)))
5371 (push (org-agenda-get-todos) results))
5373 (push (org-agenda-get-blocks) results)
5374 (push (org-agenda-get-timestamps deadlines) results))
5376 (push (org-agenda-get-sexps) results))
5378 (push (org-agenda-get-scheduled deadlines) results))
5380 (push (org-agenda-get-scheduled deadlines t) results))
5382 (push (org-agenda-get-progress) results))
5384 (setf deadlines (org-agenda-get-deadlines))
5385 (push deadlines results))
5387 (setf deadlines (org-agenda-get-deadlines t))
5388 (push deadlines results)))))))))))
5390 (defsubst org-em (x y list)
5391 "Is X or Y a member of LIST?"
5392 (or (memq x list) (memq y list)))
5394 (defvar org-heading-keyword-regexp-format) ; defined in org.el
5395 (defvar org-agenda-sorting-strategy-selected nil)
5397 (defun org-agenda-entry-get-agenda-timestamp (pom)
5398 "Retrieve timestamp information for sorting agenda views.
5399 Given a point or marker POM, returns a cons cell of the timestamp
5400 and the timestamp type relevant for the sorting strategy in
5401 `org-agenda-sorting-strategy-selected'."
5402 (let (ts ts-date-type)
5404 (cond ((org-em 'scheduled-up 'scheduled-down
5405 org-agenda-sorting-strategy-selected)
5406 (setq ts (org-entry-get pom "SCHEDULED")
5407 ts-date-type " scheduled"))
5408 ((org-em 'deadline-up 'deadline-down
5409 org-agenda-sorting-strategy-selected)
5410 (setq ts (org-entry-get pom "DEADLINE")
5411 ts-date-type " deadline"))
5412 ((org-em 'ts-up 'ts-down
5413 org-agenda-sorting-strategy-selected)
5414 (setq ts (org-entry-get pom "TIMESTAMP")
5415 ts-date-type " timestamp"))
5416 ((org-em 'tsia-up 'tsia-down
5417 org-agenda-sorting-strategy-selected)
5418 (setq ts (org-entry-get pom "TIMESTAMP_IA")
5419 ts-date-type " timestamp_ia"))
5420 ((org-em 'timestamp-up 'timestamp-down
5421 org-agenda-sorting-strategy-selected)
5422 (setq ts (or (org-entry-get pom "SCHEDULED")
5423 (org-entry-get pom "DEADLINE")
5424 (org-entry-get pom "TIMESTAMP")
5425 (org-entry-get pom "TIMESTAMP_IA"))
5427 (t (setq ts-date-type "")))
5428 (cons (when ts (ignore-errors (org-time-string-to-absolute ts)))
5431 (defun org-agenda-get-todos ()
5432 "Return the TODO information for agenda display."
5433 (let* ((props (list 'face nil
5434 'done-face 'org-agenda-done
5435 'org-not-done-regexp org-not-done-regexp
5436 'org-todo-regexp org-todo-regexp
5437 'org-complex-heading-regexp org-complex-heading-regexp
5438 'mouse-face 'highlight
5440 (format "mouse-2 or RET jump to org file %s"
5441 (abbreviate-file-name buffer-file-name))))
5442 (case-fold-search nil)
5443 (regexp (format org-heading-keyword-regexp-format
5445 ((and org-select-this-todo-keyword
5446 (equal org-select-this-todo-keyword "*"))
5448 (org-select-this-todo-keyword
5450 (mapconcat 'identity
5452 org-select-this-todo-keyword
5455 (t org-not-done-regexp))))
5456 marker priority category level tags todo-state
5457 ts-date ts-date-type ts-date-pair
5458 ee txt beg end inherited-tags todo-state-end-pos)
5459 (goto-char (point-min))
5460 (while (re-search-forward regexp nil t)
5465 (setq beg (point) end (save-excursion (outline-next-heading) (point)))
5466 (unless (and (setq todo-state (org-get-todo-state))
5467 (setq todo-state-end-pos (match-end 2)))
5470 (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
5471 (goto-char (1+ beg))
5472 (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
5474 (goto-char (match-beginning 2))
5475 (setq marker (org-agenda-new-marker (match-beginning 0))
5476 category (org-get-category)
5477 ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
5478 ts-date (car ts-date-pair)
5479 ts-date-type (cdr ts-date-pair)
5480 txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
5482 (or (eq org-agenda-show-inherited-tags 'always)
5483 (and (listp org-agenda-show-inherited-tags)
5484 (memq 'todo org-agenda-show-inherited-tags))
5485 (and (eq org-agenda-show-inherited-tags t)
5486 (or (eq org-agenda-use-tag-inheritance t)
5487 (memq 'todo org-agenda-use-tag-inheritance))))
5488 tags (org-get-tags-at nil (not inherited-tags))
5489 level (make-string (org-reduced-level (org-outline-level)) ? )
5490 txt (org-agenda-format-item "" txt level category tags t)
5491 priority (1+ (org-get-priority txt)))
5492 (org-add-props txt props
5493 'org-marker marker 'org-hd-marker marker
5497 'type (concat "todo" ts-date-type) 'todo-state todo-state)
5499 (if org-agenda-todo-list-sublevels
5500 (goto-char todo-state-end-pos)
5501 (org-end-of-subtree 'invisible))))
5504 (defun org-agenda-todo-custom-ignore-p (time n)
5505 "Check whether timestamp is farther away than n number of days.
5506 This function is invoked if `org-agenda-todo-ignore-deadlines',
5507 `org-agenda-todo-ignore-scheduled' or
5508 `org-agenda-todo-ignore-timestamp' is set to an integer."
5509 (let ((days (org-time-stamp-to-now
5510 time org-agenda-todo-ignore-time-comparison-use-seconds)))
5516 (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
5518 "Do we have a reason to ignore this TODO entry because it has a time stamp?"
5519 (when (or org-agenda-todo-ignore-with-date
5520 org-agenda-todo-ignore-scheduled
5521 org-agenda-todo-ignore-deadlines
5522 org-agenda-todo-ignore-timestamp)
5523 (setq end (or end (save-excursion (outline-next-heading) (point))))
5525 (or (and org-agenda-todo-ignore-with-date
5526 (re-search-forward org-ts-regexp end t))
5527 (and org-agenda-todo-ignore-scheduled
5528 (re-search-forward org-scheduled-time-regexp end t)
5530 ((eq org-agenda-todo-ignore-scheduled 'future)
5531 (> (org-time-stamp-to-now
5532 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5533 ((eq org-agenda-todo-ignore-scheduled 'past)
5534 (<= (org-time-stamp-to-now
5535 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5536 ((numberp org-agenda-todo-ignore-scheduled)
5537 (org-agenda-todo-custom-ignore-p
5538 (match-string 1) org-agenda-todo-ignore-scheduled))
5540 (and org-agenda-todo-ignore-deadlines
5541 (re-search-forward org-deadline-time-regexp end t)
5543 ((memq org-agenda-todo-ignore-deadlines '(t all)) t)
5544 ((eq org-agenda-todo-ignore-deadlines 'far)
5545 (not (org-deadline-close-p (match-string 1))))
5546 ((eq org-agenda-todo-ignore-deadlines 'future)
5547 (> (org-time-stamp-to-now
5548 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5549 ((eq org-agenda-todo-ignore-deadlines 'past)
5550 (<= (org-time-stamp-to-now
5551 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5552 ((numberp org-agenda-todo-ignore-deadlines)
5553 (org-agenda-todo-custom-ignore-p
5554 (match-string 1) org-agenda-todo-ignore-deadlines))
5555 (t (org-deadline-close-p (match-string 1)))))
5556 (and org-agenda-todo-ignore-timestamp
5557 (let ((buffer (current-buffer))
5560 org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
5562 ;; Copy current buffer into a temporary one
5564 (insert-buffer-substring buffer start end)
5565 (goto-char (point-min))
5566 ;; Delete SCHEDULED and DEADLINE items
5567 (while (re-search-forward regexp end t)
5568 (delete-region (match-beginning 0) (match-end 0)))
5569 (goto-char (point-min))
5570 ;; No search for timestamp left
5571 (when (re-search-forward org-ts-regexp nil t)
5573 ((eq org-agenda-todo-ignore-timestamp 'future)
5574 (> (org-time-stamp-to-now
5575 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5576 ((eq org-agenda-todo-ignore-timestamp 'past)
5577 (<= (org-time-stamp-to-now
5578 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
5579 ((numberp org-agenda-todo-ignore-timestamp)
5580 (org-agenda-todo-custom-ignore-p
5581 (match-string 1) org-agenda-todo-ignore-timestamp))
5584 (defun org-agenda-get-timestamps (&optional deadlines)
5585 "Return the date stamp information for agenda display.
5586 Optional argument DEADLINES is a list of deadline items to be
5587 displayed in agenda view."
5588 (let* ((props (list 'face 'org-agenda-calendar-event
5589 'org-not-done-regexp org-not-done-regexp
5590 'org-todo-regexp org-todo-regexp
5591 'org-complex-heading-regexp org-complex-heading-regexp
5592 'mouse-face 'highlight
5594 (format "mouse-2 or RET jump to Org file %s"
5595 (abbreviate-file-name buffer-file-name))))
5596 (current (calendar-absolute-from-gregorian date))
5598 (deadline-position-alist
5600 (let ((m (get-text-property 0 'org-hd-marker d)))
5601 (and m (marker-position m))))
5603 ;; Match time-stamps set to current date, time-stamps with
5604 ;; a repeater, and S-exp time-stamps.
5607 (if org-agenda-include-inactive-timestamps "[[<]" "<")
5611 (car org-time-stamp-formats)
5612 (apply #'encode-time ; DATE bound by calendar
5613 (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
5615 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
5616 "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
5618 (goto-char (point-min))
5619 (while (re-search-forward regexp nil t)
5620 ;; Skip date ranges, scheduled and deadlines, which are handled
5621 ;; specially. Also skip time-stamps before first headline as
5622 ;; there would be no entry to add to the agenda. Eventually,
5623 ;; ignore clock entries.
5626 (when (or (org-at-date-range-p)
5628 (org-before-first-heading-p)
5629 (and org-agenda-include-inactive-timestamps
5630 (org-at-clock-log-p)))
5633 (let* ((pos (match-beginning 0))
5634 (repeat (match-string 1))
5635 (sexp-entry (match-string 3))
5636 (time-stamp (if (or repeat sexp-entry) (match-string 0)
5639 (looking-at org-ts-regexp-both)
5641 (todo-state (org-get-todo-state))
5642 (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
5644 org-agenda-repeating-timestamp-show-all)))
5645 (warntime (get-text-property (point) 'org-appt-warntime))
5646 (done? (member todo-state org-done-keywords)))
5647 ;; Possibly skip done tasks.
5648 (when (and done? org-agenda-skip-timestamp-if-done)
5650 ;; S-exp entry doesn't match current day: skip it.
5651 (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
5653 ;; When time-stamp doesn't match CURRENT but has a repeater,
5654 ;; make sure it repeats on CURRENT. Furthermore, if
5655 ;; SHOW-ALL is nil, ensure that repeats are only the first
5656 ;; before and the first after today.
5660 (org-agenda--timestamp-to-absolute
5661 repeat current 'future (current-buffer) pos))
5663 (org-agenda--timestamp-to-absolute
5664 repeat today 'past (current-buffer) pos))
5666 (org-agenda--timestamp-to-absolute
5667 repeat today 'future (current-buffer) pos)))))
5670 (re-search-backward org-outline-regexp-bol nil t)
5671 ;; Possibly skip time-stamp when a deadline is set.
5672 (when (and org-agenda-skip-timestamp-if-deadline-is-shown
5673 (assq (point) deadline-position-alist))
5675 (let* ((category (org-get-category pos))
5677 (or (eq org-agenda-show-inherited-tags 'always)
5678 (and (consp org-agenda-show-inherited-tags)
5679 (memq 'agenda org-agenda-show-inherited-tags))
5680 (and (eq org-agenda-show-inherited-tags t)
5681 (or (eq org-agenda-use-tag-inheritance t)
5683 org-agenda-use-tag-inheritance)))))
5684 (tags (org-get-tags-at nil (not inherited-tags)))
5685 (level (make-string (org-reduced-level (org-outline-level))
5687 (head (and (looking-at "\\*+[ \t]+\\(.*\\)")
5689 (inactive? (= (char-after pos) ?\[))
5690 (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
5692 (org-agenda-format-item
5693 (and inactive? org-agenda-inactive-leader)
5694 head level category tags time-stamp org-ts-regexp habit?)))
5695 (org-add-props item props
5696 'priority (if habit?
5697 (org-habit-get-priority (org-habit-parse-todo))
5698 (org-get-priority item))
5699 'org-marker (org-agenda-new-marker pos)
5700 'org-hd-marker (org-agenda-new-marker)
5703 'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat)
5705 'todo-state todo-state
5708 (push item timestamp-items))))
5709 (when org-agenda-skip-additional-timestamps-same-entry
5710 (outline-next-heading))))
5711 (nreverse timestamp-items)))
5713 (defun org-agenda-get-sexps ()
5714 "Return the sexp information for agenda display."
5715 (require 'diary-lib)
5716 (let* ((props (list 'face 'org-agenda-calendar-sexp
5717 'mouse-face 'highlight
5719 (format "mouse-2 or RET jump to org file %s"
5720 (abbreviate-file-name buffer-file-name))))
5722 marker category extra level ee txt tags entry
5723 result beg b sexp sexp-entry todo-state warntime inherited-tags)
5724 (goto-char (point-min))
5725 (while (re-search-forward regexp nil t)
5728 (setq beg (match-beginning 0))
5729 (goto-char (1- (match-end 0)))
5732 (setq sexp (buffer-substring b (point)))
5733 (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
5734 (org-trim (match-string 1))
5736 (setq result (org-diary-sexp-entry sexp sexp-entry date))
5738 (setq marker (org-agenda-new-marker beg)
5739 level (make-string (org-reduced-level (org-outline-level)) ? )
5740 category (org-get-category beg)
5742 (or (eq org-agenda-show-inherited-tags 'always)
5743 (and (listp org-agenda-show-inherited-tags)
5744 (memq 'agenda org-agenda-show-inherited-tags))
5745 (and (eq org-agenda-show-inherited-tags t)
5746 (or (eq org-agenda-use-tag-inheritance t)
5747 (memq 'agenda org-agenda-use-tag-inheritance))))
5748 tags (org-get-tags-at nil (not inherited-tags))
5749 todo-state (org-get-todo-state)
5750 warntime (get-text-property (point) 'org-appt-warntime)
5753 (dolist (r (if (stringp result)
5755 result)) ;; we expect a list here
5756 (when (and org-agenda-diary-sexp-prefix
5757 (string-match org-agenda-diary-sexp-prefix r))
5758 (setq extra (match-string 0 r)
5759 r (replace-match "" nil nil r)))
5760 (if (string-match "\\S-" r)
5762 (setq txt "SEXP entry returned empty string"))
5763 (setq txt (org-agenda-format-item extra txt level category tags 'time))
5764 (org-add-props txt props 'org-marker marker
5765 'date date 'todo-state todo-state
5766 'level level 'type "sexp" 'warntime warntime)
5770 ;; Calendar sanity: define some functions that are independent of
5771 ;; `calendar-date-style'.
5772 (defun org-anniversary (year month day &optional mark)
5773 "Like `diary-anniversary', but with fixed (ISO) order of arguments."
5775 (let ((calendar-date-style 'iso))
5776 (diary-anniversary year month day mark))))
5777 (defun org-cyclic (N year month day &optional mark)
5778 "Like `diary-cyclic', but with fixed (ISO) order of arguments."
5780 (let ((calendar-date-style 'iso))
5781 (diary-cyclic N year month day mark))))
5782 (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
5783 "Like `diary-block', but with fixed (ISO) order of arguments."
5785 (let ((calendar-date-style 'iso))
5786 (diary-block Y1 M1 D1 Y2 M2 D2 mark))))
5787 (defun org-date (year month day &optional mark)
5788 "Like `diary-date', but with fixed (ISO) order of arguments."
5790 (let ((calendar-date-style 'iso))
5791 (diary-date year month day mark))))
5793 ;; Define the `org-class' function
5794 (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
5795 "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
5796 DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
5797 SKIP-WEEKS is any number of ISO weeks in the block period for which the
5798 item should be skipped. If any of the SKIP-WEEKS arguments is the symbol
5799 `holidays', then any date that is known by the Emacs calendar to be a
5800 holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings,
5801 then those holidays will be skipped."
5802 (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
5803 (date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
5804 (d (calendar-absolute-from-gregorian date))
5805 (h (when skip-weeks (calendar-check-holidays date))))
5809 (= (calendar-day-of-week date) dayname)
5810 (or (not skip-weeks)
5813 (not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
5814 (not (or (and h (memq 'holidays skip-weeks))
5815 (delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
5818 (defalias 'org-get-closed 'org-agenda-get-progress)
5819 (defun org-agenda-get-progress ()
5820 "Return the logged TODO entries for agenda display."
5821 (let* ((props (list 'mouse-face 'highlight
5822 'org-not-done-regexp org-not-done-regexp
5823 'org-todo-regexp org-todo-regexp
5824 'org-complex-heading-regexp org-complex-heading-regexp
5826 (format "mouse-2 or RET jump to org file %s"
5827 (abbreviate-file-name buffer-file-name))))
5828 (items (if (consp org-agenda-show-log-scoped)
5829 org-agenda-show-log-scoped
5830 (if (eq org-agenda-show-log-scoped 'clockcheck)
5832 org-agenda-log-mode-items)))
5836 (if (memq 'closed items) (concat "\\<" org-closed-string))
5837 (if (memq 'clock items) (concat "\\<" org-clock-string))
5838 (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?"))))
5839 (parts-re (if parts (mapconcat 'identity parts "\\|")
5840 (error "`org-agenda-log-mode-items' is empty")))
5842 "\\(" parts-re "\\)"
5847 (car org-time-stamp-formats)
5848 (apply 'encode-time ; DATE bound by calendar
5849 (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
5851 (org-agenda-search-headline-for-time nil)
5852 marker hdmarker priority category level tags closedp
5853 statep clockp state ee txt extra timestr rest clocked inherited-tags)
5854 (goto-char (point-min))
5855 (while (re-search-forward regexp nil t)
5858 (setq marker (org-agenda-new-marker (match-beginning 0))
5859 closedp (equal (match-string 1) org-closed-string)
5860 statep (equal (string-to-char (match-string 1)) ?-)
5861 clockp (not (or closedp statep))
5862 state (and statep (match-string 2))
5863 category (org-get-category (match-beginning 0))
5864 timestr (buffer-substring (match-beginning 0) (point-at-eol)))
5865 (when (string-match "\\]" timestr)
5866 ;; substring should only run to end of time stamp
5867 (setq rest (substring timestr (match-end 0))
5868 timestr (substring timestr 0 (match-end 0)))
5869 (if (and (not closedp) (not statep)
5870 (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
5872 (progn (setq timestr (concat (substring timestr 0 -1)
5873 "-" (match-string 1 rest) "]"))
5874 (setq clocked (match-string 2 rest)))
5875 (setq clocked "-")))
5879 ((not org-agenda-log-mode-add-notes) nil)
5881 (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
5884 (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
5885 (match-string 1)))))
5886 (if (not (re-search-backward org-outline-regexp-bol nil t))
5888 (goto-char (match-beginning 0))
5889 (setq hdmarker (org-agenda-new-marker)
5891 (or (eq org-agenda-show-inherited-tags 'always)
5892 (and (listp org-agenda-show-inherited-tags)
5893 (memq 'todo org-agenda-show-inherited-tags))
5894 (and (eq org-agenda-show-inherited-tags t)
5895 (or (eq org-agenda-use-tag-inheritance t)
5896 (memq 'todo org-agenda-use-tag-inheritance))))
5897 tags (org-get-tags-at nil (not inherited-tags))
5898 level (make-string (org-reduced-level (org-outline-level)) ? ))
5899 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
5900 (setq txt (match-string 1))
5902 (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
5903 (setq txt (concat (substring txt 0 (match-beginning 1))
5904 " - " extra " " (match-string 2 txt)))
5905 (setq txt (concat txt " - " extra))))
5906 (setq txt (org-agenda-format-item
5908 (closedp "Closed: ")
5909 (statep (concat "State: (" state ")"))
5910 (t (concat "Clocked: (" clocked ")")))
5911 txt level category tags timestr)))
5912 (setq priority 100000)
5913 (org-add-props txt props
5914 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
5915 'priority priority 'level level
5916 'type "closed" 'date date
5917 'undone-face 'org-warning 'done-face 'org-agenda-done)
5919 (goto-char (point-at-eol))))
5922 (defun org-agenda-show-clocking-issues ()
5923 "Add overlays, showing issues with clocking.
5924 See also the user option `org-agenda-clock-consistency-checks'."
5926 (let* ((org-time-clocksum-use-effort-durations nil)
5927 (pl org-agenda-clock-consistency-checks)
5928 (re (concat "^[ \t]*"
5931 "\\(\\[.*?\\]\\)" ; group 1 is first stamp
5932 "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
5935 (maxtime (org-hh:mm-string-to-minutes
5936 (or (plist-get pl :max-duration) "24:00")))
5937 (mintime (org-hh:mm-string-to-minutes
5938 (or (plist-get pl :min-duration) 0)))
5939 (maxgap (org-hh:mm-string-to-minutes
5940 ;; default 30:00 means never complain
5941 (or (plist-get pl :max-gap) "30:00")))
5942 (gapok (mapcar 'org-hh:mm-string-to-minutes
5943 (plist-get pl :gap-ok-around)))
5944 (def-face (or (plist-get pl :default-face)
5945 '((:background "DarkRed") (:foreground "white"))))
5946 issue face m te ts dt ov)
5947 (goto-char (point-min))
5948 (while (re-search-forward " Clocked: +(-\\|\\([0-9]+:[0-9]+\\))" nil t)
5949 (setq issue nil face def-face)
5951 (setq m (org-get-at-bol 'org-marker)
5953 (unless (and m (markerp m))
5954 (setq issue "No valid clock line") (throw 'next t))
5955 (org-with-point-at m
5957 (goto-char (point-at-bol))
5958 (unless (looking-at re)
5959 (error "No valid Clock line")
5961 (unless (match-end 3)
5962 (setq issue "No end time"
5963 face (or (plist-get pl :no-end-time-face) face))
5965 (setq ts (match-string 1)
5968 (apply #'encode-time (org-parse-time-string ts)))
5970 (apply #'encode-time (org-parse-time-string te)))
5973 ((> dt (* 60 maxtime))
5974 ;; a very long clocking chunk
5975 (setq issue (format "Clocking interval is very long: %s"
5976 (org-minutes-to-clocksum-string
5977 (floor (/ (float dt) 60.))))
5978 face (or (plist-get pl :long-face) face)))
5979 ((< dt (* 60 mintime))
5980 ;; a very short clocking chunk
5981 (setq issue (format "Clocking interval is very short: %s"
5982 (org-minutes-to-clocksum-string
5983 (floor (/ (float dt) 60.))))
5984 face (or (plist-get pl :short-face) face)))
5985 ((and (> tlend 0) (< ts tlend))
5986 ;; Two clock entries are overlapping
5987 (setq issue (format "Clocking overlap: %d minutes"
5988 (/ (- tlend ts) 60))
5989 face (or (plist-get pl :overlap-face) face)))
5990 ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap))))
5991 ;; There is a gap, lets see if we need to report it
5992 (unless (org-agenda-check-clock-gap tlend ts gapok)
5993 (setq issue (format "Clocking gap: %d minutes"
5994 (/ (- ts tlend) 60))
5995 face (or (plist-get pl :gap-face) face))))
5997 (setq tlend (or te tlend) tlstart (or ts tlstart))
5999 ;; OK, there was some issue, add an overlay to show the issue
6000 (setq ov (make-overlay (point-at-bol) (point-at-eol)))
6001 (overlay-put ov 'before-string
6004 (format "%-43s" (concat " " issue))
6008 (overlay-put ov 'evaporate t)))))
6010 (defun org-agenda-check-clock-gap (t1 t2 ok-list)
6011 "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values."
6014 ;; there are no OK times for gaps...
6016 (if (> (- (/ t2 36000) (/ t1 36000)) 24)
6017 ;; This is more than 24 hours, so it is OK.
6018 ;; because we have at least one OK time, that must be in the
6019 ;; 24 hour interval.
6021 ;; We have a shorter gap.
6022 ;; Now we have to get the minute of the day when these times are
6023 (let* ((t1dec (decode-time (seconds-to-time t1)))
6024 (t2dec (decode-time (seconds-to-time t2)))
6025 ;; compute the minute on the day
6026 (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec))))
6027 (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec)))))
6029 ;; if min2 is smaller than min1, this means it is on the next day.
6030 ;; Wrap it to after midnight.
6031 (setq min2 (+ min2 1440)))
6032 ;; Now check if any of the OK times is in the gap
6034 ;; Wrap the time to after midnight if necessary
6035 (if (< x min1) (setq x (+ x 1440)))
6036 ;; Check if in interval
6037 (and (<= min1 x) (>= min2 x) (throw 'exit t)))
6039 ;; Nope, this gap is not OK
6042 (defun org-agenda-get-deadlines (&optional with-hour)
6043 "Return the deadline information for agenda display.
6044 When WITH-HOUR is non-nil, only return deadlines with an hour
6045 specification like [h]h:mm."
6046 (let* ((props (list 'mouse-face 'highlight
6047 'org-not-done-regexp org-not-done-regexp
6048 'org-todo-regexp org-todo-regexp
6049 'org-complex-heading-regexp org-complex-heading-regexp
6051 (format "mouse-2 or RET jump to org file %s"
6052 (abbreviate-file-name buffer-file-name))))
6053 (regexp (if with-hour
6054 org-deadline-time-hour-regexp
6055 org-deadline-time-regexp))
6057 (today? (org-agenda-today-p date)) ; DATE bound by calendar.
6058 (current (calendar-absolute-from-gregorian date))
6060 (goto-char (point-min))
6061 (while (re-search-forward regexp nil t)
6063 (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
6065 (let* ((s (match-string 1))
6066 (pos (1- (match-beginning 1)))
6067 (todo-state (save-match-data (org-get-todo-state)))
6068 (done? (member todo-state org-done-keywords))
6069 (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
6071 org-agenda-repeating-timestamp-show-all)))
6072 (sexp? (string-prefix-p "%%" s))
6073 ;; DEADLINE is the bare deadline date, i.e., without
6074 ;; any repeater, or the last repeat if SHOW-ALL is
6075 ;; non-nil. REPEAT is closest repeat after CURRENT, if
6076 ;; all repeated time stamps are to be shown, or after
6077 ;; TODAY otherwise. REPEAT only applies to future
6080 (sexp? (org-agenda--timestamp-to-absolute s current))
6081 (show-all (org-agenda--timestamp-to-absolute s))
6082 (t (org-agenda--timestamp-to-absolute
6083 s today 'past (current-buffer) pos))))
6084 (repeat (cond (sexp? deadline)
6085 ((< current today) deadline)
6087 (org-agenda--timestamp-to-absolute
6088 s (if show-all current today) 'future
6089 (current-buffer) pos))))
6090 (diff (- deadline current))
6091 (suppress-prewarning
6093 (and org-agenda-skip-deadline-prewarning-if-scheduled
6094 (org-entry-get nil "SCHEDULED"))))
6096 ((not scheduled) nil)
6097 ;; The current item has a scheduled date, so
6098 ;; evaluate its prewarning lead time.
6099 ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
6100 ;; Use global prewarning-restart lead time.
6101 org-agenda-skip-deadline-prewarning-if-scheduled)
6102 ((eq org-agenda-skip-deadline-prewarning-if-scheduled
6104 ;; Set pre-warning to no earlier than SCHEDULED.
6106 (org-agenda--timestamp-to-absolute scheduled))
6107 org-deadline-warning-days))
6108 ;; Set pre-warning to deadline.
6110 (wdays (if suppress-prewarning
6111 (let ((org-deadline-warning-days suppress-prewarning))
6113 (org-get-wdays s))))
6114 ;; When to show a deadline in the calendar: if the
6115 ;; expiration is within WDAYS warning time. Past-due
6116 ;; deadlines are only shown on today agenda.
6117 (when (cond ((= current deadline) nil)
6120 (or (< current today) (/= repeat current))))
6121 ((> deadline current)
6122 (or (not today?) (> diff wdays)))
6123 (t (/= repeat current)))
6125 ;; Possibly skip done tasks.
6127 (or org-agenda-skip-deadline-if-done
6128 (/= deadline current)))
6131 (re-search-backward "^\\*+[ \t]+" nil t)
6132 (goto-char (match-end 0))
6133 (let* ((category (org-get-category))
6135 (make-string (org-reduced-level (org-outline-level)) ?\s))
6136 (head (buffer-substring (point) (line-end-position)))
6138 (or (eq org-agenda-show-inherited-tags 'always)
6139 (and (listp org-agenda-show-inherited-tags)
6140 (memq 'agenda org-agenda-show-inherited-tags))
6141 (and (eq org-agenda-show-inherited-tags t)
6142 (or (eq org-agenda-use-tag-inheritance t)
6144 org-agenda-use-tag-inheritance)))))
6145 (tags (org-get-tags-at nil (not inherited-tags)))
6148 ;; No time of day designation if it is only
6150 ((and (/= current deadline) (/= current repeat)) nil)
6151 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
6152 (concat (substring s (match-beginning 1)) " "))
6155 (org-agenda-format-item
6156 ;; Insert appropriate suffixes before deadlines.
6157 (pcase-let ((`(,now ,future ,past)
6158 org-agenda-deadline-leaders))
6160 ;; Future (i.e., repeated) deadlines are
6161 ;; displayed as new headlines.
6162 ((> current today) now)
6163 ;; When SHOW-ALL is nil, prefer repeated
6164 ;; deadlines over reminders of past deadlines.
6165 ((and (not show-all) (= repeat today)) now)
6166 ((= deadline current) now)
6167 ((< deadline current) (format past (- diff)))
6168 (t (format future diff))))
6169 head level category tags
6170 (and (or (= repeat current) (= deadline current))
6172 (face (org-agenda-deadline-face
6173 (- 1 (/ (float (- deadline current)) (max wdays 1)))))
6174 (upcoming? (and today? (> deadline today)))
6175 (warntime (get-text-property (point) 'org-appt-warntime)))
6176 (org-add-props item props
6177 'org-marker (org-agenda-new-marker pos)
6178 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
6183 ;; Adjust priority to today reminders about deadlines.
6184 ;; Overdue deadlines get the highest priority
6185 ;; increase, then imminent deadlines and eventually
6186 ;; more distant deadlines.
6187 (let ((adjust (cond ((not today?) 0)
6188 ((and (not show-all) (= repeat current)) 0)
6190 (+ adjust (org-get-priority item)))
6191 'todo-state todo-state
6192 'type (if upcoming? "upcoming-deadline" "deadline")
6193 'date (if upcoming? date deadline)
6194 'face (if done? 'org-agenda-done face)
6196 'done-face 'org-agenda-done)
6197 (push item deadline-items))))))
6198 (nreverse deadline-items)))
6200 (defun org-agenda-deadline-face (fraction)
6201 "Return the face to displaying a deadline item.
6202 FRACTION is what fraction of the head-warning time has passed."
6203 (assoc-default fraction org-agenda-deadline-faces #'<=))
6205 (defun org-agenda-get-scheduled (&optional deadlines with-hour)
6206 "Return the scheduled information for agenda display.
6207 Optional argument DEADLINES is a list of deadline items to be
6208 displayed in agenda view. When WITH-HOUR is non-nil, only return
6209 scheduled items with an hour specification like [h]h:mm."
6210 (let* ((props (list 'org-not-done-regexp org-not-done-regexp
6211 'org-todo-regexp org-todo-regexp
6212 'org-complex-heading-regexp org-complex-heading-regexp
6213 'done-face 'org-agenda-done
6214 'mouse-face 'highlight
6216 (format "mouse-2 or RET jump to Org file %s"
6217 (abbreviate-file-name buffer-file-name))))
6218 (regexp (if with-hour
6219 org-scheduled-time-hour-regexp
6220 org-scheduled-time-regexp))
6222 (todayp (org-agenda-today-p date)) ; DATE bound by calendar.
6223 (current (calendar-absolute-from-gregorian date))
6226 (let ((m (get-text-property 0 'org-hd-marker d)))
6227 (and m (marker-position m))))
6230 (goto-char (point-min))
6231 (while (re-search-forward regexp nil t)
6233 (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
6235 (let* ((s (match-string 1))
6236 (pos (1- (match-beginning 1)))
6237 (todo-state (save-match-data (org-get-todo-state)))
6238 (donep (member todo-state org-done-keywords))
6239 (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
6241 org-agenda-repeating-timestamp-show-all)))
6242 (sexp? (string-prefix-p "%%" s))
6243 ;; SCHEDULE is the bare scheduled date, i.e., without
6244 ;; any repeater if non-nil, or last repeat if SHOW-ALL
6245 ;; is nil. REPEAT is the closest repeat after CURRENT,
6246 ;; if all repeated time stamps are to be shown, or
6247 ;; after TODAY otherwise. REPEAT only applies to
6250 (sexp? (org-agenda--timestamp-to-absolute s current))
6251 (show-all (org-agenda--timestamp-to-absolute s))
6252 (t (org-agenda--timestamp-to-absolute
6253 s today 'past (current-buffer) pos))))
6256 ((< current today) schedule)
6258 (org-agenda--timestamp-to-absolute
6259 s (if show-all current today) 'future
6260 (current-buffer) pos))))
6261 (diff (- current schedule))
6262 (warntime (get-text-property (point) 'org-appt-warntime))
6263 (pastschedp (< schedule today))
6264 (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
6266 (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
6267 (org-entry-get nil "DEADLINE"))))
6269 ((not deadline) nil)
6270 ;; The current item has a deadline date, so
6271 ;; evaluate its delay time.
6272 ((integerp org-agenda-skip-scheduled-delay-if-deadline)
6273 ;; Use global delay time.
6274 (- org-agenda-skip-scheduled-delay-if-deadline))
6275 ((eq org-agenda-skip-scheduled-delay-if-deadline
6277 ;; Set delay to no later than DEADLINE.
6279 (org-agenda--timestamp-to-absolute deadline))
6280 org-scheduled-delay-days))
6284 ;; Nullify delay when a repeater triggered already
6285 ;; and the delay is of the form --Xd.
6286 ((and (string-match-p "--[0-9]+[hdwmy]" s)
6287 (> current schedule))
6290 (let ((org-scheduled-delay-days suppress-delay))
6291 (org-get-wdays s t t)))
6292 (t (org-get-wdays s t)))))
6293 ;; Display scheduled items at base date (SCHEDULE), today if
6294 ;; scheduled before the current date, and at any repeat past
6295 ;; today. However, skip delayed items and items that have
6296 ;; been displayed for more than `org-scheduled-past-days'.
6299 (bound-and-true-p org-habit-show-all-today))
6300 (when (or (and (> ddays 0) (< diff ddays))
6301 (> diff org-scheduled-past-days)
6302 (> schedule current)
6303 (and (< schedule current)
6305 (/= repeat current)))
6307 ;; Possibly skip done tasks.
6309 (or org-agenda-skip-scheduled-if-done
6310 (/= schedule current)))
6312 ;; Skip entry if it already appears as a deadline, per
6313 ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
6314 ;; doesn't apply to habits.
6315 (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
6317 (or (not (memq (line-beginning-position 0) deadline-pos))
6320 (`repeated-after-deadline
6321 (>= repeat (time-to-days (org-get-deadline-time (point)))))
6322 (`not-today pastschedp)
6326 ;; Skip habits if `org-habit-show-habits' is nil, or if we
6327 ;; only show them for today. Also skip done habits.
6330 (not (bound-and-true-p org-habit-show-habits))
6333 org-habit-show-habits-only-for-today))))
6336 (re-search-backward "^\\*+[ \t]+" nil t)
6337 (goto-char (match-end 0))
6338 (let* ((category (org-get-category))
6340 (or (eq org-agenda-show-inherited-tags 'always)
6341 (and (listp org-agenda-show-inherited-tags)
6342 (memq 'agenda org-agenda-show-inherited-tags))
6343 (and (eq org-agenda-show-inherited-tags t)
6344 (or (eq org-agenda-use-tag-inheritance t)
6346 org-agenda-use-tag-inheritance)))))
6347 (tags (org-get-tags-at nil (not inherited-tags)))
6349 (make-string (org-reduced-level (org-outline-level)) ?\s))
6350 (head (buffer-substring (point) (line-end-position)))
6353 ;; No time of day designation if it is only
6355 ((and (/= current schedule) (/= current repeat)) nil)
6356 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
6357 (concat (substring s (match-beginning 1)) " "))
6360 (org-agenda-format-item
6361 (pcase-let ((`(,first ,next) org-agenda-scheduled-leaders))
6363 ;; If CURRENT is in the future, don't use past
6364 ;; scheduled prefix.
6365 ((> current today) first)
6366 ;; SHOW-ALL focuses on future repeats. If one
6367 ;; such repeat happens today, ignore late
6368 ;; schedule reminder. However, still report
6369 ;; such reminders when repeat happens later.
6370 ((and (not show-all) (= repeat today)) first)
6372 ((= schedule current) first)
6373 ;; Subsequent reminders. Count from base
6375 (t (format next (1+ diff)))))
6376 head level category tags time nil habitp))
6377 (face (cond ((and (not habitp) pastschedp)
6378 'org-scheduled-previously)
6379 (todayp 'org-scheduled-today)
6380 (t 'org-scheduled)))
6381 (habitp (and habitp (org-habit-parse-todo))))
6382 (org-add-props item props
6384 'face (if donep 'org-agenda-done face)
6385 'org-marker (org-agenda-new-marker pos)
6386 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
6387 'type (if pastschedp "past-scheduled" "scheduled")
6388 'date (if pastschedp schedule date)
6392 'priority (if habitp (org-habit-get-priority habitp)
6393 (+ 99 diff (org-get-priority item)))
6395 'todo-state todo-state)
6396 (push item scheduled-items))))))
6397 (nreverse scheduled-items)))
6399 (defun org-agenda-get-blocks ()
6400 "Return the date-range information for agenda display."
6401 (let* ((props (list 'face nil
6402 'org-not-done-regexp org-not-done-regexp
6403 'org-todo-regexp org-todo-regexp
6404 'org-complex-heading-regexp org-complex-heading-regexp
6405 'mouse-face 'highlight
6407 (format "mouse-2 or RET jump to org file %s"
6408 (abbreviate-file-name buffer-file-name))))
6409 (regexp org-tr-regexp)
6410 (d0 (calendar-absolute-from-gregorian date))
6411 marker hdmarker ee txt d1 d2 s1 s2 category
6412 level todo-state tags pos head donep inherited-tags)
6413 (goto-char (point-min))
6414 (while (re-search-forward regexp nil t)
6418 (let ((start-time (match-string 1))
6419 (end-time (match-string 2)))
6420 (setq s1 (match-string 1)
6422 d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos))
6423 d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos)))
6424 (if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
6425 ;; Only allow days between the limits, because the normal
6426 ;; date stamps will catch the limits.
6428 (setq todo-state (org-get-todo-state))
6429 (setq donep (member todo-state org-done-keywords))
6430 (if (and donep org-agenda-skip-timestamp-if-done)
6432 (setq marker (org-agenda-new-marker (point))
6433 category (org-get-category))
6434 (if (not (re-search-backward org-outline-regexp-bol nil t))
6436 (goto-char (match-beginning 0))
6437 (setq hdmarker (org-agenda-new-marker (point))
6439 (or (eq org-agenda-show-inherited-tags 'always)
6440 (and (listp org-agenda-show-inherited-tags)
6441 (memq 'agenda org-agenda-show-inherited-tags))
6442 (and (eq org-agenda-show-inherited-tags t)
6443 (or (eq org-agenda-use-tag-inheritance t)
6444 (memq 'agenda org-agenda-use-tag-inheritance))))
6446 tags (org-get-tags-at nil (not inherited-tags)))
6447 (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
6448 (looking-at "\\*+[ \t]+\\(.*\\)")
6449 (setq head (match-string 1))
6451 (if org-agenda-remove-timeranges-from-blocks
6453 "<" (regexp-quote s1) ".*?>"
6455 "<" (regexp-quote s2) ".*?>")
6457 (setq txt (org-agenda-format-item
6459 (nth (if (= d1 d2) 0 1)
6460 org-agenda-timerange-leaders)
6461 (1+ (- d0 d1)) (1+ (- d2 d1)))
6462 head level category tags
6463 (cond ((and (= d1 d0) (= d2 d0))
6464 (concat "<" start-time ">--<" end-time ">"))
6466 (concat "<" start-time ">"))
6468 (concat "<" end-time ">")))
6470 (org-add-props txt props
6471 'org-marker marker 'org-hd-marker hdmarker
6472 'type "block" 'date date
6474 'todo-state todo-state
6475 'priority (org-get-priority txt))
6478 ;; Sort the entries by expiration date.
6481 ;;; Agenda presentation and sorting
6483 (defvar org-prefix-has-time nil
6484 "A flag, set by `org-compile-prefix-format'.
6485 The flag is set if the currently compiled format contains a `%t'.")
6486 (defvar org-prefix-has-tag nil
6487 "A flag, set by `org-compile-prefix-format'.
6488 The flag is set if the currently compiled format contains a `%T'.")
6489 (defvar org-prefix-has-effort nil
6490 "A flag, set by `org-compile-prefix-format'.
6491 The flag is set if the currently compiled format contains a `%e'.")
6492 (defvar org-prefix-has-breadcrumbs nil
6493 "A flag, set by `org-compile-prefix-format'.
6494 The flag is set if the currently compiled format contains a `%b'.")
6495 (defvar org-prefix-category-length nil
6496 "Used by `org-compile-prefix-format' to remember the category field width.")
6497 (defvar org-prefix-category-max-length nil
6498 "Used by `org-compile-prefix-format' to remember the category field width.")
6500 (defun org-agenda-get-category-icon (category)
6501 "Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
6502 (cl-dolist (entry org-agenda-category-icon-alist)
6503 (when (string-match-p (car entry) category)
6504 (if (listp (cadr entry))
6505 (cl-return (cadr entry))
6506 (cl-return (apply #'create-image (cdr entry)))))))
6508 (defun org-agenda-format-item (extra txt &optional level category tags dotime
6510 "Format TXT to be inserted into the agenda buffer.
6511 In particular, add the prefix and corresponding text properties.
6513 EXTRA must be a string to replace the `%s' specifier in the prefix format.
6514 LEVEL may be a string to replace the `%l' specifier.
6515 CATEGORY (a string, a symbol or nil) may be used to overrule the default
6516 category taken from local variable or file name. It will replace the `%c'
6517 specifier in the format.
6518 DOTIME, when non-nil, indicates that a time-of-day should be extracted from
6519 TXT for sorting of this entry, and for the `%t' specifier in the format.
6520 When DOTIME is a string, this string is searched for a time before TXT is.
6521 TAGS can be the tags of the headline.
6522 Any match of REMOVE-RE will be removed from TXT."
6523 ;; We keep the org-prefix-* variable values along with a compiled
6524 ;; formatter, so that multiple agendas existing at the same time do
6525 ;; not step on each other toes.
6527 ;; It was inconvenient to make these variables buffer local in
6528 ;; Agenda buffers, because this function expects to be called with
6529 ;; the buffer where item comes from being current, and not agenda
6531 (let* ((bindings (car org-prefix-format-compiled))
6532 (formatter (cadr org-prefix-format-compiled)))
6533 (cl-loop for (var value) in bindings
6536 ;; Diary entries sometimes have extra whitespace at the beginning
6537 (setq txt (org-trim txt))
6539 ;; Fix the tags part in txt
6540 (setq txt (org-agenda-fix-displayed-tags
6542 org-agenda-show-inherited-tags
6543 org-agenda-hide-tags-regexp))
6545 (let* ((category (or category
6546 (if buffer-file-name
6547 (file-name-sans-extension
6548 (file-name-nondirectory buffer-file-name))
6550 (category-icon (org-agenda-get-category-icon category))
6551 (category-icon (if category-icon
6552 (propertize " " 'display category-icon)
6554 (effort (and (not (string= txt ""))
6555 (get-text-property 1 'effort txt)))
6556 ;; time, tag, effort are needed for the eval of the prefix format
6557 (tag (if tags (nth (1- (length tags)) tags) ""))
6559 (ts (if dotime (concat
6560 (if (stringp dotime) dotime "")
6561 (and org-agenda-search-headline-for-time txt))))
6562 (time-of-day (and dotime (org-get-time-of-day ts)))
6563 stamp plain s0 s1 s2 rtn srp l
6564 duration breadcrumbs)
6565 (and (derived-mode-p 'org-mode) buffer-file-name
6566 (add-to-list 'org-agenda-contributing-files buffer-file-name))
6567 (when (and dotime time-of-day)
6568 ;; Extract starting and ending time and move them to prefix
6569 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
6570 (setq plain (string-match org-plain-time-of-day-regexp ts)))
6571 (setq s0 (match-string 0 ts)
6572 srp (and stamp (match-end 3))
6573 s1 (match-string (if plain 1 2) ts)
6574 s2 (match-string (if plain 8 (if srp 4 6)) ts))
6576 ;; If the times are in TXT (not in DOTIMES), and the prefix will list
6577 ;; them, we might want to remove them there to avoid duplication.
6578 ;; The user can turn this off with a variable.
6579 (if (and org-prefix-has-time
6580 org-agenda-remove-times-when-in-prefix (or stamp plain)
6581 (string-match (concat (regexp-quote s0) " *") txt)
6582 (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
6583 (if (eq org-agenda-remove-times-when-in-prefix 'beg)
6584 (= (match-beginning 0) 0)
6586 (setq txt (replace-match "" nil nil txt))))
6587 ;; Normalize the time(s) to 24 hour
6588 (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
6589 (if s2 (setq s2 (org-get-time-of-day s2 'string t)))
6591 ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set
6592 (let (org-time-clocksum-use-effort-durations)
6593 (when (and s1 (not s2) org-agenda-default-appointment-duration)
6595 (org-minutes-to-clocksum-string
6596 (+ (org-hh:mm-string-to-minutes s1)
6597 org-agenda-default-appointment-duration)))))
6599 ;; Compute the duration
6601 (setq duration (- (org-hh:mm-string-to-minutes s2)
6602 (org-hh:mm-string-to-minutes s1)))))
6604 (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
6605 ;; Tags are in the string
6606 (if (or (eq org-agenda-remove-tags t)
6607 (and org-agenda-remove-tags
6608 org-prefix-has-tag))
6609 (setq txt (replace-match "" t t txt))
6610 (setq txt (replace-match
6611 (concat (make-string (max (- 50 (length txt)) 1) ?\ )
6612 (match-string 2 txt))
6616 (while (string-match remove-re txt)
6617 (setq txt (replace-match "" t t txt))))
6619 ;; Set org-heading property on `txt' to mark the start of the
6621 (add-text-properties 0 (length txt) '(org-heading t) txt)
6623 ;; Prepare the variables needed in the eval of the compiled format
6624 (if org-prefix-has-breadcrumbs
6625 (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker)
6626 (let ((s (org-display-outline-path nil nil "->" t)))
6627 (if (eq "" s) "" (concat s "->"))))))
6628 (setq time (cond (s2 (concat
6629 (org-agenda-time-of-day-to-ampm-maybe s1)
6630 "-" (org-agenda-time-of-day-to-ampm-maybe s2)
6631 (if org-agenda-timegrid-use-ampm " ")))
6633 (org-agenda-time-of-day-to-ampm-maybe s1)
6634 (if org-agenda-timegrid-use-ampm
6638 extra (or (and (not habitp) extra) "")
6639 category (if (symbolp category) (symbol-name category) category)
6640 level (or level ""))
6641 (if (string-match org-bracket-link-regexp category)
6643 (setq l (if (match-end 3)
6644 (- (match-end 3) (match-beginning 3))
6645 (- (match-end 1) (match-beginning 1))))
6646 (when (< l (or org-prefix-category-length 0))
6647 (setq category (copy-sequence category))
6648 (org-add-props category nil
6649 'extra-space (make-string
6650 (- org-prefix-category-length l 1) ?\ ))))
6651 (if (and org-prefix-category-max-length
6652 (>= (length category) org-prefix-category-max-length))
6653 (setq category (substring category 0 (1- org-prefix-category-max-length)))))
6654 ;; Evaluate the compiled format
6655 (setq rtn (concat (eval formatter) txt))
6657 ;; And finally add the text properties
6658 (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
6659 (org-add-props rtn nil
6660 'org-category category
6661 'tags (mapcar 'org-downcase-keep-props tags)
6662 'org-highest-priority org-highest-priority
6663 'org-lowest-priority org-lowest-priority
6664 'time-of-day time-of-day
6666 'breadcrumbs breadcrumbs
6671 'format org-prefix-format-compiled
6674 (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
6675 "Remove tags string from TXT, and add a modified list of tags.
6676 The modified list may contain inherited tags, and tags matched by
6677 `org-agenda-hide-tags-regexp' will be removed."
6678 (when (or add-inherited hide-re)
6679 (if (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
6680 (setq txt (substring txt 0 (match-beginning 0))))
6683 (mapcar (lambda (tg)
6684 (if (or (and hide-re (string-match hide-re tg))
6685 (and (not add-inherited)
6686 (get-text-property 0 'inherited tg)))
6691 (let ((have-i (get-text-property 0 'inherited (car tags)))
6693 (setq txt (concat txt " :"
6696 (setq i (get-text-property 0 'inherited x))
6697 (if (and have-i (not i))
6703 (if have-i "::" ":"))))))
6706 (defun org-downcase-keep-props (s)
6707 (let ((props (text-properties-at 0 s)))
6708 (setq s (downcase s))
6709 (add-text-properties 0 (length s) props s)
6712 (defvar org-agenda-sorting-strategy) ;; because the def is in a let form
6714 (defun org-agenda-add-time-grid-maybe (list ndays todayp)
6715 "Add a time-grid for agenda items which need it.
6717 LIST is the list of agenda items formatted by `org-agenda-list'.
6718 NDAYS is the span of the current agenda view.
6719 TODAYP is t when the current agenda view is on today."
6721 (cond ((not org-agenda-use-time-grid) (throw 'exit list))
6722 ((and todayp (member 'today (car org-agenda-time-grid))))
6723 ((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
6724 ((member 'weekly (car org-agenda-time-grid)))
6725 (t (throw 'exit list)))
6726 (let* ((have (delq nil (mapcar
6727 (lambda (x) (get-text-property 1 'time-of-day x))
6729 (string (nth 1 org-agenda-time-grid))
6730 (gridtimes (nth 2 org-agenda-time-grid))
6731 (req (car org-agenda-time-grid))
6732 (remove (member 'remove-match req))
6734 (if (and (member 'require-timed req) (not have))
6735 ;; don't show empty grid
6737 (while (setq time (pop gridtimes))
6738 (unless (and remove (member time have))
6739 (setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
6740 (push (org-agenda-format-item
6741 nil string nil "" nil
6742 (concat (substring time 0 -2) ":" (substring time -2)))
6745 2 (length (car new)) 'face 'org-time-grid (car new))))
6746 (when (and todayp org-agenda-show-current-time-in-grid)
6747 (push (org-agenda-format-item
6748 nil org-agenda-current-time-string nil "" nil
6749 (format-time-string "%H:%M "))
6752 2 (length (car new)) 'face 'org-agenda-current-time (car new)))
6754 (if (member 'time-up org-agenda-sorting-strategy-selected)
6756 (append list new)))))
6758 (defun org-compile-prefix-format (key)
6759 "Compile the prefix format into a Lisp form that can be evaluated.
6760 The resulting form and associated variable bindings is returned
6761 and stored in the variable `org-prefix-format-compiled'."
6762 (setq org-prefix-has-time nil
6763 org-prefix-has-tag nil
6764 org-prefix-category-length nil
6765 org-prefix-has-effort nil
6766 org-prefix-has-breadcrumbs nil)
6768 ((stringp org-agenda-prefix-format)
6769 org-agenda-prefix-format)
6770 ((assq key org-agenda-prefix-format)
6771 (cdr (assq key org-agenda-prefix-format)))
6772 (t " %-12:c%?-12t% s")))
6774 varform vars var e c f opt)
6775 (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)"
6777 (setq var (or (cdr (assoc (match-string 4 s)
6778 '(("c" . category) ("t" . time) ("l" . level) ("s" . extra)
6779 ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs))))
6781 c (or (match-string 3 s) "")
6782 opt (match-beginning 1)
6783 start (1+ (match-beginning 0)))
6784 (if (eq var 'time) (setq org-prefix-has-time t))
6785 (if (eq var 'tag) (setq org-prefix-has-tag t))
6786 (if (eq var 'effort) (setq org-prefix-has-effort t))
6787 (if (eq var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t))
6788 (setq f (concat "%" (match-string 2 s) "s"))
6789 (when (eq var 'category)
6790 (setq org-prefix-category-length
6791 (floor (abs (string-to-number (match-string 2 s)))))
6792 (setq org-prefix-category-max-length
6793 (let ((x (match-string 2 s)))
6795 (if (string-match "\\.[0-9]+" x)
6796 (string-to-number (substring (match-string 0 x) 1)))))))
6798 (setq varform `(format ,f (org-eval ,(read (match-string 4 s)))))
6801 `(if (or (equal "" ,var) (equal nil ,var))
6803 (format ,f (concat ,var ,c))))
6805 `(format ,f (if (or (equal ,var "")
6806 (equal ,var nil)) ""
6807 (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
6808 (setq s (replace-match "%s" t nil s))
6809 (push varform vars))
6810 (setq vars (nreverse vars))
6811 (with-current-buffer (or org-agenda-buffer (current-buffer))
6812 (setq org-prefix-format-compiled
6814 `((org-prefix-has-time ,org-prefix-has-time)
6815 (org-prefix-has-tag ,org-prefix-has-tag)
6816 (org-prefix-category-length ,org-prefix-category-length)
6817 (org-prefix-has-effort ,org-prefix-has-effort)
6818 (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs))
6819 `(format ,s ,@vars))))))
6821 (defun org-set-sorting-strategy (key)
6822 (if (symbolp (car org-agenda-sorting-strategy))
6824 (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy)
6825 (setq org-agenda-sorting-strategy-selected
6826 (or (cdr (assq key org-agenda-sorting-strategy))
6827 (cdr (assq 'agenda org-agenda-sorting-strategy))
6828 '(time-up category-keep priority-down)))))
6830 (defun org-get-time-of-day (s &optional string mod24)
6831 "Check string S for a time of day.
6832 If found, return it as a military time number between 0 and 2400.
6833 If not found, return nil.
6834 The optional STRING argument forces conversion into a 5 character wide string
6839 (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
6840 (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
6841 (not (eq (get-text-property 1 'face s) 'org-link)))
6842 (let* ((h (string-to-number (match-string 1 s)))
6843 (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
6844 (ampm (if (match-end 4) (downcase (match-string 4 s))))
6845 (am-p (equal ampm "am"))
6846 (h1 (cond ((not ampm) h)
6847 ((= h 12) (if am-p 0 12))
6848 (t (+ h (if am-p 0 12)))))
6849 (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
6851 (t0 (+ (* 100 h2) m))
6852 (t1 (concat (if (>= h1 24) "+" " ")
6853 (if (and org-agenda-time-leading-zero
6854 (< t0 1000)) "0" "")
6855 (if (< t0 100) "0" "")
6856 (if (< t0 10) "0" "")
6857 (int-to-string t0))))
6858 (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
6860 (defvar org-agenda-before-sorting-filter-function nil
6861 "Function to be applied to agenda items prior to sorting.
6862 Prior to sorting also means just before they are inserted into the agenda.
6864 To aid sorting, you may revisit the original entries and add more text
6865 properties which will later be used by the sorting functions.
6867 The function should take a string argument, an agenda line.
6868 It has access to the text properties in that line, which contain among
6869 other things, the property `org-hd-marker' that points to the entry
6870 where the line comes from. Note that not all lines going into the agenda
6871 have this property, only most.
6873 The function should return the modified string. It is probably best
6874 to ONLY change text properties.
6876 You can also use this function as a filter, by returning nil for lines
6877 you don't want to have in the agenda at all. For this application, you
6878 could bind the variable in the options section of a custom command.")
6880 (defun org-agenda-finalize-entries (list &optional type)
6881 "Sort, limit and concatenate the LIST of agenda items.
6882 The optional argument TYPE tells the agenda type."
6883 (let ((max-effort (cond ((listp org-agenda-max-effort)
6884 (cdr (assoc type org-agenda-max-effort)))
6885 (t org-agenda-max-effort)))
6886 (max-todo (cond ((listp org-agenda-max-todos)
6887 (cdr (assoc type org-agenda-max-todos)))
6888 (t org-agenda-max-todos)))
6889 (max-tags (cond ((listp org-agenda-max-tags)
6890 (cdr (assoc type org-agenda-max-tags)))
6891 (t org-agenda-max-tags)))
6892 (max-entries (cond ((listp org-agenda-max-entries)
6893 (cdr (assoc type org-agenda-max-entries)))
6894 (t org-agenda-max-entries))))
6895 (when org-agenda-before-sorting-filter-function
6899 org-agenda-before-sorting-filter-function list))))
6900 (setq list (mapcar 'org-agenda-highlight-todo list)
6901 list (mapcar 'identity (sort list 'org-entries-lessp)))
6903 (setq list (org-agenda-limit-entries
6904 list 'effort-minutes max-effort
6905 (lambda (e) (or e (if org-sort-agenda-noeffort-is-high
6908 (setq list (org-agenda-limit-entries list 'todo-state max-todo)))
6910 (setq list (org-agenda-limit-entries list 'tags max-tags)))
6912 (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
6913 (mapconcat 'identity list "\n")))
6915 (defun org-agenda-limit-entries (list prop limit &optional fn)
6916 "Limit the number of agenda entries."
6917 (let ((include (and limit (< limit 0))))
6919 (let ((fun (or fn (lambda (p) (if p 1))))
6924 (let ((pval (funcall
6925 fun (get-text-property (1- (length e))
6927 (if pval (setq lim (+ lim pval)))
6928 (cond ((and pval (<= lim (abs limit))) e)
6929 ((and include (not pval)) e))))
6933 (defun org-agenda-limit-interactively (remove)
6934 "In agenda, interactively limit entries to various maximums."
6937 (progn (setq org-agenda-max-entries nil
6938 org-agenda-max-todos nil
6939 org-agenda-max-tags nil
6940 org-agenda-max-effort nil)
6942 (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
6943 (msg (cond ((= max ?E) "How many minutes? ")
6944 ((= max ?e) "How many entries? ")
6945 ((= max ?t) "How many TODO entries? ")
6946 ((= max ?T) "How many tagged entries? ")
6947 (t (user-error "Wrong input"))))
6948 (num (string-to-number (read-from-minibuffer msg))))
6949 (cond ((equal max ?e)
6950 (let ((org-agenda-max-entries num)) (org-agenda-redo)))
6952 (let ((org-agenda-max-todos num)) (org-agenda-redo)))
6954 (let ((org-agenda-max-tags num)) (org-agenda-redo)))
6956 (let ((org-agenda-max-effort num)) (org-agenda-redo))))))
6957 (org-agenda-fit-window-to-buffer))
6959 (defun org-agenda-highlight-todo (x)
6960 (let ((org-done-keywords org-done-keywords-for-agenda)
6961 (case-fold-search nil)
6965 (beginning-of-line 1)
6966 (setq re (org-get-at-bol 'org-todo-regexp))
6967 (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point)))
6968 (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
6969 (add-text-properties (match-beginning 0) (match-end 1)
6970 (list 'face (org-get-todo-face 1)))
6971 (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
6972 (delete-region (match-beginning 1) (1- (match-end 0)))
6973 (goto-char (match-beginning 1))
6974 (insert (format org-agenda-todo-keyword-format s)))))
6975 (let ((pl (text-property-any 0 (length x) 'org-heading t x)))
6976 (setq re (get-text-property 0 'org-todo-regexp x))
6978 ;; Test `pl' because if there's no heading content,
6979 ;; there's no point matching to highlight. Note
6980 ;; that if we didn't test `pl' first, and there
6981 ;; happened to be no keyword from `org-todo-regexp'
6982 ;; on this heading line, then the `equal' comparison
6983 ;; afterwards would spuriously succeed in the case
6984 ;; where `pl' is nil -- causing an args-out-of-range
6985 ;; error when we try to add text properties to text
6986 ;; that isn't there.
6988 (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
6990 (add-text-properties
6991 (or (match-end 1) (match-end 0)) (match-end 0)
6992 (list 'face (org-get-todo-face (match-string 2 x)))
6995 (setq x (concat (substring x 0 (match-end 1))
6996 (format org-agenda-todo-keyword-format
6998 (org-add-props " " (text-properties-at 0 x))
6999 (substring x (match-end 3)))))))
7002 (defsubst org-cmp-values (a b property)
7003 "Compare the numeric value of text PROPERTY for string A and B."
7004 (let ((pa (or (get-text-property (1- (length a)) property a) 0))
7005 (pb (or (get-text-property (1- (length b)) property b) 0)))
7006 (cond ((> pa pb) +1)
7009 (defsubst org-cmp-effort (a b)
7010 "Compare the effort values of string A and B."
7011 (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
7012 ;; `effort-minutes' property is not directly accessible from
7013 ;; the strings, but is stored as a property in `txt'.
7014 (ea (or (get-text-property
7015 0 'effort-minutes (get-text-property 0 'txt a))
7017 (eb (or (get-text-property
7018 0 'effort-minutes (get-text-property 0 'txt b))
7020 (cond ((> ea eb) +1)
7023 (defsubst org-cmp-category (a b)
7024 "Compare the string values of categories of strings A and B."
7025 (let ((ca (or (get-text-property (1- (length a)) 'org-category a) ""))
7026 (cb (or (get-text-property (1- (length b)) 'org-category b) "")))
7027 (cond ((string-lessp ca cb) -1)
7028 ((string-lessp cb ca) +1))))
7030 (defsubst org-cmp-todo-state (a b)
7031 "Compare the todo states of strings A and B."
7032 (let* ((ma (or (get-text-property 1 'org-marker a)
7033 (get-text-property 1 'org-hd-marker a)))
7034 (mb (or (get-text-property 1 'org-marker b)
7035 (get-text-property 1 'org-hd-marker b)))
7036 (fa (and ma (marker-buffer ma)))
7037 (fb (and mb (marker-buffer mb)))
7039 (or (and fa (with-current-buffer fa org-todo-keywords-1))
7040 (and fb (with-current-buffer fb org-todo-keywords-1))))
7041 (ta (or (get-text-property 1 'todo-state a) ""))
7042 (tb (or (get-text-property 1 'todo-state b) ""))
7043 (la (- (length (member ta todo-kwds))))
7044 (lb (- (length (member tb todo-kwds))))
7045 (donepa (member ta org-done-keywords-for-agenda))
7046 (donepb (member tb org-done-keywords-for-agenda)))
7047 (cond ((and donepa (not donepb)) -1)
7048 ((and (not donepa) donepb) +1)
7052 (defsubst org-cmp-alpha (a b)
7053 "Compare the headlines, alphabetically."
7054 (let* ((pla (text-property-any 0 (length a) 'org-heading t a))
7055 (plb (text-property-any 0 (length b) 'org-heading t b))
7056 (ta (and pla (substring a pla)))
7057 (tb (and plb (substring b plb)))
7058 (case-fold-search nil))
7060 (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
7061 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta)
7062 (setq ta (substring ta (match-end 0))))
7063 (setq ta (downcase ta)))
7065 (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "")
7066 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb)
7067 (setq tb (substring tb (match-end 0))))
7068 (setq tb (downcase tb)))
7071 ((string-lessp ta tb) -1)
7072 ((string-lessp tb ta) +1))))
7074 (defsubst org-cmp-tag (a b)
7075 "Compare the string values of the first tags of A and B."
7076 (let ((ta (car (last (get-text-property 1 'tags a))))
7077 (tb (car (last (get-text-property 1 'tags b)))))
7080 ((string-lessp ta tb) -1)
7081 ((string-lessp tb ta) +1))))
7083 (defsubst org-cmp-time (a b)
7084 "Compare the time-of-day values of strings A and B."
7085 (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
7086 (ta (or (get-text-property 1 'time-of-day a) def))
7087 (tb (or (get-text-property 1 'time-of-day b) def)))
7088 (cond ((< ta tb) -1)
7091 (defsubst org-cmp-ts (a b type)
7092 "Compare the timestamps values of entries A and B.
7093 When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
7094 \"timestamp_ia\", compare within each of these type. When TYPE
7095 is the empty string, compare all timestamps without respect of
7097 (let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1))
7098 (ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
7099 (get-text-property 1 'ts-date a))
7101 (tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
7102 (get-text-property 1 'ts-date b))
7104 (cond ((< ta tb) -1)
7107 (defsubst org-cmp-habit-p (a b)
7108 "Compare the todo states of strings A and B."
7109 (let ((ha (get-text-property 1 'org-habit-p a))
7110 (hb (get-text-property 1 'org-habit-p b)))
7111 (cond ((and ha (not hb)) -1)
7112 ((and (not ha) hb) +1))))
7114 (defun org-entries-lessp (a b)
7115 "Predicate for sorting agenda entries."
7116 ;; The following variables will be used when the form is evaluated.
7117 ;; So even though the compiler complains, keep them.
7118 (let* ((ss org-agenda-sorting-strategy-selected)
7119 (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss)
7120 (org-cmp-ts a b "")))
7121 (timestamp-down (if timestamp-up (- timestamp-up) nil))
7122 (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss)
7123 (org-cmp-ts a b "scheduled")))
7124 (scheduled-down (if scheduled-up (- scheduled-up) nil))
7125 (deadline-up (and (org-em 'deadline-up 'deadline-down ss)
7126 (org-cmp-ts a b "deadline")))
7127 (deadline-down (if deadline-up (- deadline-up) nil))
7128 (tsia-up (and (org-em 'tsia-up 'tsia-down ss)
7129 (org-cmp-ts a b "timestamp_ia")))
7130 (tsia-down (if tsia-up (- tsia-up) nil))
7131 (ts-up (and (org-em 'ts-up 'ts-down ss)
7132 (org-cmp-ts a b "timestamp")))
7133 (ts-down (if ts-up (- ts-up) nil))
7134 (time-up (and (org-em 'time-up 'time-down ss)
7135 (org-cmp-time a b)))
7136 (time-down (if time-up (- time-up) nil))
7137 (stats-up (and (org-em 'stats-up 'stats-down ss)
7138 (org-cmp-values a b 'org-stats)))
7139 (stats-down (if stats-up (- stats-up) nil))
7140 (priority-up (and (org-em 'priority-up 'priority-down ss)
7141 (org-cmp-values a b 'priority)))
7142 (priority-down (if priority-up (- priority-up) nil))
7143 (effort-up (and (org-em 'effort-up 'effort-down ss)
7144 (org-cmp-effort a b)))
7145 (effort-down (if effort-up (- effort-up) nil))
7146 (category-up (and (or (org-em 'category-up 'category-down ss)
7147 (memq 'category-keep ss))
7148 (org-cmp-category a b)))
7149 (category-down (if category-up (- category-up) nil))
7150 (category-keep (if category-up +1 nil))
7151 (tag-up (and (org-em 'tag-up 'tag-down ss)
7153 (tag-down (if tag-up (- tag-up) nil))
7154 (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss)
7155 (org-cmp-todo-state a b)))
7156 (todo-state-down (if todo-state-up (- todo-state-up) nil))
7157 (habit-up (and (org-em 'habit-up 'habit-down ss)
7158 (org-cmp-habit-p a b)))
7159 (habit-down (if habit-up (- habit-up) nil))
7160 (alpha-up (and (org-em 'alpha-up 'alpha-down ss)
7161 (org-cmp-alpha a b)))
7162 (alpha-down (if alpha-up (- alpha-up) nil))
7163 (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss))
7164 user-defined-up user-defined-down)
7165 (if (and need-user-cmp org-agenda-cmp-user-defined
7166 (functionp org-agenda-cmp-user-defined))
7167 (setq user-defined-up
7168 (funcall org-agenda-cmp-user-defined a b)
7169 user-defined-down (if user-defined-up (- user-defined-up) nil)))
7171 (eval (cons 'or org-agenda-sorting-strategy-selected))
7172 '((-1 . t) (1 . nil) (nil . nil))))))
7174 ;;; Agenda restriction lock
7176 (defvar org-agenda-restriction-lock-overlay (make-overlay 1 1)
7177 "Overlay to mark the headline to which agenda commands are restricted.")
7178 (overlay-put org-agenda-restriction-lock-overlay
7179 'face 'org-agenda-restriction-lock)
7180 (overlay-put org-agenda-restriction-lock-overlay
7181 'help-echo "Agendas are currently limited to this subtree.")
7182 (delete-overlay org-agenda-restriction-lock-overlay)
7185 (defun org-agenda-set-restriction-lock (&optional type)
7186 "Set restriction lock for agenda, to current subtree or file.
7187 Restriction will be the file if TYPE is `file', or if type is the
7188 universal prefix \\='(4), or if the cursor is before the first headline
7189 in the file. Otherwise, restriction will be to the current subtree."
7191 (org-agenda-remove-restriction-lock 'noupdate)
7192 (and (equal type '(4)) (setq type 'file))
7195 ((org-at-heading-p) 'subtree)
7196 ((condition-case nil (org-back-to-heading t) (error nil))
7199 (if (eq type 'subtree)
7201 (setq org-agenda-restrict (current-buffer))
7202 (setq org-agenda-overriding-restriction 'subtree)
7203 (put 'org-agenda-files 'org-restrict
7204 (list (buffer-file-name (buffer-base-buffer))))
7205 (org-back-to-heading t)
7206 (move-overlay org-agenda-restriction-lock-overlay
7208 (if org-agenda-restriction-lock-highlight-subtree
7209 (save-excursion (org-end-of-subtree t t) (point))
7211 (move-marker org-agenda-restrict-begin (point))
7212 (move-marker org-agenda-restrict-end
7213 (save-excursion (org-end-of-subtree t t)))
7214 (message "Locking agenda restriction to subtree"))
7215 (put 'org-agenda-files 'org-restrict
7216 (list (buffer-file-name (buffer-base-buffer))))
7217 (setq org-agenda-restrict nil)
7218 (setq org-agenda-overriding-restriction 'file)
7219 (move-marker org-agenda-restrict-begin nil)
7220 (move-marker org-agenda-restrict-end nil)
7221 (message "Locking agenda restriction to file"))
7222 (setq current-prefix-arg nil)
7223 (org-agenda-maybe-redo))
7225 (defun org-agenda-remove-restriction-lock (&optional noupdate)
7226 "Remove the agenda restriction lock."
7228 (delete-overlay org-agenda-restriction-lock-overlay)
7229 (delete-overlay org-speedbar-restriction-lock-overlay)
7230 (setq org-agenda-overriding-restriction nil)
7231 (setq org-agenda-restrict nil)
7232 (put 'org-agenda-files 'org-restrict nil)
7233 (move-marker org-agenda-restrict-begin nil)
7234 (move-marker org-agenda-restrict-end nil)
7235 (setq current-prefix-arg nil)
7236 (message "Agenda restriction lock removed")
7237 (or noupdate (org-agenda-maybe-redo)))
7239 (defun org-agenda-maybe-redo ()
7240 "If there is any window showing the agenda view, update it."
7241 (let ((w (get-buffer-window (or org-agenda-this-buffer-name
7242 org-agenda-buffer-name)
7244 (w0 (selected-window)))
7249 (if org-agenda-overriding-restriction
7250 (message "Agenda view shifted to new %s restriction"
7251 org-agenda-overriding-restriction)
7252 (message "Agenda restriction lock removed")))))
7256 (defun org-agenda-check-type (error &rest types)
7257 "Check if agenda buffer is of allowed type.
7258 If ERROR is non-nil, throw an error, otherwise just return nil.
7259 Allowed types are `agenda' `timeline' `todo' `tags' `search'."
7260 (if (not org-agenda-type)
7261 (error "No Org agenda currently displayed")
7262 (if (memq org-agenda-type types)
7265 (error "Not allowed in %s-type agenda buffers" org-agenda-type)
7268 (defun org-agenda-Quit ()
7269 "Exit the agenda, killing the agenda buffer.
7270 Like `org-agenda-quit', but kill the buffer even when
7271 `org-agenda-sticky' is non-nil."
7275 (defun org-agenda-quit ()
7278 When `org-agenda-sticky' is non-nil, bury the agenda buffer
7279 instead of killing it.
7281 When `org-agenda-restore-windows-after-quit' is non-nil, restore
7282 the pre-agenda window configuration.
7284 When column view is active, exit column view instead of the
7287 (org-agenda--quit org-agenda-sticky))
7289 (defun org-agenda--quit (&optional bury)
7290 (if org-agenda-columns-active
7292 (let ((wconf org-agenda-pre-window-conf)
7293 (buf (current-buffer))
7294 (org-agenda-last-indirect-window
7295 (and (eq org-indirect-buffer-display 'other-window)
7296 org-agenda-last-indirect-buffer
7297 (get-buffer-window org-agenda-last-indirect-buffer))))
7299 ((eq org-agenda-window-setup 'other-frame)
7301 ((and org-agenda-restore-windows-after-quit
7303 ;; Maybe restore the pre-agenda window configuration. Reset
7304 ;; `org-agenda-pre-window-conf' before running
7305 ;; `set-window-configuration', which loses the current buffer.
7306 (setq org-agenda-pre-window-conf nil)
7307 (set-window-configuration wconf))
7309 (when org-agenda-last-indirect-window
7310 (delete-window org-agenda-last-indirect-window))
7311 (and (not (eq org-agenda-window-setup 'current-window))
7312 (not (one-window-p))
7315 ;; Set the agenda buffer as the current buffer instead of
7316 ;; passing it as an argument to `bury-buffer' so that
7317 ;; `bury-buffer' removes it from the window.
7318 (with-current-buffer buf
7321 (setq org-agenda-archives-mode nil
7322 org-agenda-buffer nil)))))
7324 (defun org-agenda-exit ()
7325 "Exit the agenda, killing Org buffers loaded by the agenda.
7326 Like `org-agenda-Quit', but kill any buffers that were created by
7327 the agenda. Org buffers visited directly by the user will not be
7328 touched. Also, exit the agenda even if it is in column view."
7330 (when org-agenda-columns-active
7332 (org-release-buffers org-agenda-new-buffers)
7333 (setq org-agenda-new-buffers nil)
7336 (defun org-agenda-kill-all-agenda-buffers ()
7337 "Kill all buffers in `org-agenda-mode'.
7338 This is used when toggling sticky agendas."
7341 (dolist (buf (buffer-list))
7342 (when (with-current-buffer buf (eq major-mode 'org-agenda-mode))
7344 (mapc 'kill-buffer blist)))
7346 (defun org-agenda-execute (arg)
7347 "Execute another agenda command, keeping same window.
7348 So this is just a shortcut for \\<global-map>`\\[org-agenda]', available
7351 (let ((org-agenda-window-setup 'current-window))
7354 (defun org-agenda-redo (&optional all)
7355 "Rebuild possibly ALL agenda view(s) in the current buffer."
7357 (let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
7358 (cpa (unless (eq all t) current-prefix-arg))
7359 (org-agenda-doing-sticky-redo org-agenda-sticky)
7360 (org-agenda-sticky nil)
7361 (org-agenda-buffer-name (or org-agenda-this-buffer-name
7362 org-agenda-buffer-name))
7363 (org-agenda-keep-modes t)
7364 (tag-filter org-agenda-tag-filter)
7365 (tag-preset (get 'org-agenda-tag-filter :preset-filter))
7366 (top-hl-filter org-agenda-top-headline-filter)
7367 (cat-filter org-agenda-category-filter)
7368 (cat-preset (get 'org-agenda-category-filter :preset-filter))
7369 (re-filter org-agenda-regexp-filter)
7370 (re-preset (get 'org-agenda-regexp-filter :preset-filter))
7371 (effort-filter org-agenda-effort-filter)
7372 (effort-preset (get 'org-agenda-effort-filter :preset-filter))
7373 (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
7374 (cols org-agenda-columns-active)
7375 (line (org-current-line))
7376 (window-line (- line (org-current-line (window-start))))
7377 (lprops (get 'org-agenda-redo-command 'org-lprops))
7378 (redo-cmd (get-text-property p 'org-redo-cmd))
7379 (last-args (get-text-property p 'org-last-args))
7380 (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd))
7381 (org-agenda-overriding-cmd-arguments
7383 (cond ((listp last-args)
7384 (cons (or cpa (car last-args)) (cdr last-args)))
7385 ((stringp last-args)
7387 (series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
7388 (put 'org-agenda-tag-filter :preset-filter nil)
7389 (put 'org-agenda-category-filter :preset-filter nil)
7390 (put 'org-agenda-regexp-filter :preset-filter nil)
7391 (put 'org-agenda-effort-filter :preset-filter nil)
7392 (and cols (org-columns-quit))
7393 (message "Rebuilding agenda buffer...")
7395 (eval series-redo-cmd)
7396 (org-let lprops redo-cmd))
7397 (setq org-agenda-undo-list nil
7398 org-agenda-pending-undo-list nil
7399 org-agenda-tag-filter tag-filter
7400 org-agenda-category-filter cat-filter
7401 org-agenda-regexp-filter re-filter
7402 org-agenda-effort-filter effort-filter
7403 org-agenda-top-headline-filter top-hl-filter)
7404 (message "Rebuilding agenda buffer...done")
7405 (put 'org-agenda-tag-filter :preset-filter tag-preset)
7406 (put 'org-agenda-category-filter :preset-filter cat-preset)
7407 (put 'org-agenda-regexp-filter :preset-filter re-preset)
7408 (put 'org-agenda-effort-filter :preset-filter effort-preset)
7409 (let ((tag (or tag-filter tag-preset))
7410 (cat (or cat-filter cat-preset))
7411 (effort (or effort-filter effort-preset))
7412 (re (or re-filter re-preset)))
7413 (when tag (org-agenda-filter-apply tag 'tag t))
7414 (when cat (org-agenda-filter-apply cat 'category))
7415 (when effort (org-agenda-filter-apply effort 'effort))
7416 (when re (org-agenda-filter-apply re 'regexp)))
7417 (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
7418 (and cols (called-interactively-p 'any) (org-agenda-columns))
7419 (org-goto-line line)
7420 (recenter window-line)))
7422 (defvar org-global-tags-completion-table nil)
7423 (defvar org-agenda-filter-form nil)
7424 (defvar org-agenda-filtered-by-category nil)
7426 (defun org-agenda-filter-by-category (strip)
7427 "Filter lines in the agenda buffer that have a specific category.
7428 The category is that of the current line.
7429 Without prefix argument, keep only the lines of that category.
7430 With a prefix argument, exclude the lines of that category.
7433 (if (and org-agenda-filtered-by-category
7434 org-agenda-category-filter)
7435 (org-agenda-filter-show-all-cat)
7436 (let ((cat (org-no-properties (org-get-at-eol 'org-category 1))))
7439 (org-agenda-filter-apply
7440 (push (concat "-" cat) org-agenda-category-filter) 'category))
7442 (org-agenda-filter-apply
7443 (setq org-agenda-category-filter
7444 (list (concat "+" cat))) 'category))
7445 (t (error "No category at point"))))))
7447 (defun org-find-top-headline (&optional pos)
7448 "Find the topmost parent headline and return it."
7450 (with-current-buffer (if pos (marker-buffer pos) (current-buffer))
7451 (if pos (goto-char pos))
7452 ;; Skip up to the topmost parent
7453 (while (ignore-errors (outline-up-heading 1) t))
7455 (nth 4 (org-heading-components))))))
7457 (defvar org-agenda-filtered-by-top-headline nil)
7458 (defun org-agenda-filter-by-top-headline (strip)
7459 "Keep only those lines that are descendants from the same top headline.
7460 The top headline is that of the current line."
7462 (if org-agenda-filtered-by-top-headline
7464 (setq org-agenda-filtered-by-top-headline nil
7465 org-agenda-top-headline-filter nil)
7466 (org-agenda-filter-show-all-top-filter))
7467 (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
7468 (if toph (org-agenda-filter-top-headline-apply toph strip)
7469 (error "No top-level headline at point")))))
7471 (defvar org-agenda-regexp-filter nil)
7472 (defun org-agenda-filter-by-regexp (strip)
7473 "Filter agenda entries by a regular expression.
7474 Regexp filters are cumulative.
7475 With no prefix argument, keep entries matching the regexp.
7476 With one prefix argument, filter out entries matching the regexp.
7477 With two prefix arguments, remove the regexp filters."
7479 (if (not (equal strip '(16)))
7480 (let ((flt (concat (if (equal strip '(4)) "-" "+")
7481 (read-from-minibuffer
7482 (if (equal strip '(4))
7483 "Filter out entries matching regexp: "
7484 "Narrow to entries matching regexp: ")))))
7485 (push flt org-agenda-regexp-filter)
7486 (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
7487 (org-agenda-filter-show-all-re)
7488 (message "Regexp filter removed")))
7490 (defvar org-agenda-effort-filter nil)
7491 (defun org-agenda-filter-by-effort (strip)
7492 "Filter agenda entries by effort.
7493 With no prefix argument, keep entries matching the effort condition.
7494 With one prefix argument, filter out entries matching the condition.
7495 With two prefix arguments, remove the effort filters."
7498 ((member strip '(nil 4))
7499 (let* ((efforts (split-string
7500 (or (cdr (assoc (concat org-effort-property "_ALL")
7501 org-global-properties))
7502 "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")))
7503 ;; XXX: the following handles only up to 10 different
7505 (allowed-keys (if (null efforts) nil
7506 (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0
7507 (number-sequence 1 (length efforts)))))
7509 (while (not (memq op '(?< ?> ?=)))
7510 (setq op (read-char-exclusive "Effort operator? (> = or <)")))
7511 ;; Select appropriate duration. Ignore non-digit characters.
7514 (concat "Effort %c "
7515 (mapconcat (lambda (s) (concat "[%d]" s))
7520 (while (not (memq eff allowed-keys))
7522 (setq eff (- (read-char-exclusive) 48)))
7523 (setq org-agenda-effort-filter
7524 (list (concat (if strip "-" "+")
7526 ;; Numbering is 1 2 3 ... 9 0, but we want
7528 (nth (mod (1- eff) 10) efforts)))))
7529 (org-agenda-filter-apply org-agenda-effort-filter 'effort)))
7530 (t (org-agenda-filter-show-all-effort)
7531 (message "Effort filter removed"))))
7533 (defun org-agenda-filter-remove-all ()
7534 "Remove all filters from the current agenda buffer."
7536 (when org-agenda-tag-filter
7537 (org-agenda-filter-show-all-tag))
7538 (when org-agenda-category-filter
7539 (org-agenda-filter-show-all-cat))
7540 (when org-agenda-regexp-filter
7541 (org-agenda-filter-show-all-re))
7542 (when org-agenda-top-headline-filter
7543 (org-agenda-filter-show-all-top-filter))
7544 (when org-agenda-effort-filter
7545 (org-agenda-filter-show-all-effort))
7546 (org-agenda-finalize))
7548 (defun org-agenda-filter-by-tag (arg &optional char exclude)
7549 "Keep only those lines in the agenda buffer that have a specific tag.
7551 The tag is selected with its fast selection letter, as configured.
7553 With a `\\[universal-argument]' prefix, exclude the agenda search.
7555 With a `\\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \
7557 filter on all its group members.
7559 A lisp caller can specify CHAR. EXCLUDE means that the new tag
7560 should be used to exclude the search - the interactive user can
7561 also press `-' or `+' to switch between filtering and excluding."
7563 (let* ((alist org-tag-alist-for-agenda)
7564 (tag-chars (mapconcat
7565 (lambda (x) (if (and (not (symbolp (car x)))
7567 (char-to-string (cdr x))
7569 org-tag-alist-for-agenda ""))
7570 (valid-char-list (append '(?\t ?\r ?/ ?. ?\s ?q)
7571 (string-to-list tag-chars)))
7572 (exclude (or exclude (equal arg '(4))))
7573 (expand (not (equal arg '(16))))
7574 (inhibit-read-only t)
7575 (current org-agenda-tag-filter)
7578 (while (not (memq char valid-char-list))
7580 "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
7581 (if exclude "Exclude" "Filter") tag-chars
7582 (if org-agenda-auto-exclude-function "[RET], " "")
7583 (if expand "" ", no grouptag expand"))
7584 (setq char (read-char-exclusive))
7585 ;; Excluding or filtering down
7586 (cond ((eq char ?-) (setq exclude t))
7587 ((eq char ?+) (setq exclude nil)))))
7589 (unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
7590 (setq-local org-global-tags-completion-table
7591 (org-global-tags-completion-table)))
7592 (let ((completion-ignore-case t))
7593 (setq tag (completing-read
7594 "Tag: " org-global-tags-completion-table))))
7597 (org-agenda-filter-show-all-tag)
7598 (when org-agenda-auto-exclude-function
7599 (setq org-agenda-tag-filter nil)
7600 (dolist (tag (org-agenda-get-represented-tags))
7601 (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
7603 (push modifier org-agenda-tag-filter))))
7604 (if (not (null org-agenda-tag-filter))
7605 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
7607 (org-agenda-filter-show-all-tag)
7608 (when (get 'org-agenda-tag-filter :preset-filter)
7609 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
7611 (setq org-agenda-tag-filter
7612 (mapcar (lambda(tag) (concat "+" tag))
7613 (org-get-at-bol 'tags)))
7614 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
7615 ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
7617 (setq a (rassoc char alist))
7618 (and tag (setq a (cons tag nil))))
7619 (org-agenda-filter-show-all-tag)
7621 (setq org-agenda-tag-filter
7622 (cons (concat (if exclude "-" "+") tag)
7624 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
7625 (t (error "Invalid tag selection character %c" char)))))
7627 (defun org-agenda-get-represented-tags ()
7628 "Get a list of all tags currently represented in the agenda."
7631 (goto-char (point-min))
7632 (while (setq p (next-single-property-change (point) 'tags))
7634 (mapc (lambda (x) (add-to-list 'tags x))
7635 (get-text-property (point) 'tags))))
7639 (defun org-agenda-filter-make-matcher (filter type &optional expand)
7640 "Create the form that tests a line for agenda filter. Optional
7641 argument EXPAND can be used for the TYPE tag and will expand the
7642 tags in the FILTER if any of the tags in FILTER are grouptags."
7649 (append (get 'org-agenda-tag-filter :preset-filter)
7652 (let ((op (string-to-char x)))
7653 (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
7655 (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
7658 ((eq type 'category)
7661 (append (get 'org-agenda-category-filter :preset-filter)
7664 (if (equal "-" (substring x 0 1))
7665 (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
7666 (setq f1 (list 'equal (substring x 1) 'cat)))
7672 (append (get 'org-agenda-regexp-filter :preset-filter)
7675 (if (equal "-" (substring x 0 1))
7676 (setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
7677 (setq f1 (list 'string-match (substring x 1) 'txt)))
7683 (append (get 'org-agenda-effort-filter :preset-filter)
7686 (push (org-agenda-filter-effort-form x) f))))
7687 (cons 'and (nreverse f))))
7689 (defun org-agenda-filter-make-matcher-tag-exp (tags op)
7690 "Return a form associated to tag-expression TAGS.
7691 Build a form testing a line for agenda filter for
7692 tag-expressions. OP is an operator of type CHAR that allows the
7693 function to set the right switches in the returned form."
7695 ;; Any of the expressions can match if OP is +, all must match if
7696 ;; the operator is -.
7697 (dolist (x tags (cons (if (eq op ?-) 'and 'or) form))
7698 (let* ((tag (substring x 1))
7700 ((string= "" tag) '(not tags))
7701 ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag))
7703 (list 'org-match-any-p (substring tag 1 -1) 'tags))
7704 (t (list 'member (downcase tag) 'tags)))))
7705 (push (if (eq op ?-) (list 'not f) f) form)))))
7707 (defun org-agenda-filter-effort-form (e)
7708 "Return the form to compare the effort of the current line with what E says.
7709 E looks like \"+<2:25\"."
7711 (setq e (substring e 1))
7712 (setq op (string-to-char e) e (substring e 1))
7713 (setq op (cond ((equal op ?<) '<=)
7717 (list 'org-agenda-compare-effort (list 'quote op)
7718 (org-duration-string-to-minutes e))))
7720 (defun org-agenda-compare-effort (op value)
7721 "Compare the effort of the current line with VALUE, using OP.
7722 If the line does not have an effort defined, return nil."
7723 ;; `effort-minutes' property cannot be extracted directly from
7724 ;; current line but is stored as a property in `txt'.
7725 (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt))))
7727 (or effort (if org-sort-agenda-noeffort-is-high 32767 -1))
7730 (defun org-agenda-filter-expand-tags (filter &optional no-operator)
7731 "Expand group tags in FILTER for the agenda.
7732 When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
7734 (let ((case-fold-search t) rtn)
7738 (if (string-match "^\\([+-]\\)\\(.+\\)" f)
7739 (setq dir (match-string 1 f) f0 (match-string 2 f))
7740 (setq dir (if no-operator "" "+") f0 f))
7741 (setq rtn (append (mapcar (lambda(f1) (concat dir f1))
7742 (org-tags-expand f0 t t))
7748 (defun org-agenda-filter-apply (filter type &optional expand)
7749 "Set FILTER as the new agenda filter and apply it. Optional
7750 argument EXPAND can be used for the TYPE tag and will expand the
7751 tags in the FILTER if any of the tags in FILTER are grouptags."
7752 ;; Deactivate `org-agenda-entry-text-mode' when filtering
7753 (if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
7755 (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type expand))
7756 ;; Only set `org-agenda-filtered-by-category' to t when a unique
7757 ;; category is used as the filter:
7758 (setq org-agenda-filtered-by-category
7759 (and (eq type 'category)
7760 (not (equal (substring (car filter) 0 1) "-"))))
7761 (org-agenda-set-mode-name)
7763 (goto-char (point-min))
7765 (if (org-get-at-bol 'org-marker)
7767 (setq tags (org-get-at-bol 'tags)
7768 cat (org-get-at-eol 'org-category 1)
7769 txt (org-get-at-bol 'txt))
7770 (if (not (eval org-agenda-filter-form))
7771 (org-agenda-filter-hide-line type))
7772 (beginning-of-line 2))
7773 (beginning-of-line 2))))
7774 (if (get-char-property (point) 'invisible)
7775 (ignore-errors (org-agenda-previous-line)))))
7777 (defun org-agenda-filter-top-headline-apply (hl &optional negative)
7778 "Filter by top headline HL."
7779 (org-agenda-set-mode-name)
7781 (goto-char (point-min))
7783 (let* ((pos (org-get-at-bol 'org-hd-marker))
7784 (tophl (and pos (org-find-top-headline pos))))
7785 (if (and tophl (funcall (if negative 'identity 'not)
7786 (string= hl tophl)))
7787 (org-agenda-filter-hide-line 'top-headline)))
7788 (beginning-of-line 2)))
7789 (if (get-char-property (point) 'invisible)
7790 (org-agenda-previous-line))
7791 (setq org-agenda-top-headline-filter hl
7792 org-agenda-filtered-by-top-headline t))
7794 (defun org-agenda-filter-hide-line (type)
7795 "Hide lines with TYPE in the agenda buffer."
7796 (let* ((b (max (point-min) (1- (point-at-bol))))
7798 (let ((inhibit-read-only t))
7799 (add-text-properties
7800 b e `(invisible org-filtered org-filter-type ,type)))))
7802 (defun org-agenda-remove-filter (type)
7804 "Remove filter of type TYPE from the agenda buffer."
7806 (goto-char (point-min))
7807 (let ((inhibit-read-only t) pos)
7808 (while (setq pos (text-property-any (point) (point-max) 'org-filter-type type))
7810 (remove-text-properties
7811 (point) (next-single-property-change (point) 'org-filter-type)
7812 `(invisible org-filtered org-filter-type ,type))))
7813 (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil)
7814 (setq org-agenda-filter-form nil)
7815 (org-agenda-set-mode-name)
7816 (org-agenda-finalize)))
7818 (defun org-agenda-filter-show-all-tag nil
7819 (org-agenda-remove-filter 'tag))
7820 (defun org-agenda-filter-show-all-re nil
7821 (org-agenda-remove-filter 'regexp))
7822 (defun org-agenda-filter-show-all-effort nil
7823 (org-agenda-remove-filter 'effort))
7824 (defun org-agenda-filter-show-all-cat nil
7825 (org-agenda-remove-filter 'category))
7826 (defun org-agenda-filter-show-all-top-filter nil
7827 (org-agenda-remove-filter 'top-headline))
7829 (defun org-agenda-manipulate-query-add ()
7830 "Manipulate the query by adding a search term with positive selection.
7831 Positive selection means the term must be matched for selection of an entry."
7833 (org-agenda-manipulate-query ?\[))
7834 (defun org-agenda-manipulate-query-subtract ()
7835 "Manipulate the query by adding a search term with negative selection.
7836 Negative selection means term must not be matched for selection of an entry."
7838 (org-agenda-manipulate-query ?\]))
7839 (defun org-agenda-manipulate-query-add-re ()
7840 "Manipulate the query by adding a search regexp with positive selection.
7841 Positive selection means the regexp must match for selection of an entry."
7843 (org-agenda-manipulate-query ?\{))
7844 (defun org-agenda-manipulate-query-subtract-re ()
7845 "Manipulate the query by adding a search regexp with negative selection.
7846 Negative selection means regexp must not match for selection of an entry."
7848 (org-agenda-manipulate-query ?\}))
7849 (defun org-agenda-manipulate-query (char)
7851 ((memq org-agenda-type '(timeline agenda))
7852 (let ((org-agenda-include-inactive-timestamps t))
7854 (message "Display now includes inactive timestamps as well"))
7855 ((eq org-agenda-type 'search)
7857 'org-agenda-query-string
7858 (if org-agenda-last-search-view-search-was-boolean
7859 (cdr (assoc char '((?\[ . " +") (?\] . " -")
7860 (?\{ . " +{}") (?\} . " -{}"))))
7862 (setq org-agenda-redo-command
7863 (list 'org-search-view
7864 (car (get-text-property (min (1- (point-max)) (point))
7866 org-agenda-query-string
7867 (+ (length org-agenda-query-string)
7868 (if (member char '(?\{ ?\})) 0 1))))
7869 (set-register org-agenda-query-register org-agenda-query-string)
7870 (let ((org-agenda-overriding-arguments
7871 (cdr org-agenda-redo-command)))
7873 (t (error "Cannot manipulate query for %s-type agenda buffers"
7876 (defun org-add-to-string (var string)
7877 (set var (concat (symbol-value var) string)))
7879 (defun org-agenda-goto-date (span)
7880 "Jump to DATE in agenda."
7882 (let* ((org-read-date-prefer-future
7883 (eval org-agenda-jump-prefer-future))
7884 (date (org-read-date))
7885 (day (time-to-days (org-time-string-to-time date)))
7886 (org-agenda-sticky-orig org-agenda-sticky)
7887 (org-agenda-buffer-tmp-name (buffer-name))
7888 (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
7889 (0-arg (or current-prefix-arg (car args)))
7890 (2-arg (nth 2 args))
7891 (with-hour-p (nth 4 org-agenda-redo-command))
7892 (newcmd (list 'org-agenda-list 0-arg date
7893 (org-agenda-span-to-ndays
7894 2-arg (org-time-string-to-absolute date))
7896 (newargs (cdr newcmd))
7897 (inhibit-read-only t)
7899 (if (not (org-agenda-check-type t 'agenda))
7900 (error "Not available in non-agenda views")
7901 (add-text-properties (point-min) (point-max)
7902 `(org-redo-cmd ,newcmd org-last-args ,newargs))
7904 (goto-char (point-min))
7905 (while (not (or (= (or (get-text-property (point) 'day) 0) day)
7906 (save-excursion (move-beginning-of-line 2) (eobp))))
7907 (move-beginning-of-line 2))
7908 (setq org-agenda-sticky org-agenda-sticky-orig
7909 org-agenda-this-buffer-is-sticky org-agenda-sticky))))
7911 (defun org-agenda-goto-today ()
7914 (org-agenda-check-type t 'timeline 'agenda)
7915 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
7916 (curspan (nth 2 args))
7917 (tdpos (text-property-any (point-min) (point-max) 'org-today t)))
7919 (tdpos (goto-char tdpos))
7920 ((eq org-agenda-type 'agenda)
7921 (let* ((sd (org-agenda-compute-starting-span
7922 (org-today) (or curspan org-agenda-span)))
7923 (org-agenda-overriding-arguments args))
7924 (setf (nth 1 org-agenda-overriding-arguments) sd)
7926 (org-agenda-find-same-or-today-or-agenda)))
7927 (t (error "Cannot find today")))))
7929 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
7931 (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
7932 (text-property-any (point-min) (point-max) 'org-today t)
7933 (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
7934 (and (get-text-property (min (1- (point-max)) (point)) 'org-series)
7935 (org-agenda-backward-block))
7938 (defun org-agenda-backward-block ()
7939 "Move backward by one agenda block."
7941 (org-agenda-forward-block 'backward))
7943 (defun org-agenda-forward-block (&optional backward)
7944 "Move forward by one agenda block.
7945 When optional argument BACKWARD is set, go backward"
7947 (cond ((not (derived-mode-p 'org-agenda-mode))
7949 "Cannot execute this command outside of org-agenda-mode buffers"))
7950 ((looking-at (if backward "\\`" "\\'"))
7951 (message "Already at the %s block" (if backward "first" "last")))
7952 (t (let ((pos (prog1 (point)
7953 (ignore-errors (if backward (backward-char 1)
7954 (move-end-of-line 1)))))
7956 'previous-single-property-change
7957 'next-single-property-change))
7959 (while (and (setq dest (funcall
7960 f (point) 'org-agenda-structural-header))
7961 (not (get-text-property
7962 (point) 'org-agenda-structural-header)))
7965 (if moved (move-beginning-of-line 1)
7966 (goto-char (if backward (point-min) (point-max)))
7967 (move-beginning-of-line 1)
7968 (message "No %s block" (if backward "previous" "further")))))))
7970 (defun org-agenda-later (arg)
7971 "Go forward in time by the current span.
7972 With prefix ARG, go forward that many times the current span."
7974 (org-agenda-check-type t 'agenda)
7975 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
7976 (span (or (nth 2 args) org-agenda-current-span))
7977 (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day))
7978 (greg (calendar-gregorian-from-absolute sd))
7979 (cnt (org-get-at-bol 'org-day-cnt))
7983 (setq sd (+ (* span arg) sd)))
7985 (setq sd (+ arg sd)))
7987 (setq sd (+ (* 7 arg) sd)))
7988 ((eq span 'fortnight)
7989 (setq sd (+ (* 14 arg) sd)))
7991 (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
7992 sd (calendar-absolute-from-gregorian greg2))
7993 (setcar greg2 (1+ (car greg2))))
7995 (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
7996 sd (calendar-absolute-from-gregorian greg2))
7997 (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
7999 (setq sd (+ (* span arg) sd))))
8000 (let ((org-agenda-overriding-cmd
8001 ;; `cmd' may have been set by `org-agenda-run-series' which
8002 ;; uses `org-agenda-overriding-cmd' to decide whether
8003 ;; overriding is allowed for `cmd'
8004 (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
8005 (org-agenda-overriding-arguments
8006 (list (car args) sd span)))
8008 (org-agenda-find-same-or-today-or-agenda cnt))))
8010 (defun org-agenda-earlier (arg)
8011 "Go backward in time by the current span.
8012 With prefix ARG, go backward that many times the current span."
8014 (org-agenda-later (- arg)))
8016 (defun org-agenda-view-mode-dispatch ()
8017 "Call one of the view mode commands."
8019 (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort
8020 time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
8021 [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
8022 (pcase (read-char-exclusive)
8023 (?\ (call-interactively 'org-agenda-reset-view))
8024 (?d (call-interactively 'org-agenda-day-view))
8025 (?w (call-interactively 'org-agenda-week-view))
8026 (?t (call-interactively 'org-agenda-fortnight-view))
8027 (?m (call-interactively 'org-agenda-month-view))
8028 (?y (call-interactively 'org-agenda-year-view))
8029 (?l (call-interactively 'org-agenda-log-mode))
8030 (?L (org-agenda-log-mode '(4)))
8031 (?c (org-agenda-log-mode 'clockcheck))
8032 ((or ?F ?f) (call-interactively 'org-agenda-follow-mode))
8033 (?a (call-interactively 'org-agenda-archives-mode))
8034 (?A (org-agenda-archives-mode 'files))
8035 ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode))
8036 ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode))
8037 (?G (call-interactively 'org-agenda-toggle-time-grid))
8038 (?D (call-interactively 'org-agenda-toggle-diary))
8039 (?\! (call-interactively 'org-agenda-toggle-deadlines))
8040 (?\[ (let ((org-agenda-include-inactive-timestamps t))
8041 (org-agenda-check-type t 'timeline 'agenda)
8043 (message "Display now includes inactive timestamps as well"))
8044 (?q (message "Abort"))
8045 (key (user-error "Invalid key: %s" key))))
8047 (defun org-agenda-reset-view ()
8048 "Switch to default view for agenda."
8050 (org-agenda-change-time-span org-agenda-span))
8052 (defun org-agenda-day-view (&optional day-of-month)
8053 "Switch to daily view for agenda.
8054 With argument DAY-OF-MONTH, switch to that day of the month."
8056 (org-agenda-change-time-span 'day day-of-month))
8058 (defun org-agenda-week-view (&optional iso-week)
8059 "Switch to weekly view for agenda.
8060 With argument ISO-WEEK, switch to the corresponding ISO week.
8061 If ISO-WEEK has more then 2 digits, only the last two encode
8062 the week. Any digits before this encode a year. So 200712
8063 means week 12 of year 2007. Years ranging from 70 years ago
8064 to 30 years in the future can also be written as 2-digit years."
8066 (org-agenda-change-time-span 'week iso-week))
8068 (defun org-agenda-fortnight-view (&optional iso-week)
8069 "Switch to fortnightly view for agenda.
8070 With argument ISO-WEEK, switch to the corresponding ISO week.
8071 If ISO-WEEK has more then 2 digits, only the last two encode
8072 the week. Any digits before this encode a year. So 200712
8073 means week 12 of year 2007. Years ranging from 70 years ago
8074 to 30 years in the future can also be written as 2-digit years."
8076 (org-agenda-change-time-span 'fortnight iso-week))
8078 (defun org-agenda-month-view (&optional month)
8079 "Switch to monthly view for agenda.
8080 With argument MONTH, switch to that month. If MONTH has more
8081 then 2 digits, only the last two encode the month. Any digits
8082 before this encode a year. So 200712 means December year 2007.
8083 Years ranging from 70 years ago to 30 years in the future can
8084 also be written as 2-digit years."
8086 (org-agenda-change-time-span 'month month))
8088 (defun org-agenda-year-view (&optional year)
8089 "Switch to yearly view for agenda.
8090 With argument YEAR, switch to that year. Years ranging from 70
8091 years ago to 30 years in the future can also be written as
8095 (setq year (org-small-year-to-year year)))
8096 (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ")
8097 (org-agenda-change-time-span 'year year)
8100 (defun org-agenda-change-time-span (span &optional n)
8101 "Change the agenda view to SPAN.
8102 SPAN may be `day', `week', `fortnight', `month', `year'."
8103 (org-agenda-check-type t 'agenda)
8104 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
8105 (curspan (nth 2 args)))
8106 (if (and (not n) (equal curspan span))
8107 (error "Viewing span is already \"%s\"" span))
8108 (let* ((sd (or (org-get-at-bol 'day)
8111 (sd (org-agenda-compute-starting-span sd span n))
8112 (org-agenda-overriding-cmd
8113 (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
8114 (org-agenda-overriding-arguments
8115 (list (car args) sd span)))
8117 (org-agenda-find-same-or-today-or-agenda))
8118 (org-agenda-set-mode-name)
8119 (message "Switched to %s view" span)))
8121 (defun org-agenda-compute-starting-span (sd span &optional n)
8122 "Compute starting date for agenda.
8123 SPAN may be `day', `week', `fortnight', `month', `year'. The return value
8124 is a cons cell with the starting date and the number of days,
8125 so that the date SD will be in that range."
8126 (let* ((greg (calendar-gregorian-from-absolute sd))
8133 (setq sd (+ (calendar-absolute-from-gregorian
8136 ((or (eq span 'week) (eq span 'fortnight))
8137 (let* ((nt (calendar-day-of-week
8138 (calendar-gregorian-from-absolute sd)))
8139 (d (if org-agenda-start-on-weekday
8140 (- nt org-agenda-start-on-weekday)
8143 (setq sd (- sd (+ (if (< d 0) 7 0) d)))
8147 (setq y1 (org-small-year-to-year (/ n 100))
8150 (calendar-iso-to-absolute
8152 (or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
8155 (when (and n (> n 99))
8156 (setq y1 (org-small-year-to-year (/ n 100))
8158 (setq sd (calendar-absolute-from-gregorian
8159 (list (or n mg) 1 (or y1 yg))))))
8161 (setq sd (calendar-absolute-from-gregorian
8162 (list 1 1 (or n yg))))))
8165 (defun org-agenda-next-date-line (&optional arg)
8166 "Jump to the next line indicating a date in agenda buffer."
8168 (org-agenda-check-type t 'agenda 'timeline)
8169 (beginning-of-line 1)
8170 ;; This does not work if user makes date format that starts with a blank
8171 (if (looking-at "^\\S-") (forward-char 1))
8172 (if (not (re-search-forward "^\\S-" nil t arg))
8175 (error "No next date after this line in this buffer")))
8176 (goto-char (match-beginning 0)))
8178 (defun org-agenda-previous-date-line (&optional arg)
8179 "Jump to the previous line indicating a date in agenda buffer."
8181 (org-agenda-check-type t 'agenda 'timeline)
8182 (beginning-of-line 1)
8183 (if (not (re-search-backward "^\\S-" nil t arg))
8184 (error "No previous date before this line in this buffer")))
8186 ;; Initialize the highlight
8187 (defvar org-hl (make-overlay 1 1))
8188 (overlay-put org-hl 'face 'highlight)
8190 (defun org-highlight (begin end &optional buffer)
8191 "Highlight a region with overlay."
8192 (move-overlay org-hl begin end (or buffer (current-buffer))))
8194 (defun org-unhighlight ()
8195 "Detach overlay INDEX."
8196 (delete-overlay org-hl))
8198 (defun org-unhighlight-once ()
8199 "Remove the highlight from its position, and this function from the hook."
8200 (remove-hook 'pre-command-hook 'org-unhighlight-once)
8203 (defvar org-agenda-pre-follow-window-conf nil)
8204 (defun org-agenda-follow-mode ()
8205 "Toggle follow mode in an agenda buffer."
8207 (unless org-agenda-follow-mode
8208 (setq org-agenda-pre-follow-window-conf
8209 (current-window-configuration)))
8210 (setq org-agenda-follow-mode (not org-agenda-follow-mode))
8211 (unless org-agenda-follow-mode
8212 (set-window-configuration org-agenda-pre-follow-window-conf))
8213 (org-agenda-set-mode-name)
8214 (org-agenda-do-context-action)
8215 (message "Follow mode is %s"
8216 (if org-agenda-follow-mode "on" "off")))
8218 (defun org-agenda-entry-text-mode (&optional arg)
8219 "Toggle entry text mode in an agenda buffer."
8221 (if (or org-agenda-tag-filter
8222 org-agenda-category-filter
8223 org-agenda-regexp-filter
8224 org-agenda-top-headline-filter)
8225 (user-error "Can't show entry text in filtered views")
8226 (setq org-agenda-entry-text-mode (or (integerp arg)
8227 (not org-agenda-entry-text-mode)))
8228 (org-agenda-entry-text-hide)
8229 (and org-agenda-entry-text-mode
8230 (let ((org-agenda-entry-text-maxlines
8231 (if (integerp arg) arg org-agenda-entry-text-maxlines)))
8232 (org-agenda-entry-text-show)))
8233 (org-agenda-set-mode-name)
8234 (message "Entry text mode is %s%s"
8235 (if org-agenda-entry-text-mode "on" "off")
8236 (if (not org-agenda-entry-text-mode) ""
8237 (format " (maximum number of lines is %d)"
8238 (if (integerp arg) arg org-agenda-entry-text-maxlines))))))
8240 (defun org-agenda-clockreport-mode ()
8241 "Toggle clocktable mode in an agenda buffer."
8243 (org-agenda-check-type t 'agenda)
8244 (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))
8245 (setq org-agenda-start-with-clockreport-mode org-agenda-clockreport-mode)
8246 (org-agenda-set-mode-name)
8248 (message "Clocktable mode is %s"
8249 (if org-agenda-clockreport-mode "on" "off")))
8251 (defun org-agenda-log-mode (&optional special)
8252 "Toggle log mode in an agenda buffer.
8254 With argument SPECIAL, show all possible log items, not only the ones
8255 configured in `org-agenda-log-mode-items'.
8257 With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
8258 log items, nothing else."
8260 (org-agenda-check-type t 'agenda 'timeline)
8261 (setq org-agenda-show-log
8263 ((equal special '(16)) 'only)
8264 ((eq special 'clockcheck)
8265 (if (eq org-agenda-show-log 'clockcheck)
8267 (special '(closed clock state))
8268 (t (not org-agenda-show-log))))
8269 (setq org-agenda-start-with-log-mode org-agenda-show-log)
8270 (org-agenda-set-mode-name)
8272 (message "Log mode is %s" (if org-agenda-show-log "on" "off")))
8274 (defun org-agenda-archives-mode (&optional with-files)
8275 "Toggle inclusion of items in trees marked with :ARCHIVE:.
8276 When called with a prefix argument, include all archive files as well."
8278 (setq org-agenda-archives-mode
8279 (if with-files t (if org-agenda-archives-mode nil 'trees)))
8280 (org-agenda-set-mode-name)
8285 ((eq org-agenda-archives-mode nil)
8286 "No archives are included")
8287 ((eq org-agenda-archives-mode 'trees)
8288 (format "Trees with :%s: tag are included" org-archive-tag))
8289 ((eq org-agenda-archives-mode t)
8290 (format "Trees with :%s: tag and all active archive files are included"
8291 org-archive-tag)))))
8293 (defun org-agenda-toggle-diary ()
8294 "Toggle diary inclusion in an agenda buffer."
8296 (org-agenda-check-type t 'agenda)
8297 (setq org-agenda-include-diary (not org-agenda-include-diary))
8299 (org-agenda-set-mode-name)
8300 (message "Diary inclusion turned %s"
8301 (if org-agenda-include-diary "on" "off")))
8303 (defun org-agenda-toggle-deadlines ()
8304 "Toggle inclusion of entries with a deadline in an agenda buffer."
8306 (org-agenda-check-type t 'agenda)
8307 (setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
8309 (org-agenda-set-mode-name)
8310 (message "Deadlines inclusion turned %s"
8311 (if org-agenda-include-deadlines "on" "off")))
8313 (defun org-agenda-toggle-time-grid ()
8314 "Toggle time grid in an agenda buffer."
8316 (org-agenda-check-type t 'agenda)
8317 (setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
8319 (org-agenda-set-mode-name)
8320 (message "Time-grid turned %s"
8321 (if org-agenda-use-time-grid "on" "off")))
8323 (defun org-agenda-set-mode-name ()
8324 "Set the mode name to indicate all the small mode settings."
8327 (if (get 'org-agenda-files 'org-restrict) " []" "")
8329 '(:eval (org-agenda-span-name org-agenda-current-span))
8330 (if org-agenda-follow-mode " Follow" "")
8331 (if org-agenda-entry-text-mode " ETxt" "")
8332 (if org-agenda-include-diary " Diary" "")
8333 (if org-agenda-include-deadlines " Ddl" "")
8334 (if org-agenda-use-time-grid " Grid" "")
8335 (if (and (boundp 'org-habit-show-habits)
8336 org-habit-show-habits) " Habit" "")
8338 ((consp org-agenda-show-log) " LogAll")
8339 ((eq org-agenda-show-log 'clockcheck) " ClkCk")
8340 (org-agenda-show-log " Log")
8342 (if (or org-agenda-category-filter
8343 (get 'org-agenda-category-filter :preset-filter))
8349 (get 'org-agenda-category-filter :preset-filter)
8350 org-agenda-category-filter)
8353 'face 'org-agenda-filter-category
8354 'help-echo "Category used in filtering")) "")
8355 (if (or org-agenda-tag-filter
8356 (get 'org-agenda-tag-filter :preset-filter))
8362 (get 'org-agenda-tag-filter :preset-filter)
8363 org-agenda-tag-filter)
8366 'face 'org-agenda-filter-tags
8367 'help-echo "Tags used in filtering")) "")
8368 (if (or org-agenda-effort-filter
8369 (get 'org-agenda-effort-filter :preset-filter))
8375 (get 'org-agenda-effort-filter :preset-filter)
8376 org-agenda-effort-filter)
8379 'face 'org-agenda-filter-effort
8380 'help-echo "Effort conditions used in filtering")) "")
8381 (if (or org-agenda-regexp-filter
8382 (get 'org-agenda-regexp-filter :preset-filter))
8388 (get 'org-agenda-regexp-filter :preset-filter)
8389 org-agenda-regexp-filter)
8392 'face 'org-agenda-filter-regexp
8393 'help-echo "Regexp used in filtering")) "")
8394 (if org-agenda-archives-mode
8395 (if (eq org-agenda-archives-mode t)
8397 (format " :%s:" org-archive-tag))
8399 (if org-agenda-clockreport-mode " Clock" "")))
8400 (force-mode-line-update))
8402 (defun org-agenda-update-agenda-type ()
8403 "Update the agenda type after each command."
8404 (setq org-agenda-type
8405 (or (get-text-property (point) 'org-agenda-type)
8406 (get-text-property (max (point-min) (1- (point))) 'org-agenda-type))))
8408 (defun org-agenda-next-line ()
8409 "Move cursor to the next line, and show if follow mode is active."
8411 (call-interactively 'next-line)
8412 (org-agenda-do-context-action))
8414 (defun org-agenda-previous-line ()
8415 "Move cursor to the previous line, and show if follow-mode is active."
8417 (call-interactively 'previous-line)
8418 (org-agenda-do-context-action))
8420 (defun org-agenda-next-item (n)
8421 "Move cursor to next agenda item."
8423 (let ((col (current-column)))
8425 (when (next-single-property-change (point-at-eol) 'org-marker)
8426 (move-end-of-line 1)
8427 (goto-char (next-single-property-change (point) 'org-marker))))
8428 (org-move-to-column col))
8429 (org-agenda-do-context-action))
8431 (defun org-agenda-previous-item (n)
8432 "Move cursor to next agenda item."
8435 (let ((col (current-column))
8436 (goto (save-excursion
8437 (move-end-of-line 0)
8438 (previous-single-property-change (point) 'org-marker))))
8439 (if goto (goto-char goto))
8440 (org-move-to-column col)))
8441 (org-agenda-do-context-action))
8443 (defun org-agenda-do-context-action ()
8444 "Show outline path and, maybe, follow mode window."
8445 (let ((m (org-get-at-bol 'org-marker)))
8446 (when (and (markerp m) (marker-buffer m))
8447 (and org-agenda-follow-mode
8448 (if org-agenda-follow-indirect
8449 (org-agenda-tree-to-indirect-buffer nil)
8451 (and org-agenda-show-outline-path
8452 (org-with-point-at m (org-display-outline-path t))))))
8454 (defun org-agenda-show-tags ()
8455 "Show the tags applicable to the current item."
8457 (let* ((tags (org-get-at-bol 'tags)))
8459 (message "Tags are :%s:"
8460 (org-no-properties (mapconcat 'identity tags ":")))
8461 (message "No tags associated with this line"))))
8463 (defun org-agenda-goto (&optional highlight)
8464 "Go to the entry at point in the corresponding Org file."
8466 (let* ((marker (or (org-get-at-bol 'org-marker)
8467 (org-agenda-error)))
8468 (buffer (marker-buffer marker))
8469 (pos (marker-position marker)))
8470 (switch-to-buffer-other-window buffer)
8474 (when (derived-mode-p 'org-mode)
8475 (org-show-context 'agenda)
8476 (recenter (/ (window-height) 2))
8477 (org-back-to-heading t)
8478 (let ((case-fold-search nil))
8479 (when (re-search-forward org-complex-heading-regexp nil t)
8480 (goto-char (match-beginning 4)))))
8481 (run-hooks 'org-agenda-after-show-hook)
8482 (and highlight (org-highlight (point-at-bol) (point-at-eol)))))
8484 (defvar org-agenda-after-show-hook nil
8485 "Normal hook run after an item has been shown from the agenda.
8486 Point is in the buffer where the item originated.")
8488 (defun org-agenda-kill ()
8489 "Kill the entry or subtree belonging to the current agenda entry."
8491 (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
8492 (let* ((bufname-orig (buffer-name))
8493 (marker (or (org-get-at-bol 'org-marker)
8494 (org-agenda-error)))
8495 (buffer (marker-buffer marker))
8496 (pos (marker-position marker))
8497 (type (org-get-at-bol 'type))
8498 dbeg dend (n 0) conf)
8499 (org-with-remote-undo buffer
8500 (with-current-buffer buffer
8503 (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
8504 (setq dbeg (progn (org-back-to-heading t) (point))
8505 dend (org-end-of-subtree t t))
8506 (setq dbeg (point-at-bol)
8507 dend (min (point-max) (1+ (point-at-eol)))))
8509 (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
8510 (setq conf (or (eq t org-agenda-confirm-kill)
8511 (and (numberp org-agenda-confirm-kill)
8512 (> n org-agenda-confirm-kill))))
8515 (format "Delete entry with %d lines in buffer \"%s\"? "
8516 n (buffer-name buffer))))
8518 (let ((org-agenda-buffer-name bufname-orig))
8519 (org-remove-subtree-entries-from-agenda buffer dbeg dend))
8520 (with-current-buffer buffer (delete-region dbeg dend))
8521 (message "Agenda item and source killed"))))
8523 (defvar org-archive-default-command) ; defined in org-archive.el
8524 (defun org-agenda-archive-default ()
8525 "Archive the entry or subtree belonging to the current agenda entry."
8527 (require 'org-archive)
8528 (org-agenda-archive-with org-archive-default-command))
8530 (defun org-agenda-archive-default-with-confirmation ()
8531 "Archive the entry or subtree belonging to the current agenda entry."
8533 (require 'org-archive)
8534 (org-agenda-archive-with org-archive-default-command 'confirm))
8536 (defun org-agenda-archive ()
8537 "Archive the entry or subtree belonging to the current agenda entry."
8539 (org-agenda-archive-with 'org-archive-subtree))
8541 (defun org-agenda-archive-to-archive-sibling ()
8542 "Move the entry to the archive sibling."
8544 (org-agenda-archive-with 'org-archive-to-archive-sibling))
8546 (defun org-agenda-archive-with (cmd &optional confirm)
8547 "Move the entry to the archive sibling."
8549 (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
8550 (let* ((bufname-orig (buffer-name))
8551 (marker (or (org-get-at-bol 'org-marker)
8552 (org-agenda-error)))
8553 (buffer (marker-buffer marker))
8554 (pos (marker-position marker)))
8555 (org-with-remote-undo buffer
8556 (with-current-buffer buffer
8557 (if (derived-mode-p 'org-mode)
8559 (not (y-or-n-p "Archive this subtree or entry? ")))
8561 (save-window-excursion
8563 (let ((org-agenda-buffer-name bufname-orig))
8564 (org-remove-subtree-entries-from-agenda))
8565 (org-back-to-heading t)
8567 (error "Archiving works only in Org files"))))))
8569 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
8570 "Remove all lines in the agenda that correspond to a given subtree.
8571 The subtree is the one in buffer BUF, starting at BEG and ending at END.
8572 If this information is not given, the function uses the tree at point."
8573 (let ((buf (or buf (current-buffer))) m p)
8575 (unless (and beg end)
8576 (org-back-to-heading t)
8578 (org-end-of-subtree t)
8580 (set-buffer (get-buffer org-agenda-buffer-name))
8582 (goto-char (point-max))
8583 (beginning-of-line 1)
8585 (when (and (setq m (org-get-at-bol 'org-marker))
8586 (equal buf (marker-buffer m))
8587 (setq p (marker-position m))
8590 (let ((inhibit-read-only t))
8591 (delete-region (point-at-bol) (1+ (point-at-eol)))))
8592 (beginning-of-line 0))))))
8594 (defun org-agenda-refile (&optional goto rfloc no-update)
8595 "Refile the item at point.
8597 When called with `\\[universal-argument] \\[universal-argument]', \
8598 go to the location of the last
8601 When called with `\\[universal-argument] \\[universal-argument] \
8602 \\[universal-argument]' prefix or when GOTO is 0, clear
8605 RFLOC can be a refile location obtained in a different way.
8607 When NO-UPDATE is non-nil, don't redo the agenda buffer."
8610 ((member goto '(0 (64)))
8611 (org-refile-cache-clear))
8613 (org-refile-goto-last-stored))
8615 (let* ((buffer-orig (buffer-name))
8616 (marker (or (org-get-at-bol 'org-hd-marker)
8617 (org-agenda-error)))
8618 (buffer (marker-buffer marker))
8619 (pos (marker-position marker))
8621 (org-refile-get-location
8622 (if goto "Goto" "Refile to") buffer
8623 org-refile-allow-creating-parent-nodes))))
8624 (with-current-buffer buffer
8625 (org-with-wide-buffer
8627 (let ((org-agenda-buffer-name buffer-orig))
8628 (org-remove-subtree-entries-from-agenda))
8629 (org-refile goto buffer rfloc))))
8630 (unless no-update (org-agenda-redo)))))
8632 (defun org-agenda-open-link (&optional arg)
8633 "Open the link(s) in the current entry, if any.
8634 This looks for a link in the displayed line in the agenda.
8635 It also looks at the text of the entry itself."
8637 (let* ((marker (or (org-get-at-bol 'org-hd-marker)
8638 (org-get-at-bol 'org-marker)))
8639 (buffer (and marker (marker-buffer marker)))
8640 (prefix (buffer-substring (point-at-bol) (point-at-eol)))
8641 (lkall (and buffer (org-offer-links-in-entry
8642 buffer marker arg prefix)))
8644 (lk (if (stringp lk0) (list lk0) lk0))
8650 (with-current-buffer buffer
8651 (setq trg (and (string-match org-bracket-link-regexp l)
8652 (match-string 1 l)))
8653 (if (or (not trg) (string-match org-any-link-re trg))
8654 (org-with-wide-buffer
8656 (when (search-forward l nil lkend)
8657 (goto-char (match-beginning 0))
8658 (org-open-at-point)))
8659 ;; This is an internal link, widen the buffer
8660 (switch-to-buffer-other-window buffer)
8663 (when (search-forward l nil lkend)
8664 (goto-char (match-beginning 0))
8665 (org-open-at-point)))))
8667 ((or (org-in-regexp (concat "\\(" org-bracket-link-regexp "\\)"))
8669 (beginning-of-line 1)
8670 (looking-at (concat ".*?\\(" org-bracket-link-regexp "\\)"))))
8671 (org-open-link-from-string (match-string 1)))
8672 (t (message "No link to open here")))))
8674 (defun org-agenda-copy-local-variable (var)
8675 "Get a variable from a referenced buffer and install it here."
8676 (let ((m (org-get-at-bol 'org-marker)))
8677 (when (and m (buffer-live-p (marker-buffer m)))
8678 (set (make-local-variable var)
8679 (with-current-buffer (marker-buffer m)
8680 (symbol-value var))))))
8682 (defun org-agenda-switch-to (&optional delete-other-windows)
8683 "Go to the Org mode file which contains the item at point.
8684 When optional argument DELETE-OTHER-WINDOWS is non-nil, the
8685 displayed Org file fills the frame."
8687 (if (and org-return-follows-link
8688 (not (org-get-at-bol 'org-marker))
8689 (org-in-regexp org-bracket-link-regexp))
8690 (org-open-link-from-string (match-string 0))
8691 (let* ((marker (or (org-get-at-bol 'org-marker)
8692 (org-agenda-error)))
8693 (buffer (marker-buffer marker))
8694 (pos (marker-position marker)))
8695 (unless buffer (user-error "Trying to switch to non-existent buffer"))
8696 (pop-to-buffer-same-window buffer)
8697 (when delete-other-windows (delete-other-windows))
8700 (when (derived-mode-p 'org-mode)
8701 (org-show-context 'agenda)
8702 (run-hooks 'org-agenda-after-show-hook)))))
8704 (defun org-agenda-goto-mouse (ev)
8705 "Go to the Org file which contains the item at the mouse click."
8707 (mouse-set-point ev)
8710 (defun org-agenda-show (&optional full-entry)
8711 "Display the Org file which contains the item at point.
8712 With prefix argument FULL-ENTRY, make the entire entry visible
8713 if it was hidden in the outline."
8715 (let ((win (selected-window)))
8717 (when full-entry (org-show-entry))
8718 (select-window win)))
8720 (defvar org-agenda-show-window nil)
8721 (defun org-agenda-show-and-scroll-up (&optional arg)
8722 "Display the Org file which contains the item at point.
8724 When called repeatedly, scroll the window that is displaying the buffer.
8726 With a `\\[universal-argument]' prefix, use `org-show-entry' instead of \
8727 `outline-show-subtree'
8728 to display the item, so that drawers and logbooks stay folded."
8730 (let ((win (selected-window)))
8731 (if (and (window-live-p org-agenda-show-window)
8732 (eq this-command last-command))
8734 (select-window org-agenda-show-window)
8735 (ignore-errors (scroll-up)))
8737 (if arg (org-show-entry) (outline-show-subtree))
8738 (setq org-agenda-show-window (selected-window)))
8739 (select-window win)))
8741 (defun org-agenda-show-scroll-down ()
8742 "Scroll down the window showing the agenda."
8744 (let ((win (selected-window)))
8745 (when (window-live-p org-agenda-show-window)
8746 (select-window org-agenda-show-window)
8747 (ignore-errors (scroll-down))
8748 (select-window win))))
8750 (defun org-agenda-show-1 (&optional more)
8751 "Display the Org file which contains the item at point.
8752 The prefix arg selects the amount of information to display:
8755 1 just show the entry according to defaults.
8756 2 show the children view
8757 3 show the subtree view
8758 4 show the entire subtree and any LOGBOOK drawers
8759 5 show the entire subtree and any drawers
8760 With prefix argument FULL-ENTRY, make the entire entry visible
8761 if it was hidden in the outline."
8763 (let ((win (selected-window)))
8765 (org-back-to-heading)
8766 (set-window-start (selected-window) (point-at-bol))
8769 (outline-hide-subtree)
8771 (org-back-to-heading)
8772 (run-hook-with-args 'org-cycle-hook 'folded))
8773 (message "Remote: FOLDED"))
8774 ((and (called-interactively-p 'any) (= more 1))
8775 (message "Remote: show with default settings"))
8777 (outline-show-entry)
8780 (org-back-to-heading)
8781 (run-hook-with-args 'org-cycle-hook 'children))
8782 (message "Remote: CHILDREN"))
8784 (outline-show-subtree)
8786 (org-back-to-heading)
8787 (run-hook-with-args 'org-cycle-hook 'subtree))
8788 (message "Remote: SUBTREE"))
8790 (outline-show-subtree)
8792 (org-back-to-heading)
8793 (org-cycle-hide-drawers 'subtree '("LOGBOOK")))
8794 (message "Remote: SUBTREE AND LOGBOOK"))
8796 (outline-show-subtree)
8797 (message "Remote: SUBTREE AND ALL DRAWERS")))
8798 (select-window win)))
8800 (defvar org-agenda-cycle-counter nil)
8801 (defun org-agenda-cycle-show (&optional n)
8802 "Show the current entry in another window, with default settings.
8804 Default settings are taken from `org-show-context-detail'. When
8805 use repeatedly in immediate succession, the remote entry will
8806 cycle through visibility
8808 children -> subtree -> folded
8810 When called with a numeric prefix arg, that arg will be passed through to
8811 `org-agenda-show-1'. For the interpretation of that argument, see the
8812 docstring of `org-agenda-show-1'."
8815 (setq org-agenda-cycle-counter n)
8816 (if (not (eq last-command this-command))
8817 (setq org-agenda-cycle-counter 1)
8818 (if (equal org-agenda-cycle-counter 0)
8819 (setq org-agenda-cycle-counter 2)
8820 (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter))
8821 (if (> org-agenda-cycle-counter 3)
8822 (setq org-agenda-cycle-counter 0)))))
8823 (org-agenda-show-1 org-agenda-cycle-counter))
8825 (defun org-agenda-recenter (arg)
8826 "Display the Org file which contains the item at point and recenter."
8828 (let ((win (selected-window)))
8831 (select-window win)))
8833 (defun org-agenda-show-mouse (ev)
8834 "Display the Org file which contains the item at the mouse click."
8836 (mouse-set-point ev)
8839 (defun org-agenda-check-no-diary ()
8840 "Check if the entry is a diary link and abort if yes."
8841 (if (org-get-at-bol 'org-agenda-diary-link)
8842 (org-agenda-error)))
8844 (defun org-agenda-error ()
8845 "Throw an error when a command is not allowed in the agenda."
8846 (user-error "Command not allowed in this line"))
8848 (defun org-agenda-tree-to-indirect-buffer (arg)
8849 "Show the subtree corresponding to the current entry in an indirect buffer.
8850 This calls the command `org-tree-to-indirect-buffer' from the original buffer.
8852 With a numerical prefix ARG, go up to this level and then take that tree.
8853 With a negative numeric ARG, go up by this number of levels.
8855 With a `\\[universal-argument]' prefix, make a separate frame for this tree, \
8857 the dedicated frame."
8859 (if current-prefix-arg
8860 (org-agenda-do-tree-to-indirect-buffer arg)
8861 (let ((agenda-buffer (buffer-name))
8862 (agenda-window (selected-window))
8864 (and org-last-indirect-buffer
8865 (get-buffer-window org-last-indirect-buffer))))
8866 (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg))
8867 (unless (or (eq org-indirect-buffer-display 'new-frame)
8868 (eq org-indirect-buffer-display 'dedicated-frame))
8870 (unless (and indirect-window (window-live-p indirect-window))
8871 (setq indirect-window (split-window agenda-window)))
8872 (and indirect-window (select-window indirect-window))
8873 (switch-to-buffer org-last-indirect-buffer :norecord)
8874 (fit-window-to-buffer indirect-window)))
8875 (select-window (get-buffer-window agenda-buffer))
8876 (setq org-agenda-last-indirect-buffer org-last-indirect-buffer))))
8878 (defun org-agenda-do-tree-to-indirect-buffer (arg)
8879 "Same as `org-agenda-tree-to-indirect-buffer' without saving window."
8880 (org-agenda-check-no-diary)
8881 (let* ((marker (or (org-get-at-bol 'org-marker)
8882 (org-agenda-error)))
8883 (buffer (marker-buffer marker))
8884 (pos (marker-position marker)))
8885 (with-current-buffer buffer
8888 (funcall 'org-tree-to-indirect-buffer arg)))))
8890 (defvar org-last-heading-marker (make-marker)
8891 "Marker pointing to the headline that last changed its TODO state
8892 by a remote command from the agenda.")
8894 (defun org-agenda-todo-nextset ()
8895 "Switch TODO entry to next sequence."
8897 (org-agenda-todo 'nextset))
8899 (defun org-agenda-todo-previousset ()
8900 "Switch TODO entry to previous sequence."
8902 (org-agenda-todo 'previousset))
8904 (defun org-agenda-todo (&optional arg)
8905 "Cycle TODO state of line at point, also in Org file.
8906 This changes the line at point, all other lines in the agenda referring to
8907 the same tree node, and the headline of the tree node in the Org file."
8909 (org-agenda-check-no-diary)
8910 (let* ((col (current-column))
8911 (marker (or (org-get-at-bol 'org-marker)
8912 (org-agenda-error)))
8913 (buffer (marker-buffer marker))
8914 (pos (marker-position marker))
8915 (hdmarker (org-get-at-bol 'org-hd-marker))
8916 (todayp (org-agenda-today-p (org-get-at-bol 'day)))
8917 (inhibit-read-only t)
8918 org-agenda-headline-snapshot-before-repeat newhead just-one)
8919 (org-with-remote-undo buffer
8920 (with-current-buffer buffer
8923 (org-show-context 'agenda)
8924 (let ((current-prefix-arg arg))
8925 (call-interactively 'org-todo))
8926 (and (bolp) (forward-char 1))
8927 (setq newhead (org-get-heading))
8928 (when (and (bound-and-true-p
8929 org-agenda-headline-snapshot-before-repeat)
8930 (not (equal org-agenda-headline-snapshot-before-repeat
8933 (setq newhead org-agenda-headline-snapshot-before-repeat
8936 (org-back-to-heading)
8937 (move-marker org-last-heading-marker (point))))
8938 (beginning-of-line 1)
8939 (save-window-excursion
8940 (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
8941 (when (bound-and-true-p org-clock-out-when-done)
8942 (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
8944 (org-agenda-unmark-clocking-task))
8945 (org-move-to-column col)
8946 (org-agenda-mark-clocking-task))))
8948 (defun org-agenda-add-note (&optional arg)
8949 "Add a time-stamped note to the entry at point."
8951 (org-agenda-check-no-diary)
8952 (let* ((marker (or (org-get-at-bol 'org-marker)
8953 (org-agenda-error)))
8954 (buffer (marker-buffer marker))
8955 (pos (marker-position marker))
8956 (hdmarker (org-get-at-bol 'org-hd-marker))
8957 (inhibit-read-only t))
8958 (with-current-buffer buffer
8961 (org-show-context 'agenda)
8964 (defun org-agenda-change-all-lines (newhead hdmarker
8965 &optional fixface just-this)
8966 "Change all lines in the agenda buffer which match HDMARKER.
8967 The new content of the line will be NEWHEAD (as modified by
8968 `org-agenda-format-item'). HDMARKER is checked with
8969 `equal' against all `org-hd-marker' text properties in the file.
8970 If FIXFACE is non-nil, the face of each item is modified according to
8972 If JUST-THIS is non-nil, change just the current line, not all.
8973 If FORCE-TAGS is non nil, the car of it returns the new tags."
8974 (let* ((inhibit-read-only t)
8975 (line (org-current-line))
8976 (org-agenda-buffer (current-buffer))
8977 (thetags (with-current-buffer (marker-buffer hdmarker)
8978 (org-with-wide-buffer
8979 (goto-char hdmarker)
8980 (org-get-tags-at))))
8981 props m pl undone-face done-face finish new dotime level cat tags)
8983 (goto-char (point-max))
8984 (beginning-of-line 1)
8986 (setq finish (bobp))
8987 (when (and (setq m (org-get-at-bol 'org-hd-marker))
8988 (or (not just-this) (= (org-current-line) line))
8990 (setq props (text-properties-at (point))
8991 dotime (org-get-at-bol 'dotime)
8992 cat (org-get-at-eol 'org-category 1)
8993 level (org-get-at-bol 'level)
8996 (let ((org-prefix-format-compiled
8997 (or (get-text-property (min (1- (point-max)) (point)) 'format)
8998 org-prefix-format-compiled))
8999 (extra (org-get-at-bol 'extra)))
9000 (with-current-buffer (marker-buffer hdmarker)
9001 (org-with-wide-buffer
9002 (org-agenda-format-item extra newhead level cat tags dotime))))
9003 pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
9004 undone-face (org-get-at-bol 'undone-face)
9005 done-face (org-get-at-bol 'done-face))
9006 (beginning-of-line 1)
9008 ((equal new "") (delete-region (point) (line-beginning-position 2)))
9010 ;; When replacing the whole line, preserve bulk mark
9012 (let ((mark (catch :overlay
9013 (dolist (o (overlays-in (point) (+ 2 (point))))
9014 (when (eq (overlay-get o 'type)
9015 'org-marked-entry-overlay)
9016 (throw :overlay o))))))
9017 (replace-match new t t)
9019 (when mark (move-overlay mark (point) (+ 2 (point)))))
9020 (add-text-properties (point-at-bol) (point-at-eol) props)
9022 (add-text-properties
9023 (point-at-bol) (point-at-eol)
9025 (if org-last-todo-state-is-todo
9026 undone-face done-face))))
9027 (org-agenda-highlight-todo 'line)
9028 (beginning-of-line 1))
9029 (t (error "Line update did not work")))
9031 (narrow-to-region (point-at-bol) (point-at-eol))
9032 (org-agenda-finalize)))
9033 (beginning-of-line 0)))))
9035 (defun org-agenda-align-tags (&optional line)
9036 "Align all tags in agenda items to `org-agenda-tags-column'."
9037 (let ((inhibit-read-only t) l c)
9039 (goto-char (if line (point-at-bol) (point-min)))
9040 (while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
9041 (if line (point-at-eol) nil) t)
9042 (add-text-properties
9043 (match-beginning 2) (match-end 2)
9044 (list 'face (delq nil (let ((prop (get-text-property
9045 (match-beginning 2) 'face)))
9046 (or (listp prop) (setq prop (list prop)))
9047 (if (memq 'org-tag prop)
9049 (cons 'org-tag prop))))))
9050 (setq l (- (match-end 2) (match-beginning 2))
9051 c (if (< org-agenda-tags-column 0)
9052 (- (abs org-agenda-tags-column) l)
9053 org-agenda-tags-column))
9054 (delete-region (match-beginning 1) (match-end 1))
9055 (goto-char (match-beginning 1))
9056 (insert (org-add-props
9057 (make-string (max 1 (- c (current-column))) ?\ )
9058 (plist-put (copy-sequence (text-properties-at (point)))
9060 (goto-char (point-min))
9061 (org-font-lock-add-tag-faces (point-max)))))
9063 (defun org-agenda-priority-up ()
9064 "Increase the priority of line at point, also in Org file."
9066 (org-agenda-priority 'up))
9068 (defun org-agenda-priority-down ()
9069 "Decrease the priority of line at point, also in Org file."
9071 (org-agenda-priority 'down))
9073 (defun org-agenda-priority (&optional force-direction)
9074 "Set the priority of line at point, also in Org file.
9075 This changes the line at point, all other lines in the agenda referring to
9076 the same tree node, and the headline of the tree node in the Org file.
9077 Called with a universal prefix arg, show the priority instead of setting it."
9079 (if (equal force-direction '(4))
9081 (unless org-enable-priority-commands
9082 (error "Priority commands are disabled"))
9083 (org-agenda-check-no-diary)
9084 (let* ((col (current-column))
9085 (marker (or (org-get-at-bol 'org-marker)
9086 (org-agenda-error)))
9087 (hdmarker (org-get-at-bol 'org-hd-marker))
9088 (buffer (marker-buffer hdmarker))
9089 (pos (marker-position hdmarker))
9090 (inhibit-read-only t)
9092 (org-with-remote-undo buffer
9093 (with-current-buffer buffer
9096 (org-show-context 'agenda)
9097 (funcall 'org-priority force-direction)
9099 (setq newhead (org-get-heading)))
9100 (org-agenda-change-all-lines newhead hdmarker)
9101 (org-move-to-column col)))))
9103 ;; FIXME: should fix the tags property of the agenda line.
9104 (defun org-agenda-set-tags (&optional tag onoff)
9105 "Set tags for the current headline."
9107 (org-agenda-check-no-diary)
9108 (if (and (org-region-active-p) (called-interactively-p 'any))
9109 (call-interactively 'org-change-tag-in-region)
9110 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
9111 (org-agenda-error)))
9112 (buffer (marker-buffer hdmarker))
9113 (pos (marker-position hdmarker))
9114 (inhibit-read-only t)
9116 (org-with-remote-undo buffer
9117 (with-current-buffer buffer
9120 (org-show-context 'agenda)
9122 (org-toggle-tag tag onoff)
9123 (call-interactively 'org-set-tags))
9125 (setq newhead (org-get-heading)))
9126 (org-agenda-change-all-lines newhead hdmarker)
9127 (beginning-of-line 1)))))
9129 (defun org-agenda-set-property ()
9130 "Set a property for the current headline."
9132 (org-agenda-check-no-diary)
9133 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
9134 (org-agenda-error)))
9135 (buffer (marker-buffer hdmarker))
9136 (pos (marker-position hdmarker))
9137 (inhibit-read-only t)
9139 (org-with-remote-undo buffer
9140 (with-current-buffer buffer
9143 (org-show-context 'agenda)
9144 (call-interactively 'org-set-property)))))
9146 (defun org-agenda-set-effort ()
9147 "Set the effort property for the current headline."
9149 (org-agenda-check-no-diary)
9150 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
9151 (org-agenda-error)))
9152 (buffer (marker-buffer hdmarker))
9153 (pos (marker-position hdmarker))
9154 (inhibit-read-only t)
9156 (org-with-remote-undo buffer
9157 (with-current-buffer buffer
9160 (org-show-context 'agenda)
9161 (call-interactively 'org-set-effort)
9163 (setq newhead (org-get-heading)))
9164 (org-agenda-change-all-lines newhead hdmarker))))
9166 (defun org-agenda-toggle-archive-tag ()
9167 "Toggle the archive tag for the current entry."
9169 (org-agenda-check-no-diary)
9170 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
9171 (org-agenda-error)))
9172 (buffer (marker-buffer hdmarker))
9173 (pos (marker-position hdmarker))
9174 (inhibit-read-only t)
9176 (org-with-remote-undo buffer
9177 (with-current-buffer buffer
9180 (org-show-context 'agenda)
9181 (call-interactively 'org-toggle-archive-tag)
9183 (setq newhead (org-get-heading)))
9184 (org-agenda-change-all-lines newhead hdmarker)
9185 (beginning-of-line 1))))
9187 (defun org-agenda-do-date-later (arg)
9190 ((or (equal arg '(16))
9192 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
9193 (setq this-command 'org-agenda-date-later-minutes)
9194 (org-agenda-date-later-minutes 1))
9195 ((or (equal arg '(4))
9197 '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
9198 (setq this-command 'org-agenda-date-later-hours)
9199 (org-agenda-date-later-hours 1))
9201 (org-agenda-date-later (prefix-numeric-value arg)))))
9203 (defun org-agenda-do-date-earlier (arg)
9206 ((or (equal arg '(16))
9208 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
9209 (setq this-command 'org-agenda-date-earlier-minutes)
9210 (org-agenda-date-earlier-minutes 1))
9211 ((or (equal arg '(4))
9213 '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
9214 (setq this-command 'org-agenda-date-earlier-hours)
9215 (org-agenda-date-earlier-hours 1))
9217 (org-agenda-date-earlier (prefix-numeric-value arg)))))
9219 (defun org-agenda-date-later (arg &optional what)
9220 "Change the date of this item to ARG day(s) later."
9222 (org-agenda-check-type t 'agenda 'timeline)
9223 (org-agenda-check-no-diary)
9224 (let* ((marker (or (org-get-at-bol 'org-marker)
9225 (org-agenda-error)))
9226 (buffer (marker-buffer marker))
9227 (pos (marker-position marker))
9229 (org-with-remote-undo buffer
9230 (with-current-buffer buffer
9233 (if (not (org-at-timestamp-p))
9234 (error "Cannot find time stamp"))
9235 (when (and org-agenda-move-date-from-past-immediately-to-today
9237 (or (not what) (eq what 'day))
9238 (not (save-match-data (org-at-date-range-p))))
9239 (setq cdate (org-parse-time-string (match-string 0) 'nodefault)
9240 cdate (calendar-absolute-from-gregorian
9241 (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
9244 ;; immediately shift to today
9245 (setq arg (- today cdate))))
9246 (org-timestamp-change arg (or what 'day))
9247 (when (and (org-at-date-range-p)
9248 (re-search-backward org-tr-regexp-both (point-at-bol)))
9249 (let ((end org-last-changed-timestamp))
9250 (org-timestamp-change arg (or what 'day))
9251 (setq org-last-changed-timestamp
9252 (concat org-last-changed-timestamp "--" end)))))
9253 (org-agenda-show-new-time marker org-last-changed-timestamp))
9254 (message "Time stamp changed to %s" org-last-changed-timestamp)))
9256 (defun org-agenda-date-earlier (arg &optional what)
9257 "Change the date of this item to ARG day(s) earlier."
9259 (org-agenda-date-later (- arg) what))
9261 (defun org-agenda-date-later-minutes (arg)
9262 "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
9264 (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
9265 (org-agenda-date-later arg 'minute))
9267 (defun org-agenda-date-earlier-minutes (arg)
9268 "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
9270 (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
9271 (org-agenda-date-earlier arg 'minute))
9273 (defun org-agenda-date-later-hours (arg)
9274 "Change the time of this item, in hour steps."
9276 (org-agenda-date-later arg 'hour))
9278 (defun org-agenda-date-earlier-hours (arg)
9279 "Change the time of this item, in hour steps."
9281 (org-agenda-date-earlier arg 'hour))
9283 (defun org-agenda-show-new-time (marker stamp &optional prefix)
9284 "Show new date stamp via text properties."
9285 ;; We use text properties to make this undoable
9286 (let ((inhibit-read-only t))
9287 (setq stamp (concat prefix " => " stamp " "))
9289 (goto-char (point-max))
9291 (when (equal marker (org-get-at-bol 'org-marker))
9292 (remove-text-properties (point-at-bol) (point-at-eol) '(display))
9293 (org-move-to-column (- (window-width) (length stamp)) t)
9294 (add-text-properties
9295 (1- (point)) (point-at-eol)
9296 (list 'display (org-add-props stamp nil
9297 'face '(secondary-selection default))))
9298 (beginning-of-line 1))
9299 (beginning-of-line 0)))))
9301 (defun org-agenda-date-prompt (arg)
9302 "Change the date of this item. Date is prompted for, with default today.
9303 The prefix ARG is passed to the `org-time-stamp' command and can therefore
9304 be used to request time specification in the time stamp."
9306 (org-agenda-check-type t 'agenda 'timeline)
9307 (org-agenda-check-no-diary)
9308 (let* ((marker (or (org-get-at-bol 'org-marker)
9309 (org-agenda-error)))
9310 (buffer (marker-buffer marker))
9311 (pos (marker-position marker)))
9312 (org-with-remote-undo buffer
9313 (with-current-buffer buffer
9316 (if (not (org-at-timestamp-p t))
9317 (error "Cannot find time stamp"))
9318 (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
9319 (org-agenda-show-new-time marker org-last-changed-timestamp))
9320 (message "Time stamp changed to %s" org-last-changed-timestamp)))
9322 (defun org-agenda-schedule (arg &optional time)
9323 "Schedule the item at point.
9324 ARG is passed through to `org-schedule'."
9326 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
9327 (org-agenda-check-no-diary)
9328 (let* ((marker (or (org-get-at-bol 'org-marker)
9329 (org-agenda-error)))
9330 (type (marker-insertion-type marker))
9331 (buffer (marker-buffer marker))
9332 (pos (marker-position marker))
9334 (set-marker-insertion-type marker t)
9335 (org-with-remote-undo buffer
9336 (with-current-buffer buffer
9339 (setq ts (org-schedule arg time)))
9340 (org-agenda-show-new-time marker ts " S"))
9343 (defun org-agenda-deadline (arg &optional time)
9344 "Schedule the item at point.
9345 ARG is passed through to `org-deadline'."
9347 (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
9348 (org-agenda-check-no-diary)
9349 (let* ((marker (or (org-get-at-bol 'org-marker)
9350 (org-agenda-error)))
9351 (buffer (marker-buffer marker))
9352 (pos (marker-position marker))
9354 (org-with-remote-undo buffer
9355 (with-current-buffer buffer
9358 (setq ts (org-deadline arg time)))
9359 (org-agenda-show-new-time marker ts " D"))
9362 (defun org-agenda-clock-in (&optional arg)
9363 "Start the clock on the currently selected item."
9365 (org-agenda-check-no-diary)
9366 (if (equal arg '(4))
9368 (let* ((marker (or (org-get-at-bol 'org-marker)
9369 (org-agenda-error)))
9370 (hdmarker (or (org-get-at-bol 'org-hd-marker) marker))
9371 (pos (marker-position marker))
9372 (col (current-column))
9374 (org-with-remote-undo (marker-buffer marker)
9375 (with-current-buffer (marker-buffer marker)
9378 (org-show-context 'agenda)
9379 (org-cycle-hide-drawers 'children)
9381 (setq newhead (org-get-heading)))
9382 (org-agenda-change-all-lines newhead hdmarker))
9383 (org-move-to-column col))))
9385 (defun org-agenda-clock-out ()
9386 "Stop the currently running clock."
9388 (unless (marker-buffer org-clock-marker)
9389 (error "No running clock"))
9390 (let ((marker (make-marker)) (col (current-column)) newhead)
9391 (org-with-remote-undo (marker-buffer org-clock-marker)
9392 (with-current-buffer (marker-buffer org-clock-marker)
9393 (org-with-wide-buffer
9394 (goto-char org-clock-marker)
9395 (org-back-to-heading t)
9396 (move-marker marker (point))
9398 (setq newhead (org-get-heading)))))
9399 (org-agenda-change-all-lines newhead marker)
9400 (move-marker marker nil)
9401 (org-move-to-column col)
9402 (org-agenda-unmark-clocking-task)))
9404 (defun org-agenda-clock-cancel (&optional arg)
9405 "Cancel the currently running clock."
9407 (unless (marker-buffer org-clock-marker)
9408 (user-error "No running clock"))
9409 (org-with-remote-undo (marker-buffer org-clock-marker)
9410 (org-clock-cancel)))
9412 (defun org-agenda-clock-goto ()
9413 "Jump to the currently clocked in task within the agenda.
9414 If the currently clocked in task is not listed in the agenda
9415 buffer, display it in another window."
9419 (if (eq (overlay-get o 'type) 'org-agenda-clocking)
9420 (setq pos (overlay-start o))))
9421 (overlays-in (point-min) (point-max)))
9422 (cond (pos (goto-char pos))
9423 ;; If the currently clocked entry is not in the agenda
9424 ;; buffer, we visit it in another window:
9425 ((bound-and-true-p org-clock-current-task)
9426 (org-switch-to-buffer-other-window (org-clock-goto)))
9427 (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
9429 (defun org-agenda-diary-entry-in-org-file ()
9430 "Make a diary entry in the file `org-agenda-diary-file'."
9431 (let (d1 d2 char (text "") dp1 dp2)
9432 (if (equal (buffer-name) "*Calendar*")
9433 (setq d1 (calendar-cursor-to-date t)
9434 d2 (car calendar-mark-ring))
9435 (setq dp1 (get-text-property (point-at-bol) 'day))
9436 (unless dp1 (user-error "No date defined in current line"))
9437 (setq d1 (calendar-gregorian-from-absolute dp1)
9438 d2 (and (ignore-errors (mark))
9441 (setq dp2 (get-text-property (point-at-bol) 'day)))
9442 (calendar-gregorian-from-absolute dp2))))
9443 (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree")
9444 (setq char (read-char-exclusive))
9447 (setq text (read-string "Day entry: "))
9448 (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1)
9449 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
9451 (setq d1 (list (car d1) (nth 1 d1)
9452 (read-number (format "Reference year [%d]: " (nth 2 d1))
9454 (setq text (read-string "Anniversary (use %d to show years): "))
9455 (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1)
9456 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
9458 (setq text (read-string "Block entry: "))
9459 (unless (and d1 d2 (not (equal d1 d2)))
9460 (user-error "No block of days selected"))
9461 (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2)
9462 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
9464 (org-switch-to-buffer-other-window
9465 (find-file-noselect org-agenda-diary-file))
9466 (require 'org-datetree)
9467 (org-datetree-find-date-create d1)
9469 (t (user-error "Invalid selection character `%c'" char)))))
9471 (defcustom org-agenda-insert-diary-strategy 'date-tree
9472 "Where in `org-agenda-diary-file' should new entries be added?
9475 date-tree in the date tree, as first child of the date
9476 date-tree-last in the date tree, as last child of the date
9477 top-level as top-level entries at the end of the file."
9480 (const :tag "first in a date tree" date-tree)
9481 (const :tag "last in a date tree" date-tree-last)
9482 (const :tag "as top level at end of file" top-level)))
9484 (defcustom org-agenda-insert-diary-extract-time nil
9485 "Non-nil means extract any time specification from the diary entry."
9490 (defcustom org-agenda-bulk-mark-char ">"
9491 "A single-character string to be used as the bulk mark."
9496 (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
9497 "Add a diary entry with TYPE to `org-agenda-diary-file'.
9498 If TEXT is not empty, it will become the headline of the new entry, and
9499 the resulting entry will not be shown. When TEXT is empty, switch to
9500 `org-agenda-diary-file' and let the user finish the entry there."
9501 (let ((cw (current-window-configuration)))
9502 (org-switch-to-buffer-other-window
9503 (find-file-noselect org-agenda-diary-file))
9505 (goto-char (point-min))
9507 ((eq type 'anniversary)
9508 (or (re-search-forward "^*[ \t]+Anniversaries" nil t)
9510 (or (org-at-heading-p t)
9512 (outline-next-heading)
9513 (insert "* Anniversaries\n\n")
9514 (beginning-of-line -1)))))
9515 (outline-next-heading)
9516 (org-back-over-empty-lines)
9519 (insert (format "%%%%(org-anniversary %d %2d %2d) %s"
9520 (nth 2 d1) (car d1) (nth 1 d1) text)))
9522 (let ((org-prefix-has-time t)
9523 (org-agenda-time-leading-zero t)
9525 (if org-agenda-insert-diary-extract-time
9526 ;; Use org-agenda-format-item to parse text for a time-range and
9527 ;; remove it. FIXME: This is a hack, we should refactor
9528 ;; that function to make time extraction available separately
9529 (setq fmt (org-agenda-format-item nil text nil nil nil t)
9530 time (get-text-property 0 'time fmt)
9531 time2 (if (> (length time) 0)
9532 ;; split-string removes trailing ...... if
9533 ;; no end time given. First space
9534 ;; separates time from date.
9535 (concat " " (car (split-string time "\\.")))
9537 text (get-text-property 0 'txt fmt)))
9538 (if (eq org-agenda-insert-diary-strategy 'top-level)
9539 (org-agenda-insert-diary-as-top-level text)
9540 (require 'org-datetree)
9541 (org-datetree-find-date-create d1)
9542 (org-agenda-insert-diary-make-new-entry text))
9543 (org-insert-time-stamp (org-time-from-absolute
9544 (calendar-absolute-from-gregorian d1))
9545 nil nil nil nil time2))
9548 (if (> (calendar-absolute-from-gregorian d1)
9549 (calendar-absolute-from-gregorian d2))
9550 (setq d1 (prog1 d2 (setq d2 d1))))
9551 (if (eq org-agenda-insert-diary-strategy 'top-level)
9552 (org-agenda-insert-diary-as-top-level text)
9553 (require 'org-datetree)
9554 (org-datetree-find-date-create d1)
9555 (org-agenda-insert-diary-make-new-entry text))
9556 (org-insert-time-stamp (org-time-from-absolute
9557 (calendar-absolute-from-gregorian d1)))
9559 (org-insert-time-stamp (org-time-from-absolute
9560 (calendar-absolute-from-gregorian d2)))
9562 (if (string-match "\\S-" text)
9564 (set-window-configuration cw)
9565 (message "%s entry added to %s"
9566 (capitalize (symbol-name type))
9567 (abbreviate-file-name org-agenda-diary-file)))
9569 (message "Please finish entry here"))))
9571 (defun org-agenda-insert-diary-as-top-level (text)
9572 "Make new entry as a top-level entry at the end of the file.
9573 Add TEXT as headline, and position the cursor in the second line so that
9574 a timestamp can be added there."
9576 (goto-char (point-max))
9577 (unless (bolp) (insert "\n"))
9578 (org-insert-heading nil t t)
9580 (org-end-of-meta-data)
9581 (unless (bolp) (insert "\n"))
9582 (when org-adapt-indentation (indent-to-column 2)))
9584 (defun org-agenda-insert-diary-make-new-entry (text)
9585 "Make a new entry with TEXT as a child of the current subtree.
9586 Position the point in the heading's first body line so that
9587 a timestamp can be added there."
9589 ((eq org-agenda-insert-diary-strategy 'date-tree-last)
9591 (org-insert-heading '(4) t)
9594 (outline-next-heading)
9595 (org-back-over-empty-lines)
9596 (unless (looking-at "[ \t]*$") (save-excursion (insert "\n")))
9597 (org-insert-heading nil t)
9599 (let ((col (current-column)))
9601 (org-end-of-meta-data)
9602 ;; Ensure point is left on a blank line, at proper indentation.
9603 (unless (bolp) (insert "\n"))
9604 (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
9605 (when org-adapt-indentation (indent-to-column col)))
9606 (org-show-set-visibility 'lineage))
9608 (defun org-agenda-diary-entry ()
9609 "Make a diary entry, like the `i' command from the calendar.
9610 All the standard commands work: block, weekly etc.
9611 When `org-agenda-diary-file' points to a file,
9612 `org-agenda-diary-entry-in-org-file' is called instead to create
9613 entries in that Org file."
9615 (if (not (eq org-agenda-diary-file 'diary-file))
9616 (org-agenda-diary-entry-in-org-file)
9617 (require 'diary-lib)
9619 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
9620 (read-char-exclusive)))
9621 (cmd (cdr (assoc char
9622 '((?d . diary-insert-entry)
9623 (?w . diary-insert-weekly-entry)
9624 (?m . diary-insert-monthly-entry)
9625 (?y . diary-insert-yearly-entry)
9626 (?a . diary-insert-anniversary-entry)
9627 (?b . diary-insert-block-entry)
9628 (?c . diary-insert-cyclic-entry)))))
9629 (oldf (symbol-function 'calendar-cursor-to-date))
9630 ;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
9632 (mark (or (mark t) (point))))
9634 (user-error "No command associated with <%c>" char))
9635 (unless (and (get-text-property point 'day)
9636 (or (not (equal ?b char))
9637 (get-text-property mark 'day)))
9638 (user-error "Don't know which date to use for diary entry"))
9639 ;; We implement this by hacking the `calendar-cursor-to-date' function
9640 ;; and the `calendar-mark-ring' variable. Saves a lot of code.
9641 (let ((calendar-mark-ring
9642 (list (calendar-gregorian-from-absolute
9643 (or (get-text-property mark 'day)
9644 (get-text-property point 'day))))))
9647 (fset 'calendar-cursor-to-date
9648 (lambda (&optional error dummy)
9649 (calendar-gregorian-from-absolute
9650 (get-text-property point 'day))))
9651 (call-interactively cmd))
9652 (fset 'calendar-cursor-to-date oldf))))))
9654 (defun org-agenda-execute-calendar-command (cmd)
9655 "Execute a calendar command from the agenda with date from cursor."
9656 (org-agenda-check-type t 'agenda 'timeline)
9657 (require 'diary-lib)
9658 (unless (get-text-property (min (1- (point-max)) (point)) 'day)
9659 (user-error "Don't know which date to use for the calendar command"))
9660 (let* ((oldf (symbol-function 'calendar-cursor-to-date))
9662 (date (calendar-gregorian-from-absolute
9663 (get-text-property point 'day)))
9664 ;; the following 2 vars are needed in the calendar
9665 (displayed-month (car date))
9666 (displayed-year (nth 2 date)))
9669 (fset 'calendar-cursor-to-date
9670 (lambda (&optional error dummy)
9671 (calendar-gregorian-from-absolute
9672 (get-text-property point 'day))))
9673 (call-interactively cmd))
9674 (fset 'calendar-cursor-to-date oldf))))
9676 (defun org-agenda-phases-of-moon ()
9677 "Display the phases of the moon for the 3 months around the cursor date."
9679 (org-agenda-execute-calendar-command 'calendar-lunar-phases))
9681 (defun org-agenda-holidays ()
9682 "Display the holidays for the 3 months around the cursor date."
9684 (org-agenda-execute-calendar-command 'calendar-list-holidays))
9686 (defvar calendar-longitude) ; defined in calendar.el
9687 (defvar calendar-latitude) ; defined in calendar.el
9688 (defvar calendar-location-name) ; defined in calendar.el
9690 (defun org-agenda-sunrise-sunset (arg)
9691 "Display sunrise and sunset for the cursor date.
9692 Latitude and longitude can be specified with the variables
9693 `calendar-latitude' and `calendar-longitude'. When called with prefix
9694 argument, latitude and longitude will be prompted for."
9697 (let ((calendar-longitude (if arg nil calendar-longitude))
9698 (calendar-latitude (if arg nil calendar-latitude))
9699 (calendar-location-name
9700 (if arg "the given coordinates" calendar-location-name)))
9701 (org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
9703 (defun org-agenda-goto-calendar ()
9704 "Open the Emacs calendar with the date at the cursor."
9706 (org-agenda-check-type t 'agenda 'timeline)
9707 (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
9708 (user-error "Don't know which date to open in calendar")))
9709 (date (calendar-gregorian-from-absolute day))
9710 (calendar-move-hook nil)
9711 (calendar-view-holidays-initially-flag nil)
9712 (calendar-view-diary-initially-flag nil))
9714 (calendar-goto-date date)))
9717 (defun org-calendar-goto-agenda ()
9718 "Compute the Org agenda for the calendar date displayed at the cursor.
9719 This is a command that has to be installed in `calendar-mode-map'."
9721 ;; Temporarily disable sticky agenda since user clearly wants to
9722 ;; refresh view anyway.
9723 (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*")
9724 (org-agenda-sticky nil))
9725 (org-agenda-list nil (calendar-absolute-from-gregorian
9726 (calendar-cursor-to-date))
9729 (defun org-agenda-convert-date ()
9731 (org-agenda-check-type t 'agenda 'timeline)
9732 (let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
9735 (user-error "Don't know which date to convert"))
9736 (setq date (calendar-gregorian-from-absolute day))
9738 "Gregorian: " (calendar-date-string date) "\n"
9739 "ISO: " (calendar-iso-date-string date) "\n"
9740 "Day of Yr: " (calendar-day-of-year-string date) "\n"
9741 "Julian: " (calendar-julian-date-string date) "\n"
9742 "Astron. JD: " (calendar-astro-date-string date)
9743 " (Julian date number at noon UTC)\n"
9744 "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n"
9745 "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n"
9746 "French: " (calendar-french-date-string date) "\n"
9747 "Bahá’Ã: " (calendar-bahai-date-string date) " (until sunset)\n"
9748 "Mayan: " (calendar-mayan-date-string date) "\n"
9749 "Coptic: " (calendar-coptic-date-string date) "\n"
9750 "Ethiopic: " (calendar-ethiopic-date-string date) "\n"
9751 "Persian: " (calendar-persian-date-string date) "\n"
9752 "Chinese: " (calendar-chinese-date-string date) "\n"))
9753 (with-output-to-temp-buffer "*Dates*"
9755 (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
9759 (defun org-agenda-bulk-marked-p ()
9760 "Non-nil when current entry is marked for bulk action."
9761 (eq (get-char-property (point-at-bol) 'type)
9762 'org-marked-entry-overlay))
9764 (defun org-agenda-bulk-mark (&optional arg)
9765 "Mark the entry at point for future bulk action."
9767 (dotimes (i (or arg 1))
9768 (unless (org-get-at-bol 'org-agenda-diary-link)
9769 (let* ((m (org-get-at-bol 'org-hd-marker))
9771 (unless (org-agenda-bulk-marked-p)
9772 (unless m (user-error "Nothing to mark at point"))
9773 (push m org-agenda-bulk-marked-entries)
9774 (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol))))
9775 (org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
9776 (org-get-todo-face "TODO")
9778 (overlay-put ov 'type 'org-marked-entry-overlay))
9781 (goto-char (next-single-property-change (point) 'org-hd-marker)))
9782 (beginning-of-line 2))
9783 (while (and (get-char-property (point) 'invisible) (not (eobp)))
9784 (beginning-of-line 2))
9785 (message "%d entries marked for bulk action"
9786 (length org-agenda-bulk-marked-entries))))))
9788 (defun org-agenda-bulk-mark-all ()
9789 "Mark all entries for future agenda bulk action."
9791 (org-agenda-bulk-mark-regexp "."))
9793 (defun org-agenda-bulk-mark-regexp (regexp)
9794 "Mark entries matching REGEXP for future agenda bulk action."
9795 (interactive "sMark entries matching regexp: ")
9796 (let ((entries-marked 0) txt-at-point)
9798 (goto-char (point-min))
9799 (goto-char (next-single-property-change (point) 'org-hd-marker))
9800 (while (and (re-search-forward regexp nil t)
9801 (setq txt-at-point (get-text-property (point) 'txt)))
9802 (if (get-char-property (point) 'invisible)
9803 (beginning-of-line 2)
9804 (when (string-match regexp txt-at-point)
9805 (setq entries-marked (1+ entries-marked))
9806 (call-interactively 'org-agenda-bulk-mark)))))
9808 (if (not entries-marked)
9809 (message "No entry matching this regexp."))))
9811 (defun org-agenda-bulk-unmark (&optional arg)
9812 "Unmark the entry at point for future bulk action."
9815 (org-agenda-bulk-unmark-all)
9816 (cond ((org-agenda-bulk-marked-p)
9817 (org-agenda-bulk-remove-overlays
9818 (point-at-bol) (+ 2 (point-at-bol)))
9819 (setq org-agenda-bulk-marked-entries
9820 (delete (org-get-at-bol 'org-hd-marker)
9821 org-agenda-bulk-marked-entries))
9824 (goto-char (next-single-property-change (point) 'txt)))
9825 (beginning-of-line 2))
9826 (while (and (get-char-property (point) 'invisible) (not (eobp)))
9827 (beginning-of-line 2))
9828 (message "%d entries left marked for bulk action"
9829 (length org-agenda-bulk-marked-entries)))
9830 (t (message "No entry to unmark here")))))
9832 (defun org-agenda-bulk-toggle-all ()
9833 "Toggle all marks for bulk action."
9836 (goto-char (point-min))
9837 (while (ignore-errors
9838 (goto-char (next-single-property-change (point) 'org-hd-marker)))
9839 (org-agenda-bulk-toggle))))
9841 (defun org-agenda-bulk-toggle ()
9842 "Toggle the mark at point for bulk action."
9844 (if (org-agenda-bulk-marked-p)
9845 (org-agenda-bulk-unmark)
9846 (org-agenda-bulk-mark)))
9848 (defun org-agenda-bulk-remove-overlays (&optional beg end)
9849 "Remove the mark overlays between BEG and END in the agenda buffer.
9850 BEG and END default to the buffer limits.
9852 This only removes the overlays, it does not remove the markers
9853 from the list in `org-agenda-bulk-marked-entries'."
9856 (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay)
9857 (delete-overlay ov)))
9858 (overlays-in (or beg (point-min)) (or end (point-max)))))
9860 (defun org-agenda-bulk-unmark-all ()
9861 "Remove all marks in the agenda buffer.
9862 This will remove the markers and the overlays."
9864 (if (null org-agenda-bulk-marked-entries)
9865 (message "No entry to unmark")
9866 (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
9867 (setq org-agenda-bulk-marked-entries nil)
9868 (org-agenda-bulk-remove-overlays (point-min) (point-max))))
9870 (defcustom org-agenda-persistent-marks nil
9871 "Non-nil means marked items will stay marked after a bulk action.
9872 You can toggle this interactively by typing `p' when prompted for a
9878 (defun org-agenda-bulk-action (&optional arg)
9879 "Execute an remote-editing action on all marked entries.
9880 The prefix arg is passed through to the command if possible."
9882 ;; Make sure we have markers, and only valid ones
9883 (unless org-agenda-bulk-marked-entries (user-error "No entries are marked"))
9886 (unless (and (markerp m)
9888 (buffer-live-p (marker-buffer m))
9889 (marker-position m))
9890 (user-error "Marker %s for bulk command is invalid" m)))
9891 org-agenda-bulk-marked-entries)
9893 ;; Prompt for the bulk command
9894 (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")))
9895 (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
9896 "[S]catter [f]unction "
9897 (when org-agenda-bulk-custom-functions
9898 (concat " Custom: ["
9899 (mapconcat (lambda(f) (char-to-string (car f)))
9900 org-agenda-bulk-custom-functions "")
9903 (let* ((action (read-char-exclusive))
9904 (org-log-refile (if org-log-refile 'time nil))
9905 (entries (reverse org-agenda-bulk-marked-entries))
9906 (org-overriding-default-time
9907 (if (get-text-property (point) 'org-agenda-date-header)
9908 (org-get-cursor-date)))
9910 cmd rfloc state e tag pos (cnt 0) (cntskip 0))
9913 (let ((org-agenda-persistent-marks
9914 (not org-agenda-persistent-marks)))
9915 (org-agenda-bulk-action)
9919 (setq cmd '(org-agenda-archive)))
9922 (setq cmd '(org-agenda-archive-to-archive-sibling)))
9924 ((member action '(?r ?w))
9925 (setq rfloc (org-refile-get-location
9927 (marker-buffer (car entries))
9928 org-refile-allow-creating-parent-nodes))
9930 (setcar (nthcdr 3 rfloc)
9931 (move-marker (make-marker) (nth 3 rfloc)
9932 (or (get-file-buffer (nth 1 rfloc))
9933 (find-buffer-visiting (nth 1 rfloc))
9934 (error "This should not happen")))))
9936 (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t)
9940 (setq state (completing-read
9942 (with-current-buffer (marker-buffer (car entries))
9943 (mapcar #'list org-todo-keywords-1))))
9944 (setq cmd `(let ((org-inhibit-blocking t)
9945 (org-inhibit-logging 'note))
9946 (org-agenda-todo ,state))))
9948 ((memq action '(?- ?+))
9949 (setq tag (completing-read
9950 (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
9951 (with-current-buffer (marker-buffer (car entries))
9953 (mapcar (lambda (x) (and (stringp (car x)) x))
9954 org-current-tag-alist)))))
9955 (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
9957 ((memq action '(?s ?d))
9962 (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to")
9963 org-overriding-default-time)))
9964 (c1 (if (eq action ?s) 'org-agenda-schedule
9965 'org-agenda-deadline)))
9966 ;; Make sure to not prompt for a note when bulk
9967 ;; rescheduling as Org cannot cope with simultaneous Org.
9968 ;; Besides, it could be annoying depending on the number
9969 ;; of items re-scheduled.
9970 (setq cmd `(eval '(let ((org-log-reschedule
9971 (and org-log-reschedule 'time)))
9972 (,c1 arg ,time))))))
9975 (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
9976 (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
9977 (let ((days (read-number
9978 (format "Scatter tasks across how many %sdays: "
9979 (if arg "week" "")) 7)))
9981 `(let ((distance (1+ (random ,days))))
9983 (let ((dist distance)
9985 (calendar-day-of-week
9986 (calendar-gregorian-from-absolute (org-today)))))
9987 (dotimes (i (1+ dist))
9988 (while (member day-of-week org-agenda-weekend-days)
9990 (cl-incf day-of-week)
9991 (when (= day-of-week 7)
9992 (setq day-of-week 0)))
9993 (cl-incf day-of-week)
9994 (when (= day-of-week 7)
9995 (setq day-of-week 0)))))
9996 ;; silently fail when try to replan a sexp entry
9998 (let* ((date (calendar-gregorian-from-absolute
9999 (+ (org-today) distance)))
10000 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
10002 (org-agenda-schedule nil time))
10005 ((assoc action org-agenda-bulk-custom-functions)
10006 (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions)))
10010 (setq cmd (list (intern
10011 (completing-read "Function: "
10012 obarray 'fboundp t nil nil)))))
10014 (t (user-error "Invalid bulk action")))
10016 ;; Sort the markers, to make sure that parents are handled before children
10017 (setq entries (sort entries
10020 ((equal (marker-buffer a) (marker-buffer b))
10021 (< (marker-position a) (marker-position b)))
10023 (string< (buffer-name (marker-buffer a))
10024 (buffer-name (marker-buffer b))))))))
10026 ;; Now loop over all markers and apply cmd
10027 (while (setq e (pop entries))
10028 (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
10030 (progn (message "Skipping removed entry at %s" e)
10031 (setq cntskip (1+ cntskip)))
10033 (let (org-loop-over-headlines-in-active-region)
10035 ;; `post-command-hook' is not run yet. We make sure any
10036 ;; pending log note is processed.
10037 (when (or (memq 'org-add-log-note (default-value 'post-command-hook))
10038 (memq 'org-add-log-note post-command-hook))
10039 (org-add-log-note))
10040 (setq cnt (1+ cnt))))
10041 (when redo-at-end (org-agenda-redo))
10042 (unless org-agenda-persistent-marks
10043 (org-agenda-bulk-unmark-all))
10044 (message "Acted on %d entries%s%s"
10048 (format ", skipped %d (disappeared before their turn)"
10050 (if (not org-agenda-persistent-marks)
10051 "" " (kept marked)"))))))
10053 (defun org-agenda-capture (&optional with-time)
10054 "Call `org-capture' with the date at point.
10055 With a `C-1' prefix, use the HH:MM value at point (if any) or the
10056 current HH:MM time."
10058 (if (not (eq major-mode 'org-agenda-mode))
10059 (user-error "You cannot do this outside of agenda buffers")
10060 (let ((org-overriding-default-time
10061 (org-get-cursor-date (equal with-time 1))))
10062 (call-interactively 'org-capture))))
10064 ;;; Dragging agenda lines forward/backward
10066 (defun org-agenda-reapply-filters ()
10067 "Re-apply all agenda filters."
10069 (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
10070 `((,org-agenda-tag-filter tag)
10071 (,org-agenda-category-filter category)
10072 (,org-agenda-regexp-filter regexp)
10073 (,org-agenda-effort-filter effort)
10074 (,(get 'org-agenda-tag-filter :preset-filter) tag)
10075 (,(get 'org-agenda-category-filter :preset-filter) category)
10076 (,(get 'org-agenda-effort-filter :preset-filter) effort)
10077 (,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
10079 (defun org-agenda-drag-line-forward (arg &optional backward)
10080 "Drag an agenda line forward by ARG lines.
10081 When the optional argument `backward' is non-nil, move backward."
10083 (let ((inhibit-read-only t) lst line)
10084 (if (or (not (get-text-property (point) 'txt))
10087 (move-beginning-of-line (if backward 0 2))
10088 (push (not (get-text-property (point) 'txt)) lst))
10090 (message "Cannot move line forward")
10091 (let ((end (save-excursion (move-beginning-of-line 2) (point))))
10092 (move-beginning-of-line 1)
10093 (setq line (buffer-substring (point) end))
10094 (delete-region (point) end)
10095 (move-beginning-of-line (funcall (if backward '1- '1+) arg))
10097 (org-agenda-reapply-filters)
10098 (org-agenda-mark-clocking-task)
10099 (move-beginning-of-line 0)))))
10101 (defun org-agenda-drag-line-backward (arg)
10102 "Drag an agenda line backward by ARG lines."
10104 (org-agenda-drag-line-forward arg t))
10108 (defun org-agenda-show-the-flagging-note ()
10109 "Display the flagging note in the other window.
10110 When called a second time in direct sequence, offer to remove the FLAGGING
10111 tag and (if present) the flagging note."
10113 (let ((hdmarker (org-get-at-bol 'org-hd-marker))
10114 (win (selected-window))
10115 note heading newhead)
10117 (user-error "No linked entry at point"))
10118 (if (and (eq this-command last-command)
10119 (y-or-n-p "Unflag and remove any flagging note? "))
10121 (org-agenda-remove-flag hdmarker)
10122 (let ((win (get-buffer-window "*Flagging Note*")))
10123 (and win (delete-window win)))
10124 (message "Entry unflagged"))
10125 (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
10127 (user-error "No flagging note"))
10128 (org-kill-new note)
10129 (org-switch-to-buffer-other-window "*Flagging Note*")
10132 (goto-char (point-min))
10133 (while (re-search-forward "\\\\n" nil t)
10134 (replace-match "\n" t t))
10135 (goto-char (point-min))
10136 (select-window win)
10137 (message "%s" (substitute-command-keys "Flagging note pushed to \
10138 kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \
10141 (defun org-agenda-remove-flag (marker)
10142 "Remove the FLAGGED tag and any flagging note in the entry."
10144 (org-with-point-at marker
10145 (org-toggle-tag "FLAGGED" 'off)
10146 (org-entry-delete nil "THEFLAGGINGNOTE")
10147 (setq newhead (org-get-heading)))
10148 (org-agenda-change-all-lines newhead marker)
10149 (message "Entry unflagged")))
10151 (defun org-agenda-get-any-marker (&optional pos)
10152 (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker)
10153 (get-text-property (or pos (point-at-bol)) 'org-marker)))
10155 ;;; Appointment reminders
10157 (defvar appt-time-msg-list) ; defined in appt.el
10160 (defun org-agenda-to-appt (&optional refresh filter &rest args)
10161 "Activate appointments found in `org-agenda-files'.
10163 With a `\\[universal-argument]' prefix, refresh the list of \
10166 If FILTER is t, interactively prompt the user for a regular
10167 expression, and filter out entries that don't match it.
10169 If FILTER is a string, use this string as a regular expression
10170 for filtering entries out.
10172 If FILTER is a function, filter out entries against which
10173 calling the function returns nil. This function takes one
10174 argument: an entry from `org-agenda-get-day-entries'.
10176 FILTER can also be an alist with the car of each cell being
10177 either `headline' or `category'. For example:
10179 \\='((headline \"IMPORTANT\")
10180 (category \"Work\"))
10182 will only add headlines containing IMPORTANT or headlines
10183 belonging to the \"Work\" category.
10185 ARGS are symbols indicating what kind of entries to consider.
10186 By default `org-agenda-to-appt' will use :deadline*, :scheduled*
10187 \(i.e., deadlines and scheduled items with a hh:mm specification)
10188 and :timestamp entries. See the docstring of `org-diary' for
10189 details and examples.
10191 If an entry has a APPT_WARNTIME property, its value will be used
10192 to override `appt-message-warning-time'."
10194 (if refresh (setq appt-time-msg-list nil))
10196 (setq filter (read-from-minibuffer "Regexp filter: ")))
10197 (let* ((cnt 0) ; count added events
10198 (scope (or args '(:deadline* :scheduled* :timestamp)))
10199 (org-agenda-new-buffers nil)
10200 (org-deadline-warning-days 0)
10201 ;; Do not use `org-today' here because appt only takes
10202 ;; time and without date as argument, so it may pass wrong
10203 ;; information otherwise
10204 (today (org-date-to-gregorian
10205 (time-to-days (current-time))))
10206 (org-agenda-restrict nil)
10207 (files (org-agenda-files 'unrestricted)) entries file
10208 (org-agenda-buffer nil))
10209 ;; Get all entries which may contain an appt
10210 (org-agenda-prepare-buffers files)
10211 (while (setq file (pop files))
10215 (apply 'org-agenda-get-day-entries
10216 file today scope)))))
10217 ;; Map thru entries and find if we should filter them out
10220 (let* ((evt (org-trim
10221 (replace-regexp-in-string
10222 org-bracket-link-regexp "\\3"
10223 (or (get-text-property 1 'txt x) ""))))
10224 (cat (get-text-property (1- (length x)) 'org-category x))
10225 (tod (get-text-property 1 'time-of-day x))
10226 (ok (or (null filter)
10227 (and (stringp filter) (string-match filter evt))
10228 (and (functionp filter) (funcall filter x))
10229 (and (listp filter)
10230 (let ((cat-filter (cadr (assq 'category filter)))
10231 (evt-filter (cadr (assq 'headline filter))))
10232 (or (and (stringp cat-filter)
10233 (string-match cat-filter cat))
10234 (and (stringp evt-filter)
10235 (string-match evt-filter evt)))))))
10236 (wrn (get-text-property 1 'warntime x)))
10237 ;; FIXME: Shall we remove text-properties for the appt text?
10238 ;; (setq evt (set-text-properties 0 (length evt) nil evt))
10239 (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt)))
10240 (setq tod (concat "00" (number-to-string tod)))
10241 (setq tod (when (string-match
10242 "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
10243 (concat (match-string 1 tod) ":"
10244 (match-string 2 tod))))
10245 (when (if (version< emacs-version "23.3")
10247 (appt-add tod evt wrn))
10248 (setq cnt (1+ cnt))))))
10250 (org-release-buffers org-agenda-new-buffers)
10252 (message "No event to add")
10253 (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
10255 (defun org-agenda-today-p (date)
10256 "Non nil when DATE means today.
10257 DATE is either a list of the form (month day year) or a number of
10258 days as returned by `calendar-absolute-from-gregorian' or
10259 `org-today'. This function considers `org-extend-today-until'
10260 when defining today."
10262 (if (consp date) (calendar-absolute-from-gregorian date) date)))
10264 (defun org-agenda-todo-yesterday (&optional arg)
10265 "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
10267 (let* ((org-use-effective-time t)
10268 (hour (nth 2 (decode-time (org-current-time))))
10269 (org-extend-today-until (1+ hour)))
10270 (org-agenda-todo arg)))
10272 (provide 'org-agenda)
10274 ;;; org-agenda.el ends here