org-agenda.el (430633B)
1 ;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. 4 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, wp 7 ;; Homepage: https://orgmode.org 8 ;; 9 ;; This file is part of GNU Emacs. 10 ;; 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 ;; 25 ;;; Commentary: 26 27 ;; This file contains the code for creating and using the Agenda for Org. 28 ;; 29 ;; The functions `org-batch-agenda', `org-batch-agenda-csv', and 30 ;; `org-batch-store-agenda-views' are implemented as macros to provide 31 ;; a convenient way for extracting agenda information from the command 32 ;; line. The Lisp does not evaluate parameters of a macro call; thus 33 ;; it is not necessary to quote the parameters passed to one of those 34 ;; functions. E.g. you can write: 35 ;; 36 ;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)' 37 ;; 38 ;; To export an agenda spanning 7 days. If `org-batch-agenda' would 39 ;; have been implemented as a regular function you'd have to quote the 40 ;; symbol org-agenda-span. Moreover: To use a symbol as parameter 41 ;; value you would have to double quote the symbol. 42 ;; 43 ;; This is a hack, but it works even when running Org byte-compiled. 44 ;; 45 46 ;;; Code: 47 48 (require 'cl-lib) 49 (require 'ol) 50 (require 'org) 51 (require 'org-macs) 52 (require 'org-refile) 53 54 (declare-function diary-add-to-list "diary-lib" 55 (date string specifier &optional marker globcolor literal)) 56 (declare-function calendar-iso-to-absolute "cal-iso" (date)) 57 (declare-function calendar-astro-date-string "cal-julian" (&optional date)) 58 (declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) 59 (declare-function calendar-chinese-date-string "cal-china" (&optional date)) 60 (declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) 61 (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) 62 (declare-function calendar-french-date-string "cal-french" (&optional date)) 63 (declare-function calendar-goto-date "cal-move" (date)) 64 (declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) 65 (declare-function calendar-islamic-date-string "cal-islam" (&optional date)) 66 (declare-function calendar-iso-date-string "cal-iso" (&optional date)) 67 (declare-function calendar-iso-from-absolute "cal-iso" (date)) 68 (declare-function calendar-julian-date-string "cal-julian" (&optional date)) 69 (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) 70 (declare-function calendar-persian-date-string "cal-persia" (&optional date)) 71 (declare-function calendar-check-holidays "holidays" (date)) 72 73 (declare-function org-columns-remove-overlays "org-colview" ()) 74 (declare-function org-datetree-find-date-create "org-datetree" 75 (date &optional keep-restriction)) 76 (declare-function org-columns-quit "org-colview" ()) 77 (declare-function diary-date-display-form "diary-lib" (&optional type)) 78 (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file)) 79 (declare-function org-habit-insert-consistency-graphs 80 "org-habit" (&optional line)) 81 (declare-function org-is-habit-p "org-habit" (&optional pom)) 82 (declare-function org-habit-parse-todo "org-habit" (&optional pom)) 83 (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) 84 (declare-function org-agenda-columns "org-colview" ()) 85 (declare-function org-add-archive-files "org-archive" (files)) 86 (declare-function org-capture "org-capture" (&optional goto keys)) 87 (declare-function org-clock-modify-effort-estimate "org-clock" (&optional value)) 88 89 (defvar calendar-mode-map) 90 (defvar org-clock-current-task) 91 (defvar org-current-tag-alist) 92 (defvar org-mobile-force-id-on-agenda-items) 93 (defvar org-habit-show-habits) 94 (defvar org-habit-show-habits-only-for-today) 95 (defvar org-habit-show-all-today) 96 (defvar org-habit-scheduled-past-days) 97 98 ;; Defined somewhere in this file, but used before definition. 99 (defvar org-agenda-buffer-name "*Org Agenda*") 100 (defvar org-agenda-overriding-header nil) 101 (defvar org-agenda-title-append nil) 102 ;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el 103 ;; (with-no-warnings (defvar date)) ;; unprefixed, from calendar.el 104 (defvar original-date) ; dynamically scoped, calendar.el does scope this 105 106 (defvar org-agenda-undo-list nil 107 "List of undoable operations in the agenda since last refresh.") 108 (defvar org-agenda-pending-undo-list nil 109 "In a series of undo commands, this is the list of remaining undo items.") 110 111 (defcustom org-agenda-confirm-kill 1 112 "When set, remote killing from the agenda buffer needs confirmation. 113 When t, a confirmation is always needed. When a number N, confirmation is 114 only needed when the text to be killed contains more than N non-white lines." 115 :group 'org-agenda 116 :type '(choice 117 (const :tag "Never" nil) 118 (const :tag "Always" t) 119 (integer :tag "When more than N lines"))) 120 121 (defcustom org-agenda-compact-blocks nil 122 "Non-nil means make the block agenda more compact. 123 This is done globally by leaving out lines like the agenda span 124 name and week number or the separator lines." 125 :group 'org-agenda 126 :type 'boolean) 127 128 (defcustom org-agenda-block-separator ?= 129 "The separator between blocks in the agenda. 130 If this is a string, it will be used as the separator, with a newline added. 131 If it is a character, it will be repeated to fill the window width. 132 If nil the separator is disabled. In `org-agenda-custom-commands' this 133 addresses the separator between the current and the previous block." 134 :group 'org-agenda 135 :type '(choice 136 (const :tag "Disabled" nil) 137 (character) 138 (string))) 139 140 (defgroup org-agenda-export nil 141 "Options concerning exporting agenda views in Org mode." 142 :tag "Org Agenda Export" 143 :group 'org-agenda) 144 145 (defcustom org-agenda-with-colors t 146 "Non-nil means use colors in agenda views." 147 :group 'org-agenda-export 148 :type 'boolean) 149 150 (defcustom org-agenda-exporter-settings nil 151 ;; FIXME: Do we really want to evaluate those settings and thus force 152 ;; the user to use `quote' all the time? 153 "Alist of variable/value pairs that should be active during agenda export. 154 This is a good place to set options for ps-print and for htmlize. 155 Note that the way this is implemented, the values will be evaluated 156 before assigned to the variables. So make sure to quote values you do 157 *not* want evaluated, for example 158 159 (setq org-agenda-exporter-settings 160 \\='((ps-print-color-p \\='black-white)))" 161 :group 'org-agenda-export 162 :type '(repeat 163 (list 164 (variable) 165 (sexp :tag "Value")))) 166 167 (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) 168 "Hook run in a temporary buffer before writing the agenda to an export file. 169 A useful function for this hook is `org-agenda-add-entry-text'." 170 :group 'org-agenda-export 171 :type 'hook 172 :options '(org-agenda-add-entry-text)) 173 174 (defcustom org-agenda-add-entry-text-maxlines 0 175 "Maximum number of entry text lines to be added to agenda. 176 This is only relevant when `org-agenda-add-entry-text' is part of 177 `org-agenda-before-write-hook', which is the default. 178 When this is 0, nothing will happen. When it is greater than 0, it 179 specifies the maximum number of lines that will be added for each entry 180 that is listed in the agenda view. 181 182 Note that this variable is not used during display, only when exporting 183 the agenda. For agenda display, see the variables `org-agenda-entry-text-mode' 184 and `org-agenda-entry-text-maxlines'." 185 :group 'org-agenda 186 :type 'integer) 187 188 (defcustom org-agenda-add-entry-text-descriptive-links t 189 "Non-nil means export org-links as descriptive links in agenda added text. 190 This variable applies to the text added to the agenda when 191 `org-agenda-add-entry-text-maxlines' is larger than 0. 192 When this variable is nil, the URL will (also) be shown." 193 :group 'org-agenda 194 :type 'boolean) 195 196 (defcustom org-agenda-export-html-style nil 197 "The style specification for exported HTML Agenda files. 198 If this variable contains a string, it will replace the default <style> 199 section as produced by `htmlize'. 200 Since there are different ways of setting style information, this variable 201 needs to contain the full HTML structure to provide a style, including the 202 surrounding HTML tags. The style specifications should include definitions 203 the fonts used by the agenda, here is an example: 204 205 <style type=\"text/css\"> 206 p { font-weight: normal; color: gray; } 207 .org-agenda-structure { 208 font-size: 110%; 209 color: #003399; 210 font-weight: 600; 211 } 212 .org-todo { 213 color: #cc6666; 214 font-weight: bold; 215 } 216 .org-agenda-done { 217 color: #339933; 218 } 219 .org-done { 220 color: #339933; 221 } 222 .title { text-align: center; } 223 .todo, .deadline { color: red; } 224 .done { color: green; } 225 </style> 226 227 or, if you want to keep the style in a file, 228 229 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> 230 231 As the value of this option simply gets inserted into the HTML <head> header, 232 you can \"misuse\" it to also add other text to the header." 233 :group 'org-agenda-export 234 :group 'org-export-html 235 :type '(choice 236 (const nil) 237 (string))) 238 239 (defcustom org-agenda-persistent-filter nil 240 "When set, keep filters from one agenda view to the next." 241 :group 'org-agenda 242 :type 'boolean) 243 244 (defgroup org-agenda-custom-commands nil 245 "Options concerning agenda views in Org mode." 246 :tag "Org Agenda Custom Commands" 247 :group 'org-agenda) 248 249 (defconst org-sorting-choice 250 '(choice 251 (const time-up) (const time-down) 252 (const timestamp-up) (const timestamp-down) 253 (const scheduled-up) (const scheduled-down) 254 (const deadline-up) (const deadline-down) 255 (const ts-up) (const ts-down) 256 (const tsia-up) (const tsia-down) 257 (const category-keep) (const category-up) (const category-down) 258 (const tag-down) (const tag-up) 259 (const priority-up) (const priority-down) 260 (const todo-state-up) (const todo-state-down) 261 (const effort-up) (const effort-down) 262 (const habit-up) (const habit-down) 263 (const alpha-up) (const alpha-down) 264 (const user-defined-up) (const user-defined-down)) 265 "Sorting choices.") 266 267 ;; Keep custom values for `org-agenda-filter-preset' compatible with 268 ;; the new variable `org-agenda-tag-filter-preset'. 269 (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) 270 (defvaralias 'org-agenda-filter 'org-agenda-tag-filter) 271 272 (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) 273 "List of types searched for when creating the daily/weekly agenda. 274 This variable is a list of symbols that controls the types of 275 items that appear in the daily/weekly agenda. Allowed symbols in this 276 list are 277 278 :timestamp List items containing a date stamp or date range matching 279 the selected date. This includes sexp entries in angular 280 brackets. 281 282 :sexp List entries resulting from plain diary-like sexps. 283 284 :deadline List deadline due on that date. When the date is today, 285 also list any deadlines past due, or due within 286 `org-deadline-warning-days'. 287 288 :deadline* Same as above, but only include the deadline if it has an 289 hour specification as [h]h:mm. 290 291 :scheduled List all items which are scheduled for the given date. 292 The diary for *today* also contains items which were 293 scheduled earlier and are not yet marked DONE. 294 295 :scheduled* Same as above, but only include the scheduled item if it 296 has an hour specification as [h]h:mm. 297 298 By default, all four non-starred types are turned on. 299 300 When :scheduled* or :deadline* are included, :schedule or :deadline 301 will be ignored. 302 303 Never set this variable globally using `setq', because then it 304 will apply to all future agenda commands. Instead, bind it with 305 `let' to scope it dynamically into the agenda-constructing 306 command. A good way to set it is through options in 307 `org-agenda-custom-commands'. For a more flexible (though 308 somewhat less efficient) way of determining what is included in 309 the daily/weekly agenda, see `org-agenda-skip-function'.") 310 311 (defconst org-agenda-custom-commands-local-options 312 `(repeat :tag "Local settings for this command. Remember to quote values" 313 (choice :tag "Setting" 314 (list :tag "Heading for this block" 315 (const org-agenda-overriding-header) 316 (string :tag "Headline")) 317 (list :tag "Files to be searched" 318 (const org-agenda-files) 319 (list 320 (const :format "" quote) 321 (repeat (file)))) 322 (list :tag "Sorting strategy" 323 (const org-agenda-sorting-strategy) 324 (list 325 (const :format "" quote) 326 (repeat 327 ,org-sorting-choice))) 328 (list :tag "Prefix format" 329 (const org-agenda-prefix-format :value " %-12:c%?-12t% s") 330 (string)) 331 (list :tag "Number of days in agenda" 332 (const org-agenda-span) 333 (list 334 (const :format "" quote) 335 (choice (const :tag "Day" day) 336 (const :tag "Week" week) 337 (const :tag "Fortnight" fortnight) 338 (const :tag "Month" month) 339 (const :tag "Year" year) 340 (integer :tag "Custom")))) 341 (list :tag "Fixed starting date" 342 (const org-agenda-start-day) 343 (string :value "2007-11-01")) 344 (list :tag "Start on day of week" 345 (const org-agenda-start-on-weekday) 346 (choice :value 1 347 (const :tag "Today" nil) 348 (integer :tag "Weekday No."))) 349 (list :tag "Include data from diary" 350 (const org-agenda-include-diary) 351 (boolean)) 352 (list :tag "Deadline Warning days" 353 (const org-deadline-warning-days) 354 (integer :value 1)) 355 (list :tag "Category filter preset" 356 (const org-agenda-category-filter-preset) 357 (list 358 (const :format "" quote) 359 (repeat 360 (string :tag "+category or -category")))) 361 (list :tag "Tags filter preset" 362 (const org-agenda-tag-filter-preset) 363 (list 364 (const :format "" quote) 365 (repeat 366 (string :tag "+tag or -tag")))) 367 (list :tag "Effort filter preset" 368 (const org-agenda-effort-filter-preset) 369 (list 370 (const :format "" quote) 371 (repeat 372 (string :tag "+=10 or -=10 or +<10 or ->10")))) 373 (list :tag "Regexp filter preset" 374 (const org-agenda-regexp-filter-preset) 375 (list 376 (const :format "" quote) 377 (repeat 378 (string :tag "+regexp or -regexp")))) 379 (list :tag "Set daily/weekly entry types" 380 (const org-agenda-entry-types) 381 (list 382 (const :format "" quote) 383 (set :greedy t :value ,org-agenda-entry-types 384 (const :deadline) 385 (const :scheduled) 386 (const :deadline*) 387 (const :scheduled*) 388 (const :timestamp) 389 (const :sexp)))) 390 (list :tag "Columns format" 391 (const org-overriding-columns-format) 392 (string :tag "Format")) 393 (list :tag "Standard skipping condition" 394 :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) 395 (const org-agenda-skip-function) 396 (list 397 (const :format "" quote) 398 (list 399 (choice 400 :tag "Skipping range" 401 (const :tag "Skip entry" org-agenda-skip-entry-if) 402 (const :tag "Skip subtree" org-agenda-skip-subtree-if)) 403 (repeat :inline t :tag "Conditions for skipping" 404 (choice 405 :tag "Condition type" 406 (list :tag "Regexp matches" :inline t 407 (const :format "" regexp) 408 (regexp)) 409 (list :tag "Regexp does not match" :inline t 410 (const :format "" notregexp) 411 (regexp)) 412 (list :tag "TODO state is" :inline t 413 (const todo) 414 (choice 415 (const :tag "Any not-done state" todo) 416 (const :tag "Any done state" done) 417 (const :tag "Any state" any) 418 (list :tag "Keyword list" 419 (const :format "" quote) 420 (repeat (string :tag "Keyword"))))) 421 (list :tag "TODO state is not" :inline t 422 (const nottodo) 423 (choice 424 (const :tag "Any not-done state" todo) 425 (const :tag "Any done state" done) 426 (const :tag "Any state" any) 427 (list :tag "Keyword list" 428 (const :format "" quote) 429 (repeat (string :tag "Keyword"))))) 430 (const :tag "scheduled" scheduled) 431 (const :tag "not scheduled" notscheduled) 432 (const :tag "deadline" deadline) 433 (const :tag "no deadline" notdeadline) 434 (const :tag "timestamp" timestamp) 435 (const :tag "no timestamp" nottimestamp)))))) 436 (list :tag "Non-standard skipping condition" 437 :value (org-agenda-skip-function) 438 (const org-agenda-skip-function) 439 (sexp :tag "Function or form (quoted!)")) 440 (list :tag "Any variable" 441 (variable :tag "Variable") 442 (sexp :tag "Value (sexp)")))) 443 "Selection of examples for agenda command settings. 444 This will be spliced into the custom type of 445 `org-agenda-custom-commands'.") 446 447 448 (defcustom org-agenda-custom-commands 449 '(("n" "Agenda and all TODOs" ((agenda "") (alltodo "")))) 450 "Custom commands for the agenda. 451 \\<org-mode-map> 452 These commands will be offered on the splash screen displayed by the 453 agenda dispatcher `\\[org-agenda]'. Each entry is a list like this: 454 455 (key desc type match settings files) 456 457 key The key (one or more characters as a string) to be associated 458 with the command. 459 desc A description of the command, when omitted or nil, a default 460 description is built using MATCH. 461 type The command type, any of the following symbols: 462 agenda The daily/weekly agenda. 463 todo Entries with a specific TODO keyword, in all agenda files. 464 search Entries containing search words entry or headline. 465 tags Tags/Property/TODO match in all agenda files. 466 tags-todo Tags/P/T match in all agenda files, TODO entries only. 467 todo-tree Sparse tree of specific TODO keyword in *current* file. 468 tags-tree Sparse tree with all tags matches in *current* file. 469 occur-tree Occur sparse tree for *current* file. 470 ... A user-defined function. 471 match What to search for: 472 - a single keyword for TODO keyword searches 473 - a tags/property/todo match expression for searches 474 - a word search expression for text searches. 475 - a regular expression for occur searches 476 For all other commands, this should be the empty string. 477 settings A list of option settings, similar to that in a let form, so like 478 this: ((opt1 val1) (opt2 val2) ...). The values will be 479 evaluated at the moment of execution, so quote them when needed. 480 files A list of files to write the produced agenda buffer to with 481 the command `org-store-agenda-views'. 482 If a file name ends in \".html\", an HTML version of the buffer 483 is written out. If it ends in \".ps\", a postscript version is 484 produced. Otherwise, only the plain text is written to the file. 485 486 You can also define a set of commands, to create a composite agenda buffer. 487 In this case, an entry looks like this: 488 489 (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files) 490 491 where 492 493 desc A description string to be displayed in the dispatcher menu. 494 cmd An agenda command, similar to the above. However, tree commands 495 are not allowed, but instead you can get agenda and global todo list. 496 So valid commands for a set are: 497 (agenda \"\" settings) 498 (alltodo \"\" settings) 499 (stuck \"\" settings) 500 (todo \"match\" settings files) 501 (search \"match\" settings files) 502 (tags \"match\" settings files) 503 (tags-todo \"match\" settings files) 504 505 Each command can carry a list of options, and another set of options can be 506 given for the whole set of commands. Individual command options take 507 precedence over the general options. 508 509 When using several characters as key to a command, the first characters 510 are prefix commands. For the dispatcher to display useful information, you 511 should provide a description for the prefix, like 512 513 (setq org-agenda-custom-commands 514 \\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" 515 (\"hl\" tags \"+HOME+Lisa\") 516 (\"hp\" tags \"+HOME+Peter\") 517 (\"hk\" tags \"+HOME+Kim\")))" 518 :group 'org-agenda-custom-commands 519 :type `(repeat 520 (choice :value ("x" "Describe command here" tags "" nil) 521 (list :tag "Single command" 522 (string :tag "Access Key(s) ") 523 (option (string :tag "Description")) 524 (choice 525 (const :tag "Agenda" agenda) 526 (const :tag "TODO list" alltodo) 527 (const :tag "Search words" search) 528 (const :tag "Stuck projects" stuck) 529 (const :tag "Tags/Property match (all agenda files)" tags) 530 (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) 531 (const :tag "TODO keyword search (all agenda files)" todo) 532 (const :tag "Tags sparse tree (current buffer)" tags-tree) 533 (const :tag "TODO keyword tree (current buffer)" todo-tree) 534 (const :tag "Occur tree (current buffer)" occur-tree) 535 (sexp :tag "Other, user-defined function")) 536 (string :tag "Match (only for some commands)") 537 ,org-agenda-custom-commands-local-options 538 (option (repeat :tag "Export" (file :tag "Export to")))) 539 (list :tag "Command series, all agenda files" 540 (string :tag "Access Key(s)") 541 (string :tag "Description ") 542 (repeat :tag "Component" 543 (choice 544 (list :tag "Agenda" 545 (const :format "" agenda) 546 (const :tag "" :format "" "") 547 ,org-agenda-custom-commands-local-options) 548 (list :tag "TODO list (all keywords)" 549 (const :format "" alltodo) 550 (const :tag "" :format "" "") 551 ,org-agenda-custom-commands-local-options) 552 (list :tag "Search words" 553 (const :format "" search) 554 (string :tag "Match") 555 ,org-agenda-custom-commands-local-options) 556 (list :tag "Stuck projects" 557 (const :format "" stuck) 558 (const :tag "" :format "" "") 559 ,org-agenda-custom-commands-local-options) 560 (list :tag "Tags/Property match (all agenda files)" 561 (const :format "" tags) 562 (string :tag "Match") 563 ,org-agenda-custom-commands-local-options) 564 (list :tag "Tags/Property match of TODO entries (all agenda files)" 565 (const :format "" tags-todo) 566 (string :tag "Match") 567 ,org-agenda-custom-commands-local-options) 568 (list :tag "TODO keyword search" 569 (const :format "" todo) 570 (string :tag "Match") 571 ,org-agenda-custom-commands-local-options) 572 (list :tag "Other, user-defined function" 573 (symbol :tag "function") 574 (string :tag "Match") 575 ,org-agenda-custom-commands-local-options))) 576 577 (repeat :tag "Settings for entire command set" 578 (list (variable :tag "Any variable") 579 (sexp :tag "Value"))) 580 (option (repeat :tag "Export" (file :tag "Export to")))) 581 (cons :tag "Prefix key documentation" 582 (string :tag "Access Key(s)") 583 (string :tag "Description "))))) 584 585 (defcustom org-agenda-query-register ?o 586 "The register holding the current query string. 587 The purpose of this is that if you construct a query string interactively, 588 you can then use it to define a custom command." 589 :group 'org-agenda-custom-commands 590 :type 'character) 591 592 (defcustom org-stuck-projects 593 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") 594 "How to identify stuck projects. 595 This is a list of four items: 596 1. A tags/todo/property matcher string that is used to identify a project. 597 See the manual for a description of tag and property searches. 598 The entire tree below a headline matched by this is considered one project. 599 2. A list of TODO keywords identifying non-stuck projects. 600 If the project subtree contains any headline with one of these todo 601 keywords, the project is considered to be not stuck. If you specify 602 \"*\" as a keyword, any TODO keyword will mark the project unstuck. 603 3. A list of tags identifying non-stuck projects. 604 If the project subtree contains any headline with one of these tags, 605 the project is considered to be not stuck. If you specify \"*\" as 606 a tag, any tag will mark the project unstuck. Note that this is about 607 the explicit presence of a tag somewhere in the subtree, inherited 608 tags do not count here. If inherited tags make a project not stuck, 609 use \"-TAG\" in the tags part of the matcher under (1.) above. 610 4. An arbitrary regular expression matching non-stuck projects. 611 612 If the project turns out to be not stuck, search continues also in the 613 subtree to see if any of the subtasks have project status. 614 615 See also the variable `org-tags-match-list-sublevels' which applies 616 to projects matched by this search as well. 617 618 After defining this variable, you may use `org-agenda-list-stuck-projects' 619 \(bound to `\\[org-agenda] #') to produce the list." 620 :group 'org-agenda-custom-commands 621 :type '(list 622 (string :tag "Tags/TODO match to identify a project") 623 (repeat :tag "Projects are *not* stuck if they have an entry with \ 624 TODO keyword any of" (string)) 625 (repeat :tag "Projects are *not* stuck if they have an entry with \ 626 TAG being any of" (string)) 627 (regexp :tag "Projects are *not* stuck if this regexp matches inside \ 628 the subtree"))) 629 630 (defgroup org-agenda-skip nil 631 "Options concerning skipping parts of agenda files." 632 :tag "Org Agenda Skip" 633 :group 'org-agenda) 634 635 (defcustom org-agenda-skip-function-global nil 636 "Function to be called at each match during agenda construction. 637 If this function returns nil, the current match should not be skipped. 638 If the function decided to skip an agenda match, is must return the 639 buffer position from which the search should be continued. 640 This may also be a Lisp form, which will be evaluated. 641 642 This variable will be applied to every agenda match, including 643 tags/property searches and TODO lists. So try to make the test function 644 do its checking as efficiently as possible. To implement a skipping 645 condition just for specific agenda commands, use the variable 646 `org-agenda-skip-function' which can be set in the options section 647 of custom agenda commands." 648 :group 'org-agenda-skip 649 :type 'sexp) 650 651 (defgroup org-agenda-daily/weekly nil 652 "Options concerning the daily/weekly agenda." 653 :tag "Org Agenda Daily/Weekly" 654 :group 'org-agenda) 655 (defgroup org-agenda-todo-list nil 656 "Options concerning the global todo list agenda view." 657 :tag "Org Agenda Todo List" 658 :group 'org-agenda) 659 (defgroup org-agenda-match-view nil 660 "Options concerning the general tags/property/todo match agenda view." 661 :tag "Org Agenda Match View" 662 :group 'org-agenda) 663 (defgroup org-agenda-search-view nil 664 "Options concerning the search agenda view." 665 :tag "Org Agenda Search View" 666 :group 'org-agenda) 667 668 (defvar org-agenda-archives-mode nil 669 "Non-nil means the agenda will include archived items. 670 If this is the symbol `trees', trees in the selected agenda scope 671 that are marked with the ARCHIVE tag will be included anyway. When this is 672 t, also all archive files associated with the current selection of agenda 673 files will be included.") 674 675 (defcustom org-agenda-restriction-lock-highlight-subtree t 676 "Non-nil means highlight the whole subtree when restriction is active. 677 Otherwise only highlight the headline. Highlighting the whole subtree is 678 useful to ensure no edits happen beyond the restricted region." 679 :group 'org-agenda 680 :type 'boolean) 681 682 (defcustom org-agenda-skip-comment-trees t 683 "Non-nil means skip trees that start with the COMMENT keyword. 684 When nil, these trees are also scanned by agenda commands." 685 :group 'org-agenda-skip 686 :type 'boolean) 687 688 (defcustom org-agenda-todo-list-sublevels t 689 "Non-nil means check also the sublevels of a TODO entry for TODO entries. 690 When nil, the sublevels of a TODO entry are not checked, resulting in 691 potentially much shorter TODO lists." 692 :group 'org-agenda-skip 693 :group 'org-agenda-todo-list 694 :type 'boolean) 695 696 (defcustom org-agenda-todo-ignore-with-date nil 697 "Non-nil means don't show entries with a date in the global todo list. 698 You can use this if you prefer to mark mere appointments with a TODO keyword, 699 but don't want them to show up in the TODO list. 700 When this is set, it also covers deadlines and scheduled items, the settings 701 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' 702 will be ignored. 703 See also the variable `org-agenda-tags-todo-honor-ignore-options'." 704 :group 'org-agenda-skip 705 :group 'org-agenda-todo-list 706 :type 'boolean) 707 708 (defcustom org-agenda-todo-ignore-timestamp nil 709 "Non-nil means don't show entries with a timestamp. 710 This applies when creating the global todo list. 711 Valid values are: 712 713 past Don't show entries for today or in the past. 714 715 future Don't show entries with a timestamp in the future. 716 The idea behind this is that if it has a future 717 timestamp, you don't want to think about it until the 718 date. 719 720 all Don't show any entries with a timestamp in the global todo list. 721 The idea behind this is that by setting a timestamp, you 722 have already \"taken care\" of this item. 723 724 This variable can also have an integer as a value. If positive (N), 725 todos with a timestamp N or more days in the future will be ignored. If 726 negative (-N), todos with a timestamp N or more days in the past will be 727 ignored. If 0, todos with a timestamp either today or in the future will 728 be ignored. For example, a value of -1 will exclude todos with a 729 timestamp in the past (yesterday or earlier), while a value of 7 will 730 exclude todos with a timestamp a week or more in the future. 731 732 See also `org-agenda-todo-ignore-with-date'. 733 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want 734 to make his option also apply to the tags-todo list." 735 :group 'org-agenda-skip 736 :group 'org-agenda-todo-list 737 :version "24.1" 738 :type '(choice 739 (const :tag "Ignore future timestamp todos" future) 740 (const :tag "Ignore past or present timestamp todos" past) 741 (const :tag "Ignore all timestamp todos" all) 742 (const :tag "Show timestamp todos" nil) 743 (integer :tag "Ignore if N or more days in past(-) or future(+)."))) 744 745 (defcustom org-agenda-todo-ignore-scheduled nil 746 "Non-nil means, ignore some scheduled TODO items when making TODO list. 747 This applies when creating the global todo list. 748 Valid values are: 749 750 past Don't show entries scheduled today or in the past. 751 752 future Don't show entries scheduled in the future. 753 The idea behind this is that by scheduling it, you don't want to 754 think about it until the scheduled date. 755 756 all Don't show any scheduled entries in the global todo list. 757 The idea behind this is that by scheduling it, you have already 758 \"taken care\" of this item. 759 760 t Same as `all', for backward compatibility. 761 762 This variable can also have an integer as a value. See 763 `org-agenda-todo-ignore-timestamp' for more details. 764 765 See also `org-agenda-todo-ignore-with-date'. 766 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want 767 to make his option also apply to the tags-todo list." 768 :group 'org-agenda-skip 769 :group 'org-agenda-todo-list 770 :type '(choice 771 (const :tag "Ignore future-scheduled todos" future) 772 (const :tag "Ignore past- or present-scheduled todos" past) 773 (const :tag "Ignore all scheduled todos" all) 774 (const :tag "Ignore all scheduled todos (compatibility)" t) 775 (const :tag "Show scheduled todos" nil) 776 (integer :tag "Ignore if N or more days in past(-) or future(+)."))) 777 778 (defcustom org-agenda-todo-ignore-deadlines nil 779 "Non-nil means ignore some deadline TODO items when making TODO list. 780 781 There are different motivations for using different values, please think 782 carefully when configuring this variable. 783 784 This applies when creating the global TODO list. 785 786 Valid values are: 787 788 near Don't show near deadline entries. A deadline is near when it is 789 closer than `org-deadline-warning-days' days. The idea behind this 790 is that such items will appear in the agenda anyway. 791 792 far Don't show TODO entries where a deadline has been defined, but 793 is not going to happen anytime soon. This is useful if you want to use 794 the TODO list to figure out what to do now. 795 796 past Don't show entries with a deadline timestamp for today or in the past. 797 798 future Don't show entries with a deadline timestamp in the future, not even 799 when they become `near' ones. Use it with caution. 800 801 all Ignore all TODO entries that do have a deadline. 802 803 t Same as `near', for backward compatibility. 804 805 This variable can also have an integer as a value. See 806 `org-agenda-todo-ignore-timestamp' for more details. 807 808 See also `org-agenda-todo-ignore-with-date'. 809 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want 810 to make his option also apply to the tags-todo list." 811 :group 'org-agenda-skip 812 :group 'org-agenda-todo-list 813 :type '(choice 814 (const :tag "Ignore near deadlines" near) 815 (const :tag "Ignore near deadlines (compatibility)" t) 816 (const :tag "Ignore far deadlines" far) 817 (const :tag "Ignore all TODOs with a deadlines" all) 818 (const :tag "Show all TODOs, even if they have a deadline" nil) 819 (integer :tag "Ignore if N or more days in past(-) or future(+)."))) 820 821 (defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil 822 "Time unit to use when possibly ignoring an agenda item. 823 824 See the docstring of various `org-agenda-todo-ignore-*' options. 825 The default is to compare time stamps using days. An item is thus 826 considered to be in the future if it is at least one day after today. 827 Non-nil means to compare time stamps using seconds. An item is then 828 considered future if it has a time value later than current time." 829 :group 'org-agenda-skip 830 :group 'org-agenda-todo-list 831 :version "24.4" 832 :package-version '(Org . "8.0") 833 :type '(choice 834 (const :tag "Compare time with days" nil) 835 (const :tag "Compare time with seconds" t))) 836 837 (defcustom org-agenda-tags-todo-honor-ignore-options nil 838 "Non-nil means honor todo-list ignores options also in tags-todo search. 839 The variables 840 `org-agenda-todo-ignore-with-date', 841 `org-agenda-todo-ignore-timestamp', 842 `org-agenda-todo-ignore-scheduled', 843 `org-agenda-todo-ignore-deadlines' 844 make the global TODO list skip entries that have time stamps of certain 845 kinds. If this option is set, the same options will also apply for the 846 tags-todo search, which is the general tags/property matcher 847 restricted to unfinished TODO entries only." 848 :group 'org-agenda-skip 849 :group 'org-agenda-todo-list 850 :group 'org-agenda-match-view 851 :type 'boolean) 852 853 (defcustom org-agenda-skip-scheduled-if-done nil 854 "Non-nil means don't show scheduled items in agenda when they are done. 855 This is relevant for the daily/weekly agenda, not for the TODO list. It 856 applies only to the actual date of the scheduling. Warnings about an item 857 with a past scheduling dates are always turned off when the item is DONE." 858 :group 'org-agenda-skip 859 :group 'org-agenda-daily/weekly 860 :type 'boolean) 861 862 (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil 863 "Non-nil means skip scheduling line if same entry shows because of deadline. 864 865 In the agenda of today, an entry can show up multiple times 866 because it is both scheduled and has a nearby deadline, and maybe 867 a plain time stamp as well. 868 869 When this variable is nil, the entry will be shown several times. 870 871 When set to t, then only the deadline is shown and the fact that 872 the entry is scheduled today or was scheduled previously is not 873 shown. 874 875 When set to the symbol `not-today', skip scheduled previously, 876 but not scheduled today. 877 878 When set to the symbol `repeated-after-deadline', skip scheduled 879 items if they are repeated beyond the current deadline." 880 :group 'org-agenda-skip 881 :group 'org-agenda-daily/weekly 882 :type '(choice 883 (const :tag "Never" nil) 884 (const :tag "Always" t) 885 (const :tag "Not when scheduled today" not-today) 886 (const :tag "When repeated past deadline" repeated-after-deadline))) 887 888 (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil 889 "Non-nil means skip timestamp line if same entry shows because of deadline. 890 In the agenda of today, an entry can show up multiple times 891 because it has both a plain timestamp and has a nearby deadline. 892 When this variable is t, then only the deadline is shown and the 893 fact that the entry has a timestamp for or including today is not 894 shown. When this variable is nil, the entry will be shown 895 several times." 896 :group 'org-agenda-skip 897 :group 'org-agenda-daily/weekly 898 :version "24.1" 899 :type '(choice 900 (const :tag "Never" nil) 901 (const :tag "Always" t))) 902 903 (defcustom org-agenda-skip-deadline-if-done nil 904 "Non-nil means don't show deadlines when the corresponding item is done. 905 When nil, the deadline is still shown and should give you a happy feeling. 906 This is relevant for the daily/weekly agenda. It applies only to the 907 actual date of the deadline. Warnings about approaching and past-due 908 deadlines are always turned off when the item is DONE." 909 :group 'org-agenda-skip 910 :group 'org-agenda-daily/weekly 911 :type 'boolean) 912 913 (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil 914 "Non-nil means skip deadline prewarning when entry is also scheduled. 915 This will apply on all days where a prewarning for the deadline would 916 be shown, but not at the day when the entry is actually due. On that day, 917 the deadline will be shown anyway. 918 This variable may be set to nil, t, the symbol `pre-scheduled', 919 or a number which will then give the number of days before the actual 920 deadline when the prewarnings should resume. The symbol `pre-scheduled' 921 eliminates the deadline prewarning only prior to the scheduled date. 922 This can be used in a workflow where the first showing of the deadline will 923 trigger you to schedule it, and then you don't want to be reminded of it 924 because you will take care of it on the day when scheduled." 925 :group 'org-agenda-skip 926 :group 'org-agenda-daily/weekly 927 :version "24.1" 928 :type '(choice 929 (const :tag "Always show prewarning" nil) 930 (const :tag "Remove prewarning prior to scheduled date" pre-scheduled) 931 (const :tag "Remove prewarning if entry is scheduled" t) 932 (integer :tag "Restart prewarning N days before deadline"))) 933 934 (defcustom org-agenda-skip-scheduled-delay-if-deadline nil 935 "Non-nil means skip scheduled delay when entry also has a deadline. 936 This variable may be set to nil, t, the symbol `post-deadline', 937 or a number which will then give the number of days after the actual 938 scheduled date when the delay should expire. The symbol `post-deadline' 939 eliminates the schedule delay when the date is posterior to the deadline." 940 :group 'org-agenda-skip 941 :group 'org-agenda-daily/weekly 942 :version "24.4" 943 :package-version '(Org . "8.0") 944 :type '(choice 945 (const :tag "Always honor delay" nil) 946 (const :tag "Ignore delay if posterior to the deadline" post-deadline) 947 (const :tag "Ignore delay if entry has a deadline" t) 948 (integer :tag "Honor delay up until N days after the scheduled date"))) 949 950 (defcustom org-agenda-skip-additional-timestamps-same-entry nil 951 "When nil, multiple same-day timestamps in entry make multiple agenda lines. 952 When non-nil, after the search for timestamps has matched once in an 953 entry, the rest of the entry will not be searched." 954 :group 'org-agenda-skip 955 :type 'boolean) 956 957 (defcustom org-agenda-skip-timestamp-if-done nil 958 "Non-nil means don't select item by timestamp or -range if it is DONE." 959 :group 'org-agenda-skip 960 :group 'org-agenda-daily/weekly 961 :type 'boolean) 962 963 (defcustom org-agenda-dim-blocked-tasks t 964 "Non-nil means dim blocked tasks in the agenda display. 965 This causes some overhead during agenda construction, but if you 966 have turned on `org-enforce-todo-dependencies', 967 `org-enforce-todo-checkbox-dependencies', or any other blocking 968 mechanism, this will create useful feedback in the agenda. 969 970 Instead of t, this variable can also have the value `invisible'. 971 Then blocked tasks will be invisible and only become visible when 972 they become unblocked. An exemption to this behavior is when a task is 973 blocked because of unchecked checkboxes below it. Since checkboxes do 974 not show up in the agenda views, making this task invisible you remove any 975 trace from agenda views that there is something to do. Therefore, a task 976 that is blocked because of checkboxes will never be made invisible, it 977 will only be dimmed." 978 :group 'org-agenda-daily/weekly 979 :group 'org-agenda-todo-list 980 :version "24.3" 981 :type '(choice 982 (const :tag "Do not dim" nil) 983 (const :tag "Dim to a gray face" t) 984 (const :tag "Make invisible" invisible))) 985 986 (defgroup org-agenda-startup nil 987 "Options concerning initial settings in the Agenda in Org Mode." 988 :tag "Org Agenda Startup" 989 :group 'org-agenda) 990 991 (defcustom org-agenda-menu-show-matcher t 992 "Non-nil means show the match string in the agenda dispatcher menu. 993 When nil, the matcher string is not shown, but is put into the help-echo 994 property so than moving the mouse over the command shows it. 995 Setting it to nil is good if matcher strings are very long and/or if 996 you want to use two-columns display (see `org-agenda-menu-two-columns')." 997 :group 'org-agenda 998 :version "24.1" 999 :type 'boolean) 1000 1001 (defcustom org-agenda-menu-two-columns nil 1002 "Non-nil means, use two columns to show custom commands in the dispatcher. 1003 If you use this, you probably want to set `org-agenda-menu-show-matcher' 1004 to nil." 1005 :group 'org-agenda 1006 :version "24.1" 1007 :type 'boolean) 1008 1009 (defcustom org-agenda-finalize-hook nil 1010 "Hook run just before displaying an agenda buffer. 1011 The buffer is still writable when the hook is called. 1012 1013 You can modify some of the buffer substrings but you should be 1014 extra careful not to modify the text properties of the agenda 1015 headlines as the agenda display heavily relies on them." 1016 :group 'org-agenda-startup 1017 :type 'hook) 1018 1019 (defcustom org-agenda-filter-hook nil 1020 "Hook run just after filtering with `org-agenda-filter'." 1021 :group 'org-agenda-startup 1022 :package-version '(Org . "9.4") 1023 :type 'hook) 1024 1025 (defcustom org-agenda-mouse-1-follows-link nil 1026 "Non-nil means mouse-1 on a link will follow the link in the agenda. 1027 A longer mouse click will still set point. Needs to be set 1028 before org.el is loaded." 1029 :group 'org-agenda-startup 1030 :type 'boolean) 1031 1032 (defcustom org-agenda-start-with-follow-mode nil 1033 "The initial value of follow mode in a newly created agenda window." 1034 :group 'org-agenda-startup 1035 :type 'boolean) 1036 1037 (defcustom org-agenda-follow-indirect nil 1038 "Non-nil means `org-agenda-follow-mode' displays only the 1039 current item's tree, in an indirect buffer." 1040 :group 'org-agenda 1041 :version "24.1" 1042 :type 'boolean) 1043 1044 (defcustom org-agenda-show-outline-path t 1045 "Non-nil means show outline path in echo area after line motion." 1046 :group 'org-agenda-startup 1047 :type 'boolean) 1048 1049 (defcustom org-agenda-start-with-entry-text-mode nil 1050 "The initial value of entry-text-mode in a newly created agenda window." 1051 :group 'org-agenda-startup 1052 :type 'boolean) 1053 1054 (defcustom org-agenda-entry-text-maxlines 5 1055 "Number of text lines to be added when `E' is pressed in the agenda. 1056 1057 Note that this variable only used during agenda display. To add entry text 1058 when exporting the agenda, configure the variable 1059 `org-agenda-add-entry-text-maxlines'." 1060 :group 'org-agenda 1061 :type 'integer) 1062 1063 (defcustom org-agenda-entry-text-exclude-regexps nil 1064 "List of regular expressions to clean up entry text. 1065 The complete matches of all regular expressions in this list will be 1066 removed from entry text before it is shown in the agenda." 1067 :group 'org-agenda 1068 :type '(repeat (regexp))) 1069 1070 (defcustom org-agenda-entry-text-leaders " > " 1071 "Text prepended to the entry text in agenda buffers." 1072 :version "24.4" 1073 :package-version '(Org . "8.0") 1074 :group 'org-agenda 1075 :type 'string) 1076 1077 (defvar org-agenda-entry-text-cleanup-hook nil 1078 "Hook that is run after basic cleanup of entry text to be shown in agenda. 1079 This cleanup is done in a temporary buffer, so the function may inspect and 1080 change the entire buffer. 1081 Some default stuff like drawers and scheduling/deadline dates will already 1082 have been removed when this is called, as will any matches for regular 1083 expressions listed in `org-agenda-entry-text-exclude-regexps'.") 1084 1085 (defvar org-agenda-include-inactive-timestamps nil 1086 "Non-nil means include inactive time stamps in agenda. 1087 Dynamically scoped.") 1088 1089 (defgroup org-agenda-windows nil 1090 "Options concerning the windows used by the Agenda in Org Mode." 1091 :tag "Org Agenda Windows" 1092 :group 'org-agenda) 1093 1094 (defcustom org-agenda-window-setup 'reorganize-frame 1095 "How the agenda buffer should be displayed. 1096 Possible values for this option are: 1097 1098 current-window Show agenda in the current window, keeping all other windows. 1099 other-window Use `switch-to-buffer-other-window' to display agenda. 1100 only-window Show agenda, deleting all other windows. 1101 reorganize-frame Show only two windows on the current frame, the current 1102 window and the agenda. 1103 other-frame Use `switch-to-buffer-other-frame' to display agenda. 1104 Also, when exiting the agenda, kill that frame. 1105 other-tab Use `switch-to-buffer-other-tab' to display the 1106 agenda, making use of the `tab-bar-mode' introduced 1107 in Emacs version 27.1. Also, kill that tab when 1108 exiting the agenda view. 1109 1110 See also the variable `org-agenda-restore-windows-after-quit'." 1111 :group 'org-agenda-windows 1112 :type '(choice 1113 (const current-window) 1114 (const other-frame) 1115 (const other-tab) 1116 (const other-window) 1117 (const only-window) 1118 (const reorganize-frame)) 1119 :package-version '(Org . "9.4")) 1120 1121 (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) 1122 "The min and max height of the agenda window as a fraction of frame height. 1123 The value of the variable is a cons cell with two numbers between 0 and 1. 1124 It only matters if `org-agenda-window-setup' is `reorganize-frame'." 1125 :group 'org-agenda-windows 1126 :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) 1127 1128 (defcustom org-agenda-restore-windows-after-quit nil 1129 "Non-nil means restore window configuration upon exiting agenda. 1130 Before the window configuration is changed for displaying the 1131 agenda, the current status is recorded. When the agenda is 1132 exited with `q' or `x' and this option is set, the old state is 1133 restored. If `org-agenda-window-setup' is `other-frame' or 1134 `other-tab', the value of this option will be ignored." 1135 :group 'org-agenda-windows 1136 :type 'boolean) 1137 1138 (defcustom org-agenda-span 'week 1139 "Number of days to include in overview display. 1140 Can be day, week, month, year, or any number of days. 1141 Custom commands can set this variable in the options section." 1142 :group 'org-agenda-daily/weekly 1143 :type '(choice (const :tag "Day" day) 1144 (const :tag "Week" week) 1145 (const :tag "Fortnight" fortnight) 1146 (const :tag "Month" month) 1147 (const :tag "Year" year) 1148 (integer :tag "Custom"))) 1149 1150 (defcustom org-agenda-start-on-weekday 1 1151 "Non-nil means start the overview always on the specified weekday. 1152 0 denotes Sunday, 1 denotes Monday, etc. 1153 When nil, always start on the current day. 1154 Custom commands can set this variable in the options section." 1155 :group 'org-agenda-daily/weekly 1156 :type '(choice (const :tag "Today" nil) 1157 (integer :tag "Weekday No."))) 1158 1159 (defcustom org-agenda-show-all-dates t 1160 "Non-nil means `org-agenda' shows every day in the selected range. 1161 When nil, only the days which actually have entries are shown." 1162 :group 'org-agenda-daily/weekly 1163 :type 'boolean) 1164 1165 (defcustom org-agenda-format-date 'org-agenda-format-date-aligned 1166 "Format string for displaying dates in the agenda. 1167 Used by the daily/weekly agenda. This should be a format string 1168 understood by `format-time-string', or a function returning the 1169 formatted date as a string. The function must take a single 1170 argument, a calendar-style date list like (month day year)." 1171 :group 'org-agenda-daily/weekly 1172 :type '(choice 1173 (string :tag "Format string") 1174 (function :tag "Function"))) 1175 1176 (defun org-agenda-end-of-line () 1177 "Go to the end of visible line." 1178 (interactive) 1179 (goto-char (line-end-position))) 1180 1181 (defun org-agenda-format-date-aligned (date) 1182 "Format a DATE string for display in the daily/weekly agenda. 1183 This function makes sure that dates are aligned for easy reading." 1184 (require 'cal-iso) 1185 (let* ((dayname (calendar-day-name date)) 1186 (day (cadr date)) 1187 (day-of-week (calendar-day-of-week date)) 1188 (month (car date)) 1189 (monthname (calendar-month-name month)) 1190 (year (nth 2 date)) 1191 (iso-week (org-days-to-iso-week 1192 (calendar-absolute-from-gregorian date))) 1193 ;; (weekyear (cond ((and (= month 1) (>= iso-week 52)) 1194 ;; (1- year)) 1195 ;; ((and (= month 12) (<= iso-week 1)) 1196 ;; (1+ year)) 1197 ;; (t year))) 1198 (weekstring (if (= day-of-week 1) 1199 (format " W%02d" iso-week) 1200 ""))) 1201 (format "%-10s %2d %s %4d%s" 1202 dayname day monthname year weekstring))) 1203 1204 (defcustom org-agenda-time-leading-zero nil 1205 "Non-nil means use leading zero for military times in agenda. 1206 For example, 9:30am would become 09:30 rather than 9:30." 1207 :group 'org-agenda-daily/weekly 1208 :version "24.1" 1209 :type 'boolean) 1210 1211 (defcustom org-agenda-timegrid-use-ampm nil 1212 "When set, show AM/PM style timestamps on the timegrid." 1213 :group 'org-agenda 1214 :version "24.1" 1215 :type 'boolean) 1216 1217 (defun org-agenda-time-of-day-to-ampm (time) 1218 "Convert TIME of a string like \"13:45\" to an AM/PM style time string." 1219 (let* ((hour-number (string-to-number (substring time 0 -3))) 1220 (minute (substring time -2)) 1221 (ampm "am")) 1222 (cond 1223 ((equal hour-number 12) 1224 (setq ampm "pm")) 1225 ((> hour-number 12) 1226 (setq ampm "pm") 1227 (setq hour-number (- hour-number 12)))) 1228 (concat 1229 (if org-agenda-time-leading-zero 1230 (format "%02d" hour-number) 1231 (format "%02s" (number-to-string hour-number))) 1232 ":" minute ampm))) 1233 1234 (defun org-agenda-time-of-day-to-ampm-maybe (time) 1235 "Conditionally convert TIME to AM/PM format. 1236 This is based on `org-agenda-timegrid-use-ampm'." 1237 (if org-agenda-timegrid-use-ampm 1238 (org-agenda-time-of-day-to-ampm time) 1239 time)) 1240 1241 (defcustom org-agenda-weekend-days '(6 0) 1242 "Which days are weekend? 1243 These days get the special face `org-agenda-date-weekend' in the agenda." 1244 :group 'org-agenda-daily/weekly 1245 :type '(set :greedy t 1246 (const :tag "Monday" 1) 1247 (const :tag "Tuesday" 2) 1248 (const :tag "Wednesday" 3) 1249 (const :tag "Thursday" 4) 1250 (const :tag "Friday" 5) 1251 (const :tag "Saturday" 6) 1252 (const :tag "Sunday" 0))) 1253 1254 (defcustom org-agenda-move-date-from-past-immediately-to-today t 1255 "Non-nil means jump to today when moving a past date forward in time. 1256 When using S-right in the agenda to move a date forward, and the date 1257 stamp currently points to the past, the first key press will move it 1258 to today. When nil, just move one day forward even if the date stays 1259 in the past." 1260 :group 'org-agenda-daily/weekly 1261 :version "24.1" 1262 :type 'boolean) 1263 1264 (defcustom org-agenda-diary-file 'diary-file 1265 "File to which to add new entries with the `i' key in agenda and calendar. 1266 When this is the symbol `diary-file', the functionality in the Emacs 1267 calendar will be used to add entries to the `diary-file'. But when this 1268 points to a file, `org-agenda-diary-entry' will be used instead." 1269 :group 'org-agenda 1270 :type '(choice 1271 (const :tag "The standard Emacs diary file" diary-file) 1272 (file :tag "Special Org file diary entries"))) 1273 1274 (defcustom org-agenda-include-diary nil 1275 "If non-nil, include in the agenda entries from the Emacs Calendar's diary. 1276 Custom commands can set this variable in the options section." 1277 :group 'org-agenda-daily/weekly 1278 :type 'boolean) 1279 1280 (defcustom org-agenda-include-deadlines t 1281 "If non-nil, include entries within their deadline warning period. 1282 Custom commands can set this variable in the options section." 1283 :group 'org-agenda-daily/weekly 1284 :version "24.1" 1285 :type 'boolean) 1286 1287 (defcustom org-agenda-show-future-repeats t 1288 "Non-nil shows repeated entries in the future part of the agenda. 1289 When set to the symbol `next' only the first future repeat is shown." 1290 :group 'org-agenda-daily/weekly 1291 :type '(choice 1292 (const :tag "Show all repeated entries" t) 1293 (const :tag "Show next repeated entry" next) 1294 (const :tag "Do not show repeated entries" nil)) 1295 :version "26.1" 1296 :package-version '(Org . "9.1") 1297 :safe #'symbolp) 1298 1299 (defcustom org-agenda-prefer-last-repeat nil 1300 "Non-nil sets date for repeated entries to their last repeat. 1301 1302 When nil, display SCHEDULED and DEADLINE dates at their base 1303 date, and in today's agenda, as a reminder. Display plain 1304 time-stamps, on the other hand, at every repeat date in the past 1305 in addition to the base date. 1306 1307 When non-nil, show a repeated entry at its latest repeat date, 1308 possibly being today even if it wasn't marked as done. This 1309 setting is useful if you do not always mark repeated entries as 1310 done and, yet, consider that reaching repeat date starts the task 1311 anew. 1312 1313 When set to a list of strings, prefer last repeats only for 1314 entries with these TODO keywords." 1315 :group 'org-agenda-daily/weekly 1316 :type '(choice 1317 (const :tag "Prefer last repeat" t) 1318 (const :tag "Prefer base date" nil) 1319 (repeat :tag "Prefer last repeat for entries with these TODO keywords" 1320 (string :tag "TODO keyword"))) 1321 :version "26.1" 1322 :package-version '(Org . "9.1") 1323 :safe (lambda (x) (or (booleanp x) (consp x)))) 1324 1325 (defcustom org-scheduled-past-days 10000 1326 "Number of days to continue listing scheduled items not marked DONE. 1327 When an item is scheduled on a date, it shows up in the agenda on 1328 this day and will be listed until it is marked done or for the 1329 number of days given here." 1330 :group 'org-agenda-daily/weekly 1331 :type 'integer 1332 :safe 'integerp) 1333 1334 (defcustom org-deadline-past-days 10000 1335 "Number of days to warn about missed deadlines. 1336 When an item has deadline on a date, it shows up in the agenda on 1337 this day and will appear as a reminder until it is marked DONE or 1338 for the number of days given here." 1339 :group 'org-agenda-daily/weekly 1340 :type 'integer 1341 :version "26.1" 1342 :package-version '(Org . "9.1") 1343 :safe 'integerp) 1344 1345 (defcustom org-agenda-log-mode-items '(closed clock) 1346 "List of items that should be shown in agenda log mode. 1347 \\<org-agenda-mode-map>\ 1348 This list may contain the following symbols: 1349 1350 closed Show entries that have been closed on that day. 1351 clock Show entries that have received clocked time on that day. 1352 state Show all logged state changes. 1353 Note that instead of changing this variable, you can also press \ 1354 `\\[universal-argument] \\[org-agenda-log-mode]' in 1355 the agenda to display all available LOG items temporarily." 1356 :group 'org-agenda-daily/weekly 1357 :type '(set :greedy t (const closed) (const clock) (const state))) 1358 1359 (defcustom org-agenda-clock-consistency-checks 1360 '(:max-duration "10:00" :min-duration 0 :max-gap "0:05" 1361 :gap-ok-around ("4:00") 1362 :default-face ((:background "DarkRed") (:foreground "white")) 1363 :overlap-face nil :gap-face nil :no-end-time-face nil 1364 :long-face nil :short-face nil) 1365 "This is a property list, with the following keys: 1366 1367 :max-duration Mark clocking chunks that are longer than this time. 1368 This is a time string like \"HH:MM\", or the number 1369 of minutes as an integer. 1370 1371 :min-duration Mark clocking chunks that are shorter that this. 1372 This is a time string like \"HH:MM\", or the number 1373 of minutes as an integer. 1374 1375 :max-gap Mark gaps between clocking chunks that are longer than 1376 this duration. A number of minutes, or a string 1377 like \"HH:MM\". 1378 1379 :gap-ok-around List of times during the day which are usually not working 1380 times. When a gap is detected, but the gap contains any 1381 of these times, the gap is *not* reported. For example, 1382 if this is (\"4:00\" \"13:00\") then gaps that contain 1383 4:00 in the morning (i.e. the night) and 13:00 1384 (i.e. a typical lunch time) do not cause a warning. 1385 You should have at least one time during the night in this 1386 list, or otherwise the first task each morning will trigger 1387 a warning because it follows a long gap. 1388 1389 Furthermore, the following properties can be used to define faces for 1390 issue display. 1391 1392 :default-face the default face, if the specific face is undefined 1393 :overlap-face face for overlapping clocks 1394 :gap-face face for gaps between clocks 1395 :no-end-time-face face for incomplete clocks 1396 :long-face face for clock intervals that are too long 1397 :short-face face for clock intervals that are too short" 1398 :group 'org-agenda-daily/weekly 1399 :group 'org-clock 1400 :version "24.1" 1401 :type 'plist) 1402 1403 (defcustom org-agenda-log-mode-add-notes t 1404 "Non-nil means add first line of notes to log entries in agenda views. 1405 If a log item like a state change or a clock entry is associated with 1406 notes, the first line of these notes will be added to the entry in the 1407 agenda display." 1408 :group 'org-agenda-daily/weekly 1409 :type 'boolean) 1410 1411 (defcustom org-agenda-start-with-log-mode nil 1412 "The initial value of log-mode in a newly created agenda window. 1413 See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further 1414 explanations on the possible values." 1415 :group 'org-agenda-startup 1416 :group 'org-agenda-daily/weekly 1417 :type '(choice (const :tag "Don't show log items" nil) 1418 (const :tag "Show only log items" only) 1419 (const :tag "Show all possible log items" clockcheck) 1420 (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'" 1421 (choice (const :tag "Show closed log items" closed) 1422 (const :tag "Show clocked log items" clock) 1423 (const :tag "Show all logged state changes" state))))) 1424 1425 (defcustom org-agenda-start-with-clockreport-mode nil 1426 "The initial value of clockreport-mode in a newly created agenda window." 1427 :group 'org-agenda-startup 1428 :group 'org-agenda-daily/weekly 1429 :type 'boolean) 1430 1431 (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2) 1432 "Property list with parameters for the clocktable in clockreport mode. 1433 This is the display mode that shows a clock table in the daily/weekly 1434 agenda, the properties for this dynamic block can be set here. 1435 The usual clocktable parameters are allowed here, but you cannot set 1436 the properties :name, :tstart, :tend, :block, and :scope - these will 1437 be overwritten to make sure the content accurately reflects the 1438 current display in the agenda." 1439 :group 'org-agenda-daily/weekly 1440 :type 'plist) 1441 1442 (defvaralias 'org-agenda-search-view-search-words-only 1443 'org-agenda-search-view-always-boolean) 1444 1445 (defcustom org-agenda-search-view-always-boolean nil 1446 "Non-nil means the search string is interpreted as individual parts. 1447 1448 The search string for search view can either be interpreted as a phrase, 1449 or as a list of snippets that define a boolean search for a number of 1450 strings. 1451 1452 When this is non-nil, the string will be split on whitespace, and each 1453 snippet will be searched individually, and all must match in order to 1454 select an entry. A snippet is then a single string of non-white 1455 characters, or a string in double quotes, or a regexp in {} braces. 1456 If a snippet is preceded by \"-\", the snippet must *not* match. 1457 \"+\" is syntactic sugar for positive selection. Each snippet may 1458 be found as a full word or a partial word, but see the variable 1459 `org-agenda-search-view-force-full-words'. 1460 1461 When this is nil, search will look for the entire search phrase as one, 1462 with each space character matching any amount of whitespace, including 1463 line breaks. 1464 1465 Even when this is nil, you can still switch to Boolean search dynamically 1466 by preceding the first snippet with \"+\" or \"-\". If the first snippet 1467 is a regexp marked with braces like \"{abc}\", this will also switch to 1468 boolean search." 1469 :group 'org-agenda-search-view 1470 :version "24.1" 1471 :type 'boolean) 1472 1473 (defcustom org-agenda-search-view-force-full-words nil 1474 "Non-nil means, search words must be matches as complete words. 1475 When nil, they may also match part of a word." 1476 :group 'org-agenda-search-view 1477 :version "24.1" 1478 :type 'boolean) 1479 1480 (defcustom org-agenda-search-view-max-outline-level 0 1481 "Maximum outline level to display in search view. 1482 E.g. when this is set to 1, the search view will only 1483 show headlines of level 1. When set to 0, the default 1484 value, don't limit agenda view by outline level." 1485 :group 'org-agenda-search-view 1486 :version "26.1" 1487 :package-version '(Org . "8.3") 1488 :type 'integer) 1489 1490 (defgroup org-agenda-time-grid nil 1491 "Options concerning the time grid in the Org Agenda." 1492 :tag "Org Agenda Time Grid" 1493 :group 'org-agenda) 1494 1495 (defcustom org-agenda-search-headline-for-time t 1496 "Non-nil means search headline for a time-of-day. 1497 If the headline contains a time-of-day in one format or another, it will 1498 be used to sort the entry into the time sequence of items for a day. 1499 Some people have time stamps in the headline that refer to the creation 1500 time or so, and then this produces an unwanted side effect. If this is 1501 the case for your, use this variable to turn off searching the headline 1502 for a time." 1503 :group 'org-agenda-time-grid 1504 :type 'boolean) 1505 1506 (defcustom org-agenda-use-time-grid t 1507 "Non-nil means show a time grid in the agenda schedule. 1508 A time grid is a set of lines for specific times (like every two hours between 1509 8:00 and 20:00). The items scheduled for a day at specific times are 1510 sorted in between these lines. 1511 For details about when the grid will be shown, and what it will look like, see 1512 the variable `org-agenda-time-grid'." 1513 :group 'org-agenda-time-grid 1514 :type 'boolean) 1515 1516 (defcustom org-agenda-time-grid 1517 '((daily today require-timed) 1518 (800 1000 1200 1400 1600 1800 2000) 1519 "......" 1520 "----------------") 1521 1522 "The settings for time grid for agenda display. 1523 This is a list of four items. The first item is again a list. It contains 1524 symbols specifying conditions when the grid should be displayed: 1525 1526 daily if the agenda shows a single day 1527 weekly if the agenda shows an entire week 1528 today show grid on current date, independent of daily/weekly display 1529 require-timed show grid only if at least one item has a time specification 1530 remove-match skip grid times already present in an entry 1531 1532 The second item is a list of integers, indicating the times that 1533 should have a grid line. 1534 1535 The third item is a string which will be placed right after the 1536 times that have a grid line. 1537 1538 The fourth item is a string placed after the grid times. This 1539 will align with agenda items." 1540 :group 'org-agenda-time-grid 1541 :type 1542 '(list 1543 (set :greedy t :tag "Grid Display Options" 1544 (const :tag "Show grid in single day agenda display" daily) 1545 (const :tag "Show grid in weekly agenda display" weekly) 1546 (const :tag "Always show grid for today" today) 1547 (const :tag "Show grid only if any timed entries are present" 1548 require-timed) 1549 (const :tag "Skip grid times already present in an entry" 1550 remove-match)) 1551 (repeat :tag "Grid Times" (integer :tag "Time")) 1552 (string :tag "Grid String (after agenda times)") 1553 (string :tag "Grid String (aligns with agenda items)"))) 1554 1555 (defcustom org-agenda-show-current-time-in-grid t 1556 "Non-nil means show the current time in the time grid." 1557 :group 'org-agenda-time-grid 1558 :version "24.1" 1559 :type 'boolean) 1560 1561 (defcustom org-agenda-current-time-string 1562 "now - - - - - - - - - - - - - - - - - - - - - - - - -" 1563 "The string for the current time marker in the agenda." 1564 :group 'org-agenda-time-grid 1565 :version "24.1" 1566 :type 'string) 1567 1568 (defgroup org-agenda-sorting nil 1569 "Options concerning sorting in the Org Agenda." 1570 :tag "Org Agenda Sorting" 1571 :group 'org-agenda) 1572 1573 (defcustom org-agenda-sorting-strategy 1574 '((agenda habit-down time-up priority-down category-keep) 1575 (todo priority-down category-keep) 1576 (tags priority-down category-keep) 1577 (search category-keep)) 1578 "Sorting structure for the agenda items of a single day. 1579 This is a list of symbols which will be used in sequence to determine 1580 if an entry should be listed before another entry. The following 1581 symbols are recognized: 1582 1583 time-up Put entries with time-of-day indications first, early first. 1584 time-down Put entries with time-of-day indications first, late first. 1585 timestamp-up Sort by any timestamp, early first. 1586 timestamp-down Sort by any timestamp, late first. 1587 scheduled-up Sort by scheduled timestamp, early first. 1588 scheduled-down Sort by scheduled timestamp, late first. 1589 deadline-up Sort by deadline timestamp, early first. 1590 deadline-down Sort by deadline timestamp, late first. 1591 ts-up Sort by active timestamp, early first. 1592 ts-down Sort by active timestamp, late first. 1593 tsia-up Sort by inactive timestamp, early first. 1594 tsia-down Sort by inactive timestamp, late first. 1595 category-keep Keep the default order of categories, corresponding to the 1596 sequence in `org-agenda-files'. 1597 category-up Sort alphabetically by category, A-Z. 1598 category-down Sort alphabetically by category, Z-A. 1599 tag-up Sort alphabetically by last tag, A-Z. 1600 tag-down Sort alphabetically by last tag, Z-A. 1601 priority-up Sort numerically by priority, high priority last. 1602 priority-down Sort numerically by priority, high priority first. 1603 todo-state-up Sort by todo state, tasks that are done last. 1604 todo-state-down Sort by todo state, tasks that are done first. 1605 effort-up Sort numerically by estimated effort, high effort last. 1606 effort-down Sort numerically by estimated effort, high effort first. 1607 user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. 1608 user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. 1609 habit-up Put entries that are habits first. 1610 habit-down Put entries that are habits last. 1611 alpha-up Sort headlines alphabetically. 1612 alpha-down Sort headlines alphabetically, reversed. 1613 1614 The different possibilities will be tried in sequence, and testing stops 1615 if one comparison returns a \"not-equal\". For example, the default 1616 '(time-up category-keep priority-down) 1617 means: Pull out all entries having a specified time of day and sort them, 1618 in order to make a time schedule for the current day the first thing in the 1619 agenda listing for the day. Of the entries without a time indication, keep 1620 the grouped in categories, don't sort the categories, but keep them in 1621 the sequence given in `org-agenda-files'. Within each category sort by 1622 priority. 1623 1624 Leaving out `category-keep' would mean that items will be sorted across 1625 categories by priority. 1626 1627 Instead of a single list, this can also be a set of list for specific 1628 contents, with a context symbol in the car of the list, any of 1629 `agenda', `todo', `tags', `search' for the corresponding agenda views. 1630 1631 Custom commands can bind this variable in the options section." 1632 :group 'org-agenda-sorting 1633 :type `(choice 1634 (repeat :tag "General" ,org-sorting-choice) 1635 (list :tag "Individually" 1636 (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) 1637 (repeat ,org-sorting-choice)) 1638 (cons (const :tag "Strategy for TODO lists" todo) 1639 (repeat ,org-sorting-choice)) 1640 (cons (const :tag "Strategy for Tags matches" tags) 1641 (repeat ,org-sorting-choice)) 1642 (cons (const :tag "Strategy for search matches" search) 1643 (repeat ,org-sorting-choice))))) 1644 1645 (defcustom org-agenda-cmp-user-defined nil 1646 "A function to define the comparison `user-defined'. 1647 This function must receive two arguments, agenda entry a and b. 1648 If a>b, return +1. If a<b, return -1. If they are equal as seen by 1649 the user comparison, return nil. 1650 When this is defined, you can make `user-defined-up' and `user-defined-down' 1651 part of an agenda sorting strategy." 1652 :group 'org-agenda-sorting 1653 :type 'symbol) 1654 1655 (defcustom org-agenda-sort-notime-is-late t 1656 "Non-nil means items without time are considered late. 1657 This is only relevant for sorting. When t, items which have no explicit 1658 time like 15:30 will be considered as 99:01, i.e. later than any items which 1659 do have a time. When nil, the default time is before 0:00. You can use this 1660 option to decide if the schedule for today should come before or after timeless 1661 agenda entries." 1662 :group 'org-agenda-sorting 1663 :type 'boolean) 1664 1665 (defcustom org-agenda-sort-noeffort-is-high t 1666 "Non-nil means items without effort estimate are sorted as high effort. 1667 This also applies when filtering an agenda view with respect to the 1668 < or > effort operator. Then, tasks with no effort defined will be treated 1669 as tasks with high effort. 1670 When nil, such items are sorted as 0 minutes effort." 1671 :group 'org-agenda-sorting 1672 :type 'boolean) 1673 1674 (defgroup org-agenda-line-format nil 1675 "Options concerning the entry prefix in the Org agenda display." 1676 :tag "Org Agenda Line Format" 1677 :group 'org-agenda) 1678 1679 (defcustom org-agenda-prefix-format 1680 '((agenda . " %i %-12:c%?-12t% s") 1681 (todo . " %i %-12:c") 1682 (tags . " %i %-12:c") 1683 (search . " %i %-12:c")) 1684 "Format specifications for the prefix of items in the agenda views. 1685 1686 An alist with one entry per agenda type. The keys of the 1687 sublists are `agenda', `todo', `search' and `tags'. The values 1688 are format strings. 1689 1690 This format works similar to a printf format, with the following meaning: 1691 1692 %c the category of the item, \"Diary\" for entries from the diary, 1693 or as given by the CATEGORY keyword or derived from the file name 1694 %e the effort required by the item 1695 %l the level of the item (insert X space(s) if item is of level X) 1696 %i the icon category of the item, see `org-agenda-category-icon-alist' 1697 %T the last tag of the item (ignore inherited tags, which come first) 1698 %t the HH:MM time-of-day specification if one applies to the entry 1699 %s Scheduling/Deadline information, a short string 1700 %b show breadcrumbs, i.e., the names of the higher levels 1701 %(expression) Eval EXPRESSION and replace the control string 1702 by the result 1703 1704 All specifiers work basically like the standard `%s' of printf, but may 1705 contain two additional characters: a question mark just after the `%' 1706 and a whitespace/punctuation character just before the final letter. 1707 1708 If the first character after `%' is a question mark, the entire field 1709 will only be included if the corresponding value applies to the current 1710 entry. This is useful for fields which should have fixed width when 1711 present, but zero width when absent. For example, \"%?-12t\" will 1712 result in a 12 character time field if a time of the day is specified, 1713 but will completely disappear in entries which do not contain a time. 1714 1715 If there is punctuation or whitespace character just before the 1716 final format letter, this character will be appended to the field 1717 value if the value is not empty. For example, the format 1718 \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If 1719 the category is empty, no additional colon is inserted. 1720 1721 The default value for the agenda sublist is \" %-12:c%?-12t% s\", 1722 which means: 1723 1724 - Indent the line with two space characters 1725 - Give the category a 12 chars wide field, padded with whitespace on 1726 the right (because of `-'). Append a colon if there is a category 1727 (because of `:'). 1728 - If there is a time-of-day, put it into a 12 chars wide field. If no 1729 time, don't put in an empty field, just skip it (because of '?'). 1730 - Finally, put the scheduling information. 1731 1732 See also the variables `org-agenda-remove-times-when-in-prefix' and 1733 `org-agenda-remove-tags'. 1734 1735 Custom commands can set this variable in the options section." 1736 :type '(choice 1737 (string :tag "General format") 1738 (list :greedy t :tag "View dependent" 1739 (cons (const agenda) (string :tag "Format")) 1740 (cons (const todo) (string :tag "Format")) 1741 (cons (const tags) (string :tag "Format")) 1742 (cons (const search) (string :tag "Format")))) 1743 :group 'org-agenda-line-format 1744 :version "26.1" 1745 :package-version '(Org . "9.1")) 1746 1747 (defcustom org-agenda-breadcrumbs-separator "->" 1748 "The separator of breadcrumbs in agenda lines." 1749 :group 'org-agenda-line-format 1750 :package-version '(Org . "9.3") 1751 :type 'string 1752 :safe #'stringp) 1753 1754 (defvar org-prefix-format-compiled nil 1755 "The compiled prefix format and associated variables. 1756 This is a list where first element is a list of variable bindings, and second 1757 element is the compiled format expression. See the variable 1758 `org-agenda-prefix-format'.") 1759 1760 (defcustom org-agenda-todo-keyword-format "%-1s" 1761 "Format for the TODO keyword in agenda lines. 1762 Set this to something like \"%-12s\" if you want all TODO keywords 1763 to occupy a fixed space in the agenda display." 1764 :group 'org-agenda-line-format 1765 :type 'string) 1766 1767 (defcustom org-agenda-diary-sexp-prefix nil 1768 "A regexp that matches part of a diary sexp entry 1769 which should be treated as scheduling/deadline information in 1770 `org-agenda'. 1771 1772 For example, you can use this to extract the `diary-remind-message' from 1773 `diary-remind' entries." 1774 :group 'org-agenda-line-format 1775 :type '(choice (const :tag "None" nil) (regexp :tag "Regexp"))) 1776 1777 (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") 1778 "Text preceding timerange entries in the agenda view. 1779 This is a list with two strings. The first applies when the range 1780 is entirely on one day. The second applies if the range spans several days. 1781 The strings may have two \"%d\" format specifiers which will be filled 1782 with the sequence number of the days, and the total number of days in the 1783 range, respectively." 1784 :group 'org-agenda-line-format 1785 :type '(list 1786 (string :tag "Deadline today ") 1787 (choice :tag "Deadline relative" 1788 (string :tag "Format string") 1789 (function)))) 1790 1791 (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") 1792 "Text preceding scheduled items in the agenda view. 1793 This is a list with two strings. The first applies when the item is 1794 scheduled on the current day. The second applies when it has been scheduled 1795 previously, it may contain a %d indicating that this is the nth time that 1796 this item is scheduled, due to automatic rescheduling of unfinished items 1797 for the following day. So this number is one larger than the number of days 1798 that passed since this item was scheduled first." 1799 :group 'org-agenda-line-format 1800 :version "24.4" 1801 :package-version '(Org . "8.0") 1802 :type '(list 1803 (string :tag "Scheduled today ") 1804 (string :tag "Scheduled previously"))) 1805 1806 (defcustom org-agenda-inactive-leader "[" 1807 "Text preceding item pulled into the agenda by inactive time stamps. 1808 These entries are added to the agenda when pressing \"[\"." 1809 :group 'org-agenda-line-format 1810 :version "24.1" 1811 :type 'string) 1812 1813 (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ") 1814 "Text preceding deadline items in the agenda view. 1815 This is a list with three strings. The first applies when the item has its 1816 deadline on the current day. The second applies when the deadline is in the 1817 future, the third one when it is in the past. The strings may contain %d 1818 to capture the number of days." 1819 :group 'org-agenda-line-format 1820 :version "24.4" 1821 :package-version '(Org . "8.0") 1822 :type '(list 1823 (string :tag "Deadline today ") 1824 (string :tag "Deadline in the future ") 1825 (string :tag "Deadline in the past "))) 1826 1827 (defcustom org-agenda-remove-times-when-in-prefix t 1828 "Non-nil means remove duplicate time specifications in agenda items. 1829 When the format `org-agenda-prefix-format' contains a `%t' specifier, a 1830 time-of-day specification in a headline or diary entry is extracted and 1831 placed into the prefix. If this option is non-nil, the original specification 1832 \(a timestamp or -range, or just a plain time(range) specification like 1833 11:30-4pm) will be removed for agenda display. This makes the agenda less 1834 cluttered. 1835 The option can be t or nil. It may also be the symbol `beg', indicating 1836 that the time should only be removed when it is located at the beginning of 1837 the headline/diary entry." 1838 :group 'org-agenda-line-format 1839 :type '(choice 1840 (const :tag "Always" t) 1841 (const :tag "Never" nil) 1842 (const :tag "When at beginning of entry" beg))) 1843 1844 (defcustom org-agenda-remove-timeranges-from-blocks nil 1845 "Non-nil means remove time ranges specifications in agenda 1846 items that span on several days." 1847 :group 'org-agenda-line-format 1848 :version "24.1" 1849 :type 'boolean) 1850 1851 (defcustom org-agenda-default-appointment-duration nil 1852 "Default duration for appointments that only have a starting time. 1853 When nil, no duration is specified in such cases. 1854 When non-nil, this must be the number of minutes, e.g. 60 for one hour." 1855 :group 'org-agenda-line-format 1856 :type '(choice 1857 (integer :tag "Minutes") 1858 (const :tag "No default duration"))) 1859 1860 (defcustom org-agenda-show-inherited-tags t 1861 "Non-nil means show inherited tags in each agenda line. 1862 1863 When this option is set to `always', it takes precedence over 1864 `org-agenda-use-tag-inheritance' and inherited tags are shown 1865 in every agenda. 1866 1867 When this option is set to t (the default), inherited tags are 1868 shown when they are available, i.e. when the value of 1869 `org-agenda-use-tag-inheritance' enables tag inheritance for the 1870 given agenda type. 1871 1872 This can be set to a list of agenda types in which the agenda 1873 must display the inherited tags. Available types are `todo', 1874 `agenda' and `search'. 1875 1876 When set to nil, never show inherited tags in agenda lines." 1877 :group 'org-agenda-line-format 1878 :group 'org-agenda 1879 :version "24.3" 1880 :type '(choice 1881 (const :tag "Show inherited tags when available" t) 1882 (const :tag "Always show inherited tags" always) 1883 (repeat :tag "Show inherited tags only in selected agenda types" 1884 (symbol :tag "Agenda type")))) 1885 1886 (defcustom org-agenda-use-tag-inheritance '(todo search agenda) 1887 "List of agenda view types where to use tag inheritance. 1888 1889 In tags/tags-todo/tags-tree agenda views, tag inheritance is 1890 controlled by `org-use-tag-inheritance'. In other agenda types, 1891 `org-use-tag-inheritance' is not used for the selection of the 1892 agenda entries. Still, you may want the agenda to be aware of 1893 the inherited tags anyway, e.g. for later tag filtering. 1894 1895 Allowed value are `todo', `search' and `agenda'. 1896 1897 This variable has no effect if `org-agenda-show-inherited-tags' 1898 is set to `always'. In that case, the agenda is aware of those 1899 tags. 1900 1901 The default value sets tags in every agenda type. Setting this 1902 option to nil will speed up non-tags agenda view a lot." 1903 :group 'org-agenda 1904 :version "26.1" 1905 :package-version '(Org . "9.1") 1906 :type '(choice 1907 (const :tag "Use tag inheritance in all agenda types" t) 1908 (repeat :tag "Use tag inheritance in selected agenda types" 1909 (symbol :tag "Agenda type")))) 1910 1911 (defcustom org-agenda-hide-tags-regexp nil 1912 "Regular expression used to filter away specific tags in agenda views. 1913 This means that these tags will be present, but not be shown in the agenda 1914 line. Secondary filtering will still work on the hidden tags. 1915 Nil means don't hide any tags." 1916 :group 'org-agenda-line-format 1917 :type '(choice 1918 (const :tag "Hide none" nil) 1919 (regexp :tag "Regexp "))) 1920 1921 (defvaralias 'org-agenda-remove-tags-when-in-prefix 1922 'org-agenda-remove-tags) 1923 1924 (defcustom org-agenda-remove-tags nil 1925 "Non-nil means remove the tags from the headline copy in the agenda. 1926 When this is the symbol `prefix', only remove tags when 1927 `org-agenda-prefix-format' contains a `%T' specifier." 1928 :group 'org-agenda-line-format 1929 :type '(choice 1930 (const :tag "Always" t) 1931 (const :tag "Never" nil) 1932 (const :tag "When prefix format contains %T" prefix))) 1933 1934 (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) 1935 1936 (defcustom org-agenda-tags-column 'auto 1937 "Shift tags in agenda items to this column. 1938 If set to `auto', tags will be automatically aligned to the right 1939 edge of the window. 1940 1941 If set to a positive number, tags will be left-aligned to that 1942 column. If set to a negative number, tags will be right-aligned 1943 to that column. For example, -80 works well for a normal 80 1944 character screen." 1945 :group 'org-agenda-line-format 1946 :type '(choice 1947 (const :tag "Automatically align to right edge of window" auto) 1948 (integer :tag "Specific column" -80)) 1949 :package-version '(Org . "9.1") 1950 :version "26.1") 1951 1952 (defcustom org-agenda-fontify-priorities 'cookies 1953 "Non-nil means highlight low and high priorities in agenda. 1954 When t, the highest priority entries are bold, lowest priority italic. 1955 However, settings in `org-priority-faces' will overrule these faces. 1956 When this variable is the symbol `cookies', only fontify the 1957 cookies, not the entire task. 1958 This may also be an association list of priority faces, whose 1959 keys are the character values of `org-priority-highest', 1960 `org-priority-default', and `org-priority-lowest' (the default values 1961 are ?A, ?B, and ?C, respectively). The face may be a named face, a 1962 color as a string, or a list like `(:background \"Red\")'. 1963 If it is a color, the variable `org-faces-easy-properties' 1964 determines if it is a foreground or a background color." 1965 :group 'org-agenda-line-format 1966 :type '(choice 1967 (const :tag "Never" nil) 1968 (const :tag "Defaults" t) 1969 (const :tag "Cookies only" cookies) 1970 (repeat :tag "Specify" 1971 (list (character :tag "Priority" :value ?A) 1972 (choice :tag "Face " 1973 (string :tag "Color") 1974 (sexp :tag "Face")))))) 1975 1976 (defcustom org-agenda-day-face-function nil 1977 "Function called to determine what face should be used to display a day. 1978 The only argument passed to that function is the day. It should 1979 returns a face, or nil if does not want to specify a face and let 1980 the normal rules apply." 1981 :group 'org-agenda-line-format 1982 :version "24.1" 1983 :type '(choice (const nil) (function))) 1984 1985 (defcustom org-agenda-category-icon-alist nil 1986 "Alist of category icon to be displayed in agenda views. 1987 1988 Each entry should have the following format: 1989 1990 (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS) 1991 1992 Where CATEGORY-REGEXP is a regexp matching the categories where 1993 the icon should be displayed. 1994 FILE-OR-DATA either a file path or a string containing image data. 1995 1996 The other fields can be omitted safely if not needed: 1997 TYPE indicates the image type. 1998 DATA-P is a boolean indicating whether the FILE-OR-DATA string is 1999 image data. 2000 PROPS are additional image attributes to assign to the image, 2001 like, e.g. `:ascent center'. 2002 2003 (\"Org\" \"/path/to/icon.png\" nil nil :ascent center) 2004 2005 If you want to set the display properties yourself, just put a 2006 list as second element: 2007 2008 (CATEGORY-REGEXP (MY PROPERTY LIST)) 2009 2010 For example, to display a 16px horizontal space for Emacs 2011 category, you can use: 2012 2013 (\"Emacs\" \\='(space . (:width (16))))" 2014 :group 'org-agenda-line-format 2015 :version "24.1" 2016 :type '(alist :key-type (regexp :tag "Regexp matching category") 2017 :value-type (choice (list :tag "Icon" 2018 (string :tag "File or data") 2019 (symbol :tag "Type") 2020 (boolean :tag "Data?") 2021 (repeat :tag "Extra image properties" :inline t sexp)) 2022 (list :tag "Display properties" sexp)))) 2023 2024 (defgroup org-agenda-column-view nil 2025 "Options concerning column view in the agenda." 2026 :tag "Org Agenda Column View" 2027 :group 'org-agenda) 2028 2029 (defcustom org-agenda-view-columns-initially nil 2030 "When non-nil, switch to columns view right after creating the agenda." 2031 :group 'org-agenda-column-view 2032 :type 'boolean 2033 :version "26.1" 2034 :package-version '(Org . "9.0") 2035 :safe #'booleanp) 2036 2037 (defcustom org-agenda-columns-show-summaries t 2038 "Non-nil means show summaries for columns displayed in the agenda view." 2039 :group 'org-agenda-column-view 2040 :type 'boolean) 2041 2042 (defcustom org-agenda-columns-compute-summary-properties t 2043 "Non-nil means recompute all summary properties before column view. 2044 When column view in the agenda is listing properties that have a summary 2045 operator, it can go to all relevant buffers and recompute the summaries 2046 there. This can mean overhead for the agenda column view, but is necessary 2047 to have thing up to date. 2048 As a special case, a CLOCKSUM property also makes sure that the clock 2049 computations are current." 2050 :group 'org-agenda-column-view 2051 :type 'boolean) 2052 2053 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil 2054 "Non-nil means the duration of an appointment will add to day effort. 2055 The property to which appointment durations will be added is the one given 2056 in the option `org-effort-property'. If an appointment does not have 2057 an end time, `org-agenda-default-appointment-duration' will be used. If that 2058 is not set, an appointment without end time will not contribute to the time 2059 estimate." 2060 :group 'org-agenda-column-view 2061 :type 'boolean) 2062 2063 (defcustom org-agenda-auto-exclude-function nil 2064 "A function called with a tag to decide if it is filtered on \ 2065 \\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] RET'. 2066 The sole argument to the function, which is called once for each 2067 possible tag, is a string giving the name of the tag. The 2068 function should return either nil if the tag should be included 2069 as normal, \"-<TAG>\" to exclude the tag, or \"+<TAG>\" to exclude 2070 lines not carrying this tag. 2071 Note that for the purpose of tag filtering, only the lower-case version of 2072 all tags will be considered, so that this function will only ever see 2073 the lower-case version of all tags." 2074 :group 'org-agenda 2075 :type '(choice (const nil) (function))) 2076 2077 (defcustom org-agenda-bulk-custom-functions nil 2078 "Alist of characters and custom functions for bulk actions. 2079 For example, this value makes those two functions available: 2080 2081 \\='((?R set-category) 2082 (?C bulk-cut)) 2083 2084 With selected entries in an agenda buffer, `B R' will call 2085 the custom function `set-category' on the selected entries. 2086 Note that functions in this alist don't need to be quoted. 2087 2088 You can also specify a function which collects arguments to be 2089 used for each call to your bulk custom function. The argument 2090 collecting function will be run once and should return a list of 2091 arguments to pass to the bulk function. For example: 2092 2093 \\='((?R set-category get-category)) 2094 2095 Now, `B R' will call the custom `get-category' which would prompt 2096 the user once for a category. That category is then passed as an 2097 argument to `set-category' for each entry it's called against." 2098 :type 2099 '(alist :key-type character 2100 :value-type 2101 (group (function :tag "Bulk Custom Function") 2102 (choice (function :tag "Bulk Custom Argument Function") 2103 (const :tag "No Bulk Custom Argument Function" nil)))) 2104 :package-version '(Org . "9.5") 2105 :group 'org-agenda) 2106 2107 (defmacro org-agenda-with-point-at-orig-entry (string &rest body) 2108 "Execute BODY with point at location given by `org-hd-marker' property. 2109 If STRING is non-nil, the text property will be fetched from position 0 2110 in that string. If STRING is nil, it will be fetched from the beginning 2111 of the current line." 2112 (declare (debug t)) 2113 (org-with-gensyms (marker) 2114 `(let ((,marker (get-text-property (if ,string 0 (point-at-bol)) 2115 'org-hd-marker ,string))) 2116 (with-current-buffer (marker-buffer ,marker) 2117 (save-excursion 2118 (goto-char ,marker) 2119 ,@body))))) 2120 2121 (defun org-add-agenda-custom-command (entry) 2122 "Replace or add a command in `org-agenda-custom-commands'. 2123 This is mostly for hacking and trying a new command - once the command 2124 works you probably want to add it to `org-agenda-custom-commands' for good." 2125 (let ((ass (assoc (car entry) org-agenda-custom-commands))) 2126 (if ass 2127 (setcdr ass (cdr entry)) 2128 (push entry org-agenda-custom-commands)))) 2129 2130 (defmacro org-agenda--insert-overriding-header (default) 2131 "Insert header into agenda view. 2132 The inserted header depends on `org-agenda-overriding-header'. 2133 If the empty string, don't insert a header. If any other string, 2134 insert it as a header. If nil, insert DEFAULT, which should 2135 evaluate to a string. If a function, call it and insert the 2136 string that it returns." 2137 (declare (debug (form)) (indent defun)) 2138 `(cond 2139 ((not org-agenda-overriding-header) (insert ,default)) 2140 ((equal org-agenda-overriding-header "") nil) 2141 ((stringp org-agenda-overriding-header) 2142 (insert (propertize org-agenda-overriding-header 2143 'face 'org-agenda-structure) 2144 "\n")) 2145 ((functionp org-agenda-overriding-header) 2146 (insert (funcall org-agenda-overriding-header))) 2147 (t (user-error "Invalid value for `org-agenda-overriding-header': %S" 2148 org-agenda-overriding-header)))) 2149 2150 ;;; Define the org-agenda-mode 2151 2152 (defvaralias 'org-agenda-keymap 'org-agenda-mode-map) 2153 (defvar org-agenda-mode-map (make-sparse-keymap) 2154 "Keymap for `org-agenda-mode'.") 2155 2156 (org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line) 2157 2158 (defvar org-agenda-menu) ; defined later in this file. 2159 (defvar org-agenda-restrict nil) ; defined later in this file. 2160 (defvar org-agenda-follow-mode nil) 2161 (defvar org-agenda-entry-text-mode nil) 2162 (defvar org-agenda-clockreport-mode nil) 2163 (defvar org-agenda-show-log nil 2164 "When non-nil, show the log in the agenda. 2165 Do not set this directly; instead use 2166 `org-agenda-start-with-log-mode', which see.") 2167 (defvar org-agenda-redo-command nil) 2168 (defvar org-agenda-query-string nil) 2169 (defvar org-agenda-mode-hook nil 2170 "Hook run after `org-agenda-mode' is turned on. 2171 The buffer is still writable when this hook is called.") 2172 (defvar org-agenda-type nil) 2173 (defvar org-agenda-force-single-file nil) 2174 (defvar org-agenda-bulk-marked-entries nil 2175 "List of markers that refer to marked entries in the agenda.") 2176 (defvar org-agenda-current-date nil 2177 "Active date when building the agenda.") 2178 2179 ;;; Multiple agenda buffers support 2180 2181 (defcustom org-agenda-sticky nil 2182 "Non-nil means agenda q key will bury agenda buffers. 2183 Agenda commands will then show existing buffer instead of generating new ones. 2184 When nil, `q' will kill the single agenda buffer." 2185 :group 'org-agenda 2186 :version "24.3" 2187 :type 'boolean) 2188 2189 2190 ;;;###autoload 2191 (defun org-toggle-sticky-agenda (&optional arg) 2192 "Toggle `org-agenda-sticky'." 2193 (interactive "P") 2194 (let ((new-value (if arg 2195 (> (prefix-numeric-value arg) 0) 2196 (not org-agenda-sticky)))) 2197 (if (equal new-value org-agenda-sticky) 2198 (and (called-interactively-p 'interactive) 2199 (message "Sticky agenda was already %s" 2200 (if org-agenda-sticky "enabled" "disabled"))) 2201 (setq org-agenda-sticky new-value) 2202 (org-agenda-kill-all-agenda-buffers) 2203 (and (called-interactively-p 'interactive) 2204 (message "Sticky agenda %s" 2205 (if org-agenda-sticky "enabled" "disabled")))))) 2206 2207 (defvar org-agenda-buffer nil 2208 "Agenda buffer currently being generated.") 2209 2210 (defvar org-agenda-last-prefix-arg nil) 2211 (defvar org-agenda-this-buffer-name nil) 2212 (defvar org-agenda-doing-sticky-redo nil) 2213 (defvar org-agenda-this-buffer-is-sticky nil) 2214 (defvar org-agenda-last-indirect-buffer nil 2215 "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.") 2216 2217 (defconst org-agenda-local-vars 2218 '(org-agenda-this-buffer-name 2219 org-agenda-undo-list 2220 org-agenda-pending-undo-list 2221 org-agenda-follow-mode 2222 org-agenda-entry-text-mode 2223 org-agenda-clockreport-mode 2224 org-agenda-show-log 2225 org-agenda-redo-command 2226 org-agenda-query-string 2227 org-agenda-type 2228 org-agenda-bulk-marked-entries 2229 org-agenda-undo-has-started-in 2230 org-agenda-info 2231 org-agenda-pre-window-conf 2232 org-agenda-columns-active 2233 org-agenda-tag-filter 2234 org-agenda-category-filter 2235 org-agenda-top-headline-filter 2236 org-agenda-regexp-filter 2237 org-agenda-effort-filter 2238 org-agenda-markers 2239 org-agenda-last-search-view-search-was-boolean 2240 org-agenda-last-indirect-buffer 2241 org-agenda-filtered-by-category 2242 org-agenda-filter-form 2243 org-agenda-cycle-counter 2244 org-agenda-last-prefix-arg) 2245 "Variables that must be local in agenda buffers to allow multiple buffers.") 2246 2247 (defun org-agenda-mode () 2248 "Mode for time-sorted view on action items in Org files. 2249 2250 The following commands are available: 2251 2252 \\{org-agenda-mode-map}" 2253 (interactive) 2254 (ignore-errors (require 'face-remap)) 2255 (let ((agenda-local-vars-to-keep 2256 '(text-scale-mode-amount 2257 text-scale-mode 2258 text-scale-mode-lighter 2259 face-remapping-alist)) 2260 (save (buffer-local-variables))) 2261 (kill-all-local-variables) 2262 (cl-flet ((reset-saved (var-set) 2263 "Reset variables in VAR-SET to possibly stored value in SAVE." 2264 (dolist (elem save) 2265 (pcase elem 2266 (`(,var . ,val) ;ignore unbound variables 2267 (when (and val (memq var var-set)) 2268 (set var val))))))) 2269 (cond (org-agenda-doing-sticky-redo 2270 ;; Refreshing sticky agenda-buffer 2271 ;; 2272 ;; Preserve the value of `org-agenda-local-vars' variables. 2273 (mapc #'make-local-variable org-agenda-local-vars) 2274 (reset-saved org-agenda-local-vars) 2275 (setq-local org-agenda-this-buffer-is-sticky t)) 2276 (org-agenda-sticky 2277 ;; Creating a sticky Agenda buffer for the first time 2278 (mapc #'make-local-variable org-agenda-local-vars) 2279 (setq-local org-agenda-this-buffer-is-sticky t)) 2280 (t 2281 ;; Creating a non-sticky agenda buffer 2282 (setq-local org-agenda-this-buffer-is-sticky nil))) 2283 (mapc #'make-local-variable agenda-local-vars-to-keep) 2284 (reset-saved agenda-local-vars-to-keep))) 2285 (setq org-agenda-undo-list nil 2286 org-agenda-pending-undo-list nil 2287 org-agenda-bulk-marked-entries nil) 2288 (setq major-mode 'org-agenda-mode) 2289 ;; Keep global-font-lock-mode from turning on font-lock-mode 2290 (setq-local font-lock-global-modes (list 'not major-mode)) 2291 (setq mode-name "Org-Agenda") 2292 (setq indent-tabs-mode nil) 2293 (use-local-map org-agenda-mode-map) 2294 (when org-startup-truncated (setq truncate-lines t)) 2295 (setq-local line-move-visual nil) 2296 (add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local) 2297 (add-hook 'pre-command-hook #'org-unhighlight nil 'local) 2298 ;; Make sure properties are removed when copying text 2299 (if (boundp 'filter-buffer-substring-functions) 2300 (add-hook 'filter-buffer-substring-functions 2301 (lambda (fun start end delete) 2302 (substring-no-properties (funcall fun start end delete))) 2303 nil t) 2304 ;; Emacs >= 24.4. 2305 (add-function :filter-return (local 'filter-buffer-substring-function) 2306 #'substring-no-properties)) 2307 (unless org-agenda-keep-modes 2308 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode 2309 org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode 2310 org-agenda-show-log org-agenda-start-with-log-mode 2311 org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode)) 2312 (add-to-invisibility-spec '(org-filtered)) 2313 (add-to-invisibility-spec '(org-link)) 2314 (easy-menu-change 2315 '("Agenda") "Agenda Files" 2316 (append 2317 (list 2318 (vector 2319 (if (get 'org-agenda-files 'org-restrict) 2320 "Restricted to single file" 2321 "Edit File List") 2322 '(org-edit-agenda-file-list) 2323 (not (get 'org-agenda-files 'org-restrict))) 2324 "--") 2325 (mapcar #'org-file-menu-entry (org-agenda-files)))) 2326 (org-agenda-set-mode-name) 2327 (run-mode-hooks 'org-agenda-mode-hook)) 2328 2329 (substitute-key-definition #'undo #'org-agenda-undo 2330 org-agenda-mode-map global-map) 2331 (org-defkey org-agenda-mode-map "\C-i" #'org-agenda-goto) 2332 (org-defkey org-agenda-mode-map [(tab)] #'org-agenda-goto) 2333 (org-defkey org-agenda-mode-map "\C-m" #'org-agenda-switch-to) 2334 (org-defkey org-agenda-mode-map "\C-k" #'org-agenda-kill) 2335 (org-defkey org-agenda-mode-map "\C-c\C-w" #'org-agenda-refile) 2336 (org-defkey org-agenda-mode-map [(meta down)] #'org-agenda-drag-line-forward) 2337 (org-defkey org-agenda-mode-map [(meta up)] #'org-agenda-drag-line-backward) 2338 (org-defkey org-agenda-mode-map "m" #'org-agenda-bulk-mark) 2339 (org-defkey org-agenda-mode-map "\M-m" #'org-agenda-bulk-toggle) 2340 (org-defkey org-agenda-mode-map "*" #'org-agenda-bulk-mark-all) 2341 (org-defkey org-agenda-mode-map "\M-*" #'org-agenda-bulk-toggle-all) 2342 (org-defkey org-agenda-mode-map "#" #'org-agenda-dim-blocked-tasks) 2343 (org-defkey org-agenda-mode-map "%" #'org-agenda-bulk-mark-regexp) 2344 (org-defkey org-agenda-mode-map "u" #'org-agenda-bulk-unmark) 2345 (org-defkey org-agenda-mode-map "U" #'org-agenda-bulk-unmark-all) 2346 (org-defkey org-agenda-mode-map "B" #'org-agenda-bulk-action) 2347 (org-defkey org-agenda-mode-map "k" #'org-agenda-capture) 2348 (org-defkey org-agenda-mode-map "A" #'org-agenda-append-agenda) 2349 (org-defkey org-agenda-mode-map "\C-c\C-x!" #'org-reload) 2350 (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" #'org-agenda-archive-default) 2351 (org-defkey org-agenda-mode-map "\C-c\C-xa" #'org-agenda-toggle-archive-tag) 2352 (org-defkey org-agenda-mode-map "\C-c\C-xA" #'org-agenda-archive-to-archive-sibling) 2353 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" #'org-agenda-archive) 2354 (org-defkey org-agenda-mode-map "\C-c$" #'org-agenda-archive) 2355 (org-defkey org-agenda-mode-map "$" #'org-agenda-archive) 2356 (org-defkey org-agenda-mode-map "\C-c\C-o" #'org-agenda-open-link) 2357 (org-defkey org-agenda-mode-map " " #'org-agenda-show-and-scroll-up) 2358 (org-defkey org-agenda-mode-map [backspace] #'org-agenda-show-scroll-down) 2359 (org-defkey org-agenda-mode-map "\d" #'org-agenda-show-scroll-down) 2360 (org-defkey org-agenda-mode-map [(control shift right)] #'org-agenda-todo-nextset) 2361 (org-defkey org-agenda-mode-map [(control shift left)] #'org-agenda-todo-previousset) 2362 (org-defkey org-agenda-mode-map "\C-c\C-xb" #'org-agenda-tree-to-indirect-buffer) 2363 (org-defkey org-agenda-mode-map "o" #'delete-other-windows) 2364 (org-defkey org-agenda-mode-map "L" #'org-agenda-recenter) 2365 (org-defkey org-agenda-mode-map "\C-c\C-t" #'org-agenda-todo) 2366 (org-defkey org-agenda-mode-map "t" #'org-agenda-todo) 2367 (org-defkey org-agenda-mode-map "a" #'org-agenda-archive-default-with-confirmation) 2368 (org-defkey org-agenda-mode-map ":" #'org-agenda-set-tags) 2369 (org-defkey org-agenda-mode-map "\C-c\C-q" #'org-agenda-set-tags) 2370 (org-defkey org-agenda-mode-map "." #'org-agenda-goto-today) 2371 (org-defkey org-agenda-mode-map "j" #'org-agenda-goto-date) 2372 (org-defkey org-agenda-mode-map "d" #'org-agenda-day-view) 2373 (org-defkey org-agenda-mode-map "w" #'org-agenda-week-view) 2374 (org-defkey org-agenda-mode-map "y" #'org-agenda-year-view) 2375 (org-defkey org-agenda-mode-map "\C-c\C-z" #'org-agenda-add-note) 2376 (org-defkey org-agenda-mode-map "z" #'org-agenda-add-note) 2377 (org-defkey org-agenda-mode-map [(shift right)] #'org-agenda-do-date-later) 2378 (org-defkey org-agenda-mode-map [(shift left)] #'org-agenda-do-date-earlier) 2379 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] #'org-agenda-do-date-later) 2380 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] #'org-agenda-do-date-earlier) 2381 (org-defkey org-agenda-mode-map ">" #'org-agenda-date-prompt) 2382 (org-defkey org-agenda-mode-map "\C-c\C-s" #'org-agenda-schedule) 2383 (org-defkey org-agenda-mode-map "\C-c\C-d" #'org-agenda-deadline) 2384 (let ((l '(1 2 3 4 5 6 7 8 9 0))) 2385 (while l (org-defkey org-agenda-mode-map 2386 (number-to-string (pop l)) #'digit-argument))) 2387 (org-defkey org-agenda-mode-map "F" #'org-agenda-follow-mode) 2388 (org-defkey org-agenda-mode-map "R" #'org-agenda-clockreport-mode) 2389 (org-defkey org-agenda-mode-map "E" #'org-agenda-entry-text-mode) 2390 (org-defkey org-agenda-mode-map "l" #'org-agenda-log-mode) 2391 (org-defkey org-agenda-mode-map "v" #'org-agenda-view-mode-dispatch) 2392 (org-defkey org-agenda-mode-map "D" #'org-agenda-toggle-diary) 2393 (org-defkey org-agenda-mode-map "!" #'org-agenda-toggle-deadlines) 2394 (org-defkey org-agenda-mode-map "G" #'org-agenda-toggle-time-grid) 2395 (org-defkey org-agenda-mode-map "r" #'org-agenda-redo) 2396 (org-defkey org-agenda-mode-map "g" #'org-agenda-redo-all) 2397 (org-defkey org-agenda-mode-map "e" #'org-agenda-set-effort) 2398 (org-defkey org-agenda-mode-map "\C-c\C-xe" #'org-agenda-set-effort) 2399 (org-defkey org-agenda-mode-map "\C-c\C-x\C-e" 2400 #'org-clock-modify-effort-estimate) 2401 (org-defkey org-agenda-mode-map "\C-c\C-xp" #'org-agenda-set-property) 2402 (org-defkey org-agenda-mode-map "q" #'org-agenda-quit) 2403 (org-defkey org-agenda-mode-map "Q" #'org-agenda-Quit) 2404 (org-defkey org-agenda-mode-map "x" #'org-agenda-exit) 2405 (org-defkey org-agenda-mode-map "\C-x\C-w" #'org-agenda-write) 2406 (org-defkey org-agenda-mode-map "\C-x\C-s" #'org-save-all-org-buffers) 2407 (org-defkey org-agenda-mode-map "s" #'org-save-all-org-buffers) 2408 (org-defkey org-agenda-mode-map "T" #'org-agenda-show-tags) 2409 (org-defkey org-agenda-mode-map "n" #'org-agenda-next-line) 2410 (org-defkey org-agenda-mode-map "p" #'org-agenda-previous-line) 2411 (org-defkey org-agenda-mode-map "N" #'org-agenda-next-item) 2412 (org-defkey org-agenda-mode-map "P" #'org-agenda-previous-item) 2413 (substitute-key-definition #'next-line #'org-agenda-next-line 2414 org-agenda-mode-map global-map) 2415 (substitute-key-definition #'previous-line #'org-agenda-previous-line 2416 org-agenda-mode-map global-map) 2417 (org-defkey org-agenda-mode-map "\C-c\C-a" #'org-attach) 2418 (org-defkey org-agenda-mode-map "\C-c\C-n" #'org-agenda-next-date-line) 2419 (org-defkey org-agenda-mode-map "\C-c\C-p" #'org-agenda-previous-date-line) 2420 (org-defkey org-agenda-mode-map "\C-c," #'org-agenda-priority) 2421 (org-defkey org-agenda-mode-map "," #'org-agenda-priority) 2422 (org-defkey org-agenda-mode-map "i" #'org-agenda-diary-entry) 2423 (org-defkey org-agenda-mode-map "c" #'org-agenda-goto-calendar) 2424 (org-defkey org-agenda-mode-map "C" #'org-agenda-convert-date) 2425 (org-defkey org-agenda-mode-map "M" #'org-agenda-phases-of-moon) 2426 (org-defkey org-agenda-mode-map "S" #'org-agenda-sunrise-sunset) 2427 (org-defkey org-agenda-mode-map "h" #'org-agenda-holidays) 2428 (org-defkey org-agenda-mode-map "H" #'org-agenda-holidays) 2429 (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" #'org-agenda-clock-in) 2430 (org-defkey org-agenda-mode-map "I" #'org-agenda-clock-in) 2431 (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" #'org-agenda-clock-out) 2432 (org-defkey org-agenda-mode-map "O" #'org-agenda-clock-out) 2433 (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" #'org-agenda-clock-cancel) 2434 (org-defkey org-agenda-mode-map "X" #'org-agenda-clock-cancel) 2435 (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" #'org-clock-goto) 2436 (org-defkey org-agenda-mode-map "J" #'org-agenda-clock-goto) 2437 (org-defkey org-agenda-mode-map "+" #'org-agenda-priority-up) 2438 (org-defkey org-agenda-mode-map "-" #'org-agenda-priority-down) 2439 (org-defkey org-agenda-mode-map [(shift up)] #'org-agenda-priority-up) 2440 (org-defkey org-agenda-mode-map [(shift down)] #'org-agenda-priority-down) 2441 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] #'org-agenda-priority-up) 2442 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] #'org-agenda-priority-down) 2443 (org-defkey org-agenda-mode-map "f" #'org-agenda-later) 2444 (org-defkey org-agenda-mode-map "b" #'org-agenda-earlier) 2445 (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" #'org-agenda-columns) 2446 (org-defkey org-agenda-mode-map "\C-c\C-x>" #'org-agenda-remove-restriction-lock) 2447 (org-defkey org-agenda-mode-map "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda) 2448 (org-defkey org-agenda-mode-map "[" #'org-agenda-manipulate-query-add) 2449 (org-defkey org-agenda-mode-map "]" #'org-agenda-manipulate-query-subtract) 2450 (org-defkey org-agenda-mode-map "{" #'org-agenda-manipulate-query-add-re) 2451 (org-defkey org-agenda-mode-map "}" #'org-agenda-manipulate-query-subtract-re) 2452 (org-defkey org-agenda-mode-map "\\" #'org-agenda-filter-by-tag) 2453 (org-defkey org-agenda-mode-map "_" #'org-agenda-filter-by-effort) 2454 (org-defkey org-agenda-mode-map "=" #'org-agenda-filter-by-regexp) 2455 (org-defkey org-agenda-mode-map "/" #'org-agenda-filter) 2456 (org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all) 2457 (org-defkey org-agenda-mode-map "~" #'org-agenda-limit-interactively) 2458 (org-defkey org-agenda-mode-map "<" #'org-agenda-filter-by-category) 2459 (org-defkey org-agenda-mode-map "^" #'org-agenda-filter-by-top-headline) 2460 (org-defkey org-agenda-mode-map ";" #'org-timer-set-timer) 2461 (org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop) 2462 (org-defkey org-agenda-mode-map "?" #'org-agenda-show-the-flagging-note) 2463 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" #'org-mobile-pull) 2464 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" #'org-mobile-push) 2465 (org-defkey org-agenda-mode-map "\C-c\C-xI" #'org-info-find-node) 2466 (org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse) 2467 (org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse) 2468 (org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block) 2469 (org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block) 2470 (org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c) 2471 2472 (when org-agenda-mouse-1-follows-link 2473 (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) 2474 2475 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu." 2476 '("Agenda" 2477 ("Agenda Files") 2478 "--" 2479 ("Agenda Dates" 2480 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)] 2481 ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] 2482 ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] 2483 ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)]) 2484 "--" 2485 ("View" 2486 ["Day View" org-agenda-day-view 2487 :active (org-agenda-check-type nil 'agenda) 2488 :style radio :selected (eq org-agenda-current-span 'day) 2489 :keys "v d (or just d)"] 2490 ["Week View" org-agenda-week-view 2491 :active (org-agenda-check-type nil 'agenda) 2492 :style radio :selected (eq org-agenda-current-span 'week) 2493 :keys "v w"] 2494 ["Fortnight View" org-agenda-fortnight-view 2495 :active (org-agenda-check-type nil 'agenda) 2496 :style radio :selected (eq org-agenda-current-span 'fortnight) 2497 :keys "v t"] 2498 ["Month View" org-agenda-month-view 2499 :active (org-agenda-check-type nil 'agenda) 2500 :style radio :selected (eq org-agenda-current-span 'month) 2501 :keys "v m"] 2502 ["Year View" org-agenda-year-view 2503 :active (org-agenda-check-type nil 'agenda) 2504 :style radio :selected (eq org-agenda-current-span 'year) 2505 :keys "v y"] 2506 "--" 2507 ["Include Diary" org-agenda-toggle-diary 2508 :style toggle :selected org-agenda-include-diary 2509 :active (org-agenda-check-type nil 'agenda)] 2510 ["Include Deadlines" org-agenda-toggle-deadlines 2511 :style toggle :selected org-agenda-include-deadlines 2512 :active (org-agenda-check-type nil 'agenda)] 2513 ["Use Time Grid" org-agenda-toggle-time-grid 2514 :style toggle :selected org-agenda-use-time-grid 2515 :active (org-agenda-check-type nil 'agenda)] 2516 "--" 2517 ["Show clock report" org-agenda-clockreport-mode 2518 :style toggle :selected org-agenda-clockreport-mode 2519 :active (org-agenda-check-type nil 'agenda)] 2520 ["Show some entry text" org-agenda-entry-text-mode 2521 :style toggle :selected org-agenda-entry-text-mode 2522 :active t] 2523 "--" 2524 ["Show Logbook entries" org-agenda-log-mode 2525 :style toggle :selected org-agenda-show-log 2526 :active (org-agenda-check-type nil 'agenda) 2527 :keys "v l (or just l)"] 2528 ["Include archived trees" org-agenda-archives-mode 2529 :style toggle :selected org-agenda-archives-mode :active t 2530 :keys "v a"] 2531 ["Include archive files" (org-agenda-archives-mode t) 2532 :style toggle :selected (eq org-agenda-archives-mode t) :active t 2533 :keys "v A"] 2534 "--" 2535 ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) 2536 ("Filter current view" 2537 ["with generic interface" org-agenda-filter t] 2538 "--" 2539 ["by category at cursor" org-agenda-filter-by-category t] 2540 ["by tag" org-agenda-filter-by-tag t] 2541 ["by effort" org-agenda-filter-by-effort t] 2542 ["by regexp" org-agenda-filter-by-regexp t] 2543 ["by top-level headline" org-agenda-filter-by-top-headline t] 2544 "--" 2545 ["Remove all filtering" org-agenda-filter-remove-all t] 2546 "--" 2547 ["limit" org-agenda-limit-interactively t]) 2548 ["Rebuild buffer" org-agenda-redo t] 2549 ["Write view to file" org-agenda-write t] 2550 ["Save all Org buffers" org-save-all-org-buffers t] 2551 "--" 2552 ["Show original entry" org-agenda-show t] 2553 ["Go To (other window)" org-agenda-goto t] 2554 ["Go To (this window)" org-agenda-switch-to t] 2555 ["Capture with cursor date" org-agenda-capture t] 2556 ["Follow Mode" org-agenda-follow-mode 2557 :style toggle :selected org-agenda-follow-mode :active t] 2558 ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] 2559 "--" 2560 ("TODO" 2561 ["Cycle TODO" org-agenda-todo t] 2562 ["Next TODO set" org-agenda-todo-nextset t] 2563 ["Previous TODO set" org-agenda-todo-previousset t] 2564 ["Add note" org-agenda-add-note t]) 2565 ("Archive/Refile/Delete" 2566 ["Archive default" org-agenda-archive-default t] 2567 ["Archive default" org-agenda-archive-default-with-confirmation t] 2568 ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] 2569 ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] 2570 ["Archive subtree" org-agenda-archive t] 2571 "--" 2572 ["Refile" org-agenda-refile t] 2573 "--" 2574 ["Delete subtree" org-agenda-kill t]) 2575 ("Bulk action" 2576 ["Mark entry" org-agenda-bulk-mark t] 2577 ["Mark all" org-agenda-bulk-mark-all t] 2578 ["Unmark entry" org-agenda-bulk-unmark t] 2579 ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"] 2580 ["Toggle mark" org-agenda-bulk-toggle t] 2581 ["Toggle all" org-agenda-bulk-toggle-all t] 2582 ["Mark regexp" org-agenda-bulk-mark-regexp t]) 2583 ["Act on all marked" org-agenda-bulk-action t] 2584 "--" 2585 ("Tags and Properties" 2586 ["Show all Tags" org-agenda-show-tags t] 2587 ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] 2588 ["Change tag in region" org-agenda-set-tags (org-region-active-p)] 2589 "--" 2590 ["Column View" org-columns t]) 2591 ("Deadline/Schedule" 2592 ["Schedule" org-agenda-schedule t] 2593 ["Set Deadline" org-agenda-deadline t] 2594 "--" 2595 ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)] 2596 ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)] 2597 ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"] 2598 ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"] 2599 ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"] 2600 ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"] 2601 ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)]) 2602 ("Clock and Effort" 2603 ["Clock in" org-agenda-clock-in t] 2604 ["Clock out" org-agenda-clock-out t] 2605 ["Clock cancel" org-agenda-clock-cancel t] 2606 ["Goto running clock" org-clock-goto t] 2607 "--" 2608 ["Set Effort" org-agenda-set-effort t] 2609 ["Change clocked effort" org-clock-modify-effort-estimate 2610 (org-clock-is-active)]) 2611 ("Priority" 2612 ["Set Priority" org-agenda-priority t] 2613 ["Increase Priority" org-agenda-priority-up t] 2614 ["Decrease Priority" org-agenda-priority-down t] 2615 ["Show Priority" org-priority-show t]) 2616 ("Calendar/Diary" 2617 ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)] 2618 ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)] 2619 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)] 2620 ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)] 2621 ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)] 2622 ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)] 2623 "--" 2624 ["Create iCalendar File" org-icalendar-combine-agenda-files t]) 2625 "--" 2626 ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] 2627 "--" 2628 ("MobileOrg" 2629 ["Push Files and Views" org-mobile-push t] 2630 ["Get Captured and Flagged" org-mobile-pull t] 2631 ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"] 2632 ["Show note / unflag" org-agenda-show-the-flagging-note t] 2633 "--" 2634 ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) 2635 "--" 2636 ["Quit" org-agenda-quit t] 2637 ["Exit and Release Buffers" org-agenda-exit t] 2638 )) 2639 2640 ;;; Agenda undo 2641 2642 (defvar org-agenda-allow-remote-undo t 2643 "Non-nil means allow remote undo from the agenda buffer.") 2644 (defvar org-agenda-undo-has-started-in nil 2645 "Buffers that have already seen `undo-start' in the current undo sequence.") 2646 2647 (defun org-agenda-undo () 2648 "Undo a remote editing step in the agenda. 2649 This undoes changes both in the agenda buffer and in the remote buffer 2650 that have been changed along." 2651 (interactive) 2652 (or org-agenda-allow-remote-undo 2653 (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo")) 2654 (when (not (eq this-command last-command)) 2655 (setq org-agenda-undo-has-started-in nil 2656 org-agenda-pending-undo-list org-agenda-undo-list)) 2657 (when (not org-agenda-pending-undo-list) 2658 (user-error "No further undo information")) 2659 (let* ((entry (pop org-agenda-pending-undo-list)) 2660 buf line cmd rembuf) 2661 (setq cmd (pop entry) line (pop entry)) 2662 (setq rembuf (nth 2 entry)) 2663 (org-with-remote-undo rembuf 2664 (while (bufferp (setq buf (pop entry))) 2665 (when (pop entry) 2666 (with-current-buffer buf 2667 (let (;; (last-undo-buffer buf) 2668 (inhibit-read-only t)) 2669 (unless (memq buf org-agenda-undo-has-started-in) 2670 (push buf org-agenda-undo-has-started-in) 2671 (make-local-variable 'pending-undo-list) 2672 (undo-start)) 2673 (while (and pending-undo-list 2674 (listp pending-undo-list) 2675 (not (car pending-undo-list))) 2676 (pop pending-undo-list)) 2677 (undo-more 1)))))) 2678 (org-goto-line line) 2679 (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) 2680 2681 (defun org-verify-change-for-undo (l1 l2) 2682 "Verify that a real change occurred between the undo lists L1 and L2." 2683 (while (and l1 (listp l1) (null (car l1))) (pop l1)) 2684 (while (and l2 (listp l2) (null (car l2))) (pop l2)) 2685 (not (eq l1 l2))) 2686 2687 ;;; Agenda dispatch 2688 2689 (defvar org-agenda-restrict-begin (make-marker)) 2690 (defvar org-agenda-restrict-end (make-marker)) 2691 (defvar org-agenda-last-dispatch-buffer nil) 2692 (defvar org-agenda-overriding-restriction nil) 2693 2694 (defcustom org-agenda-custom-commands-contexts nil 2695 "Alist of custom agenda keys and contextual rules. 2696 2697 For example, if you have a custom agenda command \"p\" and you 2698 want this command to be accessible only from plain text files, 2699 use this: 2700 2701 \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\")))) 2702 2703 Here are the available contexts definitions: 2704 2705 in-file: command displayed only in matching files 2706 in-mode: command displayed only in matching modes 2707 not-in-file: command not displayed in matching files 2708 not-in-mode: command not displayed in matching modes 2709 in-buffer: command displayed only in matching buffers 2710 not-in-buffer: command not displayed in matching buffers 2711 [function]: a custom function taking no argument 2712 2713 If you define several checks, the agenda command will be 2714 accessible if there is at least one valid check. 2715 2716 You can also bind a key to another agenda custom command 2717 depending on contextual rules. 2718 2719 \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\")))) 2720 2721 Here it means: in .txt files, use \"p\" as the key for the 2722 agenda command otherwise associated with \"q\". (The command 2723 originally associated with \"q\" is not displayed to avoid 2724 duplicates.)" 2725 :version "24.3" 2726 :group 'org-agenda-custom-commands 2727 :type '(repeat (list :tag "Rule" 2728 (string :tag " Agenda key") 2729 (string :tag "Replace by command") 2730 (repeat :tag "Available when" 2731 (choice 2732 (cons :tag "Condition" 2733 (choice 2734 (const :tag "In file" in-file) 2735 (const :tag "Not in file" not-in-file) 2736 (const :tag "In buffer" in-buffer) 2737 (const :tag "Not in buffer" not-in-buffer) 2738 (const :tag "In mode" in-mode) 2739 (const :tag "Not in mode" not-in-mode)) 2740 (regexp)) 2741 (function :tag "Custom function")))))) 2742 2743 (defcustom org-agenda-max-entries nil 2744 "Maximum number of entries to display in an agenda. 2745 This can be nil (no limit) or an integer or an alist of agenda 2746 types with an associated number of entries to display in this 2747 type." 2748 :version "24.4" 2749 :package-version '(Org . "8.0") 2750 :group 'org-agenda-custom-commands 2751 :type '(choice (symbol :tag "No limit" nil) 2752 (integer :tag "Max number of entries") 2753 (repeat 2754 (cons (choice :tag "Agenda type" 2755 (const agenda) 2756 (const todo) 2757 (const tags) 2758 (const search)) 2759 (integer :tag "Max number of entries"))))) 2760 2761 (defcustom org-agenda-max-todos nil 2762 "Maximum number of TODOs to display in an agenda. 2763 This can be nil (no limit) or an integer or an alist of agenda 2764 types with an associated number of entries to display in this 2765 type." 2766 :version "24.4" 2767 :package-version '(Org . "8.0") 2768 :group 'org-agenda-custom-commands 2769 :type '(choice (symbol :tag "No limit" nil) 2770 (integer :tag "Max number of TODOs") 2771 (repeat 2772 (cons (choice :tag "Agenda type" 2773 (const agenda) 2774 (const todo) 2775 (const tags) 2776 (const search)) 2777 (integer :tag "Max number of TODOs"))))) 2778 2779 (defcustom org-agenda-max-tags nil 2780 "Maximum number of tagged entries to display in an agenda. 2781 This can be nil (no limit) or an integer or an alist of agenda 2782 types with an associated number of entries to display in this 2783 type." 2784 :version "24.4" 2785 :package-version '(Org . "8.0") 2786 :group 'org-agenda-custom-commands 2787 :type '(choice (symbol :tag "No limit" nil) 2788 (integer :tag "Max number of tagged entries") 2789 (repeat 2790 (cons (choice :tag "Agenda type" 2791 (const agenda) 2792 (const todo) 2793 (const tags) 2794 (const search)) 2795 (integer :tag "Max number of tagged entries"))))) 2796 2797 (defcustom org-agenda-max-effort nil 2798 "Maximum cumulated effort duration for the agenda. 2799 This can be nil (no limit) or a number of minutes (as an integer) 2800 or an alist of agenda types with an associated number of minutes 2801 to limit entries to in this type." 2802 :version "24.4" 2803 :package-version '(Org . "8.0") 2804 :group 'org-agenda-custom-commands 2805 :type '(choice (symbol :tag "No limit" nil) 2806 (integer :tag "Max number of minutes") 2807 (repeat 2808 (cons (choice :tag "Agenda type" 2809 (const agenda) 2810 (const todo) 2811 (const tags) 2812 (const search)) 2813 (integer :tag "Max number of minutes"))))) 2814 2815 (defvar org-agenda-keep-restricted-file-list nil) 2816 (defvar org-keys nil) 2817 (defvar org-match nil) 2818 ;;;###autoload 2819 (defun org-agenda (&optional arg keys restriction) 2820 "Dispatch agenda commands to collect entries to the agenda buffer. 2821 Prompts for a command to execute. Any prefix arg will be passed 2822 on to the selected command. The default selections are: 2823 2824 a Call `org-agenda-list' to display the agenda for current day or week. 2825 t Call `org-todo-list' to display the global todo list. 2826 T Call `org-todo-list' to display the global todo list, select only 2827 entries with a specific TODO keyword (the user gets a prompt). 2828 m Call `org-tags-view' to display headlines with tags matching 2829 a condition (the user is prompted for the condition). 2830 M Like `m', but select only TODO entries, no ordinary headlines. 2831 e Export views to associated files. 2832 s Search entries for keywords. 2833 S Search entries for keywords, only with TODO keywords. 2834 / Multi occur across all agenda files and also files listed 2835 in `org-agenda-text-search-extra-files'. 2836 < Restrict agenda commands to buffer, subtree, or region. 2837 Press several times to get the desired effect. 2838 > Remove a previous restriction. 2839 # List \"stuck\" projects. 2840 ! Configure what \"stuck\" means. 2841 C Configure custom agenda commands. 2842 2843 More commands can be added by configuring the variable 2844 `org-agenda-custom-commands'. In particular, specific tags and TODO keyword 2845 searches can be pre-defined in this way. 2846 2847 If the current buffer is in Org mode and visiting a file, you can also 2848 first press `<' once to indicate that the agenda should be temporarily 2849 \(until the next use of `\\[org-agenda]') restricted to the current file. 2850 Pressing `<' twice means to restrict to the current subtree or region 2851 \(if active)." 2852 (interactive "P") 2853 (catch 'exit 2854 (let* ((org-keys keys) 2855 (prefix-descriptions nil) 2856 (org-agenda-buffer-name org-agenda-buffer-name) 2857 (org-agenda-window-setup (if (equal (buffer-name) 2858 org-agenda-buffer-name) 2859 'current-window 2860 org-agenda-window-setup)) 2861 (org-agenda-custom-commands-orig org-agenda-custom-commands) 2862 (org-agenda-custom-commands 2863 ;; normalize different versions 2864 (delq nil 2865 (mapcar 2866 (lambda (x) 2867 (cond ((stringp (cdr x)) 2868 (push x prefix-descriptions) 2869 nil) 2870 ((stringp (nth 1 x)) x) 2871 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) 2872 (t (cons (car x) (cons "" (cdr x)))))) 2873 org-agenda-custom-commands))) 2874 (org-agenda-custom-commands 2875 (org-contextualize-keys 2876 org-agenda-custom-commands org-agenda-custom-commands-contexts)) 2877 ;; (buf (current-buffer)) 2878 (bfn (buffer-file-name (buffer-base-buffer))) 2879 entry type org-match lprops ans) ;; key 2880 ;; Turn off restriction unless there is an overriding one, 2881 (unless org-agenda-overriding-restriction 2882 (unless org-agenda-keep-restricted-file-list 2883 ;; There is a request to keep the file list in place 2884 (put 'org-agenda-files 'org-restrict nil)) 2885 (setq org-agenda-restrict nil) 2886 (move-marker org-agenda-restrict-begin nil) 2887 (move-marker org-agenda-restrict-end nil)) 2888 ;; Delete old local properties 2889 (put 'org-agenda-redo-command 'org-lprops nil) 2890 ;; Delete previously set last-arguments 2891 (put 'org-agenda-redo-command 'last-args nil) 2892 ;; Remember where this call originated 2893 (setq org-agenda-last-dispatch-buffer (current-buffer)) 2894 (unless org-keys 2895 (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) 2896 org-keys (car ans) 2897 restriction (cdr ans))) 2898 ;; If we have sticky agenda buffers, set a name for the buffer, 2899 ;; depending on the invoking keys. The user may still set this 2900 ;; as a command option, which will overwrite what we do here. 2901 (when org-agenda-sticky 2902 (setq org-agenda-buffer-name 2903 (format "*Org Agenda(%s)*" org-keys))) 2904 ;; Establish the restriction, if any 2905 (when (and (not org-agenda-overriding-restriction) restriction) 2906 (put 'org-agenda-files 'org-restrict (list bfn)) 2907 (cond 2908 ((eq restriction 'region) 2909 (setq org-agenda-restrict (current-buffer)) 2910 (move-marker org-agenda-restrict-begin (region-beginning)) 2911 (move-marker org-agenda-restrict-end (region-end))) 2912 ((eq restriction 'subtree) 2913 (save-excursion 2914 (setq org-agenda-restrict (current-buffer)) 2915 (org-back-to-heading t) 2916 (move-marker org-agenda-restrict-begin (point)) 2917 (move-marker org-agenda-restrict-end 2918 (progn (org-end-of-subtree t))))) 2919 ((and (eq restriction 'buffer) 2920 (or (< 1 (point-min)) 2921 (< (point-max) (1+ (buffer-size))))) 2922 (setq org-agenda-restrict (current-buffer)) 2923 (move-marker org-agenda-restrict-begin (point-min)) 2924 (move-marker org-agenda-restrict-end (point-max))))) 2925 2926 ;; For example the todo list should not need it (but does...) 2927 (cond 2928 ((setq entry (assoc org-keys org-agenda-custom-commands)) 2929 (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) 2930 (progn 2931 ;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars) 2932 ;; to some of the local variables? There's no doc about 2933 ;; that for `org-agenda-custom-commands'. 2934 (setq type (nth 2 entry) org-match (eval (nth 3 entry) t) 2935 lprops (nth 4 entry)) 2936 (when org-agenda-sticky 2937 (setq org-agenda-buffer-name 2938 (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match)) 2939 (format "*Org Agenda(%s)*" org-keys)))) 2940 (put 'org-agenda-redo-command 'org-lprops lprops) 2941 (cl-progv 2942 (mapcar #'car lprops) 2943 (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) 2944 (pcase type 2945 (`agenda 2946 (org-agenda-list current-prefix-arg)) 2947 (`agenda* 2948 (org-agenda-list current-prefix-arg nil nil t)) 2949 (`alltodo 2950 (org-todo-list current-prefix-arg)) 2951 (`search 2952 (org-search-view current-prefix-arg org-match nil)) 2953 (`stuck 2954 (org-agenda-list-stuck-projects current-prefix-arg)) 2955 (`tags 2956 (org-tags-view current-prefix-arg org-match)) 2957 (`tags-todo 2958 (org-tags-view '(4) org-match)) 2959 (`todo 2960 (org-todo-list org-match)) 2961 (`tags-tree 2962 (org-check-for-org-mode) 2963 (org-match-sparse-tree current-prefix-arg org-match)) 2964 (`todo-tree 2965 (org-check-for-org-mode) 2966 (org-occur (concat "^" org-outline-regexp "[ \t]*" 2967 (regexp-quote org-match) "\\>"))) 2968 (`occur-tree 2969 (org-check-for-org-mode) 2970 (org-occur org-match)) 2971 ((pred functionp) 2972 (funcall type org-match)) 2973 ;; FIXME: Will signal an error since it's not `functionp'! 2974 ((pred fboundp) (funcall type org-match)) 2975 (_ (user-error "Invalid custom agenda command type %s" type))))) 2976 (org-agenda-run-series (nth 1 entry) (cddr entry)))) 2977 ((equal org-keys "C") 2978 (setq org-agenda-custom-commands org-agenda-custom-commands-orig) 2979 (customize-variable 'org-agenda-custom-commands)) 2980 ((equal org-keys "a") (call-interactively 'org-agenda-list)) 2981 ((equal org-keys "s") (call-interactively 'org-search-view)) 2982 ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4)))) 2983 ((equal org-keys "t") (call-interactively 'org-todo-list)) 2984 ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) 2985 ((equal org-keys "m") (call-interactively 'org-tags-view)) 2986 ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) 2987 ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) 2988 ((equal org-keys "?") (org-tags-view nil "+FLAGGED") 2989 (add-hook 2990 'post-command-hook 2991 (lambda () 2992 (unless (current-message) 2993 (let* ((m (org-agenda-get-any-marker)) 2994 (note (and m (org-entry-get m "THEFLAGGINGNOTE")))) 2995 (when note 2996 (message "FLAGGING-NOTE ([?] for more info): %s" 2997 (org-add-props 2998 (replace-regexp-in-string 2999 "\\\\n" "//" 3000 (copy-sequence note)) 3001 nil 'face 'org-warning)))))) 3002 t t)) 3003 ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) 3004 ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) 3005 ((equal org-keys "!") (customize-variable 'org-stuck-projects)) 3006 (t (user-error "Invalid agenda key")))))) 3007 3008 (defvar org-agenda-multi) 3009 3010 (defun org-agenda-append-agenda () 3011 "Append another agenda view to the current one. 3012 This function allows interactive building of block agendas. 3013 Agenda views are separated by `org-agenda-block-separator'." 3014 (interactive) 3015 (unless (derived-mode-p 'org-agenda-mode) 3016 (user-error "Can only append from within agenda buffer")) 3017 (let ((org-agenda-multi t)) 3018 (org-agenda) 3019 (widen) 3020 (org-agenda-finalize) 3021 (setq buffer-read-only t) 3022 (org-agenda-fit-window-to-buffer))) 3023 3024 (defun org-agenda-normalize-custom-commands (cmds) 3025 "Normalize custom commands CMDS." 3026 (delq nil 3027 (mapcar 3028 (lambda (x) 3029 (cond ((stringp (cdr x)) nil) 3030 ((stringp (nth 1 x)) x) 3031 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) 3032 (t (cons (car x) (cons "" (cdr x)))))) 3033 cmds))) 3034 3035 (defun org-agenda-get-restriction-and-command (prefix-descriptions) 3036 "The user interface for selecting an agenda command." 3037 (catch 'exit 3038 (let* ((bfn (buffer-file-name (buffer-base-buffer))) 3039 (restrict-ok (and bfn (derived-mode-p 'org-mode))) 3040 (region-p (org-region-active-p)) 3041 (custom org-agenda-custom-commands) 3042 (selstring "") 3043 restriction second-time 3044 c entry key type match prefixes rmheader header-end custom1 desc 3045 line lines left right n n1) 3046 (save-window-excursion 3047 (delete-other-windows) 3048 (org-switch-to-buffer-other-window " *Agenda Commands*") 3049 (erase-buffer) 3050 (insert (eval-when-compile 3051 (let ((header 3052 (copy-sequence 3053 "Press key for an agenda command: 3054 -------------------------------- < Buffer, subtree/region restriction 3055 a Agenda for current week or day > Remove restriction 3056 t List of all TODO entries e Export agenda views 3057 m Match a TAGS/PROP/TODO query T Entries with special TODO kwd 3058 s Search for keywords M Like m, but only TODO entries 3059 / Multi-occur S Like s, but only TODO entries 3060 ? Find :FLAGGED: entries C Configure custom agenda commands 3061 * Toggle sticky agenda views # List stuck projects (!=configure) 3062 ")) 3063 (start 0)) 3064 (while (string-match 3065 "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" 3066 header start) 3067 (setq start (match-end 0)) 3068 (add-text-properties (match-beginning 2) (match-end 2) 3069 '(face bold) header)) 3070 header))) 3071 (setq header-end (point-marker)) 3072 (while t 3073 (setq custom1 custom) 3074 (when (eq rmheader t) 3075 (org-goto-line 1) 3076 (re-search-forward ":" nil t) 3077 (delete-region (match-end 0) (point-at-eol)) 3078 (forward-char 1) 3079 (looking-at "-+") 3080 (delete-region (match-end 0) (point-at-eol)) 3081 (move-marker header-end (match-end 0))) 3082 (goto-char header-end) 3083 (delete-region (point) (point-max)) 3084 3085 ;; Produce all the lines that describe custom commands and prefixes 3086 (setq lines nil) 3087 (while (setq entry (pop custom1)) 3088 (setq key (car entry) desc (nth 1 entry) 3089 type (nth 2 entry) 3090 match (nth 3 entry)) 3091 (if (> (length key) 1) 3092 (cl-pushnew (string-to-char key) prefixes :test #'equal) 3093 (setq line 3094 (format 3095 "%-4s%-14s" 3096 (org-add-props (copy-sequence key) 3097 '(face bold)) 3098 (cond 3099 ((string-match "\\S-" desc) desc) 3100 ((eq type 'agenda) "Agenda for current week or day") 3101 ((eq type 'agenda*) "Appointments for current week or day") 3102 ((eq type 'alltodo) "List of all TODO entries") 3103 ((eq type 'search) "Word search") 3104 ((eq type 'stuck) "List of stuck projects") 3105 ((eq type 'todo) "TODO keyword") 3106 ((eq type 'tags) "Tags query") 3107 ((eq type 'tags-todo) "Tags (TODO)") 3108 ((eq type 'tags-tree) "Tags tree") 3109 ((eq type 'todo-tree) "TODO kwd tree") 3110 ((eq type 'occur-tree) "Occur tree") 3111 ((functionp type) (if (symbolp type) 3112 (symbol-name type) 3113 "Lambda expression")) 3114 (t "???")))) 3115 (cond 3116 ((not (org-string-nw-p match)) nil) 3117 (org-agenda-menu-show-matcher 3118 (setq line 3119 (concat line ": " 3120 (cond 3121 ((stringp match) 3122 (propertize match 'face 'org-warning)) 3123 ((listp type) 3124 (format "set of %d commands" (length type))))))) 3125 (t 3126 (org-add-props line nil 'help-echo (concat "Matcher: " match)))) 3127 (push line lines))) 3128 (setq lines (nreverse lines)) 3129 (when prefixes 3130 (mapc (lambda (x) 3131 (push 3132 (format "%s %s" 3133 (org-add-props (char-to-string x) 3134 nil 'face 'bold) 3135 (or (cdr (assoc (concat selstring 3136 (char-to-string x)) 3137 prefix-descriptions)) 3138 "Prefix key")) 3139 lines)) 3140 prefixes)) 3141 3142 ;; Check if we should display in two columns 3143 (if org-agenda-menu-two-columns 3144 (progn 3145 (setq n (length lines) 3146 n1 (+ (/ n 2) (mod n 2)) 3147 right (nthcdr n1 lines) 3148 left (copy-sequence lines)) 3149 (setcdr (nthcdr (1- n1) left) nil)) 3150 (setq left lines right nil)) 3151 (while left 3152 (insert "\n" (pop left)) 3153 (when right 3154 (if (< (current-column) 40) 3155 (move-to-column 40 t) 3156 (insert " ")) 3157 (insert (pop right)))) 3158 3159 ;; Make the window the right size 3160 (goto-char (point-min)) 3161 (if second-time 3162 (when (not (pos-visible-in-window-p (point-max))) 3163 (org-fit-window-to-buffer)) 3164 (setq second-time t) 3165 (org-fit-window-to-buffer)) 3166 3167 ;; Hint to navigation if window too small for all information 3168 (setq header-line-format 3169 (when (not (pos-visible-in-window-p (point-max))) 3170 "Use C-v, M-v, C-n or C-p to navigate.")) 3171 3172 ;; Ask for selection 3173 (cl-loop 3174 do (progn 3175 (message "Press key for agenda command%s:" 3176 (if (or restrict-ok org-agenda-overriding-restriction) 3177 (if org-agenda-overriding-restriction 3178 " (restriction lock active)" 3179 (if restriction 3180 (format " (restricted to %s)" restriction) 3181 " (unrestricted)")) 3182 "")) 3183 (setq c (read-char-exclusive))) 3184 until (not (memq c '(14 16 22 134217846))) 3185 do (org-scroll c)) 3186 3187 (message "") 3188 (cond 3189 ((assoc (char-to-string c) custom) 3190 (setq selstring (concat selstring (char-to-string c))) 3191 (throw 'exit (cons selstring restriction))) 3192 ((memq c prefixes) 3193 (setq selstring (concat selstring (char-to-string c)) 3194 prefixes nil 3195 rmheader (or rmheader t) 3196 custom (delq nil (mapcar 3197 (lambda (x) 3198 (if (or (= (length (car x)) 1) 3199 (/= (string-to-char (car x)) c)) 3200 nil 3201 (cons (substring (car x) 1) (cdr x)))) 3202 custom)))) 3203 ((eq c ?*) 3204 (call-interactively 'org-toggle-sticky-agenda) 3205 (sit-for 2)) 3206 ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) 3207 (message "Restriction is only possible in Org buffers") 3208 (ding) (sit-for 1)) 3209 ((eq c ?1) 3210 (org-agenda-remove-restriction-lock 'noupdate) 3211 (setq restriction 'buffer)) 3212 ((eq c ?0) 3213 (org-agenda-remove-restriction-lock 'noupdate) 3214 (setq restriction (if region-p 'region 'subtree))) 3215 ((eq c ?<) 3216 (org-agenda-remove-restriction-lock 'noupdate) 3217 (setq restriction 3218 (cond 3219 ((eq restriction 'buffer) 3220 (if region-p 'region 'subtree)) 3221 ((memq restriction '(subtree region)) 3222 nil) 3223 (t 'buffer)))) 3224 ((eq c ?>) 3225 (org-agenda-remove-restriction-lock 'noupdate) 3226 (setq restriction nil)) 3227 ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) 3228 (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) 3229 ((and (> (length selstring) 0) (eq c ?\d)) 3230 (delete-window) 3231 (org-agenda-get-restriction-and-command prefix-descriptions)) 3232 3233 ((equal c ?q) (user-error "Abort")) 3234 (t (user-error "Invalid key %c" c)))))))) 3235 3236 (defun org-agenda-fit-window-to-buffer () 3237 "Fit the window to the buffer size." 3238 (and (memq org-agenda-window-setup '(reorganize-frame)) 3239 (fboundp 'fit-window-to-buffer) 3240 (if (and (= (cdr org-agenda-window-frame-fractions) 1.0) 3241 (= (car org-agenda-window-frame-fractions) 1.0)) 3242 (delete-other-windows) 3243 (org-fit-window-to-buffer 3244 nil 3245 (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) 3246 (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))) 3247 3248 (defvar org-cmd nil) 3249 (defvar org-agenda-overriding-cmd nil) 3250 (defvar org-agenda-overriding-arguments nil) 3251 (defvar org-agenda-overriding-cmd-arguments nil) 3252 3253 (defun org-let (list &rest body) ;FIXME: So many kittens are suffering here. 3254 (declare (indent 1) (obsolete cl-progv "2021")) 3255 (eval (cons 'let (cons list body)))) 3256 3257 (defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go? 3258 (declare (indent 2) (obsolete cl-progv "2021")) 3259 (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) 3260 3261 (defun org-agenda-run-series (name series) 3262 "Run agenda NAME as a SERIES of agenda commands." 3263 (let* ((gprops (nth 1 series)) 3264 (gvars (mapcar #'car gprops)) 3265 (gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops))) 3266 (cl-progv gvars gvals (org-agenda-prepare name)) 3267 ;; We need to reset agenda markers here, because when constructing a 3268 ;; block agenda, the individual blocks do not do that. 3269 (org-agenda-reset-markers) 3270 (with-no-warnings 3271 (defvar match)) ;Used via the `eval' below. 3272 (let* ((org-agenda-multi t) 3273 ;; FIXME: Redo should contain lists of (FUNS . ARGS) rather 3274 ;; than expressions, so you don't need to `quote' the args 3275 ;; and you just need to `apply' instead of `eval' when using it. 3276 (redo (list 'org-agenda-run-series name (list 'quote series))) 3277 (cmds (car series)) 3278 match 3279 org-cmd type lprops) 3280 (while (setq org-cmd (pop cmds)) 3281 (setq type (car org-cmd)) 3282 (setq match (eval (nth 1 org-cmd) t)) 3283 (setq lprops (nth 2 org-cmd)) 3284 (let ((org-agenda-overriding-arguments 3285 (if (eq org-agenda-overriding-cmd org-cmd) 3286 (or org-agenda-overriding-arguments 3287 org-agenda-overriding-cmd-arguments))) 3288 (lvars (mapcar #'car lprops)) 3289 (lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops))) 3290 (cl-progv (append gvars lvars) (append gvals lvals) 3291 (pcase type 3292 (`agenda 3293 (call-interactively 'org-agenda-list)) 3294 (`agenda* 3295 (funcall 'org-agenda-list nil nil t)) 3296 (`alltodo 3297 (call-interactively 'org-todo-list)) 3298 (`search 3299 (org-search-view current-prefix-arg match nil)) 3300 (`stuck 3301 (call-interactively 'org-agenda-list-stuck-projects)) 3302 (`tags 3303 (org-tags-view current-prefix-arg match)) 3304 (`tags-todo 3305 (org-tags-view '(4) match)) 3306 (`todo 3307 (org-todo-list match)) 3308 ((pred fboundp) 3309 (funcall type match)) 3310 (_ (error "Invalid type in command series")))))) 3311 (widen) 3312 (let ((inhibit-read-only t)) 3313 (add-text-properties (point-min) (point-max) 3314 `(org-series t org-series-redo-cmd ,redo))) 3315 (setq org-agenda-redo-command redo) 3316 (goto-char (point-min))) 3317 (org-agenda-fit-window-to-buffer) 3318 (cl-progv gvars gvals (org-agenda-finalize)))) 3319 3320 (defun org-agenda--split-plist (plist) 3321 ;; We could/should arguably use `map-keys' and `map-values'. 3322 (let (keys vals) 3323 (while plist 3324 (push (pop plist) keys) 3325 (push (pop plist) vals)) 3326 (cons (nreverse keys) (nreverse vals)))) 3327 3328 ;;;###autoload 3329 (defmacro org-batch-agenda (cmd-key &rest parameters) 3330 "Run an agenda command in batch mode and send the result to STDOUT. 3331 If CMD-KEY is a string of length 1, it is used as a key in 3332 `org-agenda-custom-commands' and triggers this command. If it is a 3333 longer string it is used as a tags/todo match string. 3334 Parameters are alternating variable names and values that will be bound 3335 before running the agenda command." 3336 (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) 3337 `(org--batch-agenda ,cmd-key ',vars (list ,@exps)))) 3338 3339 (defun org--batch-agenda (cmd-key vars vals) 3340 ;; `org-batch-agenda' is a macro because every other "parameter" is 3341 ;; a variable name rather than an expression to evaluate. Yuck! 3342 (cl-progv vars vals 3343 (let (org-agenda-sticky) 3344 (if (> (length cmd-key) 1) 3345 (org-tags-view nil cmd-key) 3346 (org-agenda nil cmd-key)))) 3347 (set-buffer org-agenda-buffer-name) 3348 (princ (buffer-string))) 3349 3350 (defvar org-agenda-info nil) 3351 3352 ;;;###autoload 3353 (defmacro org-batch-agenda-csv (cmd-key &rest parameters) 3354 "Run an agenda command in batch mode and send the result to STDOUT. 3355 If CMD-KEY is a string of length 1, it is used as a key in 3356 `org-agenda-custom-commands' and triggers this command. If it is a 3357 longer string it is used as a tags/todo match string. 3358 Parameters are alternating variable names and values that will be bound 3359 before running the agenda command. 3360 3361 The output gives a line for each selected agenda item. Each 3362 item is a list of comma-separated values, like this: 3363 3364 category,head,type,todo,tags,date,time,extra,priority-l,priority-n 3365 3366 category The category of the item 3367 head The headline, without TODO kwd, TAGS and PRIORITY 3368 type The type of the agenda entry, can be 3369 todo selected in TODO match 3370 tagsmatch selected in tags match 3371 diary imported from diary 3372 deadline a deadline on given date 3373 scheduled scheduled on given date 3374 timestamp entry has timestamp on given date 3375 closed entry was closed on given date 3376 upcoming-deadline warning about deadline 3377 past-scheduled forwarded scheduled item 3378 block entry has date block including g. date 3379 todo The todo keyword, if any 3380 tags All tags including inherited ones, separated by colons 3381 date The relevant date, like 2007-2-14 3382 time The time, like 15:00-16:50 3383 extra String with extra planning info 3384 priority-l The priority letter if any was given 3385 priority-n The computed numerical priority 3386 agenda-day The day in the agenda where this is listed" 3387 (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) 3388 `(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps)))) 3389 3390 (defun org--batch-agenda-csv (cmd-key vars vals) 3391 ;; `org-batch-agenda-csv' is a macro because every other "parameter" is 3392 ;; a variable name rather than an expression to evaluate. Yuck! 3393 (let ((org-agenda-remove-tags t)) 3394 (cl-progv vars vals 3395 ;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)? 3396 (if (> (length cmd-key) 2) 3397 (org-tags-view nil cmd-key) 3398 (org-agenda nil cmd-key)))) 3399 (set-buffer org-agenda-buffer-name) 3400 (let ((lines (org-split-string (buffer-string) "\n"))) 3401 (dolist (line lines) 3402 (when (get-text-property 0 'org-category line) 3403 (setq org-agenda-info 3404 (org-fix-agenda-info (text-properties-at 0 line))) 3405 (princ 3406 (mapconcat #'org-agenda-export-csv-mapper 3407 '(org-category txt type todo tags date time extra 3408 priority-letter priority agenda-day) 3409 ",")) 3410 (princ "\n"))))) 3411 3412 (defun org-fix-agenda-info (props) 3413 "Make sure all properties on an agenda item have a canonical form. 3414 This ensures the export commands can easily use it." 3415 (let (tmp re) 3416 (when (setq tmp (plist-get props 'tags)) 3417 (setq props (plist-put props 'tags (mapconcat #'identity tmp ":")))) 3418 (when (setq tmp (plist-get props 'date)) 3419 (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) 3420 (let ((calendar-date-display-form '(year "-" month "-" day))) 3421 '((format "%4d, %9s %2s, %4s" dayname monthname day year)) 3422 3423 (setq tmp (calendar-date-string tmp))) 3424 (setq props (plist-put props 'date tmp))) 3425 (when (setq tmp (plist-get props 'day)) 3426 (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) 3427 (let ((calendar-date-display-form '(year "-" month "-" day))) 3428 (setq tmp (calendar-date-string tmp))) 3429 (setq props (plist-put props 'day tmp)) 3430 (setq props (plist-put props 'agenda-day tmp))) 3431 (when (setq tmp (plist-get props 'txt)) 3432 (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) 3433 (plist-put props 'priority-letter (match-string 1 tmp)) 3434 (setq tmp (replace-match "" t t tmp))) 3435 (when (and (setq re (plist-get props 'org-todo-regexp)) 3436 (setq re (concat "\\`\\.*" re " ?")) 3437 (let ((case-fold-search nil)) (string-match re tmp))) 3438 (plist-put props 'todo (match-string 1 tmp)) 3439 (setq tmp (replace-match "" t t tmp))) 3440 (plist-put props 'txt tmp))) 3441 props) 3442 3443 (defun org-agenda-export-csv-mapper (prop) 3444 (let ((res (plist-get org-agenda-info prop))) 3445 (setq res 3446 (cond 3447 ((not res) "") 3448 ((stringp res) res) 3449 (t (prin1-to-string res)))) 3450 (org-trim (replace-regexp-in-string "," ";" res nil t)))) 3451 3452 ;;;###autoload 3453 (defun org-store-agenda-views (&rest _parameters) 3454 "Store agenda views." 3455 (interactive) 3456 (org--batch-store-agenda-views nil nil)) 3457 3458 ;;;###autoload 3459 (defmacro org-batch-store-agenda-views (&rest parameters) 3460 "Run all custom agenda commands that have a file argument." 3461 (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) 3462 `(org--batch-store-agenda-views ',vars (list ,@exps)))) 3463 3464 (defun org--batch-store-agenda-views (vars vals) 3465 (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) 3466 (pop-up-frames nil) 3467 (dir default-directory) 3468 cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) 3469 (save-window-excursion 3470 (while cmds 3471 (setq cmd (pop cmds) 3472 thiscmdkey (car cmd) 3473 thiscmdcmd (cdr cmd) 3474 match (nth 2 thiscmdcmd) 3475 bufname (if org-agenda-sticky 3476 (or (and (stringp match) 3477 (format "*Org Agenda(%s:%s)*" thiscmdkey match)) 3478 (format "*Org Agenda(%s)*" thiscmdkey)) 3479 org-agenda-buffer-name) 3480 cmd-or-set (nth 2 cmd) 3481 opts (nth (if (listp cmd-or-set) 3 4) cmd) 3482 files (nth (if (listp cmd-or-set) 4 5) cmd)) 3483 (if (stringp files) (setq files (list files))) 3484 (when files 3485 (let* ((opts (append org-agenda-exporter-settings opts)) 3486 (vars (append (mapcar #'car opts) vars)) 3487 (vals (append (mapcar (lambda (binding) (eval (cadr binding) t)) 3488 opts) 3489 vals))) 3490 (cl-progv vars vals 3491 (org-agenda nil thiscmdkey)) 3492 (set-buffer bufname) 3493 (while files 3494 (cl-progv vars vals 3495 (org-agenda-write (expand-file-name (pop files) dir) 3496 nil t bufname)))) 3497 (and (get-buffer bufname) 3498 (kill-buffer bufname))))))) 3499 3500 (defvar org-agenda-current-span nil 3501 "The current span used in the agenda view.") ; local variable in the agenda buffer 3502 (defun org-agenda-mark-header-line (pos) 3503 "Mark the line at POS as an agenda structure header." 3504 (save-excursion 3505 (goto-char pos) 3506 (put-text-property (point-at-bol) (point-at-eol) 3507 'org-agenda-structural-header t) 3508 (when org-agenda-title-append 3509 (put-text-property (point-at-bol) (point-at-eol) 3510 'org-agenda-title-append org-agenda-title-append)))) 3511 3512 (defvar org-mobile-creating-agendas) ; defined in org-mobile.el 3513 (defvar org-agenda-write-buffer-name "Agenda View") 3514 (defun org-agenda-write (file &optional open nosettings agenda-bufname) 3515 "Write the current buffer (an agenda view) as a file. 3516 3517 Depending on the extension of the file name, plain text (.txt), 3518 HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced. 3519 If the extension is .ics, translate visible agenda into iCalendar 3520 format. If the extension is .org, collect all subtrees 3521 corresponding to the agenda entries and add them in an .org file. 3522 3523 With prefix argument OPEN, open the new file immediately. If 3524 NOSETTINGS is given, do not scope the settings of 3525 `org-agenda-exporter-settings' into the export commands. This is 3526 used when the settings have already been scoped and we do not 3527 wish to overrule other, higher priority settings. If 3528 AGENDA-BUFFER-NAME is provided, use this as the buffer name for 3529 the agenda to write." 3530 (interactive "FWrite agenda to file: \nP") 3531 (if (or (not (file-writable-p file)) 3532 (and (file-exists-p file) 3533 (if (called-interactively-p 'any) 3534 (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) 3535 (user-error "Cannot write agenda to file %s" file)) 3536 (cl-progv 3537 (if nosettings nil (mapcar #'car org-agenda-exporter-settings)) 3538 (if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t)) 3539 org-agenda-exporter-settings)) 3540 (save-excursion 3541 (save-window-excursion 3542 (let ((bs (copy-sequence (buffer-string))) 3543 (extension (file-name-extension file)) 3544 (default-directory (file-name-directory file)) 3545 ) ;; beg content 3546 (with-temp-buffer 3547 (rename-buffer org-agenda-write-buffer-name t) 3548 (set-buffer-modified-p nil) 3549 (insert bs) 3550 (org-agenda-remove-marked-text 'invisible 'org-filtered) 3551 (run-hooks 'org-agenda-before-write-hook) 3552 (cond 3553 ((bound-and-true-p org-mobile-creating-agendas) 3554 (org-mobile-write-agenda-for-mobile file)) 3555 ((string= "org" extension) 3556 (let (content p m message-log-max) 3557 (goto-char (point-min)) 3558 (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) 3559 (goto-char p) 3560 (setq m (get-text-property (point) 'org-hd-marker)) 3561 (when m 3562 (push (with-current-buffer (marker-buffer m) 3563 (goto-char m) 3564 (org-copy-subtree 1 nil t t) 3565 org-subtree-clip) 3566 content))) 3567 (find-file file) 3568 (erase-buffer) 3569 (dolist (s content) (org-paste-subtree 1 s)) 3570 (write-file file) 3571 (kill-buffer (current-buffer)) 3572 (message "Org file written to %s" file))) 3573 ((member extension '("html" "htm")) 3574 (or (require 'htmlize nil t) 3575 (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) 3576 (declare-function htmlize-buffer "htmlize" (&optional buffer)) 3577 (set-buffer (htmlize-buffer (current-buffer))) 3578 (when org-agenda-export-html-style 3579 ;; replace <style> section with org-agenda-export-html-style 3580 (goto-char (point-min)) 3581 (kill-region (- (search-forward "<style") 6) 3582 (search-forward "</style>")) 3583 (insert org-agenda-export-html-style)) 3584 (write-file file) 3585 (kill-buffer (current-buffer)) 3586 (message "HTML written to %s" file)) 3587 ((string= "ps" extension) 3588 (require 'ps-print) 3589 (ps-print-buffer-with-faces file) 3590 (message "Postscript written to %s" file)) 3591 ((string= "pdf" extension) 3592 (require 'ps-print) 3593 (ps-print-buffer-with-faces 3594 (concat (file-name-sans-extension file) ".ps")) 3595 (call-process "ps2pdf" nil nil nil 3596 (expand-file-name 3597 (concat (file-name-sans-extension file) ".ps")) 3598 (expand-file-name file)) 3599 (delete-file (concat (file-name-sans-extension file) ".ps")) 3600 (message "PDF written to %s" file)) 3601 ((string= "ics" extension) 3602 (require 'ox-icalendar) 3603 (declare-function org-icalendar-export-current-agenda 3604 "ox-icalendar" (file)) 3605 (org-icalendar-export-current-agenda (expand-file-name file))) 3606 (t 3607 (let ((bs (buffer-string))) 3608 (find-file file) 3609 (erase-buffer) 3610 (insert bs) 3611 (save-buffer 0) 3612 (kill-buffer (current-buffer)) 3613 (message "Plain text written to %s" file)))))))) 3614 (set-buffer (or agenda-bufname 3615 ;; FIXME: I'm pretty sure called-interactively-p 3616 ;; doesn't do what we want here! 3617 (and (called-interactively-p 'any) (buffer-name)) 3618 org-agenda-buffer-name))) 3619 (when open (org-open-file file))) 3620 3621 (defun org-agenda-remove-marked-text (property &optional value) 3622 "Delete all text marked with VALUE of PROPERTY. 3623 VALUE defaults to t." 3624 (let (beg) 3625 (setq value (or value t)) 3626 (while (setq beg (text-property-any (point-min) (point-max) 3627 property value)) 3628 (delete-region 3629 beg (or (next-single-property-change beg property) 3630 (point-max)))))) 3631 3632 (defun org-agenda-add-entry-text () 3633 "Add entry text to agenda lines. 3634 This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the 3635 entry text following headings shown in the agenda. 3636 Drawers will be excluded, also the line with scheduling/deadline info." 3637 (when (and (> org-agenda-add-entry-text-maxlines 0) 3638 (not (bound-and-true-p org-mobile-creating-agendas))) 3639 (let (m txt) 3640 (goto-char (point-min)) 3641 (while (not (eobp)) 3642 (if (not (setq m (org-get-at-bol 'org-hd-marker))) 3643 (beginning-of-line 2) 3644 (setq txt (org-agenda-get-some-entry-text 3645 m org-agenda-add-entry-text-maxlines " > ")) 3646 (end-of-line 1) 3647 (if (string-match "\\S-" txt) 3648 (insert "\n" txt) 3649 (or (eobp) (forward-char 1)))))))) 3650 3651 (defun org-agenda-get-some-entry-text (marker n-lines &optional indent 3652 &rest keep) 3653 "Extract entry text from MARKER, at most N-LINES lines. 3654 This will ignore drawers etc, just get the text. 3655 If INDENT is given, prefix every line with this string. If KEEP is 3656 given, it is a list of symbols, defining stuff that should not be 3657 removed from the entry content. Currently only `planning' is allowed here." 3658 (let (txt drawer-re kwd-time-re ind) 3659 (save-excursion 3660 (with-current-buffer (marker-buffer marker) 3661 (if (not (derived-mode-p 'org-mode)) 3662 (setq txt "") 3663 (org-with-wide-buffer 3664 (goto-char marker) 3665 (end-of-line 1) 3666 (setq txt (buffer-substring 3667 (min (1+ (point)) (point-max)) 3668 (progn (outline-next-heading) (point))) 3669 drawer-re org-drawer-regexp 3670 kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp 3671 ".*\n?")) 3672 (with-temp-buffer 3673 (insert txt) 3674 (when org-agenda-add-entry-text-descriptive-links 3675 (goto-char (point-min)) 3676 (while (org-activate-links (point-max)) 3677 (goto-char (match-end 0)))) 3678 (goto-char (point-min)) 3679 (while (re-search-forward org-link-bracket-re (point-max) t) 3680 (set-text-properties (match-beginning 0) (match-end 0) 3681 nil)) 3682 (goto-char (point-min)) 3683 (while (re-search-forward drawer-re nil t) 3684 (delete-region 3685 (match-beginning 0) 3686 (progn (re-search-forward 3687 "^[ \t]*:END:.*\n?" nil 'move) 3688 (point)))) 3689 (unless (member 'planning keep) 3690 (goto-char (point-min)) 3691 (while (re-search-forward kwd-time-re nil t) 3692 (replace-match ""))) 3693 (goto-char (point-min)) 3694 (when org-agenda-entry-text-exclude-regexps 3695 (let ((re-list org-agenda-entry-text-exclude-regexps) re) 3696 (while (setq re (pop re-list)) 3697 (goto-char (point-min)) 3698 (while (re-search-forward re nil t) 3699 (replace-match ""))))) 3700 (goto-char (point-max)) 3701 (skip-chars-backward " \t\n") 3702 (when (looking-at "[ \t\n]+\\'") (replace-match "")) 3703 3704 ;; find and remove min common indentation 3705 (goto-char (point-min)) 3706 (untabify (point-min) (point-max)) 3707 (setq ind (current-indentation)) 3708 (while (not (eobp)) 3709 (unless (looking-at "[ \t]*$") 3710 (setq ind (min ind (current-indentation)))) 3711 (beginning-of-line 2)) 3712 (goto-char (point-min)) 3713 (while (not (eobp)) 3714 (unless (looking-at "[ \t]*$") 3715 (move-to-column ind) 3716 (delete-region (point-at-bol) (point))) 3717 (beginning-of-line 2)) 3718 3719 (run-hooks 'org-agenda-entry-text-cleanup-hook) 3720 3721 (goto-char (point-min)) 3722 (when indent 3723 (while (and (not (eobp)) (re-search-forward "^" nil t)) 3724 (replace-match indent t t))) 3725 (goto-char (point-min)) 3726 (while (looking-at "[ \t]*\n") (replace-match "")) 3727 (goto-char (point-max)) 3728 (when (> (org-current-line) 3729 n-lines) 3730 (org-goto-line (1+ n-lines)) 3731 (backward-char 1)) 3732 (setq txt (buffer-substring (point-min) (point)))))))) 3733 txt)) 3734 3735 (defun org-check-for-org-mode () 3736 "Make sure current buffer is in Org mode. Error if not." 3737 (or (derived-mode-p 'org-mode) 3738 (error "Cannot execute Org agenda command on buffer in %s" 3739 major-mode))) 3740 3741 ;;; Agenda prepare and finalize 3742 3743 (defvar org-agenda-multi nil) ; dynamically scoped 3744 (defvar org-agenda-pre-window-conf nil) 3745 (defvar org-agenda-columns-active nil) 3746 (defvar org-agenda-name nil) 3747 (defvar org-agenda-tag-filter nil) 3748 (defvar org-agenda-category-filter nil) 3749 (defvar org-agenda-regexp-filter nil) 3750 (defvar org-agenda-effort-filter nil) 3751 (defvar org-agenda-top-headline-filter nil) 3752 3753 (defvar org-agenda-represented-categories nil 3754 "Cache for the list of all categories in the agenda.") 3755 (defvar org-agenda-represented-tags nil 3756 "Cache for the list of all categories in the agenda.") 3757 (defvar org-agenda-tag-filter-preset nil 3758 "A preset of the tags filter used for secondary agenda filtering. 3759 This must be a list of strings, each string must be a single tag preceded 3760 by \"+\" or \"-\". 3761 This variable should not be set directly, but agenda custom commands can 3762 bind it in the options section. The preset filter is a global property of 3763 the entire agenda view. In a block agenda, it will not work reliably to 3764 define a filter for one of the individual blocks. You need to set it in 3765 the global options and expect it to be applied to the entire view.") 3766 3767 (defconst org-agenda-filter-variables 3768 '((category . org-agenda-category-filter) 3769 (tag . org-agenda-tag-filter) 3770 (effort . org-agenda-effort-filter) 3771 (regexp . org-agenda-regexp-filter)) 3772 "Alist of filter types and associated variables.") 3773 (defun org-agenda-filter-any () 3774 "Is any filter active?" 3775 (cl-some (lambda (x) 3776 (or (symbol-value (cdr x)) 3777 (get :preset-filter x))) 3778 org-agenda-filter-variables)) 3779 3780 (defvar org-agenda-category-filter-preset nil 3781 "A preset of the category filter used for secondary agenda filtering. 3782 This must be a list of strings, each string must be a single category 3783 preceded by \"+\" or \"-\". 3784 This variable should not be set directly, but agenda custom commands can 3785 bind it in the options section. The preset filter is a global property of 3786 the entire agenda view. In a block agenda, it will not work reliably to 3787 define a filter for one of the individual blocks. You need to set it in 3788 the global options and expect it to be applied to the entire view.") 3789 3790 (defvar org-agenda-regexp-filter-preset nil 3791 "A preset of the regexp filter used for secondary agenda filtering. 3792 This must be a list of strings, each string must be a single regexp 3793 preceded by \"+\" or \"-\". 3794 This variable should not be set directly, but agenda custom commands can 3795 bind it in the options section. The preset filter is a global property of 3796 the entire agenda view. In a block agenda, it will not work reliably to 3797 define a filter for one of the individual blocks. You need to set it in 3798 the global options and expect it to be applied to the entire view.") 3799 3800 (defvar org-agenda-effort-filter-preset nil 3801 "A preset of the effort condition used for secondary agenda filtering. 3802 This must be a list of strings, each string must be a single regexp 3803 preceded by \"+\" or \"-\". 3804 This variable should not be set directly, but agenda custom commands can 3805 bind it in the options section. The preset filter is a global property of 3806 the entire agenda view. In a block agenda, it will not work reliably to 3807 define a filter for one of the individual blocks. You need to set it in 3808 the global options and expect it to be applied to the entire view.") 3809 3810 (defun org-agenda-use-sticky-p () 3811 "Return non-nil if an agenda buffer named 3812 `org-agenda-buffer-name' exists and should be shown instead of 3813 generating a new one." 3814 (and 3815 ;; turned off by user 3816 org-agenda-sticky 3817 ;; For multi-agenda buffer already exists 3818 (not org-agenda-multi) 3819 ;; buffer found 3820 (get-buffer org-agenda-buffer-name) 3821 ;; C-u parameter is same as last call 3822 (with-current-buffer (get-buffer org-agenda-buffer-name) 3823 (and 3824 (equal current-prefix-arg 3825 org-agenda-last-prefix-arg) 3826 ;; In case user turned stickiness on, while having existing 3827 ;; Agenda buffer active, don't reuse that buffer, because it 3828 ;; does not have org variables local 3829 org-agenda-this-buffer-is-sticky)))) 3830 3831 (defvar org-agenda-buffer-tmp-name nil) 3832 3833 (defun org-agenda--get-buffer-name (sticky-name) 3834 (or org-agenda-buffer-tmp-name 3835 (and org-agenda-doing-sticky-redo org-agenda-buffer-name) 3836 sticky-name 3837 "*Org Agenda*")) 3838 3839 (defun org-agenda-prepare-window (abuf filter-alist) 3840 "Setup agenda buffer in the window. 3841 ABUF is the buffer for the agenda window. 3842 FILTER-ALIST is an alist of filters we need to apply when 3843 `org-agenda-persistent-filter' is non-nil." 3844 (let* ((awin (get-buffer-window abuf)) wconf) 3845 (cond 3846 ((equal (current-buffer) abuf) nil) 3847 (awin (select-window awin)) 3848 ((not (setq wconf (current-window-configuration)))) 3849 ((eq org-agenda-window-setup 'current-window) 3850 (pop-to-buffer-same-window abuf)) 3851 ((eq org-agenda-window-setup 'other-window) 3852 (org-switch-to-buffer-other-window abuf)) 3853 ((eq org-agenda-window-setup 'other-frame) 3854 (switch-to-buffer-other-frame abuf)) 3855 ((eq org-agenda-window-setup 'other-tab) 3856 (if (fboundp 'switch-to-buffer-other-tab) 3857 (switch-to-buffer-other-tab abuf) 3858 (user-error "Your version of Emacs does not have tab bar support"))) 3859 ((eq org-agenda-window-setup 'only-window) 3860 (delete-other-windows) 3861 (pop-to-buffer-same-window abuf)) 3862 ((eq org-agenda-window-setup 'reorganize-frame) 3863 (delete-other-windows) 3864 (org-switch-to-buffer-other-window abuf))) 3865 (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist))) 3866 (setq org-agenda-category-filter (cdr (assq 'cat filter-alist))) 3867 (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist))) 3868 (setq org-agenda-regexp-filter (cdr (assq 're filter-alist))) 3869 ;; Additional test in case agenda is invoked from within agenda 3870 ;; buffer via elisp link. 3871 (unless (equal (current-buffer) abuf) 3872 (pop-to-buffer-same-window abuf)) 3873 (setq org-agenda-pre-window-conf 3874 (or wconf org-agenda-pre-window-conf)))) 3875 3876 (defun org-agenda-prepare (&optional name) 3877 (let ((filter-alist (when org-agenda-persistent-filter 3878 (with-current-buffer 3879 (get-buffer-create org-agenda-buffer-name) 3880 `((tag . ,org-agenda-tag-filter) 3881 (re . ,org-agenda-regexp-filter) 3882 (effort . ,org-agenda-effort-filter) 3883 (cat . ,org-agenda-category-filter)))))) 3884 (if (org-agenda-use-sticky-p) 3885 (progn 3886 (put 'org-agenda-tag-filter :preset-filter nil) 3887 (put 'org-agenda-category-filter :preset-filter nil) 3888 (put 'org-agenda-regexp-filter :preset-filter nil) 3889 (put 'org-agenda-effort-filter :preset-filter nil) 3890 ;; Popup existing buffer 3891 (org-agenda-prepare-window (get-buffer org-agenda-buffer-name) 3892 filter-alist) 3893 (message "Sticky Agenda buffer, use `r' to refresh") 3894 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 3895 (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) 3896 (setq org-todo-keywords-for-agenda nil) 3897 (put 'org-agenda-tag-filter :preset-filter 3898 org-agenda-tag-filter-preset) 3899 (put 'org-agenda-category-filter :preset-filter 3900 org-agenda-category-filter-preset) 3901 (put 'org-agenda-regexp-filter :preset-filter 3902 org-agenda-regexp-filter-preset) 3903 (put 'org-agenda-effort-filter :preset-filter 3904 org-agenda-effort-filter-preset) 3905 (if org-agenda-multi 3906 (progn 3907 (setq buffer-read-only nil) 3908 (goto-char (point-max)) 3909 (unless (or (bobp) org-agenda-compact-blocks 3910 (not org-agenda-block-separator)) 3911 (insert "\n" 3912 (if (stringp org-agenda-block-separator) 3913 org-agenda-block-separator 3914 (make-string (window-width) org-agenda-block-separator)) 3915 "\n")) 3916 (narrow-to-region (point) (point-max))) 3917 (setq org-done-keywords-for-agenda nil) 3918 ;; Setting any org variables that are in org-agenda-local-vars 3919 ;; list need to be done after the prepare call 3920 (org-agenda-prepare-window 3921 (get-buffer-create org-agenda-buffer-name) filter-alist) 3922 (setq buffer-read-only nil) 3923 (org-agenda-reset-markers) 3924 (let ((inhibit-read-only t)) (erase-buffer)) 3925 (org-agenda-mode) 3926 (setq org-agenda-buffer (current-buffer)) 3927 (setq org-agenda-contributing-files nil) 3928 (setq org-agenda-columns-active nil) 3929 (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) 3930 (setq org-todo-keywords-for-agenda 3931 (org-uniquify org-todo-keywords-for-agenda)) 3932 (setq org-done-keywords-for-agenda 3933 (org-uniquify org-done-keywords-for-agenda)) 3934 (setq org-agenda-last-prefix-arg current-prefix-arg) 3935 (setq org-agenda-this-buffer-name org-agenda-buffer-name) 3936 (and name (not org-agenda-name) 3937 (setq-local org-agenda-name name))) 3938 (setq buffer-read-only nil)))) 3939 3940 (defvar org-overriding-columns-format) 3941 (defvar org-local-columns-format) 3942 (defun org-agenda-finalize () 3943 "Finishing touch for the agenda buffer. 3944 This function is called just before displaying the agenda. If 3945 you want to add your own functions to the finalization of the 3946 agenda display, configure `org-agenda-finalize-hook'." 3947 (unless org-agenda-multi 3948 (let ((inhibit-read-only t)) 3949 (save-excursion 3950 (goto-char (point-min)) 3951 (save-excursion 3952 (while (org-activate-links (point-max)) 3953 (goto-char (match-end 0)))) 3954 (unless (eq org-agenda-remove-tags t) 3955 (org-agenda-align-tags)) 3956 (unless org-agenda-with-colors 3957 (remove-text-properties (point-min) (point-max) '(face nil))) 3958 (when (bound-and-true-p org-overriding-columns-format) 3959 (setq-local org-local-columns-format 3960 org-overriding-columns-format)) 3961 (when org-agenda-view-columns-initially 3962 (org-agenda-columns)) 3963 (when org-agenda-fontify-priorities 3964 (org-agenda-fontify-priorities)) 3965 (when (and org-agenda-dim-blocked-tasks org-blocker-hook) 3966 (org-agenda-dim-blocked-tasks)) 3967 (org-agenda-mark-clocking-task) 3968 (when org-agenda-entry-text-mode 3969 (org-agenda-entry-text-hide) 3970 (org-agenda-entry-text-show)) 3971 (when (and (featurep 'org-habit) 3972 (save-excursion (next-single-property-change (point-min) 'org-habit-p))) 3973 (org-habit-insert-consistency-graphs)) 3974 (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) 3975 (unless (or (eq org-agenda-show-inherited-tags 'always) 3976 (and (listp org-agenda-show-inherited-tags) 3977 (memq org-agenda-type org-agenda-show-inherited-tags)) 3978 (and (eq org-agenda-show-inherited-tags t) 3979 (or (eq org-agenda-use-tag-inheritance t) 3980 (and (listp org-agenda-use-tag-inheritance) 3981 (not (memq org-agenda-type 3982 org-agenda-use-tag-inheritance)))))) 3983 (let (mrk) 3984 (save-excursion 3985 (goto-char (point-min)) 3986 (while (equal (forward-line) 0) 3987 (when (setq mrk (get-text-property (point) 'org-hd-marker)) 3988 (put-text-property (point-at-bol) (point-at-eol) 3989 'tags 3990 (org-with-point-at mrk 3991 (org-get-tags)))))))) 3992 (setq org-agenda-represented-tags nil 3993 org-agenda-represented-categories nil) 3994 (when org-agenda-top-headline-filter 3995 (org-agenda-filter-top-headline-apply 3996 org-agenda-top-headline-filter)) 3997 (when org-agenda-tag-filter 3998 (org-agenda-filter-apply org-agenda-tag-filter 'tag t)) 3999 (when (get 'org-agenda-tag-filter :preset-filter) 4000 (org-agenda-filter-apply 4001 (get 'org-agenda-tag-filter :preset-filter) 'tag t)) 4002 (when org-agenda-category-filter 4003 (org-agenda-filter-apply org-agenda-category-filter 'category)) 4004 (when (get 'org-agenda-category-filter :preset-filter) 4005 (org-agenda-filter-apply 4006 (get 'org-agenda-category-filter :preset-filter) 'category)) 4007 (when org-agenda-regexp-filter 4008 (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) 4009 (when (get 'org-agenda-regexp-filter :preset-filter) 4010 (org-agenda-filter-apply 4011 (get 'org-agenda-regexp-filter :preset-filter) 'regexp)) 4012 (when org-agenda-effort-filter 4013 (org-agenda-filter-apply org-agenda-effort-filter 'effort)) 4014 (when (get 'org-agenda-effort-filter :preset-filter) 4015 (org-agenda-filter-apply 4016 (get 'org-agenda-effort-filter :preset-filter) 'effort)) 4017 (add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local)) 4018 (run-hooks 'org-agenda-finalize-hook)))) 4019 4020 (defun org-agenda-mark-clocking-task () 4021 "Mark the current clock entry in the agenda if it is present." 4022 ;; We need to widen when `org-agenda-finalize' is called from 4023 ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in'). 4024 (when (bound-and-true-p org-clock-current-task) 4025 (save-restriction 4026 (widen) 4027 (org-agenda-unmark-clocking-task) 4028 (when (marker-buffer org-clock-hd-marker) 4029 (save-excursion 4030 (goto-char (point-min)) 4031 (let (s ov) 4032 (while (setq s (next-single-property-change (point) 'org-hd-marker)) 4033 (goto-char s) 4034 (when (equal (org-get-at-bol 'org-hd-marker) 4035 org-clock-hd-marker) 4036 (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol)))) 4037 (overlay-put ov 'type 'org-agenda-clocking) 4038 (overlay-put ov 'face 'org-agenda-clocking) 4039 (overlay-put ov 'help-echo 4040 "The clock is running in this item"))))))))) 4041 4042 (defun org-agenda-unmark-clocking-task () 4043 "Unmark the current clocking task." 4044 (mapc (lambda (o) 4045 (when (eq (overlay-get o 'type) 'org-agenda-clocking) 4046 (delete-overlay o))) 4047 (overlays-in (point-min) (point-max)))) 4048 4049 (defun org-agenda-fontify-priorities () 4050 "Make highest priority lines bold, and lowest italic." 4051 (interactive) 4052 (mapc (lambda (o) (when (eq (overlay-get o 'org-type) 'org-priority) 4053 (delete-overlay o))) 4054 (overlays-in (point-min) (point-max))) 4055 (save-excursion 4056 (let (b e p ov h l) 4057 (goto-char (point-min)) 4058 (while (re-search-forward org-priority-regexp nil t) 4059 (setq h (or (get-char-property (point) 'org-priority-highest) 4060 org-priority-highest) 4061 l (or (get-char-property (point) 'org-priority-lowest) 4062 org-priority-lowest) 4063 p (string-to-char (match-string 2)) 4064 b (match-beginning 1) 4065 e (if (eq org-agenda-fontify-priorities 'cookies) 4066 (1+ (match-end 2)) 4067 (point-at-eol)) 4068 ov (make-overlay b e)) 4069 (overlay-put 4070 ov 'face 4071 (let ((special-face 4072 (cond ((org-face-from-face-or-color 4073 'priority 'org-priority 4074 (cdr (assoc p org-priority-faces)))) 4075 ((and (listp org-agenda-fontify-priorities) 4076 (org-face-from-face-or-color 4077 'priority 'org-priority 4078 (cdr (assoc p org-agenda-fontify-priorities))))) 4079 ((equal p l) 'italic) 4080 ((equal p h) 'bold)))) 4081 (if special-face (list special-face 'org-priority) 'org-priority))) 4082 (overlay-put ov 'org-type 'org-priority))))) 4083 4084 (defvar org-depend-tag-blocked) 4085 4086 (defun org-agenda-dim-blocked-tasks (&optional _invisible) 4087 "Dim currently blocked TODOs in the agenda display. 4088 When INVISIBLE is non-nil, hide currently blocked TODO instead of 4089 dimming them." ;FIXME: The arg isn't used, actually! 4090 (interactive "P") 4091 (when (called-interactively-p 'interactive) 4092 (message "Dim or hide blocked tasks...")) 4093 (dolist (o (overlays-in (point-min) (point-max))) 4094 (when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face) 4095 (delete-overlay o))) 4096 (save-excursion 4097 (let ((inhibit-read-only t)) 4098 (goto-char (point-min)) 4099 (while (let ((pos (text-property-not-all 4100 (point) (point-max) 'org-todo-blocked nil))) 4101 (when pos (goto-char pos))) 4102 (let* ((invisible 4103 (eq (org-get-at-bol 'org-todo-blocked) 'invisible)) 4104 (todo-blocked 4105 (eq (org-get-at-bol 'org-filter-type) 'todo-blocked)) 4106 (ov (make-overlay (if invisible 4107 (line-end-position 0) 4108 (line-beginning-position)) 4109 (line-end-position)))) 4110 (when todo-blocked 4111 (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) 4112 (when invisible 4113 (org-agenda-filter-hide-line 'todo-blocked))) 4114 (if (= (point-max) (line-end-position)) 4115 (goto-char (point-max)) 4116 (move-beginning-of-line 2))))) 4117 (when (called-interactively-p 'interactive) 4118 (message "Dim or hide blocked tasks...done"))) 4119 4120 (defun org-agenda--mark-blocked-entry (entry) 4121 "If ENTRY is blocked, mark it for fontification or invisibility. 4122 4123 If the header at `org-hd-marker' is blocked according to 4124 `org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is 4125 'invisible and the header is not blocked by checkboxes, set the 4126 text property `org-todo-blocked' to `invisible', otherwise set it 4127 to t." 4128 (when (get-text-property 0 'todo-state entry) 4129 (let ((entry-marker (get-text-property 0 'org-hd-marker entry)) 4130 (org-blocked-by-checkboxes nil) 4131 ;; Necessary so that `org-entry-blocked-p' does not change 4132 ;; the buffer. 4133 (org-depend-tag-blocked nil)) 4134 (when entry-marker 4135 (let ((blocked 4136 (with-current-buffer (marker-buffer entry-marker) 4137 (save-excursion 4138 (goto-char entry-marker) 4139 (org-entry-blocked-p))))) 4140 (when blocked 4141 (let ((really-invisible 4142 (and (not org-blocked-by-checkboxes) 4143 (eq org-agenda-dim-blocked-tasks 'invisible)))) 4144 (put-text-property 4145 0 (length entry) 'org-todo-blocked 4146 (if really-invisible 'invisible t) 4147 entry) 4148 (put-text-property 4149 0 (length entry) 'org-filter-type 'todo-blocked entry))))))) 4150 entry) 4151 4152 (defvar org-agenda-skip-function nil 4153 "Function to be called at each match during agenda construction. 4154 If this function returns nil, the current match should not be skipped. 4155 Otherwise, the function must return a position from where the search 4156 should be continued. 4157 This may also be a Lisp form, it will be evaluated. 4158 Never set this variable using `setq' or so, because then it will apply 4159 to all future agenda commands. If you do want a global skipping condition, 4160 use the option `org-agenda-skip-function-global' instead. 4161 The correct usage for `org-agenda-skip-function' is to bind it with 4162 `let' to scope it dynamically into the agenda-constructing command. 4163 A good way to set it is through options in `org-agenda-custom-commands'.") 4164 4165 (defun org-agenda-skip () 4166 "Throw to `:skip' in places that should be skipped. 4167 Also moves point to the end of the skipped region, so that search can 4168 continue from there." 4169 (let ((p (point-at-bol)) to) 4170 (when (or 4171 (save-excursion (goto-char p) (looking-at comment-start-skip)) 4172 (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) 4173 (or (and (get-text-property p :org-archived) 4174 (org-end-of-subtree t)) 4175 (and (member org-archive-tag org-file-tags) 4176 (goto-char (point-max))))) 4177 (and org-agenda-skip-comment-trees 4178 (get-text-property p :org-comment) 4179 (org-end-of-subtree t)) 4180 (and (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global) 4181 (org-agenda-skip-eval org-agenda-skip-function))) 4182 (goto-char to)) 4183 (org-in-src-block-p t)) 4184 (throw :skip t)))) 4185 4186 (defun org-agenda-skip-eval (form) 4187 "If FORM is a function or a list, call (or eval) it and return the result. 4188 `save-excursion' and `save-match-data' are wrapped around the call, so point 4189 and match data are returned to the previous state no matter what these 4190 functions do." 4191 (let (fp) 4192 (and form 4193 (or (setq fp (functionp form)) 4194 (consp form)) 4195 (save-excursion 4196 (save-match-data 4197 (if fp 4198 (funcall form) 4199 (eval form t))))))) 4200 4201 (defvar org-agenda-markers nil 4202 "List of all currently active markers created by `org-agenda'.") 4203 (defvar org-agenda-last-marker-time (float-time) 4204 "Creation time of the last agenda marker.") 4205 4206 (defun org-agenda-new-marker (&optional pos) 4207 "Return a new agenda marker. 4208 Marker is at point, or at POS if non-nil. Org mode keeps a list 4209 of these markers and resets them when they are no longer in use." 4210 (let ((m (copy-marker (or pos (point)) t))) 4211 (setq org-agenda-last-marker-time (float-time)) 4212 (if org-agenda-buffer 4213 (with-current-buffer org-agenda-buffer 4214 (push m org-agenda-markers)) 4215 (push m org-agenda-markers)) 4216 m)) 4217 4218 (defun org-agenda-reset-markers () 4219 "Reset markers created by `org-agenda'." 4220 (while org-agenda-markers 4221 (move-marker (pop org-agenda-markers) nil))) 4222 4223 (defun org-agenda-save-markers-for-cut-and-paste (beg end) 4224 "Save relative positions of markers in region. 4225 This check for agenda markers in all agenda buffers currently active." 4226 (dolist (buf (buffer-list)) 4227 (with-current-buffer buf 4228 (when (eq major-mode 'org-agenda-mode) 4229 (mapc (lambda (m) (org-check-and-save-marker m beg end)) 4230 org-agenda-markers))))) 4231 4232 ;;; Entry text mode 4233 4234 (defun org-agenda-entry-text-show-here () 4235 "Add some text from the entry as context to the current line." 4236 (let (m txt o) 4237 (setq m (org-get-at-bol 'org-hd-marker)) 4238 (unless (marker-buffer m) 4239 (error "No marker points to an entry here")) 4240 (setq txt (concat "\n" (org-no-properties 4241 (org-agenda-get-some-entry-text 4242 m org-agenda-entry-text-maxlines 4243 org-agenda-entry-text-leaders)))) 4244 (when (string-match "\\S-" txt) 4245 (setq o (make-overlay (point-at-bol) (point-at-eol))) 4246 (overlay-put o 'evaporate t) 4247 (overlay-put o 'org-overlay-type 'agenda-entry-content) 4248 (overlay-put o 'after-string txt)))) 4249 4250 (defun org-agenda-entry-text-show () 4251 "Add entry context for all agenda lines." 4252 (interactive) 4253 (save-excursion 4254 (goto-char (point-max)) 4255 (beginning-of-line 1) 4256 (while (not (bobp)) 4257 (when (org-get-at-bol 'org-hd-marker) 4258 (org-agenda-entry-text-show-here)) 4259 (beginning-of-line 0)))) 4260 4261 (defun org-agenda-entry-text-hide () 4262 "Remove any shown entry context." 4263 (mapc (lambda (o) 4264 (when (eq (overlay-get o 'org-overlay-type) 4265 'agenda-entry-content) 4266 (delete-overlay o))) 4267 (overlays-in (point-min) (point-max)))) 4268 4269 (defun org-agenda-get-day-face (date) 4270 "Return the face DATE should be displayed with." 4271 (cond ((and (functionp org-agenda-day-face-function) 4272 (funcall org-agenda-day-face-function date))) 4273 ((and (org-agenda-today-p date) 4274 (memq (calendar-day-of-week date) org-agenda-weekend-days)) 4275 'org-agenda-date-weekend-today) 4276 ((org-agenda-today-p date) 'org-agenda-date-today) 4277 ((memq (calendar-day-of-week date) org-agenda-weekend-days) 4278 'org-agenda-date-weekend) 4279 (t 'org-agenda-date))) 4280 4281 (defvar org-agenda-show-log-scoped) 4282 4283 ;;; Agenda Daily/Weekly 4284 4285 (defvar org-agenda-start-day nil ; dynamically scoped parameter 4286 "Start day for the agenda view. 4287 Custom commands can set this variable in the options section. 4288 This is usually a string like \"2007-11-01\", \"+2d\" or any other 4289 input allowed when reading a date through the Org calendar. 4290 See the docstring of `org-read-date' for details.") 4291 (defvar org-starting-day nil) ; local variable in the agenda buffer 4292 (defvar org-arg-loc nil) ; local variable 4293 4294 ;;;###autoload 4295 (defun org-agenda-list (&optional arg start-day span with-hour) 4296 "Produce a daily/weekly view from all files in variable `org-agenda-files'. 4297 The view will be for the current day or week, but from the overview buffer 4298 you will be able to go to other days/weeks. 4299 4300 With a numeric prefix argument in an interactive call, the agenda will 4301 span ARG days. Lisp programs should instead specify SPAN to change 4302 the number of days. SPAN defaults to `org-agenda-span'. 4303 4304 START-DAY defaults to TODAY, or to the most recent match for the weekday 4305 given in `org-agenda-start-on-weekday'. 4306 4307 When WITH-HOUR is non-nil, only include scheduled and deadline 4308 items if they have an hour specification like [h]h:mm." 4309 (interactive "P") 4310 (when org-agenda-overriding-arguments 4311 (setq arg (car org-agenda-overriding-arguments) 4312 start-day (nth 1 org-agenda-overriding-arguments) 4313 span (nth 2 org-agenda-overriding-arguments))) 4314 (when (and (integerp arg) (> arg 0)) 4315 (setq span arg arg nil)) 4316 (when (numberp span) 4317 (unless (< 0 span) 4318 (user-error "Agenda creation impossible for this span(=%d days)" span))) 4319 (catch 'exit 4320 (setq org-agenda-buffer-name 4321 (org-agenda--get-buffer-name 4322 (and org-agenda-sticky 4323 (cond ((and org-keys (stringp org-match)) 4324 (format "*Org Agenda(%s:%s)*" org-keys org-match)) 4325 (org-keys 4326 (format "*Org Agenda(%s)*" org-keys)) 4327 (t "*Org Agenda(a)*"))))) 4328 (org-agenda-prepare "Day/Week") 4329 (setq start-day (or start-day org-agenda-start-day)) 4330 (when (stringp start-day) 4331 ;; Convert to an absolute day number 4332 (setq start-day (time-to-days (org-read-date nil t start-day)))) 4333 (org-compile-prefix-format 'agenda) 4334 (org-set-sorting-strategy 'agenda) 4335 (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span))) 4336 (today (org-today)) 4337 (sd (or start-day today)) 4338 (ndays (org-agenda-span-to-ndays span sd)) 4339 (org-agenda-start-on-weekday 4340 (and (or (eq ndays 7) (eq ndays 14)) 4341 org-agenda-start-on-weekday)) 4342 (thefiles (org-agenda-files nil 'ifmode)) 4343 (files thefiles) 4344 (start (if (or (null org-agenda-start-on-weekday) 4345 (< ndays 7)) 4346 sd 4347 (let* ((nt (calendar-day-of-week 4348 (calendar-gregorian-from-absolute sd))) 4349 (n1 org-agenda-start-on-weekday) 4350 (d (- nt n1))) 4351 (- sd (+ (if (< d 0) 7 0) d))))) 4352 (day-numbers (list start)) 4353 (day-cnt 0) 4354 (inhibit-redisplay (not debug-on-error)) 4355 (org-agenda-show-log-scoped org-agenda-show-log) 4356 s rtn rtnall file date d start-pos end-pos todayp ;; e 4357 clocktable-start clocktable-end) ;; filter 4358 (setq org-agenda-redo-command 4359 (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour)) 4360 (dotimes (_ (1- ndays)) 4361 (push (1+ (car day-numbers)) day-numbers)) 4362 (setq day-numbers (nreverse day-numbers)) 4363 (setq clocktable-start (car day-numbers) 4364 clocktable-end (1+ (or (org-last day-numbers) 0))) 4365 (setq-local org-starting-day (car day-numbers)) 4366 (setq-local org-arg-loc arg) 4367 (setq-local org-agenda-current-span (org-agenda-ndays-to-span span)) 4368 (unless org-agenda-compact-blocks 4369 (let* ((d1 (car day-numbers)) 4370 (d2 (org-last day-numbers)) 4371 (w1 (org-days-to-iso-week d1)) 4372 (w2 (org-days-to-iso-week d2))) 4373 (setq s (point)) 4374 (org-agenda--insert-overriding-header 4375 (concat (org-agenda-span-name span) 4376 "-agenda" 4377 (cond ((<= 350 (- d2 d1)) "") 4378 ((= w1 w2) (format " (W%02d)" w1)) 4379 (t (format " (W%02d-W%02d)" w1 w2))) 4380 ":\n"))) 4381 ;; Add properties if we actually inserted a header. 4382 (when (> (point) s) 4383 (add-text-properties s (1- (point)) 4384 (list 'face 'org-agenda-structure 4385 'org-date-line t)) 4386 (org-agenda-mark-header-line s))) 4387 (while (setq d (pop day-numbers)) 4388 (setq date (calendar-gregorian-from-absolute d) 4389 s (point)) 4390 (if (or (setq todayp (= d today)) 4391 (and (not start-pos) (= d sd))) 4392 (setq start-pos (point)) 4393 (when (and start-pos (not end-pos)) 4394 (setq end-pos (point)))) 4395 (setq files thefiles 4396 rtnall nil) 4397 (while (setq file (pop files)) 4398 (catch 'nextfile 4399 (org-check-agenda-file file) 4400 (let ((org-agenda-entry-types org-agenda-entry-types)) 4401 ;; Starred types override non-starred equivalents 4402 (when (member :deadline* org-agenda-entry-types) 4403 (setq org-agenda-entry-types 4404 (delq :deadline org-agenda-entry-types))) 4405 (when (member :scheduled* org-agenda-entry-types) 4406 (setq org-agenda-entry-types 4407 (delq :scheduled org-agenda-entry-types))) 4408 ;; Honor with-hour 4409 (when with-hour 4410 (when (member :deadline org-agenda-entry-types) 4411 (setq org-agenda-entry-types 4412 (delq :deadline org-agenda-entry-types)) 4413 (push :deadline* org-agenda-entry-types)) 4414 (when (member :scheduled org-agenda-entry-types) 4415 (setq org-agenda-entry-types 4416 (delq :scheduled org-agenda-entry-types)) 4417 (push :scheduled* org-agenda-entry-types))) 4418 (unless org-agenda-include-deadlines 4419 (setq org-agenda-entry-types 4420 (delq :deadline* (delq :deadline org-agenda-entry-types)))) 4421 (cond 4422 ((memq org-agenda-show-log-scoped '(only clockcheck)) 4423 (setq rtn (org-agenda-get-day-entries 4424 file date :closed))) 4425 (org-agenda-show-log-scoped 4426 (setq rtn (apply #'org-agenda-get-day-entries 4427 file date 4428 (append '(:closed) org-agenda-entry-types)))) 4429 (t 4430 (setq rtn (apply #'org-agenda-get-day-entries 4431 file date 4432 org-agenda-entry-types))))) 4433 (setq rtnall (append rtnall rtn)))) ;; all entries 4434 (when org-agenda-include-diary 4435 (let ((org-agenda-search-headline-for-time t)) 4436 (require 'diary-lib) 4437 (setq rtn (org-get-entries-from-diary date)) 4438 (setq rtnall (append rtnall rtn)))) 4439 (when (or rtnall org-agenda-show-all-dates) 4440 (setq day-cnt (1+ day-cnt)) 4441 (insert 4442 (if (stringp org-agenda-format-date) 4443 (format-time-string org-agenda-format-date 4444 (org-time-from-absolute date)) 4445 (funcall org-agenda-format-date date)) 4446 "\n") 4447 (put-text-property s (1- (point)) 'face 4448 (org-agenda-get-day-face date)) 4449 (put-text-property s (1- (point)) 'org-date-line t) 4450 (put-text-property s (1- (point)) 'org-agenda-date-header t) 4451 (put-text-property s (1- (point)) 'org-day-cnt day-cnt) 4452 (when todayp 4453 (put-text-property s (1- (point)) 'org-today t)) 4454 (setq rtnall 4455 (org-agenda-add-time-grid-maybe rtnall ndays todayp)) 4456 (when rtnall (insert ;; all entries 4457 (org-agenda-finalize-entries rtnall 'agenda) 4458 "\n")) 4459 (put-text-property s (1- (point)) 'day d) 4460 (put-text-property s (1- (point)) 'org-day-cnt day-cnt))) 4461 (when (and org-agenda-clockreport-mode clocktable-start) 4462 (let ((org-agenda-files (org-agenda-files nil 'ifmode)) 4463 ;; the above line is to ensure the restricted range! 4464 (p (copy-sequence org-agenda-clockreport-parameter-plist)) 4465 tbl) 4466 (setq p (org-plist-delete p :block)) 4467 (setq p (plist-put p :tstart clocktable-start)) 4468 (setq p (plist-put p :tend clocktable-end)) 4469 (setq p (plist-put p :scope 'agenda)) 4470 (setq tbl (apply #'org-clock-get-clocktable p)) 4471 (insert tbl))) 4472 (goto-char (point-min)) 4473 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 4474 (unless (or (not (get-buffer-window org-agenda-buffer-name)) 4475 (and (pos-visible-in-window-p (point-min)) 4476 (pos-visible-in-window-p (point-max)))) 4477 (goto-char (1- (point-max))) 4478 (recenter -1) 4479 (when (not (pos-visible-in-window-p (or start-pos 1))) 4480 (goto-char (or start-pos 1)) 4481 (recenter 1))) 4482 (goto-char (or start-pos 1)) 4483 (add-text-properties (point-min) (point-max) 4484 `(org-agenda-type agenda 4485 org-last-args (,arg ,start-day ,span) 4486 org-redo-cmd ,org-agenda-redo-command 4487 org-series-cmd ,org-cmd)) 4488 (when (eq org-agenda-show-log-scoped 'clockcheck) 4489 (org-agenda-show-clocking-issues)) 4490 (org-agenda-finalize) 4491 (setq buffer-read-only t) 4492 (message "")))) 4493 4494 (defun org-agenda-ndays-to-span (n) 4495 "Return a span symbol for a span of N days, or N if none matches." 4496 (cond ((symbolp n) n) 4497 ((= n 1) 'day) 4498 ((= n 7) 'week) 4499 ((= n 14) 'fortnight) 4500 (t n))) 4501 4502 (defun org-agenda-span-to-ndays (span &optional start-day) 4503 "Return ndays from SPAN, possibly starting at START-DAY. 4504 START-DAY is an absolute time value." 4505 (cond ((numberp span) span) 4506 ((eq span 'day) 1) 4507 ((eq span 'week) 7) 4508 ((eq span 'fortnight) 14) 4509 ((eq span 'month) 4510 (let ((date (calendar-gregorian-from-absolute start-day))) 4511 (calendar-last-day-of-month (car date) (cl-caddr date)))) 4512 ((eq span 'year) 4513 (let ((date (calendar-gregorian-from-absolute start-day))) 4514 (if (calendar-leap-year-p (cl-caddr date)) 366 365))))) 4515 4516 (defun org-agenda-span-name (span) 4517 "Return a SPAN name." 4518 (if (null span) 4519 "" 4520 (if (symbolp span) 4521 (capitalize (symbol-name span)) 4522 (format "%d days" span)))) 4523 4524 ;;; Agenda word search 4525 4526 (defvar org-agenda-search-history nil) 4527 4528 (defvar org-search-syntax-table nil 4529 "Special syntax table for Org search. 4530 In this table, we have single quotes not as word constituents, to 4531 that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") 4532 4533 (defvar org-mode-syntax-table) ; From org.el 4534 (defun org-search-syntax-table () 4535 (unless org-search-syntax-table 4536 (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) 4537 (modify-syntax-entry ?' "." org-search-syntax-table) 4538 (modify-syntax-entry ?` "." org-search-syntax-table)) 4539 org-search-syntax-table) 4540 4541 (defvar org-agenda-last-search-view-search-was-boolean nil) 4542 4543 ;;;###autoload 4544 (defun org-search-view (&optional todo-only string edit-at) 4545 "Show all entries that contain a phrase or words or regular expressions. 4546 4547 With optional prefix argument TODO-ONLY, only consider entries that are 4548 TODO entries. The argument STRING can be used to pass a default search 4549 string into this function. If EDIT-AT is non-nil, it means that the 4550 user should get a chance to edit this string, with cursor at position 4551 EDIT-AT. 4552 4553 The search string can be viewed either as a phrase that should be found as 4554 is, or it can be broken into a number of snippets, each of which must match 4555 in a Boolean way to select an entry. The default depends on the variable 4556 `org-agenda-search-view-always-boolean'. 4557 Even if this is turned off (the default) you can always switch to 4558 Boolean search dynamically by preceding the first word with \"+\" or \"-\". 4559 4560 The default is a direct search of the whole phrase, where each space in 4561 the search string can expand to an arbitrary amount of whitespace, 4562 including newlines. 4563 4564 If using a Boolean search, the search string is split on whitespace and 4565 each snippet is searched separately, with logical AND to select an entry. 4566 Words prefixed with a minus must *not* occur in the entry. Words without 4567 a prefix or prefixed with a plus must occur in the entry. Matching is 4568 case-insensitive. Words are enclosed by word delimiters (i.e. they must 4569 match whole words, not parts of a word) if 4570 `org-agenda-search-view-force-full-words' is set (default is nil). 4571 4572 Boolean search snippets enclosed by curly braces are interpreted as 4573 regular expressions that must or (when preceded with \"-\") must not 4574 match in the entry. Snippets enclosed into double quotes will be taken 4575 as a whole, to include whitespace. 4576 4577 - If the search string starts with an asterisk, search only in headlines. 4578 - If (possibly after the leading star) the search string starts with an 4579 exclamation mark, this also means to look at TODO entries only, an effect 4580 that can also be achieved with a prefix argument. 4581 - If (possibly after star and exclamation mark) the search string starts 4582 with a colon, this will mean that the (non-regexp) snippets of the 4583 Boolean search must match as full words. 4584 4585 This command searches the agenda files, and in addition the files 4586 listed in `org-agenda-text-search-extra-files' unless a restriction lock 4587 is active." 4588 (interactive "P") 4589 (when org-agenda-overriding-arguments 4590 (setq todo-only (car org-agenda-overriding-arguments) 4591 string (nth 1 org-agenda-overriding-arguments) 4592 edit-at (nth 2 org-agenda-overriding-arguments))) 4593 (let* ((props (list 'face nil 4594 'done-face 'org-agenda-done 4595 'org-not-done-regexp org-not-done-regexp 4596 'org-todo-regexp org-todo-regexp 4597 'org-complex-heading-regexp org-complex-heading-regexp 4598 'mouse-face 'highlight 4599 'help-echo "mouse-2 or RET jump to location")) 4600 (full-words org-agenda-search-view-force-full-words) 4601 (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) 4602 regexp rtn rtnall files file pos inherited-tags 4603 marker category level tags c neg re boolean 4604 ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) 4605 (unless (and (not edit-at) 4606 (stringp string) 4607 (string-match "\\S-" string)) 4608 (setq string (read-string 4609 (if org-agenda-search-view-always-boolean 4610 "[+-]Word/{Regexp} ...: " 4611 "Phrase or [+-]Word/{Regexp} ...: ") 4612 (cond 4613 ((integerp edit-at) (cons string edit-at)) 4614 (edit-at string)) 4615 'org-agenda-search-history))) 4616 (catch 'exit 4617 (setq org-agenda-buffer-name 4618 (org-agenda--get-buffer-name 4619 (and org-agenda-sticky 4620 (if (stringp string) 4621 (format "*Org Agenda(%s:%s)*" 4622 (or org-keys (or (and todo-only "S") "s")) 4623 string) 4624 (format "*Org Agenda(%s)*" 4625 (or (and todo-only "S") "s")))))) 4626 (org-agenda-prepare "SEARCH") 4627 (org-compile-prefix-format 'search) 4628 (org-set-sorting-strategy 'search) 4629 (setq org-agenda-redo-command 4630 (list 'org-search-view (if todo-only t nil) 4631 (list 'if 'current-prefix-arg nil string))) 4632 (setq org-agenda-query-string string) 4633 (if (equal (string-to-char string) ?*) 4634 (setq hdl-only t 4635 words (substring string 1)) 4636 (setq words string)) 4637 (when (equal (string-to-char words) ?!) 4638 (setq todo-only t 4639 words (substring words 1))) 4640 (when (equal (string-to-char words) ?:) 4641 (setq full-words t 4642 words (substring words 1))) 4643 (when (or org-agenda-search-view-always-boolean 4644 (member (string-to-char words) '(?- ?+ ?\{))) 4645 (setq boolean t)) 4646 (setq words (split-string words)) 4647 (let (www w) 4648 (while (setq w (pop words)) 4649 (while (and (string-match "\\\\\\'" w) words) 4650 (setq w (concat (substring w 0 -1) " " (pop words)))) 4651 (push w www)) 4652 (setq words (nreverse www) www nil) 4653 (while (setq w (pop words)) 4654 (when (and (string-match "\\`[-+]?{" w) 4655 (not (string-match "}\\'" w))) 4656 (while (and words (not (string-match "}\\'" (car words)))) 4657 (setq w (concat w " " (pop words)))) 4658 (setq w (concat w " " (pop words)))) 4659 (push w www)) 4660 (setq words (nreverse www))) 4661 (setq org-agenda-last-search-view-search-was-boolean boolean) 4662 (when boolean 4663 (let (wds w) 4664 (while (setq w (pop words)) 4665 (when (or (equal (substring w 0 1) "\"") 4666 (and (> (length w) 1) 4667 (member (substring w 0 1) '("+" "-")) 4668 (equal (substring w 1 2) "\""))) 4669 (while (and words (not (equal (substring w -1) "\""))) 4670 (setq w (concat w " " (pop words))))) 4671 (and (string-match "\\`\\([-+]?\\)\"" w) 4672 (setq w (replace-match "\\1" nil nil w))) 4673 (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) 4674 (push w wds)) 4675 (setq words (nreverse wds)))) 4676 (if boolean 4677 (mapc (lambda (w) 4678 (setq c (string-to-char w)) 4679 (if (equal c ?-) 4680 (setq neg t w (substring w 1)) 4681 (if (equal c ?+) 4682 (setq neg nil w (substring w 1)) 4683 (setq neg nil))) 4684 (if (string-match "\\`{.*}\\'" w) 4685 (setq re (substring w 1 -1)) 4686 (if full-words 4687 (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) 4688 (setq re (regexp-quote (downcase w))))) 4689 (if neg (push re regexps-) (push re regexps+))) 4690 words) 4691 (push (mapconcat #'regexp-quote words "\\s-+") 4692 regexps+)) 4693 (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) 4694 (if (not regexps+) 4695 (setq regexp org-outline-regexp-bol) 4696 (setq regexp (pop regexps+)) 4697 (when hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" 4698 regexp)))) 4699 (setq files (org-agenda-files nil 'ifmode)) 4700 ;; Add `org-agenda-text-search-extra-files' unless there is some 4701 ;; restriction. 4702 (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) 4703 (pop org-agenda-text-search-extra-files) 4704 (unless (get 'org-agenda-files 'org-restrict) 4705 (setq files (org-add-archive-files files)))) 4706 ;; Uniquify files. However, let `org-check-agenda-file' handle 4707 ;; non-existent ones. 4708 (setq files (cl-remove-duplicates 4709 (append files org-agenda-text-search-extra-files) 4710 :test (lambda (a b) 4711 (and (file-exists-p a) 4712 (file-exists-p b) 4713 (file-equal-p a b)))) 4714 rtnall nil) 4715 (while (setq file (pop files)) 4716 (setq ee nil) 4717 (catch 'nextfile 4718 (org-check-agenda-file file) 4719 (setq buffer (if (file-exists-p file) 4720 (org-get-agenda-file-buffer file) 4721 (error "No such file %s" file))) 4722 (unless buffer 4723 ;; If file does not exist, make sure an error message is sent 4724 (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" 4725 file)))) 4726 (with-current-buffer buffer 4727 (with-syntax-table (org-search-syntax-table) 4728 (unless (derived-mode-p 'org-mode) 4729 (error "Agenda file %s is not in Org mode" file)) 4730 (let ((case-fold-search t)) 4731 (save-excursion 4732 (save-restriction 4733 (if (eq buffer org-agenda-restrict) 4734 (narrow-to-region org-agenda-restrict-begin 4735 org-agenda-restrict-end) 4736 (widen)) 4737 (goto-char (point-min)) 4738 (unless (or (org-at-heading-p) 4739 (outline-next-heading)) 4740 (throw 'nextfile t)) 4741 (goto-char (max (point-min) (1- (point)))) 4742 (while (re-search-forward regexp nil t) 4743 (org-back-to-heading t) 4744 (while (and (not (zerop org-agenda-search-view-max-outline-level)) 4745 (> (org-reduced-level (org-outline-level)) 4746 org-agenda-search-view-max-outline-level) 4747 (forward-line -1) 4748 (org-back-to-heading t))) 4749 (skip-chars-forward "* ") 4750 (setq beg (point-at-bol) 4751 beg1 (point) 4752 end (progn 4753 (outline-next-heading) 4754 (while (and (not (zerop org-agenda-search-view-max-outline-level)) 4755 (> (org-reduced-level (org-outline-level)) 4756 org-agenda-search-view-max-outline-level) 4757 (forward-line 1) 4758 (outline-next-heading))) 4759 (point))) 4760 4761 (catch :skip 4762 (goto-char beg) 4763 (org-agenda-skip) 4764 (setq str (buffer-substring-no-properties 4765 (point-at-bol) 4766 (if hdl-only (point-at-eol) end))) 4767 (mapc (lambda (wr) (when (string-match wr str) 4768 (goto-char (1- end)) 4769 (throw :skip t))) 4770 regexps-) 4771 (mapc (lambda (wr) (unless (string-match wr str) 4772 (goto-char (1- end)) 4773 (throw :skip t))) 4774 (if todo-only 4775 (cons (concat "^\\*+[ \t]+" 4776 org-not-done-regexp) 4777 regexps+) 4778 regexps+)) 4779 (goto-char beg) 4780 (setq marker (org-agenda-new-marker (point)) 4781 category (org-get-category) 4782 level (make-string (org-reduced-level (org-outline-level)) ? ) 4783 inherited-tags 4784 (or (eq org-agenda-show-inherited-tags 'always) 4785 (and (listp org-agenda-show-inherited-tags) 4786 (memq 'todo org-agenda-show-inherited-tags)) 4787 (and (eq org-agenda-show-inherited-tags t) 4788 (or (eq org-agenda-use-tag-inheritance t) 4789 (memq 'todo org-agenda-use-tag-inheritance)))) 4790 tags (org-get-tags nil (not inherited-tags)) 4791 txt (org-agenda-format-item 4792 "" 4793 (buffer-substring-no-properties 4794 beg1 (point-at-eol)) 4795 level category tags t)) 4796 (org-add-props txt props 4797 'org-marker marker 'org-hd-marker marker 4798 'org-todo-regexp org-todo-regexp 4799 'level level 4800 'org-complex-heading-regexp org-complex-heading-regexp 4801 'priority 1000 4802 'type "search") 4803 (push txt ee) 4804 (goto-char (1- end)))))))))) 4805 (setq rtn (nreverse ee)) 4806 (setq rtnall (append rtnall rtn))) 4807 (org-agenda--insert-overriding-header 4808 (with-temp-buffer 4809 (insert "Search words: ") 4810 (add-text-properties (point-min) (1- (point)) 4811 (list 'face 'org-agenda-structure)) 4812 (setq pos (point)) 4813 (insert string "\n") 4814 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter)) 4815 (setq pos (point)) 4816 (unless org-agenda-multi 4817 (insert (substitute-command-keys "\\<org-agenda-mode-map>\ 4818 Press `\\[org-agenda-manipulate-query-add]', \ 4819 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \ 4820 `\\[org-agenda-manipulate-query-add-re]', \ 4821 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \ 4822 `\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n")) 4823 (add-text-properties pos (1- (point)) 4824 (list 'face 'org-agenda-structure-secondary))) 4825 (buffer-string))) 4826 (org-agenda-mark-header-line (point-min)) 4827 (when rtnall 4828 (insert (org-agenda-finalize-entries rtnall 'search) "\n")) 4829 (goto-char (point-min)) 4830 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 4831 (add-text-properties (point-min) (point-max) 4832 `(org-agenda-type search 4833 org-last-args (,todo-only ,string ,edit-at) 4834 org-redo-cmd ,org-agenda-redo-command 4835 org-series-cmd ,org-cmd)) 4836 (org-agenda-finalize) 4837 (setq buffer-read-only t)))) 4838 4839 ;;; Agenda TODO list 4840 4841 (defun org-agenda-propertize-selected-todo-keywords (keywords) 4842 "Use `org-todo-keyword-faces' for the selected todo KEYWORDS." 4843 (concat 4844 (if (or (equal keywords "ALL") (not keywords)) 4845 (propertize "ALL" 'face 'org-agenda-structure-filter) 4846 (mapconcat 4847 (lambda (kw) 4848 (propertize kw 'face (list (org-get-todo-face kw) 'org-agenda-structure))) 4849 (org-split-string keywords "|") 4850 "|")) 4851 "\n")) 4852 4853 (defvar org-select-this-todo-keyword nil) 4854 (defvar org-last-arg nil) 4855 4856 (defvar crm-separator) 4857 4858 ;;;###autoload 4859 (defun org-todo-list (&optional arg) 4860 "Show all (not done) TODO entries from all agenda file in a single list. 4861 The prefix arg can be used to select a specific TODO keyword and limit 4862 the list to these. When using `\\[universal-argument]', you will be prompted 4863 for a keyword. A numeric prefix directly selects the Nth keyword in 4864 `org-todo-keywords-1'." 4865 (interactive "P") 4866 (when org-agenda-overriding-arguments 4867 (setq arg org-agenda-overriding-arguments)) 4868 (when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) 4869 (let* ((today (org-today)) 4870 (date (calendar-gregorian-from-absolute today)) 4871 (completion-ignore-case t) 4872 kwds org-select-this-todo-keyword rtn rtnall files file pos) 4873 (catch 'exit 4874 (setq org-agenda-buffer-name 4875 (org-agenda--get-buffer-name 4876 (and org-agenda-sticky 4877 (if (stringp org-select-this-todo-keyword) 4878 (format "*Org Agenda(%s:%s)*" (or org-keys "t") 4879 org-select-this-todo-keyword) 4880 (format "*Org Agenda(%s)*" (or org-keys "t")))))) 4881 (org-agenda-prepare "TODO") 4882 (setq kwds org-todo-keywords-for-agenda 4883 org-select-this-todo-keyword (if (stringp arg) arg 4884 (and (integerp arg) 4885 (> arg 0) 4886 (nth (1- arg) kwds)))) 4887 (when (equal arg '(4)) 4888 (setq org-select-this-todo-keyword 4889 (mapconcat #'identity 4890 (let ((crm-separator "|")) 4891 (completing-read-multiple 4892 "Keyword (or KWD1|KWD2|...): " 4893 (mapcar #'list kwds) nil nil)) 4894 "|"))) 4895 (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) 4896 (org-compile-prefix-format 'todo) 4897 (org-set-sorting-strategy 'todo) 4898 (setq org-agenda-redo-command 4899 `(org-todo-list (or (and (numberp current-prefix-arg) 4900 current-prefix-arg) 4901 ,org-select-this-todo-keyword 4902 current-prefix-arg ,arg))) 4903 (setq files (org-agenda-files nil 'ifmode) 4904 rtnall nil) 4905 (while (setq file (pop files)) 4906 (catch 'nextfile 4907 (org-check-agenda-file file) 4908 (setq rtn (org-agenda-get-day-entries file date :todo)) 4909 (setq rtnall (append rtnall rtn)))) 4910 (org-agenda--insert-overriding-header 4911 (with-temp-buffer 4912 (insert "Global list of TODO items of type: ") 4913 (add-text-properties (point-min) (1- (point)) 4914 (list 'face 'org-agenda-structure 4915 'short-heading 4916 (concat "ToDo: " 4917 (or org-select-this-todo-keyword "ALL")))) 4918 (org-agenda-mark-header-line (point-min)) 4919 (insert (org-agenda-propertize-selected-todo-keywords 4920 org-select-this-todo-keyword)) 4921 (setq pos (point)) 4922 (unless org-agenda-multi 4923 (insert (substitute-command-keys "Press \ 4924 \\<org-agenda-mode-map>`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \ 4925 to search again: (0)[ALL]")) 4926 (let ((n 0)) 4927 (dolist (k kwds) 4928 (let ((s (format "(%d)%s" (cl-incf n) k))) 4929 (when (> (+ (current-column) (string-width s) 1) (window-width)) 4930 (insert "\n ")) 4931 (insert " " s)))) 4932 (insert "\n")) 4933 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary)) 4934 (buffer-string))) 4935 (org-agenda-mark-header-line (point-min)) 4936 (when rtnall 4937 (insert (org-agenda-finalize-entries rtnall 'todo) "\n")) 4938 (goto-char (point-min)) 4939 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 4940 (add-text-properties (point-min) (point-max) 4941 `(org-agenda-type todo 4942 org-last-args ,arg 4943 org-redo-cmd ,org-agenda-redo-command 4944 org-series-cmd ,org-cmd)) 4945 (org-agenda-finalize) 4946 (setq buffer-read-only t)))) 4947 4948 ;;; Agenda tags match 4949 4950 ;;;###autoload 4951 (defun org-tags-view (&optional todo-only match) 4952 "Show all headlines for all `org-agenda-files' matching a TAGS criterion. 4953 The prefix arg TODO-ONLY limits the search to TODO entries." 4954 (interactive "P") 4955 (when org-agenda-overriding-arguments 4956 (setq todo-only (car org-agenda-overriding-arguments) 4957 match (nth 1 org-agenda-overriding-arguments))) 4958 (let* ((org-tags-match-list-sublevels 4959 org-tags-match-list-sublevels) 4960 (completion-ignore-case t) 4961 (org--matcher-tags-todo-only todo-only) 4962 rtn rtnall files file pos matcher 4963 buffer) 4964 (when (and (stringp match) (not (string-match "\\S-" match))) 4965 (setq match nil)) 4966 (catch 'exit 4967 (setq org-agenda-buffer-name 4968 (org-agenda--get-buffer-name 4969 (and org-agenda-sticky 4970 (if (stringp match) 4971 (format "*Org Agenda(%s:%s)*" 4972 (or org-keys (or (and todo-only "M") "m")) 4973 match) 4974 (format "*Org Agenda(%s)*" 4975 (or (and todo-only "M") "m")))))) 4976 (setq matcher (org-make-tags-matcher match)) 4977 ;; Prepare agendas (and `org-tag-alist-for-agenda') before 4978 ;; expanding tags within `org-make-tags-matcher' 4979 (org-agenda-prepare (concat "TAGS " match)) 4980 (setq match (car matcher) 4981 matcher (cdr matcher)) 4982 (org-compile-prefix-format 'tags) 4983 (org-set-sorting-strategy 'tags) 4984 (setq org-agenda-query-string match) 4985 (setq org-agenda-redo-command 4986 (list 'org-tags-view 4987 `(quote ,org--matcher-tags-todo-only) 4988 `(if current-prefix-arg nil ,org-agenda-query-string))) 4989 (setq files (org-agenda-files nil 'ifmode) 4990 rtnall nil) 4991 (while (setq file (pop files)) 4992 (catch 'nextfile 4993 (org-check-agenda-file file) 4994 (setq buffer (if (file-exists-p file) 4995 (org-get-agenda-file-buffer file) 4996 (error "No such file %s" file))) 4997 (if (not buffer) 4998 ;; If file does not exist, error message to agenda 4999 (setq rtn (list 5000 (format "ORG-AGENDA-ERROR: No such org-file %s" file)) 5001 rtnall (append rtnall rtn)) 5002 (with-current-buffer buffer 5003 (unless (derived-mode-p 'org-mode) 5004 (error "Agenda file %s is not in Org mode" file)) 5005 (save-excursion 5006 (save-restriction 5007 (if (eq buffer org-agenda-restrict) 5008 (narrow-to-region org-agenda-restrict-begin 5009 org-agenda-restrict-end) 5010 (widen)) 5011 (setq rtn (org-scan-tags 'agenda 5012 matcher 5013 org--matcher-tags-todo-only)) 5014 (setq rtnall (append rtnall rtn)))))))) 5015 (org-agenda--insert-overriding-header 5016 (with-temp-buffer 5017 (insert "Headlines with TAGS match: ") 5018 (add-text-properties (point-min) (1- (point)) 5019 (list 'face 'org-agenda-structure 5020 'short-heading 5021 (concat "Match: " match))) 5022 (setq pos (point)) 5023 (insert match "\n") 5024 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter)) 5025 (setq pos (point)) 5026 (unless org-agenda-multi 5027 (insert (substitute-command-keys 5028 "Press \ 5029 \\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \ 5030 to search again\n"))) 5031 (add-text-properties pos (1- (point)) 5032 (list 'face 'org-agenda-structure-secondary)) 5033 (buffer-string))) 5034 (org-agenda-mark-header-line (point-min)) 5035 (when rtnall 5036 (insert (org-agenda-finalize-entries rtnall 'tags) "\n")) 5037 (goto-char (point-min)) 5038 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 5039 (add-text-properties 5040 (point-min) (point-max) 5041 `(org-agenda-type tags 5042 org-last-args (,org--matcher-tags-todo-only ,match) 5043 org-redo-cmd ,org-agenda-redo-command 5044 org-series-cmd ,org-cmd)) 5045 (org-agenda-finalize) 5046 (setq buffer-read-only t)))) 5047 5048 ;;; Agenda Finding stuck projects 5049 5050 (defvar org-agenda-skip-regexp nil 5051 "Regular expression used in skipping subtrees for the agenda. 5052 This is basically a temporary global variable that can be set and then 5053 used by user-defined selections using `org-agenda-skip-function'.") 5054 5055 (defvar org-agenda-overriding-header nil 5056 "When set during agenda, todo and tags searches it replaces the header. 5057 If an empty string, no header will be inserted. If any other 5058 string, it will be inserted as a header. If a function, insert 5059 the string returned by the function as a header. If nil, a 5060 header will be generated automatically according to the command. 5061 This variable should not be set directly, but custom commands can 5062 bind it in the options section.") 5063 5064 (defun org-agenda-skip-entry-if (&rest conditions) 5065 "Skip entry if any of CONDITIONS is true. 5066 See `org-agenda-skip-if' for details." 5067 (org-agenda-skip-if nil conditions)) 5068 5069 (defun org-agenda-skip-subtree-if (&rest conditions) 5070 "Skip subtree if any of CONDITIONS is true. 5071 See `org-agenda-skip-if' for details." 5072 (org-agenda-skip-if t conditions)) 5073 5074 (defun org-agenda-skip-if (subtree conditions) 5075 "Check current entity for CONDITIONS. 5076 If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only 5077 the entry (i.e. the text before the next heading) is checked. 5078 5079 CONDITIONS is a list of symbols, boolean OR is used to combine the results 5080 from different tests. Valid conditions are: 5081 5082 scheduled Check if there is a scheduled cookie 5083 notscheduled Check if there is no scheduled cookie 5084 deadline Check if there is a deadline 5085 notdeadline Check if there is no deadline 5086 timestamp Check if there is a timestamp (also deadline or scheduled) 5087 nottimestamp Check if there is no timestamp (also deadline or scheduled) 5088 regexp Check if regexp matches 5089 notregexp Check if regexp does not match. 5090 todo Check if TODO keyword matches 5091 nottodo Check if TODO keyword does not match 5092 5093 The regexp is taken from the conditions list, it must come right after 5094 the `regexp' or `notregexp' element. 5095 5096 `todo' and `nottodo' accept as an argument a list of todo 5097 keywords, which may include \"*\" to match any todo keyword. 5098 5099 (org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\")) 5100 5101 would skip all entries with \"TODO\" or \"WAITING\" keywords. 5102 5103 Instead of a list, a keyword class may be given. For example: 5104 5105 (org-agenda-skip-entry-if \\='nottodo \\='done) 5106 5107 would skip entries that haven't been marked with any of \"DONE\" 5108 keywords. Possible classes are: `todo', `done', `any'. 5109 5110 If any of these conditions is met, this function returns the end point of 5111 the entity, causing the search to continue from there. This is a function 5112 that can be put into `org-agenda-skip-function' for the duration of a command." 5113 (org-back-to-heading t) 5114 (let* (;; (beg (point)) 5115 (end (if subtree (save-excursion (org-end-of-subtree t) (point)) 5116 (org-entry-end-position))) 5117 (planning-end (if subtree end (line-end-position 2))) 5118 m) 5119 (and 5120 (or (and (memq 'scheduled conditions) 5121 (re-search-forward org-scheduled-time-regexp planning-end t)) 5122 (and (memq 'notscheduled conditions) 5123 (not 5124 (save-excursion 5125 (re-search-forward org-scheduled-time-regexp planning-end t)))) 5126 (and (memq 'deadline conditions) 5127 (re-search-forward org-deadline-time-regexp planning-end t)) 5128 (and (memq 'notdeadline conditions) 5129 (not 5130 (save-excursion 5131 (re-search-forward org-deadline-time-regexp planning-end t)))) 5132 (and (memq 'timestamp conditions) 5133 (re-search-forward org-ts-regexp end t)) 5134 (and (memq 'nottimestamp conditions) 5135 (not (save-excursion (re-search-forward org-ts-regexp end t)))) 5136 (and (setq m (memq 'regexp conditions)) 5137 (stringp (nth 1 m)) 5138 (re-search-forward (nth 1 m) end t)) 5139 (and (setq m (memq 'notregexp conditions)) 5140 (stringp (nth 1 m)) 5141 (not (save-excursion (re-search-forward (nth 1 m) end t)))) 5142 (and (or 5143 (setq m (memq 'nottodo conditions)) 5144 (setq m (memq 'todo-unblocked conditions)) 5145 (setq m (memq 'nottodo-unblocked conditions)) 5146 (setq m (memq 'todo conditions))) 5147 (org-agenda-skip-if-todo m end))) 5148 end))) 5149 5150 (defun org-agenda-skip-if-todo (args end) 5151 "Helper function for `org-agenda-skip-if', do not use it directly. 5152 ARGS is a list with first element either `todo', `nottodo', 5153 `todo-unblocked' or `nottodo-unblocked'. The remainder is either 5154 a list of TODO keywords, or a state symbol `todo' or `done' or 5155 `any'." 5156 (let ((todo-re 5157 (concat "^\\*+[ \t]+" 5158 (regexp-opt 5159 (pcase args 5160 (`(,_ todo) 5161 (org-delete-all org-done-keywords 5162 (copy-sequence org-todo-keywords-1))) 5163 (`(,_ done) org-done-keywords) 5164 (`(,_ any) org-todo-keywords-1) 5165 (`(,_ ,(pred atom)) 5166 (error "Invalid TODO class or type: %S" args)) 5167 (`(,_ ,(pred (member "*"))) org-todo-keywords-1) 5168 (`(,_ ,todo-list) todo-list)) 5169 'words)))) 5170 (pcase args 5171 (`(todo . ,_) 5172 (let (case-fold-search) (re-search-forward todo-re end t))) 5173 (`(nottodo . ,_) 5174 (not (let (case-fold-search) (re-search-forward todo-re end t)))) 5175 (`(todo-unblocked . ,_) 5176 (catch :unblocked 5177 (while (let (case-fold-search) (re-search-forward todo-re end t)) 5178 (when (org-entry-blocked-p) (throw :unblocked t))) 5179 nil)) 5180 (`(nottodo-unblocked . ,_) 5181 (catch :unblocked 5182 (while (let (case-fold-search) (re-search-forward todo-re end t)) 5183 (when (org-entry-blocked-p) (throw :unblocked nil))) 5184 t)) 5185 (`(,type . ,_) (error "Unknown TODO skip type: %S" type))))) 5186 5187 ;;;###autoload 5188 (defun org-agenda-list-stuck-projects (&rest _ignore) 5189 "Create agenda view for projects that are stuck. 5190 Stuck projects are project that have no next actions. For the definitions 5191 of what a project is and how to check if it stuck, customize the variable 5192 `org-stuck-projects'." 5193 (interactive) 5194 (let* ((org-agenda-overriding-header 5195 (or org-agenda-overriding-header "List of stuck projects: ")) 5196 (matcher (nth 0 org-stuck-projects)) 5197 (todo (nth 1 org-stuck-projects)) 5198 (tags (nth 2 org-stuck-projects)) 5199 (gen-re (org-string-nw-p (nth 3 org-stuck-projects))) 5200 (todo-wds 5201 (if (not (member "*" todo)) todo 5202 (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) 5203 (org-delete-all org-done-keywords-for-agenda 5204 (copy-sequence org-todo-keywords-for-agenda)))) 5205 (todo-re (and todo 5206 (format "^\\*+[ \t]+\\(%s\\)\\>" 5207 (mapconcat #'identity todo-wds "\\|")))) 5208 (tags-re (cond ((null tags) nil) 5209 ((member "*" tags) org-tag-line-re) 5210 (tags 5211 (let ((other-tags (format "\\(?:%s:\\)*" org-tag-re))) 5212 (concat org-outline-regexp-bol 5213 ".*?[ \t]:" 5214 other-tags 5215 (regexp-opt tags t) 5216 ":" other-tags "[ \t]*$"))) 5217 (t nil))) 5218 (re-list (delq nil (list todo-re tags-re gen-re))) 5219 (skip-re 5220 (if (null re-list) 5221 (error "Missing information to identify unstuck projects") 5222 (mapconcat #'identity re-list "\\|"))) 5223 (org-agenda-skip-function 5224 ;; Skip entry if `org-agenda-skip-regexp' matches anywhere 5225 ;; in the subtree. 5226 (lambda () 5227 (and (save-excursion 5228 (let ((case-fold-search nil)) 5229 (re-search-forward 5230 skip-re (save-excursion (org-end-of-subtree t)) t))) 5231 (progn (outline-next-heading) (point)))))) 5232 (org-tags-view nil matcher) 5233 (setq org-agenda-buffer-name (buffer-name)) 5234 (with-current-buffer org-agenda-buffer-name 5235 (setq org-agenda-redo-command 5236 `(org-agenda-list-stuck-projects ,current-prefix-arg)) 5237 (let ((inhibit-read-only t)) 5238 (add-text-properties 5239 (point-min) (point-max) 5240 `(org-redo-cmd ,org-agenda-redo-command)))))) 5241 5242 ;;; Diary integration 5243 5244 (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. 5245 (defvar diary-list-entries-hook) 5246 (defvar diary-time-regexp) 5247 (defvar diary-modify-entry-list-string-function) 5248 (defvar diary-file-name-prefix) 5249 (defvar diary-display-function) 5250 5251 (defun org-get-entries-from-diary (date) 5252 "Get the (Emacs Calendar) diary entries for DATE." 5253 (require 'diary-lib) 5254 (declare-function diary-fancy-display "diary-lib" ()) 5255 (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") 5256 (diary-display-function #'diary-fancy-display) 5257 (pop-up-frames nil) 5258 (diary-list-entries-hook 5259 (cons 'org-diary-default-entry diary-list-entries-hook)) 5260 (diary-file-name-prefix nil) ; turn this feature off 5261 (diary-modify-entry-list-string-function 5262 #'org-modify-diary-entry-string) 5263 (diary-time-regexp (concat "^" diary-time-regexp)) 5264 entries 5265 (org-disable-agenda-to-diary t)) 5266 (save-excursion 5267 (save-window-excursion 5268 (diary-list-entries date 1))) 5269 (if (not (get-buffer diary-fancy-buffer)) 5270 (setq entries nil) 5271 (with-current-buffer diary-fancy-buffer 5272 (setq buffer-read-only nil) 5273 (if (zerop (buffer-size)) 5274 ;; No entries 5275 (setq entries nil) 5276 ;; Omit the date and other unnecessary stuff 5277 (org-agenda-cleanup-fancy-diary) 5278 ;; Add prefix to each line and extend the text properties 5279 (if (zerop (buffer-size)) 5280 (setq entries nil) 5281 (setq entries (buffer-substring (point-min) (- (point-max) 1))) 5282 (setq entries 5283 (with-temp-buffer 5284 (insert entries) (goto-char (point-min)) 5285 (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t) 5286 (unless (save-match-data (string-match diary-time-regexp (match-string 1))) 5287 (replace-match (concat "; " (match-string 1))))) 5288 (buffer-string))))) 5289 (set-buffer-modified-p nil) 5290 (kill-buffer diary-fancy-buffer))) 5291 (when entries 5292 (setq entries (org-split-string entries "\n")) 5293 (setq entries 5294 (mapcar 5295 (lambda (x) 5296 (setq x (org-agenda-format-item "" x nil "Diary" nil 'time)) 5297 ;; Extend the text properties to the beginning of the line 5298 (org-add-props x (text-properties-at (1- (length x)) x) 5299 'type "diary" 'date date 'face 'org-agenda-diary)) 5300 entries))))) 5301 5302 (defvar org-agenda-cleanup-fancy-diary-hook nil 5303 "Hook run when the fancy diary buffer is cleaned up.") 5304 5305 (defun org-agenda-cleanup-fancy-diary () 5306 "Remove unwanted stuff in buffer created by `fancy-diary-display'. 5307 This gets rid of the date, the underline under the date, and the 5308 dummy entry installed by Org mode to ensure non-empty diary for 5309 each date. It also removes lines that contain only whitespace." 5310 (goto-char (point-min)) 5311 (if (looking-at ".*?:[ \t]*") 5312 (progn 5313 (replace-match "") 5314 (re-search-forward "\n=+$" nil t) 5315 (replace-match "") 5316 (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) 5317 (re-search-forward "\n=+$" nil t) 5318 (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) 5319 (goto-char (point-min)) 5320 (while (re-search-forward "^ +\n" nil t) 5321 (replace-match "")) 5322 (goto-char (point-min)) 5323 (when (re-search-forward "^Org mode dummy\n?" nil t) 5324 (replace-match "")) 5325 (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) 5326 5327 (defun org-modify-diary-entry-string (string) 5328 "Add text properties to string, allowing Org to act on it." 5329 (org-add-props string nil 5330 'mouse-face 'highlight 5331 'help-echo (if buffer-file-name 5332 (format "mouse-2 or RET jump to diary file %s" 5333 (abbreviate-file-name buffer-file-name)) 5334 "") 5335 'org-agenda-diary-link t 5336 'org-marker (org-agenda-new-marker (point-at-bol)))) 5337 5338 (defun org-diary-default-entry () 5339 "Add a dummy entry to the diary. 5340 Needed to avoid empty dates which mess up holiday display." 5341 ;; Catch the error if dealing with the new add-to-diary-alist 5342 (when org-disable-agenda-to-diary 5343 (diary-add-to-list original-date "Org mode dummy" ""))) 5344 5345 (defvar org-diary-last-run-time nil) 5346 5347 ;;;###autoload 5348 (defun org-diary (&rest args) 5349 "Return diary information from org files. 5350 This function can be used in a \"sexp\" diary entry in the Emacs calendar. 5351 It accesses org files and extracts information from those files to be 5352 listed in the diary. The function accepts arguments specifying what 5353 items should be listed. For a list of arguments allowed here, see the 5354 variable `org-agenda-entry-types'. 5355 5356 The call in the diary file should look like this: 5357 5358 &%%(org-diary) ~/path/to/some/orgfile.org 5359 5360 Use a separate line for each org file to check. Or, if you omit the file name, 5361 all files listed in `org-agenda-files' will be checked automatically: 5362 5363 &%%(org-diary) 5364 5365 If you don't give any arguments (as in the example above), the default value 5366 of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). 5367 So the example above may also be written as 5368 5369 &%%(org-diary :deadline :timestamp :sexp :scheduled) 5370 5371 The function expects the lisp variables `entry' and `date' to be provided 5372 by the caller, because this is how the calendar works. Don't use this 5373 function from a program - use `org-agenda-get-day-entries' instead." 5374 (with-no-warnings (defvar date) (defvar entry)) 5375 (when (> (- (float-time) 5376 org-agenda-last-marker-time) 5377 5) 5378 ;; I am not sure if this works with sticky agendas, because the marker 5379 ;; list is then no longer a global variable. 5380 (org-agenda-reset-markers)) 5381 (org-compile-prefix-format 'agenda) 5382 (org-set-sorting-strategy 'agenda) 5383 (setq args (or args org-agenda-entry-types)) 5384 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) 5385 (list entry) 5386 (org-agenda-files t))) 5387 (time (float-time)) 5388 file rtn results) 5389 (when (or (not org-diary-last-run-time) 5390 (> (- time 5391 org-diary-last-run-time) 5392 3)) 5393 (org-agenda-prepare-buffers files)) 5394 (setq org-diary-last-run-time time) 5395 ;; If this is called during org-agenda, don't return any entries to 5396 ;; the calendar. Org Agenda will list these entries itself. 5397 (when org-disable-agenda-to-diary (setq files nil)) 5398 (while (setq file (pop files)) 5399 (setq rtn (apply #'org-agenda-get-day-entries file date args)) 5400 (setq results (append results rtn))) 5401 (when results 5402 (setq results 5403 (mapcar (lambda (i) (replace-regexp-in-string 5404 org-link-bracket-re "\\2" i)) 5405 results)) 5406 (concat (org-agenda-finalize-entries results) "\n")))) 5407 5408 ;;; Agenda entry finders 5409 5410 (defun org-agenda--timestamp-to-absolute (&rest args) 5411 "Call `org-time-string-to-absolute' with ARGS. 5412 However, throw `:skip' whenever an error is raised." 5413 (condition-case e 5414 (apply #'org-time-string-to-absolute args) 5415 (org-diary-sexp-no-match (throw :skip nil)) 5416 (error 5417 (message "%s; Skipping entry" (error-message-string e)) 5418 (throw :skip nil)))) 5419 5420 (defun org-agenda-get-day-entries (file date &rest args) 5421 "Does the work for `org-diary' and `org-agenda'. 5422 FILE is the path to a file to be checked for entries. DATE is date like 5423 the one returned by `calendar-current-date'. ARGS are symbols indicating 5424 which kind of entries should be extracted. For details about these, see 5425 the documentation of `org-diary'." 5426 (let* ((org-startup-folded nil) 5427 (org-startup-align-all-tables nil) 5428 (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file) 5429 (error "No such file %s" file)))) 5430 (if (not buffer) 5431 ;; If file does not exist, signal it in diary nonetheless. 5432 (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) 5433 (with-current-buffer buffer 5434 (unless (derived-mode-p 'org-mode) 5435 (error "Agenda file %s is not in Org mode" file)) 5436 (setq org-agenda-buffer (or org-agenda-buffer buffer)) 5437 (setf org-agenda-current-date date) 5438 (save-excursion 5439 (save-restriction 5440 (if (eq buffer org-agenda-restrict) 5441 (narrow-to-region org-agenda-restrict-begin 5442 org-agenda-restrict-end) 5443 (widen)) 5444 ;; Rationalize ARGS. Also make sure `:deadline' comes 5445 ;; first in order to populate DEADLINES before passing it. 5446 ;; 5447 ;; We use `delq' since `org-uniquify' duplicates ARGS, 5448 ;; guarding us from modifying `org-agenda-entry-types'. 5449 (setf args (org-uniquify (or args org-agenda-entry-types))) 5450 (when (and (memq :scheduled args) (memq :scheduled* args)) 5451 (setf args (delq :scheduled* args))) 5452 (cond 5453 ((memq :deadline args) 5454 (setf args (cons :deadline 5455 (delq :deadline (delq :deadline* args))))) 5456 ((memq :deadline* args) 5457 (setf args (cons :deadline* (delq :deadline* args))))) 5458 ;; Collect list of headlines. Return them flattened. 5459 (let ((case-fold-search nil) results deadlines) 5460 (org-dlet 5461 ((date date)) 5462 (dolist (arg args (apply #'nconc (nreverse results))) 5463 (pcase arg 5464 ((and :todo (guard (org-agenda-today-p date))) 5465 (push (org-agenda-get-todos) results)) 5466 (:timestamp 5467 (push (org-agenda-get-blocks) results) 5468 (push (org-agenda-get-timestamps deadlines) results)) 5469 (:sexp 5470 (push (org-agenda-get-sexps) results)) 5471 (:scheduled 5472 (push (org-agenda-get-scheduled deadlines) results)) 5473 (:scheduled* 5474 (push (org-agenda-get-scheduled deadlines t) results)) 5475 (:closed 5476 (push (org-agenda-get-progress) results)) 5477 (:deadline 5478 (setf deadlines (org-agenda-get-deadlines)) 5479 (push deadlines results)) 5480 (:deadline* 5481 (setf deadlines (org-agenda-get-deadlines t)) 5482 (push deadlines results)))))))))))) 5483 5484 (defsubst org-em (x y list) 5485 "Is X or Y a member of LIST?" 5486 (or (memq x list) (memq y list))) 5487 5488 (defvar org-heading-keyword-regexp-format) ; defined in org.el 5489 (defvar org-agenda-sorting-strategy-selected nil) 5490 5491 (defun org-agenda-entry-get-agenda-timestamp (pom) 5492 "Retrieve timestamp information for sorting agenda views. 5493 Given a point or marker POM, returns a cons cell of the timestamp 5494 and the timestamp type relevant for the sorting strategy in 5495 `org-agenda-sorting-strategy-selected'." 5496 (let (ts ts-date-type) 5497 (save-match-data 5498 (cond ((org-em 'scheduled-up 'scheduled-down 5499 org-agenda-sorting-strategy-selected) 5500 (setq ts (org-entry-get pom "SCHEDULED") 5501 ts-date-type " scheduled")) 5502 ((org-em 'deadline-up 'deadline-down 5503 org-agenda-sorting-strategy-selected) 5504 (setq ts (org-entry-get pom "DEADLINE") 5505 ts-date-type " deadline")) 5506 ((org-em 'ts-up 'ts-down 5507 org-agenda-sorting-strategy-selected) 5508 (setq ts (org-entry-get pom "TIMESTAMP") 5509 ts-date-type " timestamp")) 5510 ((org-em 'tsia-up 'tsia-down 5511 org-agenda-sorting-strategy-selected) 5512 (setq ts (org-entry-get pom "TIMESTAMP_IA") 5513 ts-date-type " timestamp_ia")) 5514 ((org-em 'timestamp-up 'timestamp-down 5515 org-agenda-sorting-strategy-selected) 5516 (setq ts (or (org-entry-get pom "SCHEDULED") 5517 (org-entry-get pom "DEADLINE") 5518 (org-entry-get pom "TIMESTAMP") 5519 (org-entry-get pom "TIMESTAMP_IA")) 5520 ts-date-type "")) 5521 (t (setq ts-date-type ""))) 5522 (cons (when ts (ignore-errors (org-time-string-to-absolute ts))) 5523 ts-date-type)))) 5524 5525 (defun org-agenda-get-todos () 5526 "Return the TODO information for agenda display." 5527 (let* ((props (list 'face nil 5528 'done-face 'org-agenda-done 5529 'org-not-done-regexp org-not-done-regexp 5530 'org-todo-regexp org-todo-regexp 5531 'org-complex-heading-regexp org-complex-heading-regexp 5532 'mouse-face 'highlight 5533 'help-echo 5534 (format "mouse-2 or RET jump to org file %s" 5535 (abbreviate-file-name buffer-file-name)))) 5536 (case-fold-search nil) 5537 (regexp (format org-heading-keyword-regexp-format 5538 (cond 5539 ((and org-select-this-todo-keyword 5540 (equal org-select-this-todo-keyword "*")) 5541 org-todo-regexp) 5542 (org-select-this-todo-keyword 5543 (concat "\\(" 5544 (mapconcat #'identity 5545 (org-split-string 5546 org-select-this-todo-keyword 5547 "|") 5548 "\\|") 5549 "\\)")) 5550 (t org-not-done-regexp)))) 5551 marker priority category level tags todo-state 5552 ts-date ts-date-type ts-date-pair 5553 ee txt beg end inherited-tags todo-state-end-pos) 5554 (goto-char (point-min)) 5555 (while (re-search-forward regexp nil t) 5556 (catch :skip 5557 (save-match-data 5558 (beginning-of-line) 5559 (org-agenda-skip) 5560 (setq beg (point) end (save-excursion (outline-next-heading) (point))) 5561 (unless (and (setq todo-state (org-get-todo-state)) 5562 (setq todo-state-end-pos (match-end 2))) 5563 (goto-char end) 5564 (throw :skip nil)) 5565 (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end) 5566 (goto-char (1+ beg)) 5567 (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) 5568 (throw :skip nil))) 5569 (goto-char (match-beginning 2)) 5570 (setq marker (org-agenda-new-marker (match-beginning 0)) 5571 category (org-get-category) 5572 ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) 5573 ts-date (car ts-date-pair) 5574 ts-date-type (cdr ts-date-pair) 5575 txt (org-trim (buffer-substring (match-beginning 2) (match-end 0))) 5576 inherited-tags 5577 (or (eq org-agenda-show-inherited-tags 'always) 5578 (and (listp org-agenda-show-inherited-tags) 5579 (memq 'todo org-agenda-show-inherited-tags)) 5580 (and (eq org-agenda-show-inherited-tags t) 5581 (or (eq org-agenda-use-tag-inheritance t) 5582 (memq 'todo org-agenda-use-tag-inheritance)))) 5583 tags (org-get-tags nil (not inherited-tags)) 5584 level (make-string (org-reduced-level (org-outline-level)) ? ) 5585 txt (org-agenda-format-item "" txt level category tags t) 5586 priority (1+ (org-get-priority txt))) 5587 (org-add-props txt props 5588 'org-marker marker 'org-hd-marker marker 5589 'priority priority 5590 'level level 5591 'ts-date ts-date 5592 'type (concat "todo" ts-date-type) 'todo-state todo-state) 5593 (push txt ee) 5594 (if org-agenda-todo-list-sublevels 5595 (goto-char todo-state-end-pos) 5596 (org-end-of-subtree 'invisible)))) 5597 (nreverse ee))) 5598 5599 (defun org-agenda-todo-custom-ignore-p (time n) 5600 "Check whether timestamp is farther away than n number of days. 5601 This function is invoked if `org-agenda-todo-ignore-deadlines', 5602 `org-agenda-todo-ignore-scheduled' or 5603 `org-agenda-todo-ignore-timestamp' is set to an integer." 5604 (let ((days (org-time-stamp-to-now 5605 time org-agenda-todo-ignore-time-comparison-use-seconds))) 5606 (if (>= n 0) 5607 (>= days n) 5608 (<= days n)))) 5609 5610 ;;;###autoload 5611 (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item 5612 (&optional end) 5613 "Do we have a reason to ignore this TODO entry because it has a time stamp?" 5614 (when (or org-agenda-todo-ignore-with-date 5615 org-agenda-todo-ignore-scheduled 5616 org-agenda-todo-ignore-deadlines 5617 org-agenda-todo-ignore-timestamp) 5618 (setq end (or end (save-excursion (outline-next-heading) (point)))) 5619 (save-excursion 5620 (or (and org-agenda-todo-ignore-with-date 5621 (re-search-forward org-ts-regexp end t)) 5622 (and org-agenda-todo-ignore-scheduled 5623 (re-search-forward org-scheduled-time-regexp end t) 5624 (cond 5625 ((eq org-agenda-todo-ignore-scheduled 'future) 5626 (> (org-time-stamp-to-now 5627 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5628 0)) 5629 ((eq org-agenda-todo-ignore-scheduled 'past) 5630 (<= (org-time-stamp-to-now 5631 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5632 0)) 5633 ((numberp org-agenda-todo-ignore-scheduled) 5634 (org-agenda-todo-custom-ignore-p 5635 (match-string 1) org-agenda-todo-ignore-scheduled)) 5636 (t))) 5637 (and org-agenda-todo-ignore-deadlines 5638 (re-search-forward org-deadline-time-regexp end t) 5639 (cond 5640 ((eq org-agenda-todo-ignore-deadlines 'all) t) 5641 ((eq org-agenda-todo-ignore-deadlines 'far) 5642 (not (org-deadline-close-p (match-string 1)))) 5643 ((eq org-agenda-todo-ignore-deadlines 'future) 5644 (> (org-time-stamp-to-now 5645 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5646 0)) 5647 ((eq org-agenda-todo-ignore-deadlines 'past) 5648 (<= (org-time-stamp-to-now 5649 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5650 0)) 5651 ((numberp org-agenda-todo-ignore-deadlines) 5652 (org-agenda-todo-custom-ignore-p 5653 (match-string 1) org-agenda-todo-ignore-deadlines)) 5654 (t (org-deadline-close-p (match-string 1))))) 5655 (and org-agenda-todo-ignore-timestamp 5656 (let ((buffer (current-buffer)) 5657 (regexp 5658 (concat 5659 org-scheduled-time-regexp "\\|" org-deadline-time-regexp)) 5660 (start (point))) 5661 ;; Copy current buffer into a temporary one 5662 (with-temp-buffer 5663 (insert-buffer-substring buffer start end) 5664 (goto-char (point-min)) 5665 ;; Delete SCHEDULED and DEADLINE items 5666 (while (re-search-forward regexp end t) 5667 (delete-region (match-beginning 0) (match-end 0))) 5668 (goto-char (point-min)) 5669 ;; No search for timestamp left 5670 (when (re-search-forward org-ts-regexp nil t) 5671 (cond 5672 ((eq org-agenda-todo-ignore-timestamp 'future) 5673 (> (org-time-stamp-to-now 5674 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5675 0)) 5676 ((eq org-agenda-todo-ignore-timestamp 'past) 5677 (<= (org-time-stamp-to-now 5678 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5679 0)) 5680 ((numberp org-agenda-todo-ignore-timestamp) 5681 (org-agenda-todo-custom-ignore-p 5682 (match-string 1) org-agenda-todo-ignore-timestamp)) 5683 (t)))))))))) 5684 5685 (defun org-agenda-get-timestamps (&optional deadlines) 5686 "Return the date stamp information for agenda display. 5687 Optional argument DEADLINES is a list of deadline items to be 5688 displayed in agenda view." 5689 (with-no-warnings (defvar date)) 5690 (let* ((props (list 'face 'org-agenda-calendar-event 5691 'org-not-done-regexp org-not-done-regexp 5692 'org-todo-regexp org-todo-regexp 5693 'org-complex-heading-regexp org-complex-heading-regexp 5694 'mouse-face 'highlight 5695 'help-echo 5696 (format "mouse-2 or RET jump to Org file %s" 5697 (abbreviate-file-name buffer-file-name)))) 5698 (current (calendar-absolute-from-gregorian date)) 5699 (today (org-today)) 5700 (deadline-position-alist 5701 (mapcar (lambda (d) 5702 (let ((m (get-text-property 0 'org-hd-marker d))) 5703 (and m (marker-position m)))) 5704 deadlines)) 5705 ;; Match time-stamps set to current date, time-stamps with 5706 ;; a repeater, and S-exp time-stamps. 5707 (regexp 5708 (concat 5709 (if org-agenda-include-inactive-timestamps "[[<]" "<") 5710 (regexp-quote 5711 (substring 5712 (format-time-string 5713 (car org-time-stamp-formats) 5714 (encode-time ; DATE bound by calendar 5715 0 0 0 (nth 1 date) (car date) (nth 2 date))) 5716 1 11)) 5717 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" 5718 "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) 5719 timestamp-items) 5720 (goto-char (point-min)) 5721 (while (re-search-forward regexp nil t) 5722 ;; Skip date ranges, scheduled and deadlines, which are handled 5723 ;; specially. Also skip time-stamps before first headline as 5724 ;; there would be no entry to add to the agenda. Eventually, 5725 ;; ignore clock entries. 5726 (catch :skip 5727 (save-match-data 5728 (when (or (org-at-date-range-p) 5729 (org-at-planning-p) 5730 (org-before-first-heading-p) 5731 (and org-agenda-include-inactive-timestamps 5732 (org-at-clock-log-p))) 5733 (throw :skip nil)) 5734 (org-agenda-skip)) 5735 (let* ((pos (match-beginning 0)) 5736 (repeat (match-string 1)) 5737 (sexp-entry (match-string 3)) 5738 (time-stamp (if (or repeat sexp-entry) (match-string 0) 5739 (save-excursion 5740 (goto-char pos) 5741 (looking-at org-ts-regexp-both) 5742 (match-string 0)))) 5743 (todo-state (org-get-todo-state)) 5744 (warntime (get-text-property (point) 'org-appt-warntime)) 5745 (done? (member todo-state org-done-keywords))) 5746 ;; Possibly skip done tasks. 5747 (when (and done? org-agenda-skip-timestamp-if-done) 5748 (throw :skip t)) 5749 ;; S-exp entry doesn't match current day: skip it. 5750 (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date))) 5751 (throw :skip nil)) 5752 (when repeat 5753 (let* ((past 5754 ;; A repeating time stamp is shown at its base 5755 ;; date and every repeated date up to TODAY. If 5756 ;; `org-agenda-prefer-last-repeat' is non-nil, 5757 ;; however, only the last repeat before today 5758 ;; (inclusive) is shown. 5759 (org-agenda--timestamp-to-absolute 5760 repeat 5761 (if (or (> current today) 5762 (eq org-agenda-prefer-last-repeat t) 5763 (member todo-state org-agenda-prefer-last-repeat)) 5764 today 5765 current) 5766 'past (current-buffer) pos)) 5767 (future 5768 ;; Display every repeated date past TODAY 5769 ;; (exclusive) unless 5770 ;; `org-agenda-show-future-repeats' is nil. If 5771 ;; this variable is set to `next', only display 5772 ;; the first repeated date after TODAY 5773 ;; (exclusive). 5774 (cond 5775 ((<= current today) past) 5776 ((not org-agenda-show-future-repeats) past) 5777 (t 5778 (let ((base (if (eq org-agenda-show-future-repeats 'next) 5779 (1+ today) 5780 current))) 5781 (org-agenda--timestamp-to-absolute 5782 repeat base 'future (current-buffer) pos)))))) 5783 (when (and (/= current past) (/= current future)) 5784 (throw :skip nil)))) 5785 (save-excursion 5786 (re-search-backward org-outline-regexp-bol nil t) 5787 ;; Possibly skip time-stamp when a deadline is set. 5788 (when (and org-agenda-skip-timestamp-if-deadline-is-shown 5789 (assq (point) deadline-position-alist)) 5790 (throw :skip nil)) 5791 (let* ((category (org-get-category pos)) 5792 (inherited-tags 5793 (or (eq org-agenda-show-inherited-tags 'always) 5794 (and (consp org-agenda-show-inherited-tags) 5795 (memq 'agenda org-agenda-show-inherited-tags)) 5796 (and (eq org-agenda-show-inherited-tags t) 5797 (or (eq org-agenda-use-tag-inheritance t) 5798 (memq 'agenda 5799 org-agenda-use-tag-inheritance))))) 5800 (tags (org-get-tags nil (not inherited-tags))) 5801 (level (make-string (org-reduced-level (org-outline-level)) 5802 ?\s)) 5803 (head (and (looking-at "\\*+[ \t]+\\(.*\\)") 5804 (match-string 1))) 5805 (inactive? (= (char-after pos) ?\[)) 5806 (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p))) 5807 (item 5808 (org-agenda-format-item 5809 (and inactive? org-agenda-inactive-leader) 5810 head level category tags time-stamp org-ts-regexp habit?))) 5811 (org-add-props item props 5812 'priority (if habit? 5813 (org-habit-get-priority (org-habit-parse-todo)) 5814 (org-get-priority item)) 5815 'org-marker (org-agenda-new-marker pos) 5816 'org-hd-marker (org-agenda-new-marker) 5817 'date date 5818 'level level 5819 'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat) 5820 current) 5821 'todo-state todo-state 5822 'warntime warntime 5823 'type "timestamp") 5824 (push item timestamp-items)))) 5825 (when org-agenda-skip-additional-timestamps-same-entry 5826 (outline-next-heading)))) 5827 (nreverse timestamp-items))) 5828 5829 (defun org-agenda-get-sexps () 5830 "Return the sexp information for agenda display." 5831 (require 'diary-lib) 5832 (with-no-warnings (defvar date) (defvar entry)) 5833 (let* ((props (list 'face 'org-agenda-calendar-sexp 5834 'mouse-face 'highlight 5835 'help-echo 5836 (format "mouse-2 or RET jump to org file %s" 5837 (abbreviate-file-name buffer-file-name)))) 5838 (regexp "^&?%%(") 5839 ;; FIXME: Is this `entry' binding intended to be dynamic, 5840 ;; so as to "hide" any current binding for it? 5841 marker category extra level ee txt tags entry 5842 result beg b sexp sexp-entry todo-state warntime inherited-tags) 5843 (goto-char (point-min)) 5844 (while (re-search-forward regexp nil t) 5845 (catch :skip 5846 (org-agenda-skip) 5847 (setq beg (match-beginning 0)) 5848 (goto-char (1- (match-end 0))) 5849 (setq b (point)) 5850 (forward-sexp 1) 5851 (setq sexp (buffer-substring b (point))) 5852 (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)") 5853 (org-trim (match-string 1)) 5854 "")) 5855 (setq result (org-diary-sexp-entry sexp sexp-entry date)) 5856 (when result 5857 (setq marker (org-agenda-new-marker beg) 5858 level (make-string (org-reduced-level (org-outline-level)) ? ) 5859 category (org-get-category beg) 5860 inherited-tags 5861 (or (eq org-agenda-show-inherited-tags 'always) 5862 (and (listp org-agenda-show-inherited-tags) 5863 (memq 'agenda org-agenda-show-inherited-tags)) 5864 (and (eq org-agenda-show-inherited-tags t) 5865 (or (eq org-agenda-use-tag-inheritance t) 5866 (memq 'agenda org-agenda-use-tag-inheritance)))) 5867 tags (org-get-tags nil (not inherited-tags)) 5868 todo-state (org-get-todo-state) 5869 warntime (get-text-property (point) 'org-appt-warntime) 5870 extra nil) 5871 5872 (dolist (r (if (stringp result) 5873 (list result) 5874 result)) ;; we expect a list here 5875 (when (and org-agenda-diary-sexp-prefix 5876 (string-match org-agenda-diary-sexp-prefix r)) 5877 (setq extra (match-string 0 r) 5878 r (replace-match "" nil nil r))) 5879 (if (string-match "\\S-" r) 5880 (setq txt r) 5881 (setq txt "SEXP entry returned empty string")) 5882 (setq txt (org-agenda-format-item extra txt level category tags 'time)) 5883 (org-add-props txt props 'org-marker marker 5884 'date date 'todo-state todo-state 5885 'level level 'type "sexp" 'warntime warntime) 5886 (push txt ee))))) 5887 (nreverse ee))) 5888 5889 ;; Calendar sanity: define some functions that are independent of 5890 ;; `calendar-date-style'. 5891 (defun org-anniversary (year month day &optional mark) 5892 "Like `diary-anniversary', but with fixed (ISO) order of arguments." 5893 (with-no-warnings 5894 (let ((calendar-date-style 'iso)) 5895 (diary-anniversary year month day mark)))) 5896 (defun org-cyclic (N year month day &optional mark) 5897 "Like `diary-cyclic', but with fixed (ISO) order of arguments." 5898 (with-no-warnings 5899 (let ((calendar-date-style 'iso)) 5900 (diary-cyclic N year month day mark)))) 5901 (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark) 5902 "Like `diary-block', but with fixed (ISO) order of arguments." 5903 (with-no-warnings 5904 (let ((calendar-date-style 'iso)) 5905 (diary-block Y1 M1 D1 Y2 M2 D2 mark)))) 5906 (defun org-date (year month day &optional mark) 5907 "Like `diary-date', but with fixed (ISO) order of arguments." 5908 (with-no-warnings 5909 (let ((calendar-date-style 'iso)) 5910 (diary-date year month day mark)))) 5911 5912 ;; Define the `org-class' function 5913 (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks) 5914 "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. 5915 DAYNAME is a number between 0 (Sunday) and 6 (Saturday). 5916 SKIP-WEEKS is any number of ISO weeks in the block period for which the 5917 item should be skipped. If any of the SKIP-WEEKS arguments is the symbol 5918 `holidays', then any date that is known by the Emacs calendar to be a 5919 holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings, 5920 then those holidays will be skipped." 5921 (with-no-warnings (defvar date) (defvar entry)) 5922 (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1))) 5923 (date2 (calendar-absolute-from-gregorian (list m2 d2 y2))) 5924 (d (calendar-absolute-from-gregorian date)) 5925 (h (when skip-weeks (calendar-check-holidays date)))) 5926 (and 5927 (<= date1 d) 5928 (<= d date2) 5929 (= (calendar-day-of-week date) dayname) 5930 (or (not skip-weeks) 5931 (progn 5932 (require 'cal-iso) 5933 (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) 5934 (not (or (and h (memq 'holidays skip-weeks)) 5935 (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) 5936 entry))) 5937 5938 (defalias 'org-get-closed #'org-agenda-get-progress) 5939 (defun org-agenda-get-progress () 5940 "Return the logged TODO entries for agenda display." 5941 (with-no-warnings (defvar date)) 5942 (let* ((props (list 'mouse-face 'highlight 5943 'org-not-done-regexp org-not-done-regexp 5944 'org-todo-regexp org-todo-regexp 5945 'org-complex-heading-regexp org-complex-heading-regexp 5946 'help-echo 5947 (format "mouse-2 or RET jump to org file %s" 5948 (abbreviate-file-name buffer-file-name)))) 5949 (items (if (consp org-agenda-show-log-scoped) 5950 org-agenda-show-log-scoped 5951 (if (eq org-agenda-show-log-scoped 'clockcheck) 5952 '(clock) 5953 org-agenda-log-mode-items))) 5954 (parts 5955 (delq nil 5956 (list 5957 (when (memq 'closed items) (concat "\\<" org-closed-string)) 5958 (when (memq 'clock items) (concat "\\<" org-clock-string)) 5959 (when (memq 'state items) 5960 (format "- +State \"%s\".*?" org-todo-regexp))))) 5961 (parts-re (if parts (mapconcat #'identity parts "\\|") 5962 (error "`org-agenda-log-mode-items' is empty"))) 5963 (regexp (concat 5964 "\\(" parts-re "\\)" 5965 " *\\[" 5966 (regexp-quote 5967 (substring 5968 (format-time-string 5969 (car org-time-stamp-formats) 5970 (encode-time ; DATE bound by calendar 5971 0 0 0 (nth 1 date) (car date) (nth 2 date))) 5972 1 11)))) 5973 (org-agenda-search-headline-for-time nil) 5974 marker hdmarker priority category level tags closedp type 5975 statep clockp state ee txt extra timestr rest clocked inherited-tags) 5976 (goto-char (point-min)) 5977 (while (re-search-forward regexp nil t) 5978 (catch :skip 5979 (org-agenda-skip) 5980 (setq marker (org-agenda-new-marker (match-beginning 0)) 5981 closedp (equal (match-string 1) org-closed-string) 5982 statep (equal (string-to-char (match-string 1)) ?-) 5983 clockp (not (or closedp statep)) 5984 state (and statep (match-string 2)) 5985 category (org-get-category (match-beginning 0)) 5986 timestr (buffer-substring (match-beginning 0) (point-at-eol))) 5987 (when (string-match "\\]" timestr) 5988 ;; substring should only run to end of time stamp 5989 (setq rest (substring timestr (match-end 0)) 5990 timestr (substring timestr 0 (match-end 0))) 5991 (if (and (not closedp) (not statep) 5992 (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" 5993 rest)) 5994 (progn (setq timestr (concat (substring timestr 0 -1) 5995 "-" (match-string 1 rest) "]")) 5996 (setq clocked (match-string 2 rest))) 5997 (setq clocked "-"))) 5998 (save-excursion 5999 (setq extra 6000 (cond 6001 ((not org-agenda-log-mode-add-notes) nil) 6002 (statep 6003 (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") 6004 (match-string 1))) 6005 (clockp 6006 (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") 6007 (match-string 1))))) 6008 (if (not (re-search-backward org-outline-regexp-bol nil t)) 6009 (throw :skip nil) 6010 (goto-char (match-beginning 0)) 6011 (setq hdmarker (org-agenda-new-marker) 6012 inherited-tags 6013 (or (eq org-agenda-show-inherited-tags 'always) 6014 (and (listp org-agenda-show-inherited-tags) 6015 (memq 'todo org-agenda-show-inherited-tags)) 6016 (and (eq org-agenda-show-inherited-tags t) 6017 (or (eq org-agenda-use-tag-inheritance t) 6018 (memq 'todo org-agenda-use-tag-inheritance)))) 6019 tags (org-get-tags nil (not inherited-tags)) 6020 level (make-string (org-reduced-level (org-outline-level)) ? )) 6021 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 6022 (setq txt (match-string 1)) 6023 (when extra 6024 (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt) 6025 (setq txt (concat (substring txt 0 (match-beginning 1)) 6026 " - " extra " " (match-string 2 txt))) 6027 (setq txt (concat txt " - " extra)))) 6028 (setq txt (org-agenda-format-item 6029 (cond 6030 (closedp "Closed: ") 6031 (statep (concat "State: (" state ")")) 6032 (t (concat "Clocked: (" clocked ")"))) 6033 txt level category tags timestr))) 6034 (setq type (cond (closedp "closed") 6035 (statep "state") 6036 (t "clock"))) 6037 (setq priority 100000) 6038 (org-add-props txt props 6039 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 6040 'priority priority 'level level 6041 'type type 'date date 6042 'undone-face 'org-warning 'done-face 'org-agenda-done) 6043 (push txt ee)) 6044 (goto-char (point-at-eol)))) 6045 (nreverse ee))) 6046 6047 (defun org-agenda-show-clocking-issues () 6048 "Add overlays, showing issues with clocking. 6049 See also the user option `org-agenda-clock-consistency-checks'." 6050 (interactive) 6051 (let* ((pl org-agenda-clock-consistency-checks) 6052 (re (concat "^[ \t]*" 6053 org-clock-string 6054 "[ \t]+" 6055 "\\(\\[.*?\\]\\)" ; group 1 is first stamp 6056 "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second 6057 (tlstart 0.) 6058 (tlend 0.) 6059 (maxtime (org-duration-to-minutes 6060 (or (plist-get pl :max-duration) "24:00"))) 6061 (mintime (org-duration-to-minutes 6062 (or (plist-get pl :min-duration) 0))) 6063 (maxgap (org-duration-to-minutes 6064 ;; default 30:00 means never complain 6065 (or (plist-get pl :max-gap) "30:00"))) 6066 (gapok (mapcar #'org-duration-to-minutes 6067 (plist-get pl :gap-ok-around))) 6068 (def-face (or (plist-get pl :default-face) 6069 '((:background "DarkRed") (:foreground "white")))) 6070 issue face m te ts dt ov) 6071 (goto-char (point-min)) 6072 (while (re-search-forward " Clocked: +(\\(?:-\\|\\([0-9]+:[0-9]+\\)\\))" nil t) 6073 (setq issue nil face def-face) 6074 (catch 'next 6075 (setq m (org-get-at-bol 'org-marker) 6076 te nil ts nil) 6077 (unless (and m (markerp m)) 6078 (setq issue "No valid clock line") (throw 'next t)) 6079 (org-with-point-at m 6080 (save-excursion 6081 (goto-char (point-at-bol)) 6082 (unless (looking-at re) 6083 (error "No valid Clock line") 6084 (throw 'next t)) 6085 (unless (match-end 3) 6086 (setq issue 6087 (format 6088 "No end time: (%s)" 6089 (org-duration-from-minutes 6090 (floor 6091 (- (float-time (org-current-time)) 6092 (float-time (org-time-string-to-time (match-string 1)))) 6093 60))) 6094 face (or (plist-get pl :no-end-time-face) face)) 6095 (throw 'next t)) 6096 (setq ts (match-string 1) 6097 te (match-string 3) 6098 ts (float-time (org-time-string-to-time ts)) 6099 te (float-time (org-time-string-to-time te)) 6100 dt (- te ts)))) 6101 (cond 6102 ((> dt (* 60 maxtime)) 6103 ;; a very long clocking chunk 6104 (setq issue (format "Clocking interval is very long: %s" 6105 (org-duration-from-minutes (floor dt 60))) 6106 face (or (plist-get pl :long-face) face))) 6107 ((< dt (* 60 mintime)) 6108 ;; a very short clocking chunk 6109 (setq issue (format "Clocking interval is very short: %s" 6110 (org-duration-from-minutes (floor dt 60))) 6111 face (or (plist-get pl :short-face) face))) 6112 ((and (> tlend 0) (< ts tlend)) 6113 ;; Two clock entries are overlapping 6114 (setq issue (format "Clocking overlap: %d minutes" 6115 (/ (- tlend ts) 60)) 6116 face (or (plist-get pl :overlap-face) face))) 6117 ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap)))) 6118 ;; There is a gap, lets see if we need to report it 6119 (unless (org-agenda-check-clock-gap tlend ts gapok) 6120 (setq issue (format "Clocking gap: %d minutes" 6121 (/ (- ts tlend) 60)) 6122 face (or (plist-get pl :gap-face) face)))) 6123 (t nil))) 6124 (setq tlend (or te tlend) tlstart (or ts tlstart)) 6125 (when issue 6126 ;; OK, there was some issue, add an overlay to show the issue 6127 (setq ov (make-overlay (point-at-bol) (point-at-eol))) 6128 (overlay-put ov 'before-string 6129 (concat 6130 (org-add-props 6131 (format "%-43s" (concat " " issue)) 6132 nil 6133 'face face) 6134 "\n")) 6135 (overlay-put ov 'evaporate t))))) 6136 6137 (defun org-agenda-check-clock-gap (t1 t2 ok-list) 6138 "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values." 6139 (catch 'exit 6140 (unless ok-list 6141 ;; there are no OK times for gaps... 6142 (throw 'exit nil)) 6143 (when (> (- (/ t2 36000) (/ t1 36000)) 24) 6144 ;; This is more than 24 hours, so it is OK. 6145 ;; because we have at least one OK time, that must be in the 6146 ;; 24 hour interval. 6147 (throw 'exit t)) 6148 ;; We have a shorter gap. 6149 ;; Now we have to get the minute of the day when these times are 6150 (let* ((t1dec (org-decode-time t1)) 6151 (t2dec (org-decode-time t2)) 6152 ;; compute the minute on the day 6153 (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec)))) 6154 (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec))))) 6155 (when (< min2 min1) 6156 ;; if min2 is smaller than min1, this means it is on the next day. 6157 ;; Wrap it to after midnight. 6158 (setq min2 (+ min2 1440))) 6159 ;; Now check if any of the OK times is in the gap 6160 (mapc (lambda (x) 6161 ;; Wrap the time to after midnight if necessary 6162 (when (< x min1) (setq x (+ x 1440))) 6163 ;; Check if in interval 6164 (and (<= min1 x) (>= min2 x) (throw 'exit t))) 6165 ok-list) 6166 ;; Nope, this gap is not OK 6167 nil))) 6168 6169 (defun org-agenda-get-deadlines (&optional with-hour) 6170 "Return the deadline information for agenda display. 6171 When WITH-HOUR is non-nil, only return deadlines with an hour 6172 specification like [h]h:mm." 6173 (with-no-warnings (defvar date)) 6174 (let* ((props (list 'mouse-face 'highlight 6175 'org-not-done-regexp org-not-done-regexp 6176 'org-todo-regexp org-todo-regexp 6177 'org-complex-heading-regexp org-complex-heading-regexp 6178 'help-echo 6179 (format "mouse-2 or RET jump to org file %s" 6180 (abbreviate-file-name buffer-file-name)))) 6181 (regexp (if with-hour 6182 org-deadline-time-hour-regexp 6183 org-deadline-time-regexp)) 6184 (today (org-today)) 6185 (today? (org-agenda-today-p date)) ; DATE bound by calendar. 6186 (current (calendar-absolute-from-gregorian date)) 6187 deadline-items) 6188 (goto-char (point-min)) 6189 (while (re-search-forward regexp nil t) 6190 (catch :skip 6191 (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) 6192 (org-agenda-skip) 6193 (let* ((s (match-string 1)) 6194 (pos (1- (match-beginning 1))) 6195 (todo-state (save-match-data (org-get-todo-state))) 6196 (done? (member todo-state org-done-keywords)) 6197 (sexp? (string-prefix-p "%%" s)) 6198 ;; DEADLINE is the deadline date for the entry. It is 6199 ;; either the base date or the last repeat, according 6200 ;; to `org-agenda-prefer-last-repeat'. 6201 (deadline 6202 (cond 6203 (sexp? (org-agenda--timestamp-to-absolute s current)) 6204 ((or (eq org-agenda-prefer-last-repeat t) 6205 (member todo-state org-agenda-prefer-last-repeat)) 6206 (org-agenda--timestamp-to-absolute 6207 s today 'past (current-buffer) pos)) 6208 (t (org-agenda--timestamp-to-absolute s)))) 6209 ;; REPEAT is the future repeat closest from CURRENT, 6210 ;; according to `org-agenda-show-future-repeats'. If 6211 ;; the latter is nil, or if the time stamp has no 6212 ;; repeat part, default to DEADLINE. 6213 (repeat 6214 (cond 6215 (sexp? deadline) 6216 ((<= current today) deadline) 6217 ((not org-agenda-show-future-repeats) deadline) 6218 (t 6219 (let ((base (if (eq org-agenda-show-future-repeats 'next) 6220 (1+ today) 6221 current))) 6222 (org-agenda--timestamp-to-absolute 6223 s base 'future (current-buffer) pos))))) 6224 (diff (- deadline current)) 6225 (suppress-prewarning 6226 (let ((scheduled 6227 (and org-agenda-skip-deadline-prewarning-if-scheduled 6228 (org-entry-get nil "SCHEDULED")))) 6229 (cond 6230 ((not scheduled) nil) 6231 ;; The current item has a scheduled date, so 6232 ;; evaluate its prewarning lead time. 6233 ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) 6234 ;; Use global prewarning-restart lead time. 6235 org-agenda-skip-deadline-prewarning-if-scheduled) 6236 ((eq org-agenda-skip-deadline-prewarning-if-scheduled 6237 'pre-scheduled) 6238 ;; Set pre-warning to no earlier than SCHEDULED. 6239 (min (- deadline 6240 (org-agenda--timestamp-to-absolute scheduled)) 6241 org-deadline-warning-days)) 6242 ;; Set pre-warning to deadline. 6243 (t 0)))) 6244 (wdays (or suppress-prewarning (org-get-wdays s)))) 6245 (cond 6246 ;; Only display deadlines at their base date, at future 6247 ;; repeat occurrences or in today agenda. 6248 ((= current deadline) nil) 6249 ((= current repeat) nil) 6250 ((not today?) (throw :skip nil)) 6251 ;; Upcoming deadline: display within warning period WDAYS. 6252 ((> deadline current) (when (> diff wdays) (throw :skip nil))) 6253 ;; Overdue deadline: warn about it for 6254 ;; `org-deadline-past-days' duration. 6255 (t (when (< org-deadline-past-days (- diff)) (throw :skip nil)))) 6256 ;; Possibly skip done tasks. 6257 (when (and done? 6258 (or org-agenda-skip-deadline-if-done 6259 (/= deadline current))) 6260 (throw :skip nil)) 6261 (save-excursion 6262 (re-search-backward "^\\*+[ \t]+" nil t) 6263 (goto-char (match-end 0)) 6264 (let* ((category (org-get-category)) 6265 (level (make-string (org-reduced-level (org-outline-level)) 6266 ?\s)) 6267 (head (buffer-substring (point) (line-end-position))) 6268 (inherited-tags 6269 (or (eq org-agenda-show-inherited-tags 'always) 6270 (and (listp org-agenda-show-inherited-tags) 6271 (memq 'agenda org-agenda-show-inherited-tags)) 6272 (and (eq org-agenda-show-inherited-tags t) 6273 (or (eq org-agenda-use-tag-inheritance t) 6274 (memq 'agenda 6275 org-agenda-use-tag-inheritance))))) 6276 (tags (org-get-tags nil (not inherited-tags))) 6277 (time 6278 (cond 6279 ;; No time of day designation if it is only 6280 ;; a reminder. 6281 ((and (/= current deadline) (/= current repeat)) nil) 6282 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 6283 (concat (substring s (match-beginning 1)) " ")) 6284 (t 'time))) 6285 (item 6286 (org-agenda-format-item 6287 ;; Insert appropriate suffixes before deadlines. 6288 ;; Those only apply to today agenda. 6289 (pcase-let ((`(,now ,future ,past) 6290 org-agenda-deadline-leaders)) 6291 (cond 6292 ((and today? (< deadline today)) (format past (- diff))) 6293 ((and today? (> deadline today)) (format future diff)) 6294 (t now))) 6295 head level category tags time)) 6296 (face (org-agenda-deadline-face 6297 (- 1 (/ (float diff) (max wdays 1))))) 6298 (upcoming? (and today? (> deadline today))) 6299 (warntime (get-text-property (point) 'org-appt-warntime))) 6300 (org-add-props item props 6301 'org-marker (org-agenda-new-marker pos) 6302 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 6303 'warntime warntime 6304 'level level 6305 'ts-date deadline 6306 'priority 6307 ;; Adjust priority to today reminders about deadlines. 6308 ;; Overdue deadlines get the highest priority 6309 ;; increase, then imminent deadlines and eventually 6310 ;; more distant deadlines. 6311 (let ((adjust (if today? (- diff) 0))) 6312 (+ adjust (org-get-priority item))) 6313 'todo-state todo-state 6314 'type (if upcoming? "upcoming-deadline" "deadline") 6315 'date (if upcoming? date deadline) 6316 'face (if done? 'org-agenda-done face) 6317 'undone-face face 6318 'done-face 'org-agenda-done) 6319 (push item deadline-items)))))) 6320 (nreverse deadline-items))) 6321 6322 (defun org-agenda-deadline-face (fraction) 6323 "Return the face to displaying a deadline item. 6324 FRACTION is what fraction of the head-warning time has passed." 6325 (assoc-default fraction org-agenda-deadline-faces #'<=)) 6326 6327 (defun org-agenda-get-scheduled (&optional deadlines with-hour) 6328 "Return the scheduled information for agenda display. 6329 Optional argument DEADLINES is a list of deadline items to be 6330 displayed in agenda view. When WITH-HOUR is non-nil, only return 6331 scheduled items with an hour specification like [h]h:mm." 6332 (with-no-warnings (defvar date)) 6333 (let* ((props (list 'org-not-done-regexp org-not-done-regexp 6334 'org-todo-regexp org-todo-regexp 6335 'org-complex-heading-regexp org-complex-heading-regexp 6336 'done-face 'org-agenda-done 6337 'mouse-face 'highlight 6338 'help-echo 6339 (format "mouse-2 or RET jump to Org file %s" 6340 (abbreviate-file-name buffer-file-name)))) 6341 (regexp (if with-hour 6342 org-scheduled-time-hour-regexp 6343 org-scheduled-time-regexp)) 6344 (today (org-today)) 6345 (todayp (org-agenda-today-p date)) ; DATE bound by calendar. 6346 (current (calendar-absolute-from-gregorian date)) 6347 (deadline-pos 6348 (mapcar (lambda (d) 6349 (let ((m (get-text-property 0 'org-hd-marker d))) 6350 (and m (marker-position m)))) 6351 deadlines)) 6352 scheduled-items) 6353 (goto-char (point-min)) 6354 (while (re-search-forward regexp nil t) 6355 (catch :skip 6356 (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) 6357 (org-agenda-skip) 6358 (let* ((s (match-string 1)) 6359 (pos (1- (match-beginning 1))) 6360 (todo-state (save-match-data (org-get-todo-state))) 6361 (donep (member todo-state org-done-keywords)) 6362 (sexp? (string-prefix-p "%%" s)) 6363 ;; SCHEDULE is the scheduled date for the entry. It is 6364 ;; either the bare date or the last repeat, according 6365 ;; to `org-agenda-prefer-last-repeat'. 6366 (schedule 6367 (cond 6368 (sexp? (org-agenda--timestamp-to-absolute s current)) 6369 ((or (eq org-agenda-prefer-last-repeat t) 6370 (member todo-state org-agenda-prefer-last-repeat)) 6371 (org-agenda--timestamp-to-absolute 6372 s today 'past (current-buffer) pos)) 6373 (t (org-agenda--timestamp-to-absolute s)))) 6374 ;; REPEAT is the future repeat closest from CURRENT, 6375 ;; according to `org-agenda-show-future-repeats'. If 6376 ;; the latter is nil, or if the time stamp has no 6377 ;; repeat part, default to SCHEDULE. 6378 (repeat 6379 (cond 6380 (sexp? schedule) 6381 ((<= current today) schedule) 6382 ((not org-agenda-show-future-repeats) schedule) 6383 (t 6384 (let ((base (if (eq org-agenda-show-future-repeats 'next) 6385 (1+ today) 6386 current))) 6387 (org-agenda--timestamp-to-absolute 6388 s base 'future (current-buffer) pos))))) 6389 (diff (- current schedule)) 6390 (warntime (get-text-property (point) 'org-appt-warntime)) 6391 (pastschedp (< schedule today)) 6392 (futureschedp (> schedule today)) 6393 (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p))) 6394 (suppress-delay 6395 (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline 6396 (org-entry-get nil "DEADLINE")))) 6397 (cond 6398 ((not deadline) nil) 6399 ;; The current item has a deadline date, so 6400 ;; evaluate its delay time. 6401 ((integerp org-agenda-skip-scheduled-delay-if-deadline) 6402 ;; Use global delay time. 6403 (- org-agenda-skip-scheduled-delay-if-deadline)) 6404 ((eq org-agenda-skip-scheduled-delay-if-deadline 6405 'post-deadline) 6406 ;; Set delay to no later than DEADLINE. 6407 (min (- schedule 6408 (org-agenda--timestamp-to-absolute deadline)) 6409 org-scheduled-delay-days)) 6410 (t 0)))) 6411 (ddays 6412 (cond 6413 ;; Nullify delay when a repeater triggered already 6414 ;; and the delay is of the form --Xd. 6415 ((and (string-match-p "--[0-9]+[hdwmy]" s) 6416 (> schedule (org-agenda--timestamp-to-absolute s))) 6417 0) 6418 (suppress-delay 6419 (let ((org-scheduled-delay-days suppress-delay)) 6420 (org-get-wdays s t t))) 6421 (t (org-get-wdays s t))))) 6422 ;; Display scheduled items at base date (SCHEDULE), today if 6423 ;; scheduled before the current date, and at any repeat past 6424 ;; today. However, skip delayed items and items that have 6425 ;; been displayed for more than `org-scheduled-past-days'. 6426 (unless (and todayp 6427 habitp 6428 (bound-and-true-p org-habit-show-all-today)) 6429 (when (or (and (> ddays 0) (< diff ddays)) 6430 (> diff (or (and habitp org-habit-scheduled-past-days) 6431 org-scheduled-past-days)) 6432 (> schedule current) 6433 (and (/= current schedule) 6434 (/= current today) 6435 (/= current repeat))) 6436 (throw :skip nil))) 6437 ;; Possibly skip done tasks. 6438 (when (and donep 6439 (or org-agenda-skip-scheduled-if-done 6440 (/= schedule current))) 6441 (throw :skip nil)) 6442 ;; Skip entry if it already appears as a deadline, per 6443 ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This 6444 ;; doesn't apply to habits. 6445 (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown 6446 ((guard 6447 (or (not (memq (line-beginning-position 0) deadline-pos)) 6448 habitp)) 6449 nil) 6450 (`repeated-after-deadline 6451 (let ((deadline (time-to-days 6452 (org-get-deadline-time (point))))) 6453 (and (<= schedule deadline) (> current deadline)))) 6454 (`not-today pastschedp) 6455 (`t t) 6456 (_ nil)) 6457 (throw :skip nil)) 6458 ;; Skip habits if `org-habit-show-habits' is nil, or if we 6459 ;; only show them for today. Also skip done habits. 6460 (when (and habitp 6461 (or donep 6462 (not (bound-and-true-p org-habit-show-habits)) 6463 (and (not todayp) 6464 (bound-and-true-p 6465 org-habit-show-habits-only-for-today)))) 6466 (throw :skip nil)) 6467 (save-excursion 6468 (re-search-backward "^\\*+[ \t]+" nil t) 6469 (goto-char (match-end 0)) 6470 (let* ((category (org-get-category)) 6471 (inherited-tags 6472 (or (eq org-agenda-show-inherited-tags 'always) 6473 (and (listp org-agenda-show-inherited-tags) 6474 (memq 'agenda org-agenda-show-inherited-tags)) 6475 (and (eq org-agenda-show-inherited-tags t) 6476 (or (eq org-agenda-use-tag-inheritance t) 6477 (memq 'agenda 6478 org-agenda-use-tag-inheritance))))) 6479 (tags (org-get-tags nil (not inherited-tags))) 6480 (level (make-string (org-reduced-level (org-outline-level)) 6481 ?\s)) 6482 (head (buffer-substring (point) (line-end-position))) 6483 (time 6484 (cond 6485 ;; No time of day designation if it is only a 6486 ;; reminder, except for habits, which always show 6487 ;; the time of day. Habits are an exception 6488 ;; because if there is a time of day, that is 6489 ;; interpreted to mean they should usually happen 6490 ;; then, even if doing the habit was missed. 6491 ((and 6492 (not habitp) 6493 (/= current schedule) 6494 (/= current repeat)) 6495 nil) 6496 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 6497 (concat (substring s (match-beginning 1)) " ")) 6498 (t 'time))) 6499 (item 6500 (org-agenda-format-item 6501 (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders)) 6502 ;; Show a reminder of a past scheduled today. 6503 (if (and todayp pastschedp) 6504 (format past diff) 6505 first)) 6506 head level category tags time nil habitp)) 6507 (face (cond ((and (not habitp) pastschedp) 6508 'org-scheduled-previously) 6509 ((and habitp futureschedp) 6510 'org-agenda-done) 6511 (todayp 'org-scheduled-today) 6512 (t 'org-scheduled))) 6513 (habitp (and habitp (org-habit-parse-todo)))) 6514 (org-add-props item props 6515 'undone-face face 6516 'face (if donep 'org-agenda-done face) 6517 'org-marker (org-agenda-new-marker pos) 6518 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 6519 'type (if pastschedp "past-scheduled" "scheduled") 6520 'date (if pastschedp schedule date) 6521 'ts-date schedule 6522 'warntime warntime 6523 'level level 6524 'priority (if habitp (org-habit-get-priority habitp) 6525 (+ 99 diff (org-get-priority item))) 6526 'org-habit-p habitp 6527 'todo-state todo-state) 6528 (push item scheduled-items)))))) 6529 (nreverse scheduled-items))) 6530 6531 (defun org-agenda-get-blocks () 6532 "Return the date-range information for agenda display." 6533 (with-no-warnings (defvar date)) 6534 (let* ((props (list 'face nil 6535 'org-not-done-regexp org-not-done-regexp 6536 'org-todo-regexp org-todo-regexp 6537 'org-complex-heading-regexp org-complex-heading-regexp 6538 'mouse-face 'highlight 6539 'help-echo 6540 (format "mouse-2 or RET jump to org file %s" 6541 (abbreviate-file-name buffer-file-name)))) 6542 (regexp org-tr-regexp) 6543 (d0 (calendar-absolute-from-gregorian date)) 6544 marker hdmarker ee txt d1 d2 s1 s2 category 6545 level todo-state tags pos head donep inherited-tags) 6546 (goto-char (point-min)) 6547 (while (re-search-forward regexp nil t) 6548 (catch :skip 6549 (org-agenda-skip) 6550 (setq pos (point)) 6551 (let ((start-time (match-string 1)) 6552 (end-time (match-string 2))) 6553 (setq s1 (match-string 1) 6554 s2 (match-string 2) 6555 d1 (time-to-days 6556 (condition-case err 6557 (org-time-string-to-time s1) 6558 (error 6559 (error 6560 "Bad timestamp %S at %d in buffer %S\nError was: %s" 6561 s1 6562 pos 6563 (current-buffer) 6564 (error-message-string err))))) 6565 d2 (time-to-days 6566 (condition-case err 6567 (org-time-string-to-time s2) 6568 (error 6569 (error 6570 "Bad timestamp %S at %d in buffer %S\nError was: %s" 6571 s2 6572 pos 6573 (current-buffer) 6574 (error-message-string err)))))) 6575 (when (and (> (- d0 d1) -1) (> (- d2 d0) -1)) 6576 ;; Only allow days between the limits, because the normal 6577 ;; date stamps will catch the limits. 6578 (save-excursion 6579 (setq todo-state (org-get-todo-state)) 6580 (setq donep (member todo-state org-done-keywords)) 6581 (when (and donep org-agenda-skip-timestamp-if-done) 6582 (throw :skip t)) 6583 (setq marker (org-agenda-new-marker (point)) 6584 category (org-get-category)) 6585 (if (not (re-search-backward org-outline-regexp-bol nil t)) 6586 (throw :skip nil) 6587 (goto-char (match-beginning 0)) 6588 (setq hdmarker (org-agenda-new-marker (point)) 6589 inherited-tags 6590 (or (eq org-agenda-show-inherited-tags 'always) 6591 (and (listp org-agenda-show-inherited-tags) 6592 (memq 'agenda org-agenda-show-inherited-tags)) 6593 (and (eq org-agenda-show-inherited-tags t) 6594 (or (eq org-agenda-use-tag-inheritance t) 6595 (memq 'agenda org-agenda-use-tag-inheritance)))) 6596 tags (org-get-tags nil (not inherited-tags))) 6597 (setq level (make-string (org-reduced-level (org-outline-level)) ? )) 6598 (looking-at "\\*+[ \t]+\\(.*\\)") 6599 (setq head (match-string 1)) 6600 (let ((remove-re 6601 (if org-agenda-remove-timeranges-from-blocks 6602 (concat 6603 "<" (regexp-quote s1) ".*?>" 6604 "--" 6605 "<" (regexp-quote s2) ".*?>") 6606 nil))) 6607 (setq txt (org-agenda-format-item 6608 (format 6609 (nth (if (= d1 d2) 0 1) 6610 org-agenda-timerange-leaders) 6611 (1+ (- d0 d1)) (1+ (- d2 d1))) 6612 head level category tags 6613 (save-match-data 6614 (let ((hhmm1 (and (string-match org-ts-regexp1 s1) 6615 (match-string 6 s1))) 6616 (hhmm2 (and (string-match org-ts-regexp1 s2) 6617 (match-string 6 s2)))) 6618 (cond ((string= hhmm1 hhmm2) 6619 (concat "<" start-time ">--<" end-time ">")) 6620 ((and (= d1 d0) (= d2 d0)) 6621 (concat "<" start-time ">--<" end-time ">")) 6622 ((= d1 d0) 6623 (concat "<" start-time ">")) 6624 ((= d2 d0) 6625 (concat "<" end-time ">"))))) 6626 remove-re)))) 6627 (org-add-props txt props 6628 'org-marker marker 'org-hd-marker hdmarker 6629 'type "block" 'date date 6630 'level level 6631 'todo-state todo-state 6632 'priority (org-get-priority txt)) 6633 (push txt ee)))) 6634 (goto-char pos))) 6635 ;; Sort the entries by expiration date. 6636 (nreverse ee))) 6637 6638 ;;; Agenda presentation and sorting 6639 6640 (defvar org-prefix-has-time nil 6641 "A flag, set by `org-compile-prefix-format'. 6642 The flag is set if the currently compiled format contains a `%t'.") 6643 (defvar org-prefix-has-tag nil 6644 "A flag, set by `org-compile-prefix-format'. 6645 The flag is set if the currently compiled format contains a `%T'.") 6646 (defvar org-prefix-has-effort nil 6647 "A flag, set by `org-compile-prefix-format'. 6648 The flag is set if the currently compiled format contains a `%e'.") 6649 (defvar org-prefix-has-breadcrumbs nil 6650 "A flag, set by `org-compile-prefix-format'. 6651 The flag is set if the currently compiled format contains a `%b'.") 6652 (defvar org-prefix-category-length nil 6653 "Used by `org-compile-prefix-format' to remember the category field width.") 6654 (defvar org-prefix-category-max-length nil 6655 "Used by `org-compile-prefix-format' to remember the category field width.") 6656 6657 (defun org-agenda-get-category-icon (category) 6658 "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." 6659 (cl-dolist (entry org-agenda-category-icon-alist) 6660 (when (string-match-p (car entry) category) 6661 (if (listp (cadr entry)) 6662 (cl-return (cadr entry)) 6663 (cl-return (apply #'create-image (cdr entry))))))) 6664 6665 (defun org-agenda-format-item (extra txt &optional with-level with-category tags dotime 6666 remove-re habitp) 6667 "Format TXT to be inserted into the agenda buffer. 6668 In particular, add the prefix and corresponding text properties. 6669 6670 EXTRA must be a string to replace the `%s' specifier in the prefix format. 6671 WITH-LEVEL may be a string to replace the `%l' specifier. 6672 WITH-CATEGORY (a string, a symbol or nil) may be used to overrule the default 6673 category taken from local variable or file name. It will replace the `%c' 6674 specifier in the format. 6675 DOTIME, when non-nil, indicates that a time-of-day should be extracted from 6676 TXT for sorting of this entry, and for the `%t' specifier in the format. 6677 When DOTIME is a string, this string is searched for a time before TXT is. 6678 TAGS can be the tags of the headline. 6679 Any match of REMOVE-RE will be removed from TXT." 6680 ;; We keep the org-prefix-* variable values along with a compiled 6681 ;; formatter, so that multiple agendas existing at the same time do 6682 ;; not step on each other toes. 6683 ;; 6684 ;; It was inconvenient to make these variables buffer local in 6685 ;; Agenda buffers, because this function expects to be called with 6686 ;; the buffer where item comes from being current, and not agenda 6687 ;; buffer 6688 (let* ((bindings (car org-prefix-format-compiled)) 6689 (formatter (cadr org-prefix-format-compiled))) 6690 (cl-loop for (var value) in bindings 6691 do (set var value)) 6692 (save-match-data 6693 ;; Diary entries sometimes have extra whitespace at the beginning 6694 (setq txt (org-trim txt)) 6695 6696 ;; Fix the tags part in txt 6697 (setq txt (org-agenda-fix-displayed-tags 6698 txt tags 6699 org-agenda-show-inherited-tags 6700 org-agenda-hide-tags-regexp)) 6701 6702 (with-no-warnings 6703 ;; `time', `tag', `effort' are needed for the eval of the prefix format. 6704 ;; Based on what I see in `org-compile-prefix-format', I added 6705 ;; a few more. 6706 (defvar breadcrumbs) (defvar category) (defvar category-icon) 6707 (defvar effort) (defvar extra) 6708 (defvar level) (defvar tag) (defvar time)) 6709 (let* ((category (or with-category 6710 (if buffer-file-name 6711 (file-name-sans-extension 6712 (file-name-nondirectory buffer-file-name)) 6713 ""))) 6714 (category-icon (org-agenda-get-category-icon category)) 6715 (category-icon (if category-icon 6716 (propertize " " 'display category-icon) 6717 "")) 6718 (effort (and (not (string= txt "")) 6719 (get-text-property 1 'effort txt))) 6720 (tag (if tags (nth (1- (length tags)) tags) "")) 6721 (time-grid-trailing-characters (nth 2 org-agenda-time-grid)) 6722 (extra (or (and (not habitp) extra) "")) 6723 time 6724 (ts (when dotime (concat 6725 (if (stringp dotime) dotime "") 6726 (and org-agenda-search-headline-for-time txt)))) 6727 (time-of-day (and dotime (org-get-time-of-day ts))) 6728 stamp plain s0 s1 s2 rtn srp l 6729 duration breadcrumbs) 6730 (and (derived-mode-p 'org-mode) buffer-file-name 6731 (add-to-list 'org-agenda-contributing-files buffer-file-name)) 6732 (when (and dotime time-of-day) 6733 ;; Extract starting and ending time and move them to prefix 6734 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) 6735 (setq plain (string-match org-plain-time-of-day-regexp ts))) 6736 (setq s0 (match-string 0 ts) 6737 srp (and stamp (match-end 3)) 6738 s1 (match-string (if plain 1 2) ts) 6739 s2 (match-string (if plain 8 (if srp 4 6)) ts)) 6740 6741 ;; If the times are in TXT (not in DOTIMES), and the prefix will list 6742 ;; them, we might want to remove them there to avoid duplication. 6743 ;; The user can turn this off with a variable. 6744 (when (and org-prefix-has-time 6745 org-agenda-remove-times-when-in-prefix (or stamp plain) 6746 (string-match (concat (regexp-quote s0) " *") txt) 6747 (not (equal ?\] (string-to-char (substring txt (match-end 0))))) 6748 (if (eq org-agenda-remove-times-when-in-prefix 'beg) 6749 (= (match-beginning 0) 0) 6750 t)) 6751 (setq txt (replace-match "" nil nil txt)))) 6752 ;; Normalize the time(s) to 24 hour. 6753 (when s1 (setq s1 (org-get-time-of-day s1 t))) 6754 (when s2 (setq s2 (org-get-time-of-day s2 t))) 6755 ;; Try to set s2 if s1 and 6756 ;; `org-agenda-default-appointment-duration' are set 6757 (when (and s1 (not s2) org-agenda-default-appointment-duration) 6758 (setq s2 6759 (org-duration-from-minutes 6760 (+ (org-duration-to-minutes s1 t) 6761 org-agenda-default-appointment-duration) 6762 nil t))) 6763 ;; Compute the duration 6764 (when s2 6765 (setq duration (- (org-duration-to-minutes s2) 6766 (org-duration-to-minutes s1)))) 6767 ;; Format S1 and S2 for display. 6768 (when s1 (setq s1 (org-get-time-of-day s1 'overtime))) 6769 (when s2 (setq s2 (org-get-time-of-day s2 'overtime)))) 6770 (when (string-match org-tag-group-re txt) 6771 ;; Tags are in the string 6772 (if (or (eq org-agenda-remove-tags t) 6773 (and org-agenda-remove-tags 6774 org-prefix-has-tag)) 6775 (setq txt (replace-match "" t t txt)) 6776 (setq txt (replace-match 6777 (concat (make-string (max (- 50 (length txt)) 1) ?\ ) 6778 (match-string 1 txt)) 6779 t t txt)))) 6780 6781 (when remove-re 6782 (while (string-match remove-re txt) 6783 (setq txt (replace-match "" t t txt)))) 6784 6785 ;; Set org-heading property on `txt' to mark the start of the 6786 ;; heading. 6787 (add-text-properties 0 (length txt) '(org-heading t) txt) 6788 6789 ;; Prepare the variables needed in the eval of the compiled format 6790 (when org-prefix-has-breadcrumbs 6791 (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker) 6792 (let ((s (org-format-outline-path (org-get-outline-path) 6793 (1- (frame-width)) 6794 nil org-agenda-breadcrumbs-separator))) 6795 (if (eq "" s) "" (concat s org-agenda-breadcrumbs-separator)))))) 6796 (setq time (cond (s2 (concat 6797 (org-agenda-time-of-day-to-ampm-maybe s1) 6798 "-" (org-agenda-time-of-day-to-ampm-maybe s2) 6799 (when org-agenda-timegrid-use-ampm " "))) 6800 (s1 (concat 6801 (org-agenda-time-of-day-to-ampm-maybe s1) 6802 (if org-agenda-timegrid-use-ampm 6803 (concat time-grid-trailing-characters " ") 6804 time-grid-trailing-characters))) 6805 (t "")) 6806 category (if (symbolp category) (symbol-name category) category) 6807 level (or with-level "")) 6808 (if (string-match org-link-bracket-re category) 6809 (progn 6810 (setq l (string-width (or (match-string 2) (match-string 1)))) 6811 (when (< l (or org-prefix-category-length 0)) 6812 (setq category (copy-sequence category)) 6813 (org-add-props category nil 6814 'extra-space (make-string 6815 (- org-prefix-category-length l 1) ?\ )))) 6816 (when (and org-prefix-category-max-length 6817 (>= (length category) org-prefix-category-max-length)) 6818 (setq category (substring category 0 (1- org-prefix-category-max-length))))) 6819 ;; Evaluate the compiled format 6820 (setq rtn (concat (eval formatter t) txt)) 6821 6822 ;; And finally add the text properties 6823 (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) 6824 (org-add-props rtn nil 6825 'org-category category 6826 'tags tags 6827 'org-priority-highest org-priority-highest 6828 'org-priority-lowest org-priority-lowest 6829 'time-of-day time-of-day 6830 'duration duration 6831 'breadcrumbs breadcrumbs 6832 'txt txt 6833 'level level 6834 'time time 6835 'extra extra 6836 'format org-prefix-format-compiled 6837 'dotime dotime))))) 6838 6839 (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) 6840 "Remove tags string from TXT, and add a modified list of tags. 6841 The modified list may contain inherited tags, and tags matched by 6842 `org-agenda-hide-tags-regexp' will be removed." 6843 (when (or add-inherited hide-re) 6844 (when (string-match org-tag-group-re txt) 6845 (setq txt (substring txt 0 (match-beginning 0)))) 6846 (setq tags 6847 (delq nil 6848 (mapcar (lambda (tg) 6849 (if (or (and hide-re (string-match hide-re tg)) 6850 (and (not add-inherited) 6851 (get-text-property 0 'inherited tg))) 6852 nil 6853 tg)) 6854 tags))) 6855 (when tags 6856 (let ((have-i (get-text-property 0 'inherited (car tags))) 6857 i) 6858 (setq txt (concat txt " :" 6859 (mapconcat 6860 (lambda (x) 6861 (setq i (get-text-property 0 'inherited x)) 6862 (if (and have-i (not i)) 6863 (progn 6864 (setq have-i nil) 6865 (concat ":" x)) 6866 x)) 6867 tags ":") 6868 (if have-i "::" ":")))))) 6869 txt) 6870 6871 (defvar org-agenda-sorting-strategy) ;; because the def is in a let form 6872 6873 (defun org-agenda-add-time-grid-maybe (list ndays todayp) 6874 "Add a time-grid for agenda items which need it. 6875 6876 LIST is the list of agenda items formatted by `org-agenda-list'. 6877 NDAYS is the span of the current agenda view. 6878 TODAYP is t when the current agenda view is on today." 6879 (catch 'exit 6880 (cond ((not org-agenda-use-time-grid) (throw 'exit list)) 6881 ((and todayp (member 'today (car org-agenda-time-grid)))) 6882 ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) 6883 ((member 'weekly (car org-agenda-time-grid))) 6884 (t (throw 'exit list))) 6885 (let* ((have (delq nil (mapcar 6886 (lambda (x) (get-text-property 1 'time-of-day x)) 6887 list))) 6888 (string (nth 3 org-agenda-time-grid)) 6889 (gridtimes (nth 1 org-agenda-time-grid)) 6890 (req (car org-agenda-time-grid)) 6891 (remove (member 'remove-match req)) 6892 new time) 6893 (when (and (member 'require-timed req) (not have)) 6894 ;; don't show empty grid 6895 (throw 'exit list)) 6896 (while (setq time (pop gridtimes)) 6897 (unless (and remove (member time have)) 6898 (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) 6899 (push (org-agenda-format-item 6900 nil string nil "" nil 6901 (concat (substring time 0 -2) ":" (substring time -2))) 6902 new) 6903 (put-text-property 6904 2 (length (car new)) 'face 'org-time-grid (car new)))) 6905 (when (and todayp org-agenda-show-current-time-in-grid) 6906 (push (org-agenda-format-item 6907 nil org-agenda-current-time-string nil "" nil 6908 (format-time-string "%H:%M ")) 6909 new) 6910 (put-text-property 6911 2 (length (car new)) 'face 'org-agenda-current-time (car new))) 6912 6913 (if (member 'time-up org-agenda-sorting-strategy-selected) 6914 (append new list) 6915 (append list new))))) 6916 6917 (defun org-compile-prefix-format (key) 6918 "Compile the prefix format into a Lisp form that can be evaluated. 6919 The resulting form and associated variable bindings is returned 6920 and stored in the variable `org-prefix-format-compiled'." 6921 (setq org-prefix-has-time nil 6922 org-prefix-has-tag nil 6923 org-prefix-category-length nil 6924 org-prefix-has-effort nil 6925 org-prefix-has-breadcrumbs nil) 6926 (let ((s (cond 6927 ((stringp org-agenda-prefix-format) 6928 org-agenda-prefix-format) 6929 ((assq key org-agenda-prefix-format) 6930 (cdr (assq key org-agenda-prefix-format))) 6931 (t " %-12:c%?-12t% s"))) 6932 (start 0) 6933 varform vars var c f opt) ;; e 6934 (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)" 6935 s start) 6936 (setq var (or (cdr (assoc (match-string 4 s) 6937 '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) 6938 ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs)))) 6939 'eval) 6940 c (or (match-string 3 s) "") 6941 opt (match-beginning 1) 6942 start (1+ (match-beginning 0))) 6943 (cl-case var 6944 (time (setq org-prefix-has-time t)) 6945 (tag (setq org-prefix-has-tag t)) 6946 (effort (setq org-prefix-has-effort t)) 6947 (breadcrumbs (setq org-prefix-has-breadcrumbs t))) 6948 (setq f (concat "%" (match-string 2 s) "s")) 6949 (when (eq var 'category) 6950 (setq org-prefix-category-length 6951 (floor (abs (string-to-number (match-string 2 s))))) 6952 (setq org-prefix-category-max-length 6953 (let ((x (match-string 2 s))) 6954 (save-match-data 6955 (and (string-match "\\.[0-9]+" x) 6956 (string-to-number (substring (match-string 0 x) 1))))))) 6957 (if (eq var 'eval) 6958 (setq varform `(format ,f (org-eval ,(read (substring s (match-beginning 4)))))) 6959 (if opt 6960 (setq varform 6961 `(if (member ,var '("" nil)) 6962 "" 6963 (format ,f (concat ,var ,c)))) 6964 (setq varform 6965 `(format ,f (if (member ,var '("" nil)) "" 6966 (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) 6967 (if (eq var 'eval) 6968 (setf (substring s (match-beginning 0) 6969 (+ (match-beginning 4) 6970 (length (format "%S" (read (substring s (match-beginning 4))))))) 6971 "%s") 6972 (setq s (replace-match "%s" t nil s))) 6973 (push varform vars)) 6974 (setq vars (nreverse vars)) 6975 (with-current-buffer (or org-agenda-buffer (current-buffer)) 6976 (setq org-prefix-format-compiled 6977 (list 6978 `((org-prefix-has-time ,org-prefix-has-time) 6979 (org-prefix-has-tag ,org-prefix-has-tag) 6980 (org-prefix-category-length ,org-prefix-category-length) 6981 (org-prefix-has-effort ,org-prefix-has-effort) 6982 (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs)) 6983 `(format ,s ,@vars)))))) 6984 6985 (defun org-set-sorting-strategy (key) 6986 (setq org-agenda-sorting-strategy-selected 6987 (if (symbolp (car org-agenda-sorting-strategy)) 6988 ;; the old format 6989 org-agenda-sorting-strategy 6990 (or (cdr (assq key org-agenda-sorting-strategy)) 6991 (cdr (assq 'agenda org-agenda-sorting-strategy)) 6992 '(time-up category-keep priority-down))))) 6993 6994 (defun org-get-time-of-day (s &optional string) 6995 "Check string S for a time of day. 6996 6997 If found, return it as a military time number between 0 and 2400. 6998 If not found, return nil. 6999 7000 The optional STRING argument forces conversion into a 5 character wide string 7001 HH:MM. When it is `overtime', any time above 24:00 is turned into \"+H:MM\" 7002 where H:MM is the duration above midnight." 7003 (let ((case-fold-search t) 7004 (time-regexp 7005 (rx word-start 7006 (group (opt (any "012")) digit) ;group 1: hours 7007 (or (and ":" (group (any "012345") digit) ;group 2: minutes 7008 (opt (group (or "am" "pm")))) ;group 3: am/pm 7009 ;; Special "HHam/pm" case. 7010 (group-n 3 (or "am" "pm"))) 7011 word-end))) 7012 (save-match-data 7013 (when (and (string-match time-regexp s) 7014 (not (eq 'org-link (get-text-property 1 'face s)))) 7015 (let ((hours 7016 (let* ((ampm (and (match-end 3) (downcase (match-string 3 s)))) 7017 (am-p (equal ampm "am"))) 7018 (pcase (string-to-number (match-string 1 s)) 7019 ((and (guard (not ampm)) h) h) 7020 (12 (if am-p 0 12)) 7021 (h (+ h (if am-p 0 12)))))) 7022 (minutes 7023 (if (match-end 2) 7024 (string-to-number (match-string 2 s)) 7025 0))) 7026 (pcase string 7027 (`nil (+ minutes (* hours 100))) 7028 ((and `overtime 7029 (guard (or (> hours 24) 7030 (and (= hours 24) 7031 (> minutes 0))))) 7032 (format "+%d:%02d" (- hours 24) minutes)) 7033 ((guard org-agenda-time-leading-zero) 7034 (format "%02d:%02d" hours minutes)) 7035 (_ 7036 (format "%d:%02d" hours minutes)))))))) 7037 7038 (defvar org-agenda-before-sorting-filter-function nil 7039 "Function to be applied to agenda items prior to sorting. 7040 Prior to sorting also means just before they are inserted into the agenda. 7041 7042 To aid sorting, you may revisit the original entries and add more text 7043 properties which will later be used by the sorting functions. 7044 7045 The function should take a string argument, an agenda line. 7046 It has access to the text properties in that line, which contain among 7047 other things, the property `org-hd-marker' that points to the entry 7048 where the line comes from. Note that not all lines going into the agenda 7049 have this property, only most. 7050 7051 The function should return the modified string. It is probably best 7052 to ONLY change text properties. 7053 7054 You can also use this function as a filter, by returning nil for lines 7055 you don't want to have in the agenda at all. For this application, you 7056 could bind the variable in the options section of a custom command.") 7057 7058 (defun org-agenda-finalize-entries (list &optional type) 7059 "Sort, limit and concatenate the LIST of agenda items. 7060 The optional argument TYPE tells the agenda type." 7061 (let ((max-effort (cond ((listp org-agenda-max-effort) 7062 (cdr (assoc type org-agenda-max-effort))) 7063 (t org-agenda-max-effort))) 7064 (max-todo (cond ((listp org-agenda-max-todos) 7065 (cdr (assoc type org-agenda-max-todos))) 7066 (t org-agenda-max-todos))) 7067 (max-tags (cond ((listp org-agenda-max-tags) 7068 (cdr (assoc type org-agenda-max-tags))) 7069 (t org-agenda-max-tags))) 7070 (max-entries (cond ((listp org-agenda-max-entries) 7071 (cdr (assoc type org-agenda-max-entries))) 7072 (t org-agenda-max-entries)))) 7073 (when org-agenda-before-sorting-filter-function 7074 (setq list 7075 (delq nil 7076 (mapcar 7077 org-agenda-before-sorting-filter-function list)))) 7078 (setq list (mapcar #'org-agenda-highlight-todo list) 7079 list (mapcar #'identity (sort list #'org-entries-lessp))) 7080 (when max-effort 7081 (setq list (org-agenda-limit-entries 7082 list 'effort-minutes max-effort 7083 (lambda (e) (or e (if org-agenda-sort-noeffort-is-high 7084 32767 -1)))))) 7085 (when max-todo 7086 (setq list (org-agenda-limit-entries list 'todo-state max-todo))) 7087 (when max-tags 7088 (setq list (org-agenda-limit-entries list 'tags max-tags))) 7089 (when max-entries 7090 (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) 7091 (when (and org-agenda-dim-blocked-tasks org-blocker-hook) 7092 (setq list (mapcar #'org-agenda--mark-blocked-entry list))) 7093 (mapconcat #'identity list "\n"))) 7094 7095 (defun org-agenda-limit-entries (list prop limit &optional fn) 7096 "Limit the number of agenda entries." 7097 (let ((include (and limit (< limit 0)))) 7098 (if limit 7099 (let ((fun (or fn (lambda (p) (when p 1)))) 7100 (lim 0)) 7101 (delq nil 7102 (mapcar 7103 (lambda (e) 7104 (let ((pval (funcall 7105 fun (get-text-property (1- (length e)) 7106 prop e)))) 7107 (when pval (setq lim (+ lim pval))) 7108 (cond ((and pval (<= lim (abs limit))) e) 7109 ((and include (not pval)) e)))) 7110 list))) 7111 list))) 7112 7113 (defun org-agenda-limit-interactively (remove) 7114 "In agenda, interactively limit entries to various maximums." 7115 (interactive "P") 7116 (if remove 7117 (progn (setq org-agenda-max-entries nil 7118 org-agenda-max-todos nil 7119 org-agenda-max-tags nil 7120 org-agenda-max-effort nil) 7121 (org-agenda-redo)) 7122 (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) 7123 (msg (cond ((= max ?E) "How many minutes? ") 7124 ((= max ?e) "How many entries? ") 7125 ((= max ?t) "How many TODO entries? ") 7126 ((= max ?T) "How many tagged entries? ") 7127 (t (user-error "Wrong input")))) 7128 (num (string-to-number (read-from-minibuffer msg)))) 7129 (cond ((equal max ?e) 7130 (let ((org-agenda-max-entries num)) (org-agenda-redo))) 7131 ((equal max ?t) 7132 (let ((org-agenda-max-todos num)) (org-agenda-redo))) 7133 ((equal max ?T) 7134 (let ((org-agenda-max-tags num)) (org-agenda-redo))) 7135 ((equal max ?E) 7136 (let ((org-agenda-max-effort num)) (org-agenda-redo)))))) 7137 (org-agenda-fit-window-to-buffer)) 7138 7139 (defun org-agenda-highlight-todo (x) 7140 (let ((org-done-keywords org-done-keywords-for-agenda) 7141 (case-fold-search nil) 7142 re) 7143 (if (eq x 'line) 7144 (save-excursion 7145 (beginning-of-line 1) 7146 (setq re (org-get-at-bol 'org-todo-regexp)) 7147 (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point))) 7148 (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) 7149 (add-text-properties (match-beginning 0) (match-end 1) 7150 (list 'face (org-get-todo-face 1))) 7151 (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) 7152 (delete-region (match-beginning 1) (1- (match-end 0))) 7153 (goto-char (match-beginning 1)) 7154 (insert (format org-agenda-todo-keyword-format s))))) 7155 (let ((pl (text-property-any 0 (length x) 'org-heading t x))) 7156 (setq re (get-text-property 0 'org-todo-regexp x)) 7157 (when (and re 7158 ;; Test `pl' because if there's no heading content, 7159 ;; there's no point matching to highlight. Note 7160 ;; that if we didn't test `pl' first, and there 7161 ;; happened to be no keyword from `org-todo-regexp' 7162 ;; on this heading line, then the `equal' comparison 7163 ;; afterwards would spuriously succeed in the case 7164 ;; where `pl' is nil -- causing an args-out-of-range 7165 ;; error when we try to add text properties to text 7166 ;; that isn't there. 7167 pl 7168 (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") 7169 x pl) 7170 pl)) 7171 (add-text-properties 7172 (or (match-end 1) (match-end 0)) (match-end 0) 7173 (list 'face (org-get-todo-face (match-string 2 x))) 7174 x) 7175 (when (match-end 1) 7176 (setq x 7177 (concat 7178 (substring x 0 (match-end 1)) 7179 (unless (string= org-agenda-todo-keyword-format "") 7180 (format org-agenda-todo-keyword-format 7181 (match-string 2 x))) 7182 ;; Remove `display' property as the icon could leak 7183 ;; on the white space. 7184 (org-add-props " " (org-plist-delete (text-properties-at 0 x) 7185 'display)) 7186 (substring x (match-end 3))))))) 7187 x))) 7188 7189 (defsubst org-cmp-values (a b property) 7190 "Compare the numeric value of text PROPERTY for string A and B." 7191 (let ((pa (or (get-text-property (1- (length a)) property a) 0)) 7192 (pb (or (get-text-property (1- (length b)) property b) 0))) 7193 (cond ((> pa pb) +1) 7194 ((< pa pb) -1)))) 7195 7196 (defsubst org-cmp-effort (a b) 7197 "Compare the effort values of string A and B." 7198 (let* ((def (if org-agenda-sort-noeffort-is-high 32767 -1)) 7199 ;; `effort-minutes' property is not directly accessible from 7200 ;; the strings, but is stored as a property in `txt'. 7201 (ea (or (get-text-property 7202 0 'effort-minutes (get-text-property 0 'txt a)) 7203 def)) 7204 (eb (or (get-text-property 7205 0 'effort-minutes (get-text-property 0 'txt b)) 7206 def))) 7207 (cond ((> ea eb) +1) 7208 ((< ea eb) -1)))) 7209 7210 (defsubst org-cmp-category (a b) 7211 "Compare the string values of categories of strings A and B." 7212 (let ((ca (or (get-text-property (1- (length a)) 'org-category a) "")) 7213 (cb (or (get-text-property (1- (length b)) 'org-category b) ""))) 7214 (cond ((string-lessp ca cb) -1) 7215 ((string-lessp cb ca) +1)))) 7216 7217 (defsubst org-cmp-todo-state (a b) 7218 "Compare the todo states of strings A and B." 7219 (let* ((ma (or (get-text-property 1 'org-marker a) 7220 (get-text-property 1 'org-hd-marker a))) 7221 (mb (or (get-text-property 1 'org-marker b) 7222 (get-text-property 1 'org-hd-marker b))) 7223 (fa (and ma (marker-buffer ma))) 7224 (fb (and mb (marker-buffer mb))) 7225 (todo-kwds 7226 (or (and fa (with-current-buffer fa org-todo-keywords-1)) 7227 (and fb (with-current-buffer fb org-todo-keywords-1)))) 7228 (ta (or (get-text-property 1 'todo-state a) "")) 7229 (tb (or (get-text-property 1 'todo-state b) "")) 7230 (la (- (length (member ta todo-kwds)))) 7231 (lb (- (length (member tb todo-kwds)))) 7232 (donepa (member ta org-done-keywords-for-agenda)) 7233 (donepb (member tb org-done-keywords-for-agenda))) 7234 (cond ((and donepa (not donepb)) -1) 7235 ((and (not donepa) donepb) +1) 7236 ((< la lb) -1) 7237 ((< lb la) +1)))) 7238 7239 (defsubst org-cmp-alpha (a b) 7240 "Compare the headlines, alphabetically." 7241 (let* ((pla (text-property-any 0 (length a) 'org-heading t a)) 7242 (plb (text-property-any 0 (length b) 'org-heading t b)) 7243 (ta (and pla (substring a pla))) 7244 (tb (and plb (substring b plb))) 7245 (case-fold-search nil)) 7246 (when pla 7247 (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") 7248 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") 7249 ta) 7250 (setq ta (substring ta (match-end 0)))) 7251 (setq ta (downcase ta))) 7252 (when plb 7253 (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") 7254 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") 7255 tb) 7256 (setq tb (substring tb (match-end 0)))) 7257 (setq tb (downcase tb))) 7258 (cond ((not (or ta tb)) nil) 7259 ((not ta) +1) 7260 ((not tb) -1) 7261 ((string-lessp ta tb) -1) 7262 ((string-lessp tb ta) +1)))) 7263 7264 (defsubst org-cmp-tag (a b) 7265 "Compare the string values of the first tags of A and B." 7266 (let ((ta (car (last (get-text-property 1 'tags a)))) 7267 (tb (car (last (get-text-property 1 'tags b))))) 7268 (cond ((not (or ta tb)) nil) 7269 ((not ta) +1) 7270 ((not tb) -1) 7271 ((string-lessp ta tb) -1) 7272 ((string-lessp tb ta) +1)))) 7273 7274 (defsubst org-cmp-time (a b) 7275 "Compare the time-of-day values of strings A and B." 7276 (let* ((def (if org-agenda-sort-notime-is-late 9901 -1)) 7277 (ta (or (get-text-property 1 'time-of-day a) def)) 7278 (tb (or (get-text-property 1 'time-of-day b) def))) 7279 (cond ((< ta tb) -1) 7280 ((< tb ta) +1)))) 7281 7282 (defsubst org-cmp-ts (a b type) 7283 "Compare the timestamps values of entries A and B. 7284 When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or 7285 \"timestamp_ia\", compare within each of these type. When TYPE 7286 is the empty string, compare all timestamps without respect of 7287 their type." 7288 (let* ((def (and (not org-agenda-sort-notime-is-late) -1)) 7289 (ta (or (and (string-match type (or (get-text-property 1 'type a) "")) 7290 (get-text-property 1 'ts-date a)) 7291 def)) 7292 (tb (or (and (string-match type (or (get-text-property 1 'type b) "")) 7293 (get-text-property 1 'ts-date b)) 7294 def))) 7295 (cond ((if ta (and tb (< ta tb)) tb) -1) 7296 ((if tb (and ta (< tb ta)) ta) +1)))) 7297 7298 (defsubst org-cmp-habit-p (a b) 7299 "Compare the todo states of strings A and B." 7300 (let ((ha (get-text-property 1 'org-habit-p a)) 7301 (hb (get-text-property 1 'org-habit-p b))) 7302 (cond ((and ha (not hb)) -1) 7303 ((and (not ha) hb) +1)))) 7304 7305 (defun org-entries-lessp (a b) 7306 "Predicate for sorting agenda entries." 7307 ;; The following variables will be used when the form is evaluated. 7308 ;; So even though the compiler complains, keep them. 7309 (let ((ss org-agenda-sorting-strategy-selected)) 7310 (org-dlet 7311 ((timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) 7312 (org-cmp-ts a b ""))) 7313 (timestamp-down (if timestamp-up (- timestamp-up) nil)) 7314 (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) 7315 (org-cmp-ts a b "scheduled"))) 7316 (scheduled-down (if scheduled-up (- scheduled-up) nil)) 7317 (deadline-up (and (org-em 'deadline-up 'deadline-down ss) 7318 (org-cmp-ts a b "deadline"))) 7319 (deadline-down (if deadline-up (- deadline-up) nil)) 7320 (tsia-up (and (org-em 'tsia-up 'tsia-down ss) 7321 (org-cmp-ts a b "timestamp_ia"))) 7322 (tsia-down (if tsia-up (- tsia-up) nil)) 7323 (ts-up (and (org-em 'ts-up 'ts-down ss) 7324 (org-cmp-ts a b "timestamp"))) 7325 (ts-down (if ts-up (- ts-up) nil)) 7326 (time-up (and (org-em 'time-up 'time-down ss) 7327 (org-cmp-time a b))) 7328 (time-down (if time-up (- time-up) nil)) 7329 (stats-up (and (org-em 'stats-up 'stats-down ss) 7330 (org-cmp-values a b 'org-stats))) 7331 (stats-down (if stats-up (- stats-up) nil)) 7332 (priority-up (and (org-em 'priority-up 'priority-down ss) 7333 (org-cmp-values a b 'priority))) 7334 (priority-down (if priority-up (- priority-up) nil)) 7335 (effort-up (and (org-em 'effort-up 'effort-down ss) 7336 (org-cmp-effort a b))) 7337 (effort-down (if effort-up (- effort-up) nil)) 7338 (category-up (and (or (org-em 'category-up 'category-down ss) 7339 (memq 'category-keep ss)) 7340 (org-cmp-category a b))) 7341 (category-down (if category-up (- category-up) nil)) 7342 (category-keep (if category-up +1 nil)) 7343 (tag-up (and (org-em 'tag-up 'tag-down ss) 7344 (org-cmp-tag a b))) 7345 (tag-down (if tag-up (- tag-up) nil)) 7346 (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) 7347 (org-cmp-todo-state a b))) 7348 (todo-state-down (if todo-state-up (- todo-state-up) nil)) 7349 (habit-up (and (org-em 'habit-up 'habit-down ss) 7350 (org-cmp-habit-p a b))) 7351 (habit-down (if habit-up (- habit-up) nil)) 7352 (alpha-up (and (org-em 'alpha-up 'alpha-down ss) 7353 (org-cmp-alpha a b))) 7354 (alpha-down (if alpha-up (- alpha-up) nil)) 7355 (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) 7356 user-defined-up user-defined-down) 7357 (when (and need-user-cmp org-agenda-cmp-user-defined 7358 (functionp org-agenda-cmp-user-defined)) 7359 (setq user-defined-up 7360 (funcall org-agenda-cmp-user-defined a b) 7361 user-defined-down (if user-defined-up (- user-defined-up) nil))) 7362 (cdr (assoc 7363 (eval (cons 'or org-agenda-sorting-strategy-selected) t) 7364 '((-1 . t) (1 . nil) (nil . nil))))))) 7365 7366 ;;; Agenda restriction lock 7367 7368 (defvar org-agenda-restriction-lock-overlay (make-overlay 1 1) 7369 "Overlay to mark the headline to which agenda commands are restricted.") 7370 (overlay-put org-agenda-restriction-lock-overlay 7371 'face 'org-agenda-restriction-lock) 7372 (overlay-put org-agenda-restriction-lock-overlay 7373 'help-echo "Agendas are currently limited to this subtree.") 7374 (delete-overlay org-agenda-restriction-lock-overlay) 7375 7376 (defun org-agenda-set-restriction-lock-from-agenda (arg) 7377 "Set the restriction lock to the agenda item at point from within the agenda. 7378 When called with a `\\[universal-argument]' prefix, restrict to 7379 the file which contains the item. 7380 Argument ARG is the prefix argument." 7381 (interactive "P") 7382 (unless (derived-mode-p 'org-agenda-mode) 7383 (user-error "Not in an Org agenda buffer")) 7384 (let* ((marker (or (org-get-at-bol 'org-marker) 7385 (org-agenda-error))) 7386 (buffer (marker-buffer marker)) 7387 (pos (marker-position marker))) 7388 (with-current-buffer buffer 7389 (goto-char pos) 7390 (org-agenda-set-restriction-lock arg)))) 7391 7392 ;;;###autoload 7393 (defun org-agenda-set-restriction-lock (&optional type) 7394 "Set restriction lock for agenda to current subtree or file. 7395 When in a restricted subtree, remove it. 7396 7397 The restriction will span over the entire file if TYPE is `file', 7398 or if type is '(4), or if the cursor is before the first headline 7399 in the file. Otherwise, only apply the restriction to the current 7400 subtree." 7401 (interactive "P") 7402 (if (and org-agenda-overriding-restriction 7403 (member org-agenda-restriction-lock-overlay 7404 (overlays-at (point))) 7405 (equal (overlay-start org-agenda-restriction-lock-overlay) 7406 (point))) 7407 (org-agenda-remove-restriction-lock 'noupdate) 7408 (org-agenda-remove-restriction-lock 'noupdate) 7409 (and (equal type '(4)) (setq type 'file)) 7410 (setq type (cond 7411 (type type) 7412 ((org-at-heading-p) 'subtree) 7413 ((condition-case nil (org-back-to-heading t) (error nil)) 7414 'subtree) 7415 (t 'file))) 7416 (if (eq type 'subtree) 7417 (progn 7418 (setq org-agenda-restrict (current-buffer)) 7419 (setq org-agenda-overriding-restriction 'subtree) 7420 (put 'org-agenda-files 'org-restrict 7421 (list (buffer-file-name (buffer-base-buffer)))) 7422 (org-back-to-heading t) 7423 (move-overlay org-agenda-restriction-lock-overlay 7424 (point) 7425 (if org-agenda-restriction-lock-highlight-subtree 7426 (save-excursion (org-end-of-subtree t t) (point)) 7427 (point-at-eol))) 7428 (move-marker org-agenda-restrict-begin (point)) 7429 (move-marker org-agenda-restrict-end 7430 (save-excursion (org-end-of-subtree t t))) 7431 (message "Locking agenda restriction to subtree")) 7432 (put 'org-agenda-files 'org-restrict 7433 (list (buffer-file-name (buffer-base-buffer)))) 7434 (setq org-agenda-restrict nil) 7435 (setq org-agenda-overriding-restriction 'file) 7436 (move-marker org-agenda-restrict-begin nil) 7437 (move-marker org-agenda-restrict-end nil) 7438 (message "Locking agenda restriction to file")) 7439 (setq current-prefix-arg nil)) 7440 (org-agenda-maybe-redo)) 7441 7442 (defun org-agenda-remove-restriction-lock (&optional noupdate) 7443 "Remove agenda restriction lock." 7444 (interactive "P") 7445 (if (not org-agenda-restrict) 7446 (message "No agenda restriction to remove.") 7447 (delete-overlay org-agenda-restriction-lock-overlay) 7448 (delete-overlay org-speedbar-restriction-lock-overlay) 7449 (setq org-agenda-overriding-restriction nil) 7450 (setq org-agenda-restrict nil) 7451 (put 'org-agenda-files 'org-restrict nil) 7452 (move-marker org-agenda-restrict-begin nil) 7453 (move-marker org-agenda-restrict-end nil) 7454 (setq current-prefix-arg nil) 7455 (message "Agenda restriction lock removed") 7456 (or noupdate (org-agenda-maybe-redo)))) 7457 7458 (defun org-agenda-maybe-redo () 7459 "If there is any window showing the agenda view, update it." 7460 (let ((w (get-buffer-window (or org-agenda-this-buffer-name 7461 org-agenda-buffer-name) 7462 t)) 7463 (w0 (selected-window))) 7464 (when w 7465 (select-window w) 7466 (org-agenda-redo) 7467 (select-window w0) 7468 (if org-agenda-overriding-restriction 7469 (message "Agenda view shifted to new %s restriction" 7470 org-agenda-overriding-restriction) 7471 (message "Agenda restriction lock removed"))))) 7472 7473 ;;; Agenda commands 7474 7475 (defun org-agenda-check-type (error &rest types) 7476 "Check if agenda buffer or component is of allowed type. 7477 If ERROR is non-nil, throw an error, otherwise just return nil. 7478 Allowed types are `agenda' `todo' `tags' `search'." 7479 (cond ((not org-agenda-type) 7480 (error "No Org agenda currently displayed")) 7481 ((memq org-agenda-type types) t) 7482 (error 7483 (error "Not allowed in '%s'-type agenda buffer or component" org-agenda-type)) 7484 (t nil))) 7485 7486 (defun org-agenda-Quit () 7487 "Exit the agenda, killing the agenda buffer. 7488 Like `org-agenda-quit', but kill the buffer even when 7489 `org-agenda-sticky' is non-nil." 7490 (interactive) 7491 (org-agenda--quit)) 7492 7493 (defun org-agenda-quit () 7494 "Exit the agenda. 7495 7496 When `org-agenda-sticky' is non-nil, bury the agenda buffer 7497 instead of killing it. 7498 7499 When `org-agenda-restore-windows-after-quit' is non-nil, restore 7500 the pre-agenda window configuration. 7501 7502 When column view is active, exit column view instead of the 7503 agenda." 7504 (interactive) 7505 (org-agenda--quit org-agenda-sticky)) 7506 7507 (defun org-agenda--quit (&optional bury) 7508 (if org-agenda-columns-active 7509 (org-columns-quit) 7510 (let ((wconf org-agenda-pre-window-conf) 7511 (buf (current-buffer)) 7512 (org-agenda-last-indirect-window 7513 (and (eq org-indirect-buffer-display 'other-window) 7514 org-agenda-last-indirect-buffer 7515 (get-buffer-window org-agenda-last-indirect-buffer)))) 7516 (cond 7517 ((eq org-agenda-window-setup 'other-frame) 7518 (delete-frame)) 7519 ((eq org-agenda-window-setup 'other-tab) 7520 (if (fboundp 'tab-bar-close-tab) 7521 (tab-bar-close-tab) 7522 (user-error "Your version of Emacs does not have tab bar mode support"))) 7523 ((and org-agenda-restore-windows-after-quit 7524 wconf) 7525 ;; Maybe restore the pre-agenda window configuration. Reset 7526 ;; `org-agenda-pre-window-conf' before running 7527 ;; `set-window-configuration', which loses the current buffer. 7528 (setq org-agenda-pre-window-conf nil) 7529 (set-window-configuration wconf)) 7530 (t 7531 (when org-agenda-last-indirect-window 7532 (delete-window org-agenda-last-indirect-window)) 7533 (and (not (eq org-agenda-window-setup 'current-window)) 7534 (not (one-window-p)) 7535 (delete-window)))) 7536 (if bury 7537 ;; Set the agenda buffer as the current buffer instead of 7538 ;; passing it as an argument to `bury-buffer' so that 7539 ;; `bury-buffer' removes it from the window. 7540 (with-current-buffer buf 7541 (bury-buffer)) 7542 (kill-buffer buf) 7543 (setq org-agenda-archives-mode nil 7544 org-agenda-buffer nil))))) 7545 7546 (defun org-agenda-exit () 7547 "Exit the agenda, killing Org buffers loaded by the agenda. 7548 Like `org-agenda-Quit', but kill any buffers that were created by 7549 the agenda. Org buffers visited directly by the user will not be 7550 touched. Also, exit the agenda even if it is in column view." 7551 (interactive) 7552 (when org-agenda-columns-active 7553 (org-columns-quit)) 7554 (org-release-buffers org-agenda-new-buffers) 7555 (setq org-agenda-new-buffers nil) 7556 (org-agenda-Quit)) 7557 7558 (defun org-agenda-kill-all-agenda-buffers () 7559 "Kill all buffers in `org-agenda-mode'. 7560 This is used when toggling sticky agendas." 7561 (interactive) 7562 (let (blist) 7563 (dolist (buf (buffer-list)) 7564 (when (with-current-buffer buf (eq major-mode 'org-agenda-mode)) 7565 (push buf blist))) 7566 (mapc #'kill-buffer blist))) 7567 7568 (defun org-agenda-execute (arg) 7569 "Execute another agenda command, keeping same window. 7570 So this is just a shortcut for \\<global-map>`\\[org-agenda]', available 7571 in the agenda." 7572 (interactive "P") 7573 (let ((org-agenda-window-setup 'current-window)) 7574 (org-agenda arg))) 7575 7576 (defun org-agenda-redo (&optional all) 7577 "Rebuild possibly ALL agenda view(s) in the current buffer." 7578 (interactive "P") 7579 (defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used? 7580 (let* ((p (or (and (looking-at "\\'") (1- (point))) (point))) 7581 (cpa (unless (eq all t) current-prefix-arg)) 7582 (org-agenda-doing-sticky-redo org-agenda-sticky) 7583 (org-agenda-sticky nil) 7584 (org-agenda-buffer-name (or org-agenda-this-buffer-name 7585 org-agenda-buffer-name)) 7586 (org-agenda-keep-modes t) 7587 (tag-filter org-agenda-tag-filter) 7588 (tag-preset (get 'org-agenda-tag-filter :preset-filter)) 7589 (top-hl-filter org-agenda-top-headline-filter) 7590 (cat-filter org-agenda-category-filter) 7591 (cat-preset (get 'org-agenda-category-filter :preset-filter)) 7592 (re-filter org-agenda-regexp-filter) 7593 (re-preset (get 'org-agenda-regexp-filter :preset-filter)) 7594 (effort-filter org-agenda-effort-filter) 7595 (effort-preset (get 'org-agenda-effort-filter :preset-filter)) 7596 (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) 7597 (cols org-agenda-columns-active) 7598 (line (org-current-line)) 7599 (window-line (- line (org-current-line (window-start)))) 7600 (lprops (get 'org-agenda-redo-command 'org-lprops)) 7601 (redo-cmd (get-text-property p 'org-redo-cmd)) 7602 (last-args (get-text-property p 'org-last-args)) 7603 (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd)) 7604 (org-agenda-overriding-cmd-arguments 7605 (unless (eq all t) 7606 (cond ((listp last-args) 7607 (cons (or cpa (car last-args)) (cdr last-args))) 7608 ((stringp last-args) 7609 last-args)))) 7610 (series-redo-cmd (get-text-property p 'org-series-redo-cmd))) 7611 (put 'org-agenda-tag-filter :preset-filter nil) 7612 (put 'org-agenda-category-filter :preset-filter nil) 7613 (put 'org-agenda-regexp-filter :preset-filter nil) 7614 (put 'org-agenda-effort-filter :preset-filter nil) 7615 (and cols (org-columns-quit)) 7616 (message "Rebuilding agenda buffer...") 7617 (if series-redo-cmd 7618 (eval series-redo-cmd t) 7619 (cl-progv 7620 (mapcar #'car lprops) 7621 (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) 7622 (eval redo-cmd t))) 7623 (setq org-agenda-undo-list nil 7624 org-agenda-pending-undo-list nil 7625 org-agenda-tag-filter tag-filter 7626 org-agenda-category-filter cat-filter 7627 org-agenda-regexp-filter re-filter 7628 org-agenda-effort-filter effort-filter 7629 org-agenda-top-headline-filter top-hl-filter) 7630 (message "Rebuilding agenda buffer...done") 7631 (put 'org-agenda-tag-filter :preset-filter tag-preset) 7632 (put 'org-agenda-category-filter :preset-filter cat-preset) 7633 (put 'org-agenda-regexp-filter :preset-filter re-preset) 7634 (put 'org-agenda-effort-filter :preset-filter effort-preset) 7635 (let ((tag (or tag-filter tag-preset)) 7636 (cat (or cat-filter cat-preset)) 7637 (effort (or effort-filter effort-preset)) 7638 (re (or re-filter re-preset))) 7639 (when tag (org-agenda-filter-apply tag 'tag t)) 7640 (when cat (org-agenda-filter-apply cat 'category)) 7641 (when effort (org-agenda-filter-apply effort 'effort)) 7642 (when re (org-agenda-filter-apply re 'regexp))) 7643 (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) 7644 (and cols (called-interactively-p 'any) (org-agenda-columns)) 7645 (org-goto-line line) 7646 (when (called-interactively-p 'any) (recenter window-line)))) 7647 7648 (defun org-agenda-redo-all (&optional exhaustive) 7649 "Rebuild all agenda views in the current buffer. 7650 With a prefix argument, do so in all agenda buffers." 7651 (interactive "P") 7652 (if exhaustive 7653 (dolist (buffer (buffer-list)) 7654 (with-current-buffer buffer 7655 (when (derived-mode-p 'org-agenda-mode) 7656 (org-agenda-redo t)))) 7657 (org-agenda-redo t))) 7658 7659 (defvar org-global-tags-completion-table nil) 7660 (defvar org-agenda-filter-form nil) 7661 (defvar org-agenda-filtered-by-category nil) 7662 7663 (defsubst org-agenda-get-category () 7664 "Return the category of the agenda line." 7665 (org-get-at-bol 'org-category)) 7666 7667 (defun org-agenda-filter-by-category (strip) 7668 "Filter lines in the agenda buffer that have a specific category. 7669 The category is that of the current line. 7670 With a `\\[universal-argument]' prefix argument, exclude the lines of that category. 7671 When there is already a category filter in place, this command removes the 7672 filter." 7673 (interactive "P") 7674 (if (and org-agenda-filtered-by-category 7675 org-agenda-category-filter) 7676 (org-agenda-filter-show-all-cat) 7677 (let ((cat (org-no-properties (org-get-at-eol 'org-category 1)))) 7678 (cond 7679 ((and cat strip) 7680 (org-agenda-filter-apply 7681 (push (concat "-" cat) org-agenda-category-filter) 'category)) 7682 (cat 7683 (org-agenda-filter-apply 7684 (setq org-agenda-category-filter 7685 (list (concat "+" cat))) 7686 'category)) 7687 (t (error "No category at point")))))) 7688 7689 (defun org-find-top-headline (&optional pos) 7690 "Find the topmost parent headline and return it. 7691 POS when non-nil is the marker or buffer position to start the 7692 search from." 7693 (save-excursion 7694 (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) 7695 (when pos (goto-char pos)) 7696 ;; Skip up to the topmost parent. 7697 (while (org-up-heading-safe)) 7698 (ignore-errors 7699 (replace-regexp-in-string 7700 "^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" "" 7701 (nth 4 (org-heading-components))))))) 7702 7703 (defvar org-agenda-filtered-by-top-headline nil) 7704 (defun org-agenda-filter-by-top-headline (strip) 7705 "Keep only those lines that are descendants from the same top headline. 7706 The top headline is that of the current line. With prefix arg STRIP, hide 7707 all lines of the category at point." 7708 (interactive "P") 7709 (if org-agenda-filtered-by-top-headline 7710 (progn 7711 (setq org-agenda-filtered-by-top-headline nil 7712 org-agenda-top-headline-filter nil) 7713 (org-agenda-filter-show-all-top-filter)) 7714 (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker)))) 7715 (if toph (org-agenda-filter-top-headline-apply toph strip) 7716 (error "No top-level headline at point"))))) 7717 7718 (defvar org-agenda-regexp-filter nil) 7719 (defun org-agenda-filter-by-regexp (strip-or-accumulate) 7720 "Filter agenda entries by a regular expressions. 7721 You will be prompted for the regular expression, and the agenda 7722 view will only show entries that are matched by that expression. 7723 7724 With one `\\[universal-argument]' prefix argument, hide entries matching the regexp. 7725 When there is already a regexp filter active, this command removed the 7726 filter. However, with two `\\[universal-argument]' prefix arguments, add a new condition to 7727 an already existing regexp filter." 7728 (interactive "P") 7729 (let* ((strip (equal strip-or-accumulate '(4))) 7730 (accumulate (equal strip-or-accumulate '(16)))) 7731 (cond 7732 ((and org-agenda-regexp-filter (not accumulate)) 7733 (org-agenda-filter-show-all-re) 7734 (message "Regexp filter removed")) 7735 (t (let ((flt (concat (if strip "-" "+") 7736 (read-from-minibuffer 7737 (if strip 7738 "Hide entries matching regexp: " 7739 "Narrow to entries matching regexp: "))))) 7740 (push flt org-agenda-regexp-filter) 7741 (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)))))) 7742 7743 (defvar org-agenda-effort-filter nil) 7744 (defun org-agenda-filter-by-effort (strip-or-accumulate) 7745 "Filter agenda entries by effort. 7746 With no `\\[universal-argument]' prefix argument, keep entries matching the effort condition. 7747 With one `\\[universal-argument]' prefix argument, filter out entries matching the condition. 7748 With two `\\[universal-argument]' prefix arguments, add a second condition to the existing filter. 7749 This last option is in practice not very useful, but it is available for 7750 consistency with the other filter commands." 7751 (interactive "P") 7752 (let* ((efforts (split-string 7753 (or (cdr (assoc-string (concat org-effort-property "_ALL") 7754 org-global-properties 7755 t)) 7756 "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00"))) 7757 ;; XXX: the following handles only up to 10 different 7758 ;; effort values. 7759 (allowed-keys (if (null efforts) nil 7760 (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0 7761 (number-sequence 1 (length efforts))))) 7762 (keep (equal strip-or-accumulate '(16))) 7763 (negative (equal strip-or-accumulate '(4))) 7764 (current org-agenda-effort-filter) 7765 (op nil)) 7766 (while (not (memq op '(?< ?> ?= ?_))) 7767 (setq op (read-char-exclusive 7768 "Effort operator? (> = or <) or press `_' again to remove filter"))) 7769 ;; Select appropriate duration. Ignore non-digit characters. 7770 (if (eq op ?_) 7771 (progn 7772 (org-agenda-filter-show-all-effort) 7773 (message "Effort filter removed")) 7774 (let ((prompt 7775 (apply #'format 7776 (concat "Effort %c " 7777 (mapconcat (lambda (s) (concat "[%d]" s)) 7778 efforts 7779 " ")) 7780 op allowed-keys)) 7781 (eff -1)) 7782 (while (not (memq eff allowed-keys)) 7783 (message prompt) 7784 (setq eff (- (read-char-exclusive) 48))) 7785 (org-agenda-filter-show-all-effort) 7786 (setq org-agenda-effort-filter 7787 (append 7788 (list (concat (if negative "-" "+") 7789 (char-to-string op) 7790 ;; Numbering is 1 2 3 ... 9 0, but we want 7791 ;; 0 1 2 ... 8 9. 7792 (nth (mod (1- eff) 10) efforts))) 7793 (if keep current nil))) 7794 (org-agenda-filter-apply org-agenda-effort-filter 'effort))))) 7795 7796 (defun org-agenda-filter (&optional strip-or-accumulate) 7797 "Prompt for a general filter string and apply it to the agenda. 7798 7799 The string may contain filter elements like 7800 7801 +category 7802 +tag 7803 +<effort > and = are also allowed as effort operators 7804 +/regexp/ 7805 7806 Instead of `+', `-' is allowed to strip the agenda of matching entries. 7807 `+' is optional if it is not required to separate two string parts. 7808 Multiple filter elements can be concatenated without spaces, for example 7809 7810 +work-John<0:10-/plot/ 7811 7812 selects entries with category `work' and effort estimates below 10 minutes, 7813 and deselects entries with tag `John' or matching the regexp `plot'. 7814 7815 During entry of the filter, completion for tags, categories and effort 7816 values is offered. Since the syntax for categories and tags is identical 7817 there should be no overlap between categories and tags. If there is, tags 7818 get priority. 7819 7820 A single `\\[universal-argument]' prefix arg STRIP-OR-ACCUMULATE will negate the 7821 entire filter, which can be useful in connection with the prompt history. 7822 7823 A double `\\[universal-argument] \\[universal-argument]' prefix arg will add the new filter elements to the 7824 existing ones. A shortcut for this is to add an additional `+' at the 7825 beginning of the string, like `+-John'. 7826 7827 With a triple prefix argument, execute the computed filtering defined in 7828 the variable `org-agenda-auto-exclude-function'." 7829 (interactive "P") 7830 (if (equal strip-or-accumulate '(64)) 7831 ;; Execute the auto-exclude action 7832 (if (not org-agenda-auto-exclude-function) 7833 (user-error "`org-agenda-auto-exclude-function' is undefined") 7834 (org-agenda-filter-show-all-tag) 7835 (setq org-agenda-tag-filter nil) 7836 (dolist (tag (org-agenda-get-represented-tags)) 7837 (let ((modifier (funcall org-agenda-auto-exclude-function tag))) 7838 (when modifier 7839 (push modifier org-agenda-tag-filter)))) 7840 (unless (null org-agenda-tag-filter) 7841 (org-agenda-filter-apply org-agenda-tag-filter 'tag 'expand))) 7842 ;; Prompt for a filter and act 7843 (let* ((tag-list (org-agenda-get-represented-tags)) 7844 (category-list (org-agenda-get-represented-categories)) 7845 (negate (equal strip-or-accumulate '(4))) 7846 (cf (mapconcat #'identity org-agenda-category-filter "")) 7847 (tf (mapconcat #'identity org-agenda-tag-filter "")) 7848 ;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) "")))) 7849 (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) ""))) 7850 (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) ""))) 7851 (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/")))) 7852 (f-string (completing-read 7853 (concat 7854 (if negate "Negative filter" "Filter") 7855 " [+cat-tag<0:10-/regexp/]: ") 7856 #'org-agenda-filter-completion-function 7857 nil nil ff)) 7858 (keep (or (if (string-match "^\\+[+-]" f-string) 7859 (progn (setq f-string (substring f-string 1)) t)) 7860 (equal strip-or-accumulate '(16)))) 7861 (fc (if keep org-agenda-category-filter)) 7862 (ft (if keep org-agenda-tag-filter)) 7863 (fe (if keep org-agenda-effort-filter)) 7864 (fr (if keep org-agenda-regexp-filter)) 7865 pm s) 7866 ;; If the filter contains a double-quoted string, replace a 7867 ;; single hyphen by the arbitrary and temporary string "~~~" 7868 ;; to disambiguate such hyphens from syntactic ones. 7869 (setq f-string (replace-regexp-in-string 7870 "\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string)) 7871 (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string) 7872 (setq pm (if (match-beginning 1) (match-string 1 f-string) "+")) 7873 (when negate 7874 (setq pm (if (equal pm "+") "-" "+"))) 7875 (cond 7876 ((match-beginning 3) 7877 ;; category or tag 7878 (setq s (replace-regexp-in-string ; Remove the temporary special string. 7879 "~~~" "-" (match-string 3 f-string))) 7880 (cond 7881 ((member s tag-list) 7882 (org-pushnew-to-end (concat pm s) ft)) 7883 ((member s category-list) 7884 (org-pushnew-to-end (concat pm ; Remove temporary double quotes. 7885 (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s)) 7886 fc)) 7887 (t (message 7888 "`%s%s' filter ignored because tag/category is not represented" 7889 pm s)))) 7890 ((match-beginning 4) 7891 ;; effort 7892 (org-pushnew-to-end (concat pm (match-string 4 f-string)) fe)) 7893 ((match-beginning 5) 7894 ;; regexp 7895 (org-pushnew-to-end (concat pm (match-string 6 f-string)) fr))) 7896 (setq f-string (substring f-string (match-end 0)))) 7897 (org-agenda-filter-remove-all) 7898 (and fc (org-agenda-filter-apply 7899 (setq org-agenda-category-filter fc) 'category)) 7900 (and ft (org-agenda-filter-apply 7901 (setq org-agenda-tag-filter ft) 'tag 'expand)) 7902 (and fe (org-agenda-filter-apply 7903 (setq org-agenda-effort-filter fe) 'effort)) 7904 (and fr (org-agenda-filter-apply 7905 (setq org-agenda-regexp-filter fr) 'regexp)) 7906 (run-hooks 'org-agenda-filter-hook)))) 7907 7908 (defun org-agenda-filter-completion-function (string _predicate &optional flag) 7909 "Complete a complex filter string. 7910 FLAG specifies the type of completion operation to perform. This 7911 function is passed as a collection function to `completing-read', 7912 which see." 7913 (let ((completion-ignore-case t) ;tags are case-sensitive 7914 (confirm (lambda (x) (stringp x))) 7915 (prefix "") 7916 (operator "") 7917 table) 7918 (when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string) 7919 (setq prefix (match-string 1 string) 7920 operator (match-string 2 string) 7921 string (match-string 3 string))) 7922 (cond 7923 ((member operator '("+" "-" "" nil)) 7924 (setq table (append (org-agenda-get-represented-categories) 7925 (org-agenda-get-represented-tags)))) 7926 ((member operator '("<" ">" "=")) 7927 (setq table (split-string 7928 (or (cdr (assoc-string (concat org-effort-property "_ALL") 7929 org-global-properties 7930 t)) 7931 "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00") 7932 " +"))) 7933 (t (setq table nil))) 7934 (pcase flag 7935 (`t (all-completions string table confirm)) 7936 (`lambda (assoc string table)) ;exact match? 7937 (`nil 7938 (pcase (try-completion string table confirm) 7939 ((and completion (pred stringp)) 7940 (concat prefix completion)) 7941 (completion completion))) 7942 (_ nil)))) 7943 7944 (defun org-agenda-filter-remove-all () 7945 "Remove all filters from the current agenda buffer." 7946 (interactive) 7947 (when org-agenda-tag-filter 7948 (org-agenda-filter-show-all-tag)) 7949 (when org-agenda-category-filter 7950 (org-agenda-filter-show-all-cat)) 7951 (when org-agenda-regexp-filter 7952 (org-agenda-filter-show-all-re)) 7953 (when org-agenda-top-headline-filter 7954 (org-agenda-filter-show-all-top-filter)) 7955 (when org-agenda-effort-filter 7956 (org-agenda-filter-show-all-effort)) 7957 (org-agenda-finalize) 7958 (when (called-interactively-p 'interactive) 7959 (message "All agenda filters removed"))) 7960 7961 (defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude) 7962 "Keep only those lines in the agenda buffer that have a specific tag. 7963 7964 The tag is selected with its fast selection letter, as configured. 7965 7966 With a `\\[universal-argument]' prefix, apply the filter negatively, stripping all matches. 7967 7968 With a `\\[universal-argument] \\[universal-argument]' prefix, add the new tag to the existing filter 7969 instead of replacing it. 7970 7971 With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \ 7972 i.e. don't 7973 filter on all its group members. 7974 7975 A Lisp caller can specify CHAR. EXCLUDE means that the new tag 7976 should be used to exclude the search - the interactive user can 7977 also press `-' or `+' to switch between filtering and excluding." 7978 (interactive "P") 7979 (let* ((alist org-tag-alist-for-agenda) 7980 (seen-chars nil) 7981 (tag-chars (mapconcat 7982 (lambda (x) (if (and (not (symbolp (car x))) 7983 (cdr x) 7984 (not (member (cdr x) seen-chars))) 7985 (progn 7986 (push (cdr x) seen-chars) 7987 (char-to-string (cdr x))) 7988 "")) 7989 org-tag-alist-for-agenda "")) 7990 (valid-char-list (append '(?\t ?\r ?\\ ?. ?\s ?q) 7991 (string-to-list tag-chars))) 7992 (exclude (or exclude (equal strip-or-accumulate '(4)))) 7993 (accumulate (equal strip-or-accumulate '(16))) 7994 (expand (not (equal strip-or-accumulate '(64)))) 7995 (inhibit-read-only t) 7996 (current org-agenda-tag-filter) 7997 a tag) ;; n 7998 (unless char 7999 (while (not (memq char valid-char-list)) 8000 (org-unlogged-message 8001 "%s by tag%s: [%s ]tag-char [TAB]tag %s[\\]off [q]uit" 8002 (if exclude "Exclude[+]" "Filter[-]") 8003 (if expand "" " (no grouptag expand)") 8004 tag-chars 8005 (if org-agenda-auto-exclude-function "[RET] " "")) 8006 (setq char (read-char-exclusive)) 8007 ;; Excluding or filtering down 8008 (cond ((eq char ?-) (setq exclude t)) 8009 ((eq char ?+) (setq exclude nil))))) 8010 (when (eq char ?\t) 8011 (unless (local-variable-p 'org-global-tags-completion-table) 8012 (setq-local org-global-tags-completion-table 8013 (org-global-tags-completion-table))) 8014 (let ((completion-ignore-case t)) 8015 (setq tag (completing-read 8016 "Tag: " org-global-tags-completion-table nil t)))) 8017 (cond 8018 ((eq char ?\r) 8019 (org-agenda-filter-show-all-tag) 8020 (when org-agenda-auto-exclude-function 8021 (setq org-agenda-tag-filter nil) 8022 (dolist (tag (org-agenda-get-represented-tags)) 8023 (let ((modifier (funcall org-agenda-auto-exclude-function tag))) 8024 (when modifier 8025 (push modifier org-agenda-tag-filter)))) 8026 (unless (null org-agenda-tag-filter) 8027 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))) 8028 ((eq char ?\\) 8029 (org-agenda-filter-show-all-tag) 8030 (when (get 'org-agenda-tag-filter :preset-filter) 8031 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))) 8032 ((eq char ?.) 8033 (setq org-agenda-tag-filter 8034 (mapcar (lambda(tag) (concat "+" tag)) 8035 (org-get-at-bol 'tags))) 8036 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)) 8037 ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...) 8038 ((or (eq char ?\s) 8039 (setq a (rassoc char alist)) 8040 (and tag (setq a (cons tag nil)))) 8041 (org-agenda-filter-show-all-tag) 8042 (setq tag (car a)) 8043 (setq org-agenda-tag-filter 8044 (cons (concat (if exclude "-" "+") tag) 8045 (if accumulate current nil))) 8046 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)) 8047 (t (error "Invalid tag selection character %c" char))))) 8048 8049 (defun org-agenda-get-represented-categories () 8050 "Return a list of all categories used in this agenda buffer." 8051 (or org-agenda-represented-categories 8052 (when (derived-mode-p 'org-agenda-mode) 8053 (let ((pos (point-min)) categories) 8054 (while (and (< pos (point-max)) 8055 (setq pos (next-single-property-change 8056 pos 'org-category nil (point-max)))) 8057 (push (get-text-property pos 'org-category) categories)) 8058 (setq org-agenda-represented-categories 8059 ;; Enclose category names with a hyphen in double 8060 ;; quotes to process them specially in `org-agenda-filter'. 8061 (mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s)) 8062 (nreverse (org-uniquify (delq nil categories))))))))) 8063 8064 (defvar org-tag-groups-alist-for-agenda) 8065 (defun org-agenda-get-represented-tags () 8066 "Return a list of all tags used in this agenda buffer. 8067 These will be lower-case, for filtering." 8068 (or org-agenda-represented-tags 8069 (when (derived-mode-p 'org-agenda-mode) 8070 (let ((pos (point-min)) tags-lists tt) 8071 (while (and (< pos (point-max)) 8072 (setq pos (next-single-property-change 8073 pos 'tags nil (point-max)))) 8074 (setq tt (get-text-property pos 'tags)) 8075 (if tt (push tt tags-lists))) 8076 (setq tags-lists 8077 (nreverse (org-uniquify 8078 (delq nil (apply #'append tags-lists))))) 8079 (dolist (tag tags-lists) 8080 (mapc 8081 (lambda (group) 8082 (when (member tag group) 8083 (push (car group) tags-lists))) 8084 org-tag-groups-alist-for-agenda)) 8085 (setq org-agenda-represented-tags tags-lists))))) 8086 8087 (defun org-agenda-filter-make-matcher (filter type &optional expand) 8088 "Create the form that tests a line for agenda filter. 8089 Optional argument EXPAND can be used for the TYPE tag and will 8090 expand the tags in the FILTER if any of the tags in FILTER are 8091 grouptags." 8092 (let ((multi-pos-cats 8093 (and (eq type 'category) 8094 (string-match-p "\\+.*\\+" 8095 (mapconcat (lambda (cat) (substring cat 0 1)) 8096 filter "")))) 8097 f f1) 8098 (cond 8099 ;; Tag filter 8100 ((eq type 'tag) 8101 (setq filter 8102 (delete-dups 8103 (append (get 'org-agenda-tag-filter :preset-filter) 8104 filter))) 8105 (dolist (x filter) 8106 (let ((op (string-to-char x))) 8107 (if expand (setq x (org-agenda-filter-expand-tags (list x) t)) 8108 (setq x (list x))) 8109 (setq f1 (org-agenda-filter-make-matcher-tag-exp x op)) 8110 (push f1 f)))) 8111 ;; Category filter 8112 ((eq type 'category) 8113 (setq filter 8114 (delete-dups 8115 (append (get 'org-agenda-category-filter :preset-filter) 8116 filter))) 8117 (dolist (x filter) 8118 (if (equal "-" (substring x 0 1)) 8119 (setq f1 (list 'not (list 'equal (substring x 1) 'cat))) 8120 (setq f1 (list 'equal (substring x 1) 'cat))) 8121 (push f1 f))) 8122 ;; Regexp filter 8123 ((eq type 'regexp) 8124 (setq filter 8125 (delete-dups 8126 (append (get 'org-agenda-regexp-filter :preset-filter) 8127 filter))) 8128 (dolist (x filter) 8129 (if (equal "-" (substring x 0 1)) 8130 (setq f1 (list 'not (list 'string-match (substring x 1) 'txt))) 8131 (setq f1 (list 'string-match (substring x 1) 'txt))) 8132 (push f1 f))) 8133 ;; Effort filter 8134 ((eq type 'effort) 8135 (setq filter 8136 (delete-dups 8137 (append (get 'org-agenda-effort-filter :preset-filter) 8138 filter))) 8139 (dolist (x filter) 8140 (push (org-agenda-filter-effort-form x) f)))) 8141 (cons (if multi-pos-cats 'or 'and) (nreverse f)))) 8142 8143 (defun org-agenda-filter-make-matcher-tag-exp (tags op) 8144 "Return a form associated to tag-expression TAGS. 8145 Build a form testing a line for agenda filter for 8146 tag-expressions. OP is an operator of type CHAR that allows the 8147 function to set the right switches in the returned form." 8148 (let (form) 8149 ;; Any of the expressions can match if OP is +, all must match if 8150 ;; the operator is -. 8151 (dolist (x tags (cons (if (eq op ?-) 'and 'or) form)) 8152 (let* ((tag (substring x 1)) 8153 (f (cond 8154 ((string= "" tag) 'tags) 8155 ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag)) 8156 ;; TAG is a regexp. 8157 (list 'org-match-any-p (substring tag 1 -1) 'tags)) 8158 (t (list 'member tag 'tags))))) 8159 (push (if (eq op ?-) (list 'not f) f) form))))) 8160 8161 (defun org-agenda-filter-effort-form (e) 8162 "Return the form to compare the effort of the current line with what E says. 8163 E looks like \"+<2:25\"." 8164 (let (op) 8165 (setq e (substring e 1)) 8166 (setq op (string-to-char e) e (substring e 1)) 8167 (setq op (cond ((equal op ?<) '<=) 8168 ((equal op ?>) '>=) 8169 ((equal op ??) op) 8170 (t '=))) 8171 (list 'org-agenda-compare-effort (list 'quote op) 8172 (org-duration-to-minutes e)))) 8173 8174 (defun org-agenda-compare-effort (op value) 8175 "Compare the effort of the current line with VALUE, using OP. 8176 If the line does not have an effort defined, return nil." 8177 ;; `effort-minutes' property cannot be extracted directly from 8178 ;; current line but is stored as a property in `txt'. 8179 (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt)))) 8180 (funcall op 8181 (or effort (if org-agenda-sort-noeffort-is-high 32767 -1)) 8182 value))) 8183 8184 (defun org-agenda-filter-expand-tags (filter &optional no-operator) 8185 "Expand group tags in FILTER for the agenda. 8186 When NO-OPERATOR is non-nil, do not add the + operator to 8187 returned tags." 8188 (if org-group-tags 8189 (let (case-fold-search rtn) 8190 (mapc 8191 (lambda (f) 8192 (let (f0 dir) 8193 (if (string-match "^\\([+-]\\)\\(.+\\)" f) 8194 (setq dir (match-string 1 f) f0 (match-string 2 f)) 8195 (setq dir (if no-operator "" "+") f0 f)) 8196 (setq rtn (append (mapcar (lambda(f1) (concat dir f1)) 8197 (org-tags-expand f0 t)) 8198 rtn)))) 8199 filter) 8200 (reverse rtn)) 8201 filter)) 8202 8203 (defun org-agenda-filter-apply (filter type &optional expand) 8204 "Set FILTER as the new agenda filter and apply it. 8205 Optional argument EXPAND can be used for the TYPE tag and will 8206 expand the tags in the FILTER if any of the tags in FILTER are 8207 grouptags." 8208 ;; Deactivate `org-agenda-entry-text-mode' when filtering 8209 (when org-agenda-entry-text-mode (org-agenda-entry-text-mode)) 8210 (setq org-agenda-filter-form (org-agenda-filter-make-matcher 8211 filter type expand)) 8212 ;; Only set `org-agenda-filtered-by-category' to t when a unique 8213 ;; category is used as the filter: 8214 (setq org-agenda-filtered-by-category 8215 (and (eq type 'category) 8216 (not (equal (substring (car filter) 0 1) "-")))) 8217 (org-agenda-set-mode-name) 8218 (save-excursion 8219 (goto-char (point-min)) 8220 (while (not (eobp)) 8221 (when (or (org-get-at-bol 'org-hd-marker) 8222 (org-get-at-bol 'org-marker)) 8223 (org-dlet 8224 ((tags (org-get-at-bol 'tags)) 8225 (cat (org-agenda-get-category)) 8226 (txt (or (org-get-at-bol 'txt) ""))) 8227 (unless (eval org-agenda-filter-form t) 8228 (org-agenda-filter-hide-line type)))) 8229 (beginning-of-line 2))) 8230 (when (get-char-property (point) 'invisible) 8231 (ignore-errors (org-agenda-previous-line)))) 8232 8233 (defun org-agenda-filter-top-headline-apply (hl &optional negative) 8234 "Filter by top headline HL." 8235 (org-agenda-set-mode-name) 8236 (save-excursion 8237 (goto-char (point-min)) 8238 (while (not (eobp)) 8239 (let* ((pos (org-get-at-bol 'org-hd-marker)) 8240 (tophl (and pos (org-find-top-headline pos)))) 8241 (when (and tophl (funcall (if negative 'identity 'not) 8242 (string= hl tophl))) 8243 (org-agenda-filter-hide-line 'top-headline))) 8244 (beginning-of-line 2))) 8245 (when (get-char-property (point) 'invisible) 8246 (org-agenda-previous-line)) 8247 (setq org-agenda-top-headline-filter hl 8248 org-agenda-filtered-by-top-headline t)) 8249 8250 (defun org-agenda-filter-hide-line (type) 8251 "If current line is TYPE, hide it in the agenda buffer." 8252 (let* (buffer-invisibility-spec 8253 (beg (max (point-min) (1- (point-at-bol)))) 8254 (end (point-at-eol))) 8255 (let ((inhibit-read-only t)) 8256 (add-text-properties 8257 beg end `(invisible org-filtered org-filter-type ,type))))) 8258 8259 (defun org-agenda-remove-filter (type) 8260 "Remove filter of type TYPE from the agenda buffer." 8261 (interactive) 8262 (save-excursion 8263 (goto-char (point-min)) 8264 (let ((inhibit-read-only t) pos) 8265 (while (setq pos (text-property-any (point) (point-max) 8266 'org-filter-type type)) 8267 (goto-char pos) 8268 (remove-text-properties 8269 (point) (next-single-property-change (point) 'org-filter-type) 8270 `(invisible org-filtered org-filter-type ,type)))) 8271 (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil) 8272 (setq org-agenda-filter-form nil) 8273 (org-agenda-set-mode-name) 8274 (org-agenda-finalize))) 8275 8276 (defun org-agenda-filter-show-all-tag nil 8277 (org-agenda-remove-filter 'tag)) 8278 (defun org-agenda-filter-show-all-re nil 8279 (org-agenda-remove-filter 'regexp)) 8280 (defun org-agenda-filter-show-all-effort nil 8281 (org-agenda-remove-filter 'effort)) 8282 (defun org-agenda-filter-show-all-cat nil 8283 (org-agenda-remove-filter 'category)) 8284 (defun org-agenda-filter-show-all-top-filter nil 8285 (org-agenda-remove-filter 'top-headline)) 8286 8287 (defun org-agenda-manipulate-query-add () 8288 "Manipulate the query by adding a search term with positive selection. 8289 Positive selection means the term must be matched for selection of an entry." 8290 (interactive) 8291 (org-agenda-manipulate-query ?\[)) 8292 (defun org-agenda-manipulate-query-subtract () 8293 "Manipulate the query by adding a search term with negative selection. 8294 Negative selection means term must not be matched for selection of an entry." 8295 (interactive) 8296 (org-agenda-manipulate-query ?\])) 8297 (defun org-agenda-manipulate-query-add-re () 8298 "Manipulate the query by adding a search regexp with positive selection. 8299 Positive selection means the regexp must match for selection of an entry." 8300 (interactive) 8301 (org-agenda-manipulate-query ?\{)) 8302 (defun org-agenda-manipulate-query-subtract-re () 8303 "Manipulate the query by adding a search regexp with negative selection. 8304 Negative selection means regexp must not match for selection of an entry." 8305 (interactive) 8306 (org-agenda-manipulate-query ?\})) 8307 (defun org-agenda-manipulate-query (char) 8308 (cond 8309 ((eq org-agenda-type 'agenda) 8310 (let ((org-agenda-include-inactive-timestamps t)) 8311 (org-agenda-redo)) 8312 (message "Display now includes inactive timestamps as well")) 8313 ((eq org-agenda-type 'search) 8314 (org-add-to-string 8315 'org-agenda-query-string 8316 (if org-agenda-last-search-view-search-was-boolean 8317 (cdr (assoc char '((?\[ . " +") (?\] . " -") 8318 (?\{ . " +{}") (?\} . " -{}")))) 8319 " ")) 8320 (setq org-agenda-redo-command 8321 (list 'org-search-view 8322 (car (get-text-property (min (1- (point-max)) (point)) 8323 'org-last-args)) 8324 org-agenda-query-string 8325 (+ (length org-agenda-query-string) 8326 (if (member char '(?\{ ?\})) 0 1)))) 8327 (set-register org-agenda-query-register org-agenda-query-string) 8328 (let ((org-agenda-overriding-arguments 8329 (cdr org-agenda-redo-command))) 8330 (org-agenda-redo))) 8331 (t (error "Cannot manipulate query for %s-type agenda buffers" 8332 org-agenda-type)))) 8333 8334 (defun org-add-to-string (var string) 8335 (set var (concat (symbol-value var) string))) 8336 8337 (defun org-agenda-goto-date (date) 8338 "Jump to DATE in agenda." 8339 (interactive 8340 (list 8341 (let ((org-read-date-prefer-future org-agenda-jump-prefer-future)) 8342 (org-read-date)))) 8343 (let* ((day (time-to-days (org-time-string-to-time date))) 8344 (org-agenda-sticky-orig org-agenda-sticky) 8345 (org-agenda-buffer-tmp-name (buffer-name)) 8346 (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8347 (0-arg (or current-prefix-arg (car args))) 8348 (2-arg (nth 2 args)) 8349 (with-hour-p (nth 4 org-agenda-redo-command)) 8350 (newcmd (list 'org-agenda-list 0-arg date 8351 (org-agenda-span-to-ndays 8352 2-arg (org-time-string-to-absolute date)) 8353 with-hour-p)) 8354 (newargs (cdr newcmd)) 8355 (inhibit-read-only t) 8356 org-agenda-sticky) 8357 (if (not (org-agenda-check-type t 'agenda)) 8358 (error "Not available in non-agenda views") 8359 (add-text-properties (point-min) (point-max) 8360 `(org-redo-cmd ,newcmd org-last-args ,newargs)) 8361 (org-agenda-redo) 8362 (goto-char (point-min)) 8363 (while (not (or (= (or (get-text-property (point) 'day) 0) day) 8364 (save-excursion (move-beginning-of-line 2) (eobp)))) 8365 (move-beginning-of-line 2)) 8366 (setq org-agenda-sticky org-agenda-sticky-orig 8367 org-agenda-this-buffer-is-sticky org-agenda-sticky)))) 8368 8369 (defun org-agenda-goto-today () 8370 "Go to today." 8371 (interactive) 8372 (org-agenda-check-type t 'agenda) 8373 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8374 (curspan (nth 2 args)) 8375 (tdpos (text-property-any (point-min) (point-max) 'org-today t))) 8376 (cond 8377 (tdpos (goto-char tdpos)) 8378 ((eq org-agenda-type 'agenda) 8379 (let* ((sd (org-agenda-compute-starting-span 8380 (org-today) (or curspan org-agenda-span))) 8381 (org-agenda-overriding-arguments args)) 8382 (setf (nth 1 org-agenda-overriding-arguments) sd) 8383 (org-agenda-redo) 8384 (org-agenda-find-same-or-today-or-agenda))) 8385 (t (error "Cannot find today"))))) 8386 8387 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt) 8388 (goto-char 8389 (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) 8390 (text-property-any (point-min) (point-max) 'org-today t) 8391 (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) 8392 (and (get-text-property (min (1- (point-max)) (point)) 'org-series) 8393 (org-agenda-backward-block)) 8394 (point-min)))) 8395 8396 (defun org-agenda-backward-block () 8397 "Move backward by one agenda block." 8398 (interactive) 8399 (org-agenda-forward-block 'backward)) 8400 8401 (defun org-agenda-forward-block (&optional backward) 8402 "Move forward by one agenda block. 8403 When optional argument BACKWARD is set, go backward." 8404 (interactive) 8405 (cond ((not (derived-mode-p 'org-agenda-mode)) 8406 (user-error 8407 "Cannot execute this command outside of org-agenda-mode buffers")) 8408 ((looking-at (if backward "\\`" "\\'")) 8409 (message "Already at the %s block" (if backward "first" "last"))) 8410 (t (let ((_pos (prog1 (point) 8411 (ignore-errors (if backward (backward-char 1) 8412 (move-end-of-line 1))))) 8413 (f (if backward 8414 #'previous-single-property-change 8415 #'next-single-property-change)) 8416 moved dest) 8417 (while (and (setq dest (funcall 8418 f (point) 'org-agenda-structural-header)) 8419 (not (get-text-property 8420 (point) 'org-agenda-structural-header))) 8421 (setq moved t) 8422 (goto-char dest)) 8423 (if moved (move-beginning-of-line 1) 8424 (goto-char (if backward (point-min) (point-max))) 8425 (move-beginning-of-line 1) 8426 (message "No %s block" (if backward "previous" "further"))))))) 8427 8428 (defun org-agenda-later (arg) 8429 "Go forward in time by the current span. 8430 With prefix ARG, go forward that many times the current span." 8431 (interactive "p") 8432 (org-agenda-check-type t 'agenda) 8433 (let* ((wstart (window-start)) 8434 (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8435 (span (or (nth 2 args) org-agenda-current-span)) 8436 (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day)) 8437 (greg (calendar-gregorian-from-absolute sd)) 8438 (cnt (org-get-at-bol 'org-day-cnt)) 8439 greg2) 8440 (cond 8441 ((numberp span) 8442 (setq sd (+ (* span arg) sd))) 8443 ((eq span 'day) 8444 (setq sd (+ arg sd))) 8445 ((eq span 'week) 8446 (setq sd (+ (* 7 arg) sd))) 8447 ((eq span 'fortnight) 8448 (setq sd (+ (* 14 arg) sd))) 8449 ((eq span 'month) 8450 (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) 8451 sd (calendar-absolute-from-gregorian greg2)) 8452 (setcar greg2 (1+ (car greg2)))) 8453 ((eq span 'year) 8454 (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) 8455 sd (calendar-absolute-from-gregorian greg2)) 8456 (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) 8457 (t 8458 (setq sd (+ (* span arg) sd)))) 8459 (let ((org-agenda-overriding-cmd 8460 ;; `cmd' may have been set by `org-agenda-run-series' which 8461 ;; uses `org-agenda-overriding-cmd' to decide whether 8462 ;; overriding is allowed for `cmd' 8463 (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) 8464 (org-agenda-overriding-arguments 8465 (list (car args) sd span))) 8466 (org-agenda-redo) 8467 (org-agenda-find-same-or-today-or-agenda cnt)) 8468 (set-window-start nil wstart))) 8469 8470 (defun org-agenda-earlier (arg) 8471 "Go backward in time by the current span. 8472 With prefix ARG, go backward that many times the current span." 8473 (interactive "p") 8474 (org-agenda-later (- arg))) 8475 8476 (defun org-agenda-view-mode-dispatch () 8477 "Call one of the view mode commands." 8478 (interactive) 8479 (org-unlogged-message 8480 "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort 8481 time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck 8482 [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") 8483 (pcase (read-char-exclusive) 8484 (?\ (call-interactively 'org-agenda-reset-view)) 8485 (?d (call-interactively 'org-agenda-day-view)) 8486 (?w (call-interactively 'org-agenda-week-view)) 8487 (?t (call-interactively 'org-agenda-fortnight-view)) 8488 (?m (call-interactively 'org-agenda-month-view)) 8489 (?y (call-interactively 'org-agenda-year-view)) 8490 (?l (call-interactively 'org-agenda-log-mode)) 8491 (?L (org-agenda-log-mode '(4))) 8492 (?c (org-agenda-log-mode 'clockcheck)) 8493 ((or ?F ?f) (call-interactively 'org-agenda-follow-mode)) 8494 (?a (call-interactively 'org-agenda-archives-mode)) 8495 (?A (org-agenda-archives-mode 'files)) 8496 ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode)) 8497 ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode)) 8498 (?G (call-interactively 'org-agenda-toggle-time-grid)) 8499 (?D (call-interactively 'org-agenda-toggle-diary)) 8500 (?\! (call-interactively 'org-agenda-toggle-deadlines)) 8501 (?\[ (let ((org-agenda-include-inactive-timestamps t)) 8502 (org-agenda-check-type t 'agenda) 8503 (org-agenda-redo)) 8504 (message "Display now includes inactive timestamps as well")) 8505 (?q (message "Abort")) 8506 (key (user-error "Invalid key: %s" key)))) 8507 8508 (defun org-agenda-reset-view () 8509 "Switch to default view for agenda." 8510 (interactive) 8511 (org-agenda-change-time-span org-agenda-span)) 8512 8513 (defun org-agenda-day-view (&optional day-of-month) 8514 "Switch to daily view for agenda. 8515 With argument DAY-OF-MONTH, switch to that day of the month." 8516 (interactive "P") 8517 (org-agenda-change-time-span 'day day-of-month)) 8518 8519 (defun org-agenda-week-view (&optional iso-week) 8520 "Switch to weekly view for agenda. 8521 With argument ISO-WEEK, switch to the corresponding ISO week. 8522 If ISO-WEEK has more then 2 digits, only the last two encode 8523 the week. Any digits before this encode a year. So 200712 8524 means week 12 of year 2007. Years ranging from 70 years ago 8525 to 30 years in the future can also be written as 2-digit years." 8526 (interactive "P") 8527 (org-agenda-change-time-span 'week iso-week)) 8528 8529 (defun org-agenda-fortnight-view (&optional iso-week) 8530 "Switch to fortnightly view for agenda. 8531 With argument ISO-WEEK, switch to the corresponding ISO week. 8532 If ISO-WEEK has more then 2 digits, only the last two encode 8533 the week. Any digits before this encode a year. So 200712 8534 means week 12 of year 2007. Years ranging from 70 years ago 8535 to 30 years in the future can also be written as 2-digit years." 8536 (interactive "P") 8537 (org-agenda-change-time-span 'fortnight iso-week)) 8538 8539 (defun org-agenda-month-view (&optional month) 8540 "Switch to monthly view for agenda. 8541 With argument MONTH, switch to that month. If MONTH has more 8542 then 2 digits, only the last two encode the month. Any digits 8543 before this encode a year. So 200712 means December year 2007. 8544 Years ranging from 70 years ago to 30 years in the future can 8545 also be written as 2-digit years." 8546 (interactive "P") 8547 (org-agenda-change-time-span 'month month)) 8548 8549 (defun org-agenda-year-view (&optional year) 8550 "Switch to yearly view for agenda. 8551 With argument YEAR, switch to that year. Years ranging from 70 8552 years ago to 30 years in the future can also be written as 8553 2-digit years." 8554 (interactive "P") 8555 (when year 8556 (setq year (org-small-year-to-year year))) 8557 (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") 8558 (org-agenda-change-time-span 'year year) 8559 (error "Abort"))) 8560 8561 (defun org-agenda-change-time-span (span &optional n) 8562 "Change the agenda view to SPAN. 8563 SPAN may be `day', `week', `fortnight', `month', `year'." 8564 (org-agenda-check-type t 'agenda) 8565 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8566 (curspan (nth 2 args))) 8567 (when (and (not n) (equal curspan span)) 8568 (error "Viewing span is already \"%s\"" span)) 8569 (let* ((sd (or (org-get-at-bol 'day) 8570 (nth 1 args) 8571 org-starting-day)) 8572 (sd (org-agenda-compute-starting-span sd span n)) 8573 (org-agenda-overriding-cmd 8574 (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) 8575 (org-agenda-overriding-arguments 8576 (list (car args) sd span))) 8577 (org-agenda-redo) 8578 (org-agenda-find-same-or-today-or-agenda)) 8579 (org-agenda-set-mode-name) 8580 (message "Switched to %s view" span))) 8581 8582 (defun org-agenda-compute-starting-span (sd span &optional n) 8583 "Compute starting date for agenda. 8584 SPAN may be `day', `week', `fortnight', `month', `year'. The return value 8585 is a cons cell with the starting date and the number of days, 8586 so that the date SD will be in that range." 8587 (let* ((greg (calendar-gregorian-from-absolute sd)) 8588 ;; (dg (nth 1 greg)) 8589 (mg (car greg)) 8590 (yg (nth 2 greg))) 8591 (cond 8592 ((eq span 'day) 8593 (when n 8594 (setq sd (+ (calendar-absolute-from-gregorian 8595 (list mg 1 yg)) 8596 n -1)))) 8597 ((or (eq span 'week) (eq span 'fortnight)) 8598 (let* ((nt (calendar-day-of-week 8599 (calendar-gregorian-from-absolute sd))) 8600 (d (if org-agenda-start-on-weekday 8601 (- nt org-agenda-start-on-weekday) 8602 0)) 8603 y1) 8604 (setq sd (- sd (+ (if (< d 0) 7 0) d))) 8605 (when n 8606 (require 'cal-iso) 8607 (when (> n 99) 8608 (setq y1 (org-small-year-to-year (/ n 100)) 8609 n (mod n 100))) 8610 (setq sd 8611 (calendar-iso-to-absolute 8612 (list n 1 8613 (or y1 (nth 2 (calendar-iso-from-absolute sd))))))))) 8614 ((eq span 'month) 8615 (let (y1) 8616 (when (and n (> n 99)) 8617 (setq y1 (org-small-year-to-year (/ n 100)) 8618 n (mod n 100))) 8619 (setq sd (calendar-absolute-from-gregorian 8620 (list (or n mg) 1 (or y1 yg)))))) 8621 ((eq span 'year) 8622 (setq sd (calendar-absolute-from-gregorian 8623 (list 1 1 (or n yg)))))) 8624 sd)) 8625 8626 (defun org-agenda-next-date-line (&optional arg) 8627 "Jump to the next line indicating a date in agenda buffer." 8628 (interactive "p") 8629 (org-agenda-check-type t 'agenda) 8630 (beginning-of-line 1) 8631 ;; This does not work if user makes date format that starts with a blank 8632 (when (looking-at-p "^\\S-") (forward-char 1)) 8633 (unless (re-search-forward "^\\S-" nil t arg) 8634 (backward-char 1) 8635 (error "No next date after this line in this buffer")) 8636 (goto-char (match-beginning 0))) 8637 8638 (defun org-agenda-previous-date-line (&optional arg) 8639 "Jump to the previous line indicating a date in agenda buffer." 8640 (interactive "p") 8641 (org-agenda-check-type t 'agenda) 8642 (beginning-of-line 1) 8643 (unless (re-search-backward "^\\S-" nil t arg) 8644 (error "No previous date before this line in this buffer"))) 8645 8646 ;; Initialize the highlight 8647 (defvar org-hl (make-overlay 1 1)) 8648 (overlay-put org-hl 'face 'highlight) 8649 8650 (defun org-highlight (begin end &optional buffer) 8651 "Highlight a region with overlay." 8652 (move-overlay org-hl begin end (or buffer (current-buffer)))) 8653 8654 (defun org-unhighlight () 8655 "Detach overlay INDEX." 8656 (delete-overlay org-hl)) 8657 8658 (defun org-unhighlight-once () 8659 "Remove the highlight from its position, and this function from the hook." 8660 (remove-hook 'pre-command-hook #'org-unhighlight-once) 8661 (org-unhighlight)) 8662 8663 (defvar org-agenda-pre-follow-window-conf nil) 8664 (defun org-agenda-follow-mode () 8665 "Toggle follow mode in an agenda buffer." 8666 (interactive) 8667 (unless org-agenda-follow-mode 8668 (setq org-agenda-pre-follow-window-conf 8669 (current-window-configuration))) 8670 (setq org-agenda-follow-mode (not org-agenda-follow-mode)) 8671 (unless org-agenda-follow-mode 8672 (set-window-configuration org-agenda-pre-follow-window-conf)) 8673 (org-agenda-set-mode-name) 8674 (org-agenda-do-context-action) 8675 (message "Follow mode is %s" 8676 (if org-agenda-follow-mode "on" "off"))) 8677 8678 (defun org-agenda-entry-text-mode (&optional arg) 8679 "Toggle entry text mode in an agenda buffer." 8680 (interactive "P") 8681 (if (or org-agenda-tag-filter 8682 org-agenda-category-filter 8683 org-agenda-regexp-filter 8684 org-agenda-top-headline-filter) 8685 (user-error "Can't show entry text in filtered views") 8686 (setq org-agenda-entry-text-mode (or (integerp arg) 8687 (not org-agenda-entry-text-mode))) 8688 (org-agenda-entry-text-hide) 8689 (and org-agenda-entry-text-mode 8690 (let ((org-agenda-entry-text-maxlines 8691 (if (integerp arg) arg org-agenda-entry-text-maxlines))) 8692 (org-agenda-entry-text-show))) 8693 (org-agenda-set-mode-name) 8694 (message "Entry text mode is %s%s" 8695 (if org-agenda-entry-text-mode "on" "off") 8696 (if (not org-agenda-entry-text-mode) "" 8697 (format " (maximum number of lines is %d)" 8698 (if (integerp arg) arg org-agenda-entry-text-maxlines)))))) 8699 8700 (defun org-agenda-clockreport-mode () 8701 "Toggle clocktable mode in an agenda buffer." 8702 (interactive) 8703 (org-agenda-check-type t 'agenda) 8704 (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)) 8705 (org-agenda-set-mode-name) 8706 (org-agenda-redo) 8707 (message "Clocktable mode is %s" 8708 (if org-agenda-clockreport-mode "on" "off"))) 8709 8710 (defun org-agenda-log-mode (&optional special) 8711 "Toggle log mode in an agenda buffer. 8712 8713 With argument SPECIAL, show all possible log items, not only the ones 8714 configured in `org-agenda-log-mode-items'. 8715 8716 With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ 8717 log items, nothing else." 8718 (interactive "P") 8719 (org-agenda-check-type t 'agenda) 8720 (setq org-agenda-show-log 8721 (cond 8722 ((equal special '(16)) 'only) 8723 ((eq special 'clockcheck) 8724 (if (eq org-agenda-show-log 'clockcheck) 8725 nil 'clockcheck)) 8726 (special '(closed clock state)) 8727 (t (not org-agenda-show-log)))) 8728 (org-agenda-set-mode-name) 8729 (org-agenda-redo) 8730 (message "Log mode is %s" (if org-agenda-show-log "on" "off"))) 8731 8732 (defun org-agenda-archives-mode (&optional with-files) 8733 "Toggle inclusion of items in trees marked with :ARCHIVE:. 8734 When called with a prefix argument, include all archive files as well." 8735 (interactive "P") 8736 (setq org-agenda-archives-mode 8737 (cond ((and with-files (eq org-agenda-archives-mode t)) nil) 8738 (with-files t) 8739 (org-agenda-archives-mode nil) 8740 (t 'trees))) 8741 (org-agenda-set-mode-name) 8742 (org-agenda-redo) 8743 (message 8744 "%s" 8745 (cond 8746 ((eq org-agenda-archives-mode nil) 8747 "No archives are included") 8748 ((eq org-agenda-archives-mode 'trees) 8749 (format "Trees with :%s: tag are included" org-archive-tag)) 8750 ((eq org-agenda-archives-mode t) 8751 (format "Trees with :%s: tag and all active archive files are included" 8752 org-archive-tag))))) 8753 8754 (defun org-agenda-toggle-diary () 8755 "Toggle diary inclusion in an agenda buffer." 8756 (interactive) 8757 (org-agenda-check-type t 'agenda) 8758 (setq org-agenda-include-diary (not org-agenda-include-diary)) 8759 (org-agenda-redo) 8760 (org-agenda-set-mode-name) 8761 (message "Diary inclusion turned %s" 8762 (if org-agenda-include-diary "on" "off"))) 8763 8764 (defun org-agenda-toggle-deadlines () 8765 "Toggle inclusion of entries with a deadline in an agenda buffer." 8766 (interactive) 8767 (org-agenda-check-type t 'agenda) 8768 (setq org-agenda-include-deadlines (not org-agenda-include-deadlines)) 8769 (org-agenda-redo) 8770 (org-agenda-set-mode-name) 8771 (message "Deadlines inclusion turned %s" 8772 (if org-agenda-include-deadlines "on" "off"))) 8773 8774 (defun org-agenda-toggle-time-grid () 8775 "Toggle time grid in an agenda buffer." 8776 (interactive) 8777 (org-agenda-check-type t 'agenda) 8778 (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) 8779 (org-agenda-redo) 8780 (org-agenda-set-mode-name) 8781 (message "Time-grid turned %s" 8782 (if org-agenda-use-time-grid "on" "off"))) 8783 8784 (defun org-agenda-set-mode-name () 8785 "Set the mode name to indicate all the small mode settings." 8786 (setq mode-name 8787 (list "Org-Agenda" 8788 (if (get 'org-agenda-files 'org-restrict) " []" "") 8789 " " 8790 '(:eval (org-agenda-span-name org-agenda-current-span)) 8791 (if org-agenda-follow-mode " Follow" "") 8792 (if org-agenda-entry-text-mode " ETxt" "") 8793 (if org-agenda-include-diary " Diary" "") 8794 (if org-agenda-include-deadlines " Ddl" "") 8795 (if org-agenda-use-time-grid " Grid" "") 8796 (if (and (boundp 'org-habit-show-habits) 8797 org-habit-show-habits) 8798 " Habit" "") 8799 (cond 8800 ((consp org-agenda-show-log) " LogAll") 8801 ((eq org-agenda-show-log 'clockcheck) " ClkCk") 8802 (org-agenda-show-log " Log") 8803 (t "")) 8804 (if (org-agenda-filter-any) " " "") 8805 (if (or org-agenda-category-filter 8806 (get 'org-agenda-category-filter :preset-filter)) 8807 '(:eval (propertize 8808 (concat "[" 8809 (mapconcat 8810 #'identity 8811 (append 8812 (get 'org-agenda-category-filter :preset-filter) 8813 org-agenda-category-filter) 8814 "") 8815 "]") 8816 'face 'org-agenda-filter-category 8817 'help-echo "Category used in filtering")) 8818 "") 8819 (if (or org-agenda-tag-filter 8820 (get 'org-agenda-tag-filter :preset-filter)) 8821 '(:eval (propertize 8822 (concat (mapconcat 8823 #'identity 8824 (append 8825 (get 'org-agenda-tag-filter :preset-filter) 8826 org-agenda-tag-filter) 8827 "")) 8828 'face 'org-agenda-filter-tags 8829 'help-echo "Tags used in filtering")) 8830 "") 8831 (if (or org-agenda-effort-filter 8832 (get 'org-agenda-effort-filter :preset-filter)) 8833 '(:eval (propertize 8834 (concat (mapconcat 8835 #'identity 8836 (append 8837 (get 'org-agenda-effort-filter :preset-filter) 8838 org-agenda-effort-filter) 8839 "")) 8840 'face 'org-agenda-filter-effort 8841 'help-echo "Effort conditions used in filtering")) 8842 "") 8843 (if (or org-agenda-regexp-filter 8844 (get 'org-agenda-regexp-filter :preset-filter)) 8845 '(:eval (propertize 8846 (concat (mapconcat 8847 (lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/")) 8848 (append 8849 (get 'org-agenda-regexp-filter :preset-filter) 8850 org-agenda-regexp-filter) 8851 "")) 8852 'face 'org-agenda-filter-regexp 8853 'help-echo "Regexp used in filtering")) 8854 "") 8855 (if org-agenda-archives-mode 8856 (if (eq org-agenda-archives-mode t) 8857 " Archives" 8858 (format " :%s:" org-archive-tag)) 8859 "") 8860 (if org-agenda-clockreport-mode " Clock" ""))) 8861 (force-mode-line-update)) 8862 8863 (defun org-agenda-update-agenda-type () 8864 "Update the agenda type after each command." 8865 (setq org-agenda-type 8866 (or (get-text-property (point) 'org-agenda-type) 8867 (get-text-property (max (point-min) (1- (point))) 'org-agenda-type)))) 8868 8869 (defun org-agenda-next-line () 8870 "Move cursor to the next line, and show if follow mode is active." 8871 (interactive) 8872 (call-interactively 'next-line) 8873 (org-agenda-do-context-action)) 8874 8875 (defun org-agenda-previous-line () 8876 "Move cursor to the previous line, and show if follow-mode is active." 8877 (interactive) 8878 (call-interactively 'previous-line) 8879 (org-agenda-do-context-action)) 8880 8881 (defun org-agenda-next-item (n) 8882 "Move cursor to next agenda item." 8883 (interactive "p") 8884 (let ((col (current-column))) 8885 (dotimes (_ n) 8886 (when (next-single-property-change (point-at-eol) 'org-marker) 8887 (move-end-of-line 1) 8888 (goto-char (next-single-property-change (point) 'org-marker)))) 8889 (org-move-to-column col)) 8890 (org-agenda-do-context-action)) 8891 8892 (defun org-agenda-previous-item (n) 8893 "Move cursor to next agenda item." 8894 (interactive "p") 8895 (dotimes (_ n) 8896 (let ((col (current-column)) 8897 (goto (save-excursion 8898 (move-end-of-line 0) 8899 (previous-single-property-change (point) 'org-marker)))) 8900 (when goto (goto-char goto)) 8901 (org-move-to-column col))) 8902 (org-agenda-do-context-action)) 8903 8904 (defun org-agenda-do-context-action () 8905 "Show outline path and, maybe, follow mode window." 8906 (let ((m (org-get-at-bol 'org-marker))) 8907 (when (and (markerp m) (marker-buffer m)) 8908 (and org-agenda-follow-mode 8909 (if org-agenda-follow-indirect 8910 (org-agenda-tree-to-indirect-buffer nil) 8911 (org-agenda-show))) 8912 (and org-agenda-show-outline-path 8913 (org-with-point-at m (org-display-outline-path t)))))) 8914 8915 (defun org-agenda-show-tags () 8916 "Show the tags applicable to the current item." 8917 (interactive) 8918 (let* ((tags (org-get-at-bol 'tags))) 8919 (if tags 8920 (message "Tags are :%s:" 8921 (org-no-properties (mapconcat #'identity tags ":"))) 8922 (message "No tags associated with this line")))) 8923 8924 (defun org-agenda-goto (&optional highlight) 8925 "Go to the entry at point in the corresponding Org file." 8926 (interactive) 8927 (let* ((marker (or (org-get-at-bol 'org-marker) 8928 (org-agenda-error))) 8929 (buffer (marker-buffer marker)) 8930 (pos (marker-position marker))) 8931 ;; FIXME: use `org-switch-to-buffer-other-window'? 8932 (switch-to-buffer-other-window buffer) 8933 (widen) 8934 (push-mark) 8935 (goto-char pos) 8936 (when (derived-mode-p 'org-mode) 8937 (org-show-context 'agenda) 8938 (recenter (/ (window-height) 2)) 8939 (org-back-to-heading t) 8940 (let ((case-fold-search nil)) 8941 (when (re-search-forward org-complex-heading-regexp nil t) 8942 (goto-char (match-beginning 4))))) 8943 (run-hooks 'org-agenda-after-show-hook) 8944 (and highlight (org-highlight (point-at-bol) (point-at-eol))))) 8945 8946 (defvar org-agenda-after-show-hook nil 8947 "Normal hook run after an item has been shown from the agenda. 8948 Point is in the buffer where the item originated.") 8949 8950 ;; Defined later in org-agenda.el 8951 (defvar org-agenda-loop-over-headlines-in-active-region nil) 8952 8953 (defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete) 8954 "Between region BEG and END, call agenda command CMD. 8955 When optional argument ARG is non-nil or FORCE-ARG is t, pass 8956 ARG to CMD. When optional argument DELETE is non-nil, assume CMD 8957 deletes the agenda entry and don't move to the next entry." 8958 (save-excursion 8959 (goto-char beg) 8960 (let ((mend (move-marker (make-marker) end)) 8961 (all (eq org-agenda-loop-over-headlines-in-active-region t)) 8962 (match (and (stringp org-agenda-loop-over-headlines-in-active-region) 8963 org-agenda-loop-over-headlines-in-active-region)) 8964 (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level) 8965 (org-get-at-bol 'level)))) 8966 (while (< (point) mend) 8967 (let ((ov (make-overlay (point) (point-at-eol)))) 8968 (if (not (or all 8969 (and match (looking-at-p match)) 8970 (eq level (org-get-at-bol 'level)))) 8971 (org-agenda-next-item 1) 8972 (overlay-put ov 'face 'region) 8973 (if (or arg force-arg) (funcall cmd arg) (funcall cmd)) 8974 (when (not delete) (org-agenda-next-item 1)) 8975 (delete-overlay ov))))))) 8976 8977 ;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*, 8978 ;; kill,set-property,set-effort] commands may loop over agenda 8979 ;; entries. Commands `org-agenda-set-tags' and `org-agenda-bulk-mark' 8980 ;; use their own mechanisms on active regions. 8981 (defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body) 8982 "Maybe loop over agenda entries and perform CMD. 8983 Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." 8984 (declare (debug t)) 8985 `(if (and (called-interactively-p 'any) 8986 org-agenda-loop-over-headlines-in-active-region 8987 (org-region-active-p)) 8988 (org-agenda-do-in-region 8989 (region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete) 8990 ,@body)) 8991 8992 (defun org-agenda-kill () 8993 "Kill the entry or subtree belonging to the current agenda entry." 8994 (interactive) 8995 (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) 8996 (org-agenda-maybe-loop 8997 #'org-agenda-kill nil nil t 8998 (let* ((bufname-orig (buffer-name)) 8999 (marker (or (org-get-at-bol 'org-marker) 9000 (org-agenda-error))) 9001 (buffer (marker-buffer marker)) 9002 (pos (marker-position marker)) 9003 (type (org-get-at-bol 'type)) 9004 dbeg dend (n 0)) 9005 (org-with-remote-undo buffer 9006 (with-current-buffer buffer 9007 (save-excursion 9008 (goto-char pos) 9009 (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) 9010 (setq dbeg (progn (org-back-to-heading t) (point)) 9011 dend (org-end-of-subtree t t)) 9012 (setq dbeg (point-at-bol) 9013 dend (min (point-max) (1+ (point-at-eol))))) 9014 (goto-char dbeg) 9015 (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) 9016 (when (or (eq t org-agenda-confirm-kill) 9017 (and (numberp org-agenda-confirm-kill) 9018 (> n org-agenda-confirm-kill))) 9019 (let ((win-conf (current-window-configuration))) 9020 (unwind-protect 9021 (and 9022 (prog2 9023 (org-agenda-tree-to-indirect-buffer nil) 9024 (not (y-or-n-p 9025 (format "Delete entry with %d lines in buffer \"%s\"? " 9026 n (buffer-name buffer)))) 9027 (kill-buffer org-last-indirect-buffer)) 9028 (error "Abort")) 9029 (set-window-configuration win-conf)))) 9030 (let ((org-agenda-buffer-name bufname-orig)) 9031 (org-remove-subtree-entries-from-agenda buffer dbeg dend)) 9032 (with-current-buffer buffer (delete-region dbeg dend)) 9033 (message "Agenda item and source killed"))))) 9034 9035 (defvar org-archive-default-command) ; defined in org-archive.el 9036 (defun org-agenda-archive-default () 9037 "Archive the entry or subtree belonging to the current agenda entry." 9038 (interactive) 9039 (require 'org-archive) 9040 (funcall-interactively 9041 #'org-agenda-archive-with org-archive-default-command)) 9042 9043 (defun org-agenda-archive-default-with-confirmation () 9044 "Archive the entry or subtree belonging to the current agenda entry." 9045 (interactive) 9046 (require 'org-archive) 9047 (funcall-interactively 9048 #'org-agenda-archive-with org-archive-default-command 'confirm)) 9049 9050 (defun org-agenda-archive () 9051 "Archive the entry or subtree belonging to the current agenda entry." 9052 (interactive) 9053 (funcall-interactively 9054 #'org-agenda-archive-with 'org-archive-subtree)) 9055 9056 (defun org-agenda-archive-to-archive-sibling () 9057 "Move the entry to the archive sibling." 9058 (interactive) 9059 (funcall-interactively 9060 #'org-agenda-archive-with 'org-archive-to-archive-sibling)) 9061 9062 (defvar org-archive-from-agenda) 9063 9064 (defun org-agenda-archive-with (cmd &optional confirm) 9065 "Move the entry to the archive sibling." 9066 (interactive) 9067 (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) 9068 (org-agenda-maybe-loop 9069 #'org-agenda-archive-with cmd nil t 9070 (let* ((bufname-orig (buffer-name)) 9071 (marker (or (org-get-at-bol 'org-marker) 9072 (org-agenda-error))) 9073 (buffer (marker-buffer marker)) 9074 (pos (marker-position marker))) 9075 (org-with-remote-undo buffer 9076 (with-current-buffer buffer 9077 (if (derived-mode-p 'org-mode) 9078 (if (and confirm 9079 (not (y-or-n-p "Archive this subtree or entry? "))) 9080 (error "Abort") 9081 (save-window-excursion 9082 (goto-char pos) 9083 (let ((org-agenda-buffer-name bufname-orig)) 9084 (org-remove-subtree-entries-from-agenda)) 9085 (org-back-to-heading t) 9086 (let ((org-archive-from-agenda t)) 9087 (funcall cmd)))) 9088 (error "Archiving works only in Org files"))))))) 9089 9090 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end) 9091 "Remove all lines in the agenda that correspond to a given subtree. 9092 The subtree is the one in buffer BUF, starting at BEG and ending at END. 9093 If this information is not given, the function uses the tree at point." 9094 (let ((buf (or buf (current-buffer))) m p) 9095 (save-excursion 9096 (unless (and beg end) 9097 (org-back-to-heading t) 9098 (setq beg (point)) 9099 (org-end-of-subtree t) 9100 (setq end (point))) 9101 (set-buffer (get-buffer org-agenda-buffer-name)) 9102 (save-excursion 9103 (goto-char (point-max)) 9104 (beginning-of-line 1) 9105 (while (not (bobp)) 9106 (when (and (setq m (org-get-at-bol 'org-marker)) 9107 (equal buf (marker-buffer m)) 9108 (setq p (marker-position m)) 9109 (>= p beg) 9110 (< p end)) 9111 (let ((inhibit-read-only t)) 9112 (delete-region (point-at-bol) (1+ (point-at-eol))))) 9113 (beginning-of-line 0)))))) 9114 9115 (defun org-agenda-refile (&optional goto rfloc no-update) 9116 "Refile the item at point. 9117 9118 When called with `\\[universal-argument] \\[universal-argument]', \ 9119 go to the location of the last 9120 refiled item. 9121 9122 When called with `\\[universal-argument] \\[universal-argument] \ 9123 \\[universal-argument]' prefix or when GOTO is 0, clear 9124 the refile cache. 9125 9126 RFLOC can be a refile location obtained in a different way. 9127 9128 When NO-UPDATE is non-nil, don't redo the agenda buffer." 9129 (interactive "P") 9130 (cond 9131 ((member goto '(0 (64))) 9132 (org-refile-cache-clear)) 9133 ((equal goto '(16)) 9134 (org-refile-goto-last-stored)) 9135 (t 9136 (let* ((buffer-orig (buffer-name)) 9137 (marker (or (org-get-at-bol 'org-hd-marker) 9138 (org-agenda-error))) 9139 (buffer (marker-buffer marker)) 9140 ;; (pos (marker-position marker)) 9141 (rfloc (or rfloc 9142 (org-refile-get-location 9143 (if goto "Goto" "Refile to") buffer 9144 org-refile-allow-creating-parent-nodes)))) 9145 (with-current-buffer buffer 9146 (org-with-wide-buffer 9147 (goto-char marker) 9148 (let ((org-agenda-buffer-name buffer-orig)) 9149 (org-remove-subtree-entries-from-agenda)) 9150 (org-refile goto buffer rfloc)))) 9151 (unless no-update (org-agenda-redo))))) 9152 9153 (defun org-agenda-open-link (&optional arg) 9154 "Open the link(s) in the current entry, if any. 9155 This looks for a link in the displayed line in the agenda. 9156 It also looks at the text of the entry itself." 9157 (interactive "P") 9158 (let* ((marker (or (org-get-at-bol 'org-hd-marker) 9159 (org-get-at-bol 'org-marker))) 9160 (buffer (and marker (marker-buffer marker))) 9161 (prefix (buffer-substring (point-at-bol) (point-at-eol))) 9162 (lkall (and buffer (org-offer-links-in-entry 9163 buffer marker arg prefix))) 9164 (lk0 (car lkall)) 9165 (lk (if (stringp lk0) (list lk0) lk0)) 9166 (lkend (cdr lkall)) 9167 trg) 9168 (cond 9169 ((and buffer lk) 9170 (mapcar (lambda(l) 9171 (with-current-buffer buffer 9172 (setq trg (and (string-match org-link-bracket-re l) 9173 (match-string 1 l))) 9174 (if (or (not trg) (string-match org-link-any-re trg)) 9175 ;; Don't use `org-with-wide-buffer' here as 9176 ;; opening the link may result in moving the point 9177 (save-restriction 9178 (widen) 9179 (goto-char marker) 9180 (when (search-forward l nil lkend) 9181 (goto-char (match-beginning 0)) 9182 (org-open-at-point))) 9183 ;; This is an internal link, widen the buffer 9184 ;; FIXME: use `org-switch-to-buffer-other-window'? 9185 (switch-to-buffer-other-window buffer) 9186 (widen) 9187 (goto-char marker) 9188 (when (search-forward l nil lkend) 9189 (goto-char (match-beginning 0)) 9190 (org-open-at-point))))) 9191 lk)) 9192 ((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)")) 9193 (save-excursion 9194 (beginning-of-line 1) 9195 (looking-at (concat ".*?\\(" org-link-bracket-re "\\)")))) 9196 (org-link-open-from-string (match-string 1))) 9197 (t (message "No link to open here"))))) 9198 9199 (defun org-agenda-copy-local-variable (var) 9200 "Get a variable from a referenced buffer and install it here." 9201 (let ((m (org-get-at-bol 'org-marker))) 9202 (when (and m (buffer-live-p (marker-buffer m))) 9203 (set (make-local-variable var) 9204 (with-current-buffer (marker-buffer m) 9205 (symbol-value var)))))) 9206 9207 (defun org-agenda-switch-to (&optional delete-other-windows) 9208 "Go to the Org mode file which contains the item at point. 9209 When optional argument DELETE-OTHER-WINDOWS is non-nil, the 9210 displayed Org file fills the frame." 9211 (interactive) 9212 (if (and org-return-follows-link 9213 (not (org-get-at-bol 'org-marker)) 9214 (org-in-regexp org-link-bracket-re)) 9215 (org-link-open-from-string (match-string 0)) 9216 (let* ((marker (or (org-get-at-bol 'org-marker) 9217 (org-agenda-error))) 9218 (buffer (marker-buffer marker)) 9219 (pos (marker-position marker))) 9220 (unless buffer (user-error "Trying to switch to non-existent buffer")) 9221 (pop-to-buffer-same-window buffer) 9222 (when delete-other-windows (delete-other-windows)) 9223 (widen) 9224 (goto-char pos) 9225 (when (derived-mode-p 'org-mode) 9226 (org-show-context 'agenda) 9227 (run-hooks 'org-agenda-after-show-hook))))) 9228 9229 (defun org-agenda-goto-mouse (ev) 9230 "Go to the Org file which contains the item at the mouse click." 9231 (interactive "e") 9232 (mouse-set-point ev) 9233 (org-agenda-goto)) 9234 9235 (defun org-agenda-show (&optional full-entry) 9236 "Display the Org file which contains the item at point. 9237 With prefix argument FULL-ENTRY, make the entire entry visible 9238 if it was hidden in the outline." 9239 (interactive "P") 9240 (let ((win (selected-window))) 9241 (org-agenda-goto t) 9242 (when full-entry (org-show-entry)) 9243 (select-window win))) 9244 9245 (defvar org-agenda-show-window nil) 9246 (defun org-agenda-show-and-scroll-up (&optional arg) 9247 "Display the Org file which contains the item at point. 9248 9249 When called repeatedly, scroll the window that is displaying the buffer. 9250 9251 With a `\\[universal-argument]' prefix argument, display the item, but \ 9252 fold drawers." 9253 (interactive "P") 9254 (let ((win (selected-window))) 9255 (if (and (window-live-p org-agenda-show-window) 9256 (eq this-command last-command)) 9257 (progn 9258 (select-window org-agenda-show-window) 9259 (ignore-errors (scroll-up))) 9260 (org-agenda-goto t) 9261 (org-show-entry) 9262 (if arg (org-cycle-hide-drawers 'children) 9263 (org-with-wide-buffer 9264 (narrow-to-region (org-entry-beginning-position) 9265 (org-entry-end-position)) 9266 (org-show-all '(drawers)))) 9267 (setq org-agenda-show-window (selected-window))) 9268 (select-window win))) 9269 9270 (defun org-agenda-show-scroll-down () 9271 "Scroll down the window showing the agenda." 9272 (interactive) 9273 (let ((win (selected-window))) 9274 (when (window-live-p org-agenda-show-window) 9275 (select-window org-agenda-show-window) 9276 (ignore-errors (scroll-down)) 9277 (select-window win)))) 9278 9279 (defun org-agenda-show-1 (&optional more) 9280 "Display the Org file which contains the item at point. 9281 The prefix arg selects the amount of information to display: 9282 9283 0 hide the subtree 9284 1 just show the entry according to defaults. 9285 2 show the children view 9286 3 show the subtree view 9287 4 show the entire subtree and any drawers 9288 With prefix argument FULL-ENTRY, make the entire entry visible 9289 if it was hidden in the outline." 9290 (interactive "p") 9291 (let ((win (selected-window))) 9292 (org-agenda-goto t) 9293 (org-back-to-heading) 9294 (set-window-start (selected-window) (point-at-bol)) 9295 (cond 9296 ((= more 0) 9297 (org-flag-subtree t) 9298 (save-excursion 9299 (org-back-to-heading) 9300 (run-hook-with-args 'org-cycle-hook 'folded)) 9301 (message "Remote: FOLDED")) 9302 ((and (called-interactively-p 'any) (= more 1)) 9303 (message "Remote: show with default settings")) 9304 ((= more 2) 9305 (outline-show-entry) 9306 (org-show-children) 9307 (save-excursion 9308 (org-back-to-heading) 9309 (run-hook-with-args 'org-cycle-hook 'children)) 9310 (message "Remote: CHILDREN")) 9311 ((= more 3) 9312 (outline-show-subtree) 9313 (save-excursion 9314 (org-back-to-heading) 9315 (run-hook-with-args 'org-cycle-hook 'subtree)) 9316 (message "Remote: SUBTREE")) 9317 ((> more 3) 9318 (outline-show-subtree) 9319 (message "Remote: SUBTREE AND ALL DRAWERS"))) 9320 (select-window win))) 9321 9322 (defvar org-agenda-cycle-counter nil) 9323 (defun org-agenda-cycle-show (&optional n) 9324 "Show the current entry in another window, with default settings. 9325 9326 Default settings are taken from `org-show-context-detail'. When 9327 use repeatedly in immediate succession, the remote entry will 9328 cycle through visibility 9329 9330 children -> subtree -> folded 9331 9332 When called with a numeric prefix arg, that arg will be passed through to 9333 `org-agenda-show-1'. For the interpretation of that argument, see the 9334 docstring of `org-agenda-show-1'." 9335 (interactive "P") 9336 (if (integerp n) 9337 (setq org-agenda-cycle-counter n) 9338 (if (not (eq last-command this-command)) 9339 (setq org-agenda-cycle-counter 1) 9340 (if (equal org-agenda-cycle-counter 0) 9341 (setq org-agenda-cycle-counter 2) 9342 (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) 9343 (when (> org-agenda-cycle-counter 3) 9344 (setq org-agenda-cycle-counter 0))))) 9345 (org-agenda-show-1 org-agenda-cycle-counter)) 9346 9347 (defun org-agenda-recenter (arg) 9348 "Display the Org file which contains the item at point and recenter." 9349 (interactive "P") 9350 (let ((win (selected-window))) 9351 (org-agenda-goto t) 9352 (recenter arg) 9353 (select-window win))) 9354 9355 (defun org-agenda-show-mouse (ev) 9356 "Display the Org file which contains the item at the mouse click." 9357 (interactive "e") 9358 (mouse-set-point ev) 9359 (org-agenda-show)) 9360 9361 (defun org-agenda-check-no-diary () 9362 "Check if the entry is a diary link and abort if yes." 9363 (when (org-get-at-bol 'org-agenda-diary-link) 9364 (org-agenda-error))) 9365 9366 (defun org-agenda-error () 9367 "Throw an error when a command is not allowed in the agenda." 9368 (user-error "Command not allowed in this line")) 9369 9370 (defun org-agenda-tree-to-indirect-buffer (arg) 9371 "Show the subtree corresponding to the current entry in an indirect buffer. 9372 This calls the command `org-tree-to-indirect-buffer' from the original buffer. 9373 9374 With a numerical prefix ARG, go up to this level and then take that tree. 9375 With a negative numeric ARG, go up by this number of levels. 9376 9377 With a `\\[universal-argument]' prefix, make a separate frame for this tree, \ 9378 i.e. don't use 9379 the dedicated frame." 9380 (interactive "P") 9381 (if current-prefix-arg 9382 (org-agenda-do-tree-to-indirect-buffer arg) 9383 (let ((agenda-buffer (buffer-name)) 9384 (agenda-window (selected-window)) 9385 (indirect-window 9386 (and org-last-indirect-buffer 9387 (get-buffer-window org-last-indirect-buffer)))) 9388 (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg)) 9389 (unless (or (eq org-indirect-buffer-display 'new-frame) 9390 (eq org-indirect-buffer-display 'dedicated-frame)) 9391 (unwind-protect 9392 (unless (and indirect-window (window-live-p indirect-window)) 9393 (setq indirect-window (split-window agenda-window))) 9394 (and indirect-window (select-window indirect-window)) 9395 (switch-to-buffer org-last-indirect-buffer :norecord) 9396 (fit-window-to-buffer indirect-window))) 9397 (select-window (get-buffer-window agenda-buffer)) 9398 (setq org-agenda-last-indirect-buffer org-last-indirect-buffer)))) 9399 9400 (defun org-agenda-do-tree-to-indirect-buffer (arg) 9401 "Same as `org-agenda-tree-to-indirect-buffer' without saving window." 9402 (org-agenda-check-no-diary) 9403 (let* ((marker (or (org-get-at-bol 'org-marker) 9404 (org-agenda-error))) 9405 (buffer (marker-buffer marker)) 9406 (pos (marker-position marker))) 9407 (with-current-buffer buffer 9408 (save-excursion 9409 (goto-char pos) 9410 (org-tree-to-indirect-buffer arg))))) 9411 9412 (defvar org-last-heading-marker (make-marker) 9413 "Marker pointing to the headline that last changed its TODO state 9414 by a remote command from the agenda.") 9415 9416 (defun org-agenda-todo-nextset () 9417 "Switch TODO entry to next sequence." 9418 (interactive) 9419 (org-agenda-todo 'nextset)) 9420 9421 (defun org-agenda-todo-previousset () 9422 "Switch TODO entry to previous sequence." 9423 (interactive) 9424 (org-agenda-todo 'previousset)) 9425 9426 (defvar org-agenda-headline-snapshot-before-repeat) 9427 9428 (defun org-agenda-todo (&optional arg) 9429 "Cycle TODO state of line at point, also in Org file. 9430 This changes the line at point, all other lines in the agenda referring to 9431 the same tree node, and the headline of the tree node in the Org file." 9432 (interactive "P") 9433 (org-agenda-check-no-diary) 9434 (org-agenda-maybe-loop 9435 #'org-agenda-todo arg nil nil 9436 (let* ((col (current-column)) 9437 (marker (or (org-get-at-bol 'org-marker) 9438 (org-agenda-error))) 9439 (buffer (marker-buffer marker)) 9440 (pos (marker-position marker)) 9441 (hdmarker (org-get-at-bol 'org-hd-marker)) 9442 (todayp (org-agenda-today-p (org-get-at-bol 'day))) 9443 (inhibit-read-only t) 9444 org-loop-over-headlines-in-active-region 9445 org-agenda-headline-snapshot-before-repeat newhead just-one) 9446 (org-with-remote-undo buffer 9447 (with-current-buffer buffer 9448 (widen) 9449 (goto-char pos) 9450 (org-show-context 'agenda) 9451 (let ((current-prefix-arg arg)) 9452 (call-interactively 'org-todo) 9453 ;; Make sure that log is recorded in current undo. 9454 (when (and org-log-setup 9455 (not (eq org-log-note-how 'note))) 9456 (org-add-log-note))) 9457 (and (bolp) (forward-char 1)) 9458 (setq newhead (org-get-heading)) 9459 (when (and org-agenda-headline-snapshot-before-repeat 9460 (not (equal org-agenda-headline-snapshot-before-repeat 9461 newhead)) 9462 todayp) 9463 (setq newhead org-agenda-headline-snapshot-before-repeat 9464 just-one t)) 9465 (save-excursion 9466 (org-back-to-heading) 9467 (move-marker org-last-heading-marker (point)))) 9468 (beginning-of-line 1) 9469 (save-window-excursion 9470 (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) 9471 (when (bound-and-true-p org-clock-out-when-done) 9472 (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda)) 9473 newhead) 9474 (org-agenda-unmark-clocking-task)) 9475 (org-move-to-column col) 9476 (org-agenda-mark-clocking-task))))) 9477 9478 (defun org-agenda-add-note (&optional _arg) 9479 "Add a time-stamped note to the entry at point." 9480 (interactive) ;; "P" 9481 (org-agenda-check-no-diary) 9482 (let* ((marker (or (org-get-at-bol 'org-marker) 9483 (org-agenda-error))) 9484 (buffer (marker-buffer marker)) 9485 (pos (marker-position marker)) 9486 (_hdmarker (org-get-at-bol 'org-hd-marker)) 9487 (inhibit-read-only t)) 9488 (with-current-buffer buffer 9489 (widen) 9490 (goto-char pos) 9491 (org-show-context 'agenda) 9492 (org-add-note)))) 9493 9494 (defun org-agenda-change-all-lines (newhead hdmarker 9495 &optional fixface just-this) 9496 "Change all lines in the agenda buffer which match HDMARKER. 9497 The new content of the line will be NEWHEAD (as modified by 9498 `org-agenda-format-item'). HDMARKER is checked with 9499 `equal' against all `org-hd-marker' text properties in the file. 9500 If FIXFACE is non-nil, the face of each item is modified according to 9501 the new TODO state. 9502 If JUST-THIS is non-nil, change just the current line, not all. 9503 If FORCE-TAGS is non-nil, the car of it returns the new tags." 9504 (let* ((inhibit-read-only t) 9505 (line (org-current-line)) 9506 (org-agenda-buffer (current-buffer)) 9507 (thetags (with-current-buffer (marker-buffer hdmarker) 9508 (org-get-tags hdmarker))) 9509 props m undone-face done-face finish new dotime level cat tags) ;; pl 9510 (save-excursion 9511 (goto-char (point-max)) 9512 (beginning-of-line 1) 9513 (while (not finish) 9514 (setq finish (bobp)) 9515 (when (and (setq m (org-get-at-bol 'org-hd-marker)) 9516 (or (not just-this) (= (org-current-line) line)) 9517 (equal m hdmarker)) 9518 (setq props (text-properties-at (point)) 9519 dotime (org-get-at-bol 'dotime) 9520 cat (org-agenda-get-category) 9521 level (org-get-at-bol 'level) 9522 tags thetags 9523 new 9524 (let ((org-prefix-format-compiled 9525 (or (get-text-property (min (1- (point-max)) (point)) 'format) 9526 org-prefix-format-compiled)) 9527 (extra (org-get-at-bol 'extra))) 9528 (with-current-buffer (marker-buffer hdmarker) 9529 (org-with-wide-buffer 9530 (org-agenda-format-item extra newhead level cat tags dotime)))) 9531 ;; pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) 9532 undone-face (org-get-at-bol 'undone-face) 9533 done-face (org-get-at-bol 'done-face)) 9534 (beginning-of-line 1) 9535 (cond 9536 ((equal new "") (delete-region (point) (line-beginning-position 2))) 9537 ((looking-at ".*") 9538 ;; When replacing the whole line, preserve bulk mark 9539 ;; overlay, if any. 9540 (let ((mark (catch :overlay 9541 (dolist (o (overlays-in (point) (+ 2 (point)))) 9542 (when (eq (overlay-get o 'type) 9543 'org-marked-entry-overlay) 9544 (throw :overlay o)))))) 9545 (replace-match new t t) 9546 (beginning-of-line) 9547 (when mark (move-overlay mark (point) (+ 2 (point))))) 9548 (add-text-properties (point-at-bol) (point-at-eol) props) 9549 (when fixface 9550 (add-text-properties 9551 (point-at-bol) (point-at-eol) 9552 (list 'face 9553 (if org-last-todo-state-is-todo 9554 undone-face done-face)))) 9555 (org-agenda-highlight-todo 'line) 9556 (beginning-of-line 1)) 9557 (t (error "Line update did not work"))) 9558 (save-restriction 9559 (narrow-to-region (point-at-bol) (point-at-eol)) 9560 (org-agenda-finalize))) 9561 (beginning-of-line 0))))) 9562 9563 (defun org-agenda-align-tags (&optional line) 9564 "Align all tags in agenda items to `org-agenda-tags-column'. 9565 When optional argument LINE is non-nil, align tags only on the 9566 current line." 9567 (let ((inhibit-read-only t) 9568 (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column) 9569 (- (window-text-width)) 9570 org-agenda-tags-column)) 9571 (end (and line (line-end-position))) 9572 l c) 9573 (save-excursion 9574 (goto-char (if line (line-beginning-position) (point-min))) 9575 (while (re-search-forward org-tag-group-re end t) 9576 (add-text-properties 9577 (match-beginning 1) (match-end 1) 9578 (list 'face (delq nil (let ((prop (get-text-property 9579 (match-beginning 1) 'face))) 9580 (or (listp prop) (setq prop (list prop))) 9581 (if (memq 'org-tag prop) 9582 prop 9583 (cons 'org-tag prop)))))) 9584 (setq l (string-width (match-string 1)) 9585 c (if (< org-agenda-tags-column 0) 9586 (- (abs org-agenda-tags-column) l) 9587 org-agenda-tags-column)) 9588 (goto-char (match-beginning 1)) 9589 (delete-region (save-excursion (skip-chars-backward " \t") (point)) 9590 (point)) 9591 (insert (org-add-props 9592 (make-string (max 1 (- c (current-column))) ?\s) 9593 (plist-put (copy-sequence (text-properties-at (point))) 9594 'face nil)))) 9595 (goto-char (point-min)) 9596 (org-font-lock-add-tag-faces (point-max))))) 9597 9598 (defun org-agenda-priority-up () 9599 "Increase the priority of line at point, also in Org file." 9600 (interactive) 9601 (org-agenda-priority 'up)) 9602 9603 (defun org-agenda-priority-down () 9604 "Decrease the priority of line at point, also in Org file." 9605 (interactive) 9606 (org-agenda-priority 'down)) 9607 9608 (defun org-agenda-priority (&optional force-direction) 9609 "Set the priority of line at point, also in Org file. 9610 This changes the line at point, all other lines in the agenda 9611 referring to the same tree node, and the headline of the tree 9612 node in the Org file. 9613 9614 Called with one universal prefix arg, show the priority instead 9615 of setting it. 9616 9617 When called programmatically, FORCE-DIRECTION can be `set', `up', 9618 `down', or a character." 9619 (interactive "P") 9620 (unless org-priority-enable-commands 9621 (user-error "Priority commands are disabled")) 9622 (org-agenda-check-no-diary) 9623 (let* ((col (current-column)) 9624 (hdmarker (org-get-at-bol 'org-hd-marker)) 9625 (buffer (marker-buffer hdmarker)) 9626 (pos (marker-position hdmarker)) 9627 (inhibit-read-only t) 9628 newhead) 9629 (org-with-remote-undo buffer 9630 (with-current-buffer buffer 9631 (widen) 9632 (goto-char pos) 9633 (org-show-context 'agenda) 9634 (org-priority force-direction) 9635 (end-of-line 1) 9636 (setq newhead (org-get-heading))) 9637 (org-agenda-change-all-lines newhead hdmarker) 9638 (org-move-to-column col)))) 9639 9640 ;; FIXME: should fix the tags property of the agenda line. 9641 (defun org-agenda-set-tags (&optional tag onoff) 9642 "Set tags for the current headline." 9643 (interactive) 9644 (org-agenda-check-no-diary) 9645 (if (and (org-region-active-p) (called-interactively-p 'any)) 9646 (call-interactively 'org-change-tag-in-region) 9647 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 9648 (org-agenda-error))) 9649 (buffer (marker-buffer hdmarker)) 9650 (pos (marker-position hdmarker)) 9651 (inhibit-read-only t) 9652 newhead) 9653 (org-with-remote-undo buffer 9654 (with-current-buffer buffer 9655 (widen) 9656 (goto-char pos) 9657 (org-show-context 'agenda) 9658 (if tag 9659 (org-toggle-tag tag onoff) 9660 (call-interactively #'org-set-tags-command)) 9661 (end-of-line 1) 9662 (setq newhead (org-get-heading))) 9663 (org-agenda-change-all-lines newhead hdmarker) 9664 (beginning-of-line 1))))) 9665 9666 (defun org-agenda-set-property () 9667 "Set a property for the current headline." 9668 (interactive) 9669 (org-agenda-check-no-diary) 9670 (org-agenda-maybe-loop 9671 #'org-agenda-set-property nil nil nil 9672 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 9673 (org-agenda-error))) 9674 (buffer (marker-buffer hdmarker)) 9675 (pos (marker-position hdmarker)) 9676 (inhibit-read-only t) 9677 ) ;; newhead 9678 (org-with-remote-undo buffer 9679 (with-current-buffer buffer 9680 (widen) 9681 (goto-char pos) 9682 (org-show-context 'agenda) 9683 (call-interactively 'org-set-property)))))) 9684 9685 (defun org-agenda-set-effort () 9686 "Set the effort property for the current headline." 9687 (interactive) 9688 (org-agenda-check-no-diary) 9689 (org-agenda-maybe-loop 9690 #'org-agenda-set-effort nil nil nil 9691 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 9692 (org-agenda-error))) 9693 (buffer (marker-buffer hdmarker)) 9694 (pos (marker-position hdmarker)) 9695 (inhibit-read-only t) 9696 newhead) 9697 (org-with-remote-undo buffer 9698 (with-current-buffer buffer 9699 (widen) 9700 (goto-char pos) 9701 (org-show-context 'agenda) 9702 (call-interactively 'org-set-effort) 9703 (end-of-line 1) 9704 (setq newhead (org-get-heading))) 9705 (org-agenda-change-all-lines newhead hdmarker))))) 9706 9707 (defun org-agenda-toggle-archive-tag () 9708 "Toggle the archive tag for the current entry." 9709 (interactive) 9710 (org-agenda-check-no-diary) 9711 (org-agenda-maybe-loop 9712 #'org-agenda-toggle-archive-tag nil nil nil 9713 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 9714 (org-agenda-error))) 9715 (buffer (marker-buffer hdmarker)) 9716 (pos (marker-position hdmarker)) 9717 (inhibit-read-only t) 9718 newhead) 9719 (org-with-remote-undo buffer 9720 (with-current-buffer buffer 9721 (widen) 9722 (goto-char pos) 9723 (org-show-context 'agenda) 9724 (call-interactively 'org-toggle-archive-tag) 9725 (end-of-line 1) 9726 (setq newhead (org-get-heading))) 9727 (org-agenda-change-all-lines newhead hdmarker) 9728 (beginning-of-line 1))))) 9729 9730 (defun org-agenda-do-date-later (arg) 9731 (interactive "P") 9732 (cond 9733 ((or (equal arg '(16)) 9734 (memq last-command 9735 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) 9736 (setq this-command 'org-agenda-date-later-minutes) 9737 (org-agenda-date-later-minutes 1)) 9738 ((or (equal arg '(4)) 9739 (memq last-command 9740 '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) 9741 (setq this-command 'org-agenda-date-later-hours) 9742 (org-agenda-date-later-hours 1)) 9743 (t 9744 (org-agenda-date-later (prefix-numeric-value arg))))) 9745 9746 (defun org-agenda-do-date-earlier (arg) 9747 (interactive "P") 9748 (cond 9749 ((or (equal arg '(16)) 9750 (memq last-command 9751 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) 9752 (setq this-command 'org-agenda-date-earlier-minutes) 9753 (org-agenda-date-earlier-minutes 1)) 9754 ((or (equal arg '(4)) 9755 (memq last-command 9756 '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) 9757 (setq this-command 'org-agenda-date-earlier-hours) 9758 (org-agenda-date-earlier-hours 1)) 9759 (t 9760 (org-agenda-date-earlier (prefix-numeric-value arg))))) 9761 9762 (defun org-agenda-date-later (arg &optional what) 9763 "Change the date of this item to ARG day(s) later." 9764 (interactive "p") 9765 (org-agenda-check-type t 'agenda) 9766 (org-agenda-check-no-diary) 9767 (let* ((marker (or (org-get-at-bol 'org-marker) 9768 (org-agenda-error))) 9769 (buffer (marker-buffer marker)) 9770 (pos (marker-position marker)) 9771 cdate today) 9772 (org-with-remote-undo buffer 9773 (with-current-buffer buffer 9774 (widen) 9775 (goto-char pos) 9776 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) 9777 (when (and org-agenda-move-date-from-past-immediately-to-today 9778 (equal arg 1) 9779 (or (not what) (eq what 'day)) 9780 (not (save-match-data (org-at-date-range-p)))) 9781 (setq cdate (org-parse-time-string (match-string 0) 'nodefault) 9782 cdate (calendar-absolute-from-gregorian 9783 (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate))) 9784 today (org-today)) 9785 (when (> today cdate) 9786 ;; immediately shift to today 9787 (setq arg (- today cdate)))) 9788 (org-timestamp-change arg (or what 'day)) 9789 (when (and (org-at-date-range-p) 9790 (re-search-backward org-tr-regexp-both (point-at-bol))) 9791 (let ((end org-last-changed-timestamp)) 9792 (org-timestamp-change arg (or what 'day)) 9793 (setq org-last-changed-timestamp 9794 (concat org-last-changed-timestamp "--" end))))) 9795 (org-agenda-show-new-time marker org-last-changed-timestamp)) 9796 (message "Time stamp changed to %s" org-last-changed-timestamp))) 9797 9798 (defun org-agenda-date-earlier (arg &optional what) 9799 "Change the date of this item to ARG day(s) earlier." 9800 (interactive "p") 9801 (org-agenda-date-later (- arg) what)) 9802 9803 (defun org-agenda-date-later-minutes (arg) 9804 "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." 9805 (interactive "p") 9806 (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) 9807 (org-agenda-date-later arg 'minute)) 9808 9809 (defun org-agenda-date-earlier-minutes (arg) 9810 "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." 9811 (interactive "p") 9812 (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) 9813 (org-agenda-date-earlier arg 'minute)) 9814 9815 (defun org-agenda-date-later-hours (arg) 9816 "Change the time of this item, in hour steps." 9817 (interactive "p") 9818 (org-agenda-date-later arg 'hour)) 9819 9820 (defun org-agenda-date-earlier-hours (arg) 9821 "Change the time of this item, in hour steps." 9822 (interactive "p") 9823 (org-agenda-date-earlier arg 'hour)) 9824 9825 (defun org-agenda-show-new-time (marker stamp &optional prefix) 9826 "Show new date stamp via text properties." 9827 ;; We use text properties to make this undoable 9828 (let ((inhibit-read-only t)) 9829 (setq stamp (concat prefix " => " stamp " ")) 9830 (save-excursion 9831 (goto-char (point-max)) 9832 (while (not (bobp)) 9833 (when (equal marker (org-get-at-bol 'org-marker)) 9834 (remove-text-properties (line-beginning-position) 9835 (line-end-position) 9836 '(display nil)) 9837 (org-move-to-column 9838 (- (if (fboundp 'window-font-width) 9839 (/ (window-width nil t) (window-font-width)) 9840 ;; Fall back to pre-9.3.3 behavior on Emacs <25. 9841 (window-width)) 9842 (length stamp)) 9843 t) 9844 (add-text-properties 9845 (1- (point)) (point-at-eol) 9846 (list 'display (org-add-props stamp nil 9847 'face '(secondary-selection default)))) 9848 (beginning-of-line 1)) 9849 (beginning-of-line 0))))) 9850 9851 (defun org-agenda-date-prompt (arg) 9852 "Change the date of this item. Date is prompted for, with default today. 9853 The prefix ARG is passed to the `org-time-stamp' command and can therefore 9854 be used to request time specification in the time stamp." 9855 (interactive "P") 9856 (org-agenda-check-type t 'agenda) 9857 (org-agenda-check-no-diary) 9858 (org-agenda-maybe-loop 9859 #'org-agenda-date-prompt arg t nil 9860 (let* ((marker (or (org-get-at-bol 'org-marker) 9861 (org-agenda-error))) 9862 (buffer (marker-buffer marker)) 9863 (pos (marker-position marker))) 9864 (org-with-remote-undo buffer 9865 (with-current-buffer buffer 9866 (widen) 9867 (goto-char pos) 9868 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) 9869 (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) 9870 (org-agenda-show-new-time marker org-last-changed-timestamp)) 9871 (message "Time stamp changed to %s" org-last-changed-timestamp)))) 9872 9873 (defun org-agenda-schedule (arg &optional time) 9874 "Schedule the item at point. 9875 ARG is passed through to `org-schedule'." 9876 (interactive "P") 9877 (org-agenda-check-type t 'agenda 'todo 'tags 'search) 9878 (org-agenda-check-no-diary) 9879 (org-agenda-maybe-loop 9880 #'org-agenda-schedule arg t nil 9881 (let* ((marker (or (org-get-at-bol 'org-marker) 9882 (org-agenda-error))) 9883 ;; (type (marker-insertion-type marker)) 9884 (buffer (marker-buffer marker)) 9885 (pos (marker-position marker)) 9886 ts) 9887 (set-marker-insertion-type marker t) 9888 (org-with-remote-undo buffer 9889 (with-current-buffer buffer 9890 (widen) 9891 (goto-char pos) 9892 (setq ts (org-schedule arg time))) 9893 (org-agenda-show-new-time marker ts " S")) 9894 (message "%s" ts)))) 9895 9896 (defun org-agenda-deadline (arg &optional time) 9897 "Schedule the item at point. 9898 ARG is passed through to `org-deadline'." 9899 (interactive "P") 9900 (org-agenda-check-type t 'agenda 'todo 'tags 'search) 9901 (org-agenda-check-no-diary) 9902 (org-agenda-maybe-loop 9903 #'org-agenda-deadline arg t nil 9904 (let* ((marker (or (org-get-at-bol 'org-marker) 9905 (org-agenda-error))) 9906 (buffer (marker-buffer marker)) 9907 (pos (marker-position marker)) 9908 ts) 9909 (org-with-remote-undo buffer 9910 (with-current-buffer buffer 9911 (widen) 9912 (goto-char pos) 9913 (setq ts (org-deadline arg time))) 9914 (org-agenda-show-new-time marker ts " D")) 9915 (message "%s" ts)))) 9916 9917 (defun org-agenda-clock-in (&optional arg) 9918 "Start the clock on the currently selected item." 9919 (interactive "P") 9920 (org-agenda-check-no-diary) 9921 (if (equal arg '(4)) 9922 (org-clock-in arg) 9923 (let* ((marker (or (org-get-at-bol 'org-marker) 9924 (org-agenda-error))) 9925 (hdmarker (or (org-get-at-bol 'org-hd-marker) marker)) 9926 (pos (marker-position marker)) 9927 (col (current-column)) 9928 newhead) 9929 (org-with-remote-undo (marker-buffer marker) 9930 (with-current-buffer (marker-buffer marker) 9931 (widen) 9932 (goto-char pos) 9933 (org-show-context 'agenda) 9934 (org-clock-in arg) 9935 (setq newhead (org-get-heading))) 9936 (org-agenda-change-all-lines newhead hdmarker)) 9937 (org-move-to-column col)))) 9938 9939 (defun org-agenda-clock-out () 9940 "Stop the currently running clock." 9941 (interactive) 9942 (unless (marker-buffer org-clock-marker) 9943 (user-error "No running clock")) 9944 (let ((marker (make-marker)) (col (current-column)) newhead) 9945 (org-with-remote-undo (marker-buffer org-clock-marker) 9946 (with-current-buffer (marker-buffer org-clock-marker) 9947 (org-with-wide-buffer 9948 (goto-char org-clock-marker) 9949 (org-back-to-heading t) 9950 (move-marker marker (point)) 9951 (org-clock-out) 9952 (setq newhead (org-get-heading))))) 9953 (org-agenda-change-all-lines newhead marker) 9954 (move-marker marker nil) 9955 (org-move-to-column col) 9956 (org-agenda-unmark-clocking-task))) 9957 9958 (defun org-agenda-clock-cancel (&optional _arg) 9959 "Cancel the currently running clock." 9960 (interactive) ;; "P" 9961 (unless (marker-buffer org-clock-marker) 9962 (user-error "No running clock")) 9963 (org-with-remote-undo (marker-buffer org-clock-marker) 9964 (org-clock-cancel))) 9965 9966 (defun org-agenda-clock-goto () 9967 "Jump to the currently clocked in task within the agenda. 9968 If the currently clocked in task is not listed in the agenda 9969 buffer, display it in another window." 9970 (interactive) 9971 (let (pos) 9972 (mapc (lambda (o) 9973 (when (eq (overlay-get o 'type) 'org-agenda-clocking) 9974 (setq pos (overlay-start o)))) 9975 (overlays-in (point-min) (point-max))) 9976 (cond (pos (goto-char pos)) 9977 ;; If the currently clocked entry is not in the agenda 9978 ;; buffer, we visit it in another window: 9979 ((bound-and-true-p org-clock-current-task) 9980 (org-switch-to-buffer-other-window (org-clock-goto))) 9981 (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) 9982 9983 (defun org-agenda-diary-entry-in-org-file () 9984 "Make a diary entry in the file `org-agenda-diary-file'." 9985 (let (d1 d2 char (text "") dp1 dp2) 9986 (if (equal (buffer-name) "*Calendar*") 9987 (setq d1 (calendar-cursor-to-date t) 9988 d2 (car calendar-mark-ring)) 9989 (setq dp1 (get-text-property (point-at-bol) 'day)) 9990 (unless dp1 (user-error "No date defined in current line")) 9991 (setq d1 (calendar-gregorian-from-absolute dp1) 9992 d2 (and (ignore-errors (mark)) 9993 (save-excursion 9994 (goto-char (mark)) 9995 (setq dp2 (get-text-property (point-at-bol) 'day))) 9996 (calendar-gregorian-from-absolute dp2)))) 9997 (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree") 9998 (setq char (read-char-exclusive)) 9999 (cond 10000 ((equal char ?d) 10001 (setq text (read-string "Day entry: ")) 10002 (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1) 10003 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) 10004 ((equal char ?a) 10005 (setq d1 (list (car d1) (nth 1 d1) 10006 (read-number (format "Reference year [%d]: " (nth 2 d1)) 10007 (nth 2 d1)))) 10008 (setq text (read-string "Anniversary (use %d to show years): ")) 10009 (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1) 10010 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) 10011 ((equal char ?b) 10012 (setq text (read-string "Block entry: ")) 10013 (unless (and d1 d2 (not (equal d1 d2))) 10014 (user-error "No block of days selected")) 10015 (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2) 10016 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) 10017 ((equal char ?j) 10018 (org-switch-to-buffer-other-window 10019 (find-file-noselect org-agenda-diary-file)) 10020 (require 'org-datetree) 10021 (org-datetree-find-date-create d1) 10022 (org-reveal t)) 10023 (t (user-error "Invalid selection character `%c'" char))))) 10024 10025 (defcustom org-agenda-insert-diary-strategy 'date-tree 10026 "Where in `org-agenda-diary-file' should new entries be added? 10027 Valid values: 10028 10029 date-tree in the date tree, as first child of the date 10030 date-tree-last in the date tree, as last child of the date 10031 top-level as top-level entries at the end of the file." 10032 :group 'org-agenda 10033 :type '(choice 10034 (const :tag "first in a date tree" date-tree) 10035 (const :tag "last in a date tree" date-tree-last) 10036 (const :tag "as top level at end of file" top-level))) 10037 10038 (defcustom org-agenda-insert-diary-extract-time nil 10039 "Non-nil means extract any time specification from the diary entry." 10040 :group 'org-agenda 10041 :version "24.1" 10042 :type 'boolean) 10043 10044 (defcustom org-agenda-bulk-mark-char ">" 10045 "A single-character string to be used as the bulk mark." 10046 :group 'org-agenda 10047 :version "24.1" 10048 :type 'string) 10049 10050 (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) 10051 "Add a diary entry with TYPE to `org-agenda-diary-file'. 10052 If TEXT is not empty, it will become the headline of the new entry, and 10053 the resulting entry will not be shown. When TEXT is empty, switch to 10054 `org-agenda-diary-file' and let the user finish the entry there." 10055 (let ((cw (current-window-configuration))) 10056 (org-switch-to-buffer-other-window 10057 (find-file-noselect org-agenda-diary-file)) 10058 (widen) 10059 (goto-char (point-min)) 10060 (cl-case type 10061 (anniversary 10062 (or (re-search-forward "^\\*[ \t]+Anniversaries" nil t) 10063 (progn 10064 (or (org-at-heading-p t) 10065 (progn 10066 (outline-next-heading) 10067 (insert "* Anniversaries\n\n") 10068 (beginning-of-line -1))))) 10069 (outline-next-heading) 10070 (org-back-over-empty-lines) 10071 (backward-char 1) 10072 (insert "\n") 10073 (insert (format "%%%%(org-anniversary %d %2d %2d) %s" 10074 (nth 2 d1) (car d1) (nth 1 d1) text))) 10075 (day 10076 (let ((org-prefix-has-time t) 10077 (org-agenda-time-leading-zero t) 10078 fmt time time2) 10079 (when org-agenda-insert-diary-extract-time 10080 ;; Use org-agenda-format-item to parse text for a time-range and 10081 ;; remove it. FIXME: This is a hack, we should refactor 10082 ;; that function to make time extraction available separately 10083 (setq fmt (org-agenda-format-item nil text nil nil nil t) 10084 time (get-text-property 0 'time fmt) 10085 time2 (if (> (length time) 0) 10086 ;; split-string removes trailing ...... if 10087 ;; no end time given. First space 10088 ;; separates time from date. 10089 (concat " " (car (split-string time "\\."))) 10090 nil) 10091 text (get-text-property 0 'txt fmt))) 10092 (if (eq org-agenda-insert-diary-strategy 'top-level) 10093 (org-agenda-insert-diary-as-top-level text) 10094 (require 'org-datetree) 10095 (org-datetree-find-date-create d1) 10096 (org-agenda-insert-diary-make-new-entry text)) 10097 (org-insert-time-stamp (org-time-from-absolute 10098 (calendar-absolute-from-gregorian d1)) 10099 nil nil nil nil time2)) 10100 (end-of-line 0)) 10101 ((block) ;; Wrap this in (strictly unnecessary) parens because 10102 ;; otherwise the indentation gets confused by the 10103 ;; special meaning of 'block 10104 (when (> (calendar-absolute-from-gregorian d1) 10105 (calendar-absolute-from-gregorian d2)) 10106 (setq d1 (prog1 d2 (setq d2 d1)))) 10107 (if (eq org-agenda-insert-diary-strategy 'top-level) 10108 (org-agenda-insert-diary-as-top-level text) 10109 (require 'org-datetree) 10110 (org-datetree-find-date-create d1) 10111 (org-agenda-insert-diary-make-new-entry text)) 10112 (org-insert-time-stamp (org-time-from-absolute 10113 (calendar-absolute-from-gregorian d1))) 10114 (insert "--") 10115 (org-insert-time-stamp (org-time-from-absolute 10116 (calendar-absolute-from-gregorian d2))) 10117 (end-of-line 0))) 10118 (if (string-match "\\S-" text) 10119 (progn 10120 (set-window-configuration cw) 10121 (message "%s entry added to %s" 10122 (capitalize (symbol-name type)) 10123 (abbreviate-file-name org-agenda-diary-file))) 10124 (org-reveal t) 10125 (message "Please finish entry here")))) 10126 10127 (defun org-agenda-insert-diary-as-top-level (text) 10128 "Make new entry as a top-level entry at the end of the file. 10129 Add TEXT as headline, and position the cursor in the second line so that 10130 a timestamp can be added there." 10131 (widen) 10132 (goto-char (point-max)) 10133 (unless (bolp) (insert "\n")) 10134 (org-insert-heading nil t t) 10135 (insert text) 10136 (org-end-of-meta-data) 10137 (unless (bolp) (insert "\n")) 10138 (when org-adapt-indentation (indent-to-column 2))) 10139 10140 (defun org-agenda-insert-diary-make-new-entry (text) 10141 "Make a new entry with TEXT as a child of the current subtree. 10142 Position the point in the heading's first body line so that 10143 a timestamp can be added there." 10144 (cond 10145 ((eq org-agenda-insert-diary-strategy 'date-tree-last) 10146 (end-of-line) 10147 (org-insert-heading '(4) t) 10148 (org-do-demote)) 10149 (t 10150 (outline-next-heading) 10151 (org-back-over-empty-lines) 10152 (unless (looking-at "[ \t]*$") (save-excursion (insert "\n"))) 10153 (org-insert-heading nil t) 10154 (org-do-demote))) 10155 (let ((col (current-column))) 10156 (insert text) 10157 (org-end-of-meta-data) 10158 ;; Ensure point is left on a blank line, at proper indentation. 10159 (unless (bolp) (insert "\n")) 10160 (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n"))) 10161 (when org-adapt-indentation (indent-to-column col))) 10162 (org-show-set-visibility 'lineage)) 10163 10164 (defun org-agenda-diary-entry () 10165 "Make a diary entry, like the `i' command from the calendar. 10166 All the standard commands work: block, weekly etc. 10167 When `org-agenda-diary-file' points to a file, 10168 `org-agenda-diary-entry-in-org-file' is called instead to create 10169 entries in that Org file." 10170 (interactive) 10171 (if (not (eq org-agenda-diary-file 'diary-file)) 10172 (org-agenda-diary-entry-in-org-file) 10173 (require 'diary-lib) 10174 (let* ((char (read-char-exclusive 10175 "Diary entry: [d]ay [w]eekly [m]onthly [y]early\ 10176 [a]nniversary [b]lock [c]yclic")) 10177 (cmd (cdr (assoc char 10178 '((?d . diary-insert-entry) 10179 (?w . diary-insert-weekly-entry) 10180 (?m . diary-insert-monthly-entry) 10181 (?y . diary-insert-yearly-entry) 10182 (?a . diary-insert-anniversary-entry) 10183 (?b . diary-insert-block-entry) 10184 (?c . diary-insert-cyclic-entry))))) 10185 (oldf (symbol-function 'calendar-cursor-to-date)) 10186 ;; (buf (get-file-buffer (substitute-in-file-name diary-file))) 10187 (point (point)) 10188 (mark (or (mark t) (point)))) 10189 (unless cmd 10190 (user-error "No command associated with <%c>" char)) 10191 (unless (and (get-text-property point 'day) 10192 (or (not (equal ?b char)) 10193 (get-text-property mark 'day))) 10194 (user-error "Don't know which date to use for diary entry")) 10195 ;; We implement this by hacking the `calendar-cursor-to-date' function 10196 ;; and the `calendar-mark-ring' variable. Saves a lot of code. 10197 (let ((calendar-mark-ring 10198 (list (calendar-gregorian-from-absolute 10199 (or (get-text-property mark 'day) 10200 (get-text-property point 'day)))))) 10201 (unwind-protect 10202 (progn 10203 (fset 'calendar-cursor-to-date 10204 (lambda (&optional _error _dummy) 10205 (calendar-gregorian-from-absolute 10206 (get-text-property point 'day)))) 10207 (call-interactively cmd)) 10208 (fset 'calendar-cursor-to-date oldf)))))) 10209 10210 (defun org-agenda-execute-calendar-command (cmd) 10211 "Execute a calendar command from the agenda with date from cursor." 10212 (org-agenda-check-type t 'agenda) 10213 (require 'diary-lib) 10214 (unless (get-text-property (min (1- (point-max)) (point)) 'day) 10215 (user-error "Don't know which date to use for the calendar command")) 10216 (let* ((oldf (symbol-function 'calendar-cursor-to-date)) 10217 (point (point)) 10218 (date (calendar-gregorian-from-absolute 10219 (get-text-property point 'day)))) 10220 ;; the following 2 vars are needed in the calendar 10221 (org-dlet 10222 ((displayed-month (car date)) 10223 (displayed-year (nth 2 date))) 10224 (unwind-protect 10225 (progn 10226 (fset 'calendar-cursor-to-date 10227 (lambda (&optional _error _dummy) 10228 (calendar-gregorian-from-absolute 10229 (get-text-property point 'day)))) 10230 (call-interactively cmd)) 10231 (fset 'calendar-cursor-to-date oldf))))) 10232 10233 (defun org-agenda-phases-of-moon () 10234 "Display the phases of the moon for the 3 months around the cursor date." 10235 (interactive) 10236 (org-agenda-execute-calendar-command 'calendar-lunar-phases)) 10237 10238 (defun org-agenda-holidays () 10239 "Display the holidays for the 3 months around the cursor date." 10240 (interactive) 10241 (org-agenda-execute-calendar-command 'calendar-list-holidays)) 10242 10243 (defvar calendar-longitude) ; defined in calendar.el 10244 (defvar calendar-latitude) ; defined in calendar.el 10245 (defvar calendar-location-name) ; defined in calendar.el 10246 10247 (defun org-agenda-sunrise-sunset (arg) 10248 "Display sunrise and sunset for the cursor date. 10249 Latitude and longitude can be specified with the variables 10250 `calendar-latitude' and `calendar-longitude'. When called with prefix 10251 argument, latitude and longitude will be prompted for." 10252 (interactive "P") 10253 (require 'solar) 10254 (let ((calendar-longitude (if arg nil calendar-longitude)) 10255 (calendar-latitude (if arg nil calendar-latitude)) 10256 (calendar-location-name 10257 (if arg "the given coordinates" calendar-location-name))) 10258 (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) 10259 10260 (defun org-agenda-goto-calendar () 10261 "Open the Emacs calendar with the date at the cursor." 10262 (interactive) 10263 (org-agenda-check-type t 'agenda) 10264 (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) 10265 (user-error "Don't know which date to open in calendar"))) 10266 (date (calendar-gregorian-from-absolute day)) 10267 (calendar-move-hook nil) 10268 (calendar-view-holidays-initially-flag nil) 10269 (calendar-view-diary-initially-flag nil)) 10270 (calendar) 10271 (calendar-goto-date date))) 10272 10273 ;;;###autoload 10274 (defun org-calendar-goto-agenda () 10275 "Compute the Org agenda for the calendar date displayed at the cursor. 10276 This is a command that has to be installed in `calendar-mode-map'." 10277 (interactive) 10278 ;; Temporarily disable sticky agenda since user clearly wants to 10279 ;; refresh view anyway. 10280 (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*") 10281 (org-agenda-sticky nil)) 10282 (org-agenda-list nil (calendar-absolute-from-gregorian 10283 (calendar-cursor-to-date)) 10284 nil))) 10285 10286 (defun org-agenda-convert-date () 10287 (interactive) 10288 (org-agenda-check-type t 'agenda) 10289 (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) 10290 date s) 10291 (unless day 10292 (user-error "Don't know which date to convert")) 10293 (setq date (calendar-gregorian-from-absolute day)) 10294 (setq s (concat 10295 "Gregorian: " (calendar-date-string date) "\n" 10296 "ISO: " (calendar-iso-date-string date) "\n" 10297 "Day of Yr: " (calendar-day-of-year-string date) "\n" 10298 "Julian: " (calendar-julian-date-string date) "\n" 10299 "Astron. JD: " (calendar-astro-date-string date) 10300 " (Julian date number at noon UTC)\n" 10301 "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" 10302 "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" 10303 "French: " (calendar-french-date-string date) "\n" 10304 "Bahá’í: " (calendar-bahai-date-string date) " (until sunset)\n" 10305 "Mayan: " (calendar-mayan-date-string date) "\n" 10306 "Coptic: " (calendar-coptic-date-string date) "\n" 10307 "Ethiopic: " (calendar-ethiopic-date-string date) "\n" 10308 "Persian: " (calendar-persian-date-string date) "\n" 10309 "Chinese: " (calendar-chinese-date-string date) "\n")) 10310 (with-output-to-temp-buffer "*Dates*" 10311 (princ s)) 10312 (org-fit-window-to-buffer (get-buffer-window "*Dates*")))) 10313 10314 ;;; Bulk commands 10315 10316 (defun org-agenda-bulk-marked-p () 10317 "Non-nil when current entry is marked for bulk action." 10318 (eq (get-char-property (point-at-bol) 'type) 10319 'org-marked-entry-overlay)) 10320 10321 (defun org-agenda-bulk-mark (&optional arg) 10322 "Mark entries for future bulk action. 10323 10324 When ARG is nil or one and region is not active then mark the 10325 entry at point. 10326 10327 When ARG is nil or one and region is active then mark the entries 10328 in the region. 10329 10330 When ARG is greater than one mark ARG lines." 10331 (interactive "p") 10332 (when (and (or (not arg) (= arg 1)) (use-region-p)) 10333 (setq arg (count-lines (region-beginning) (region-end))) 10334 (goto-char (region-beginning)) 10335 (deactivate-mark)) 10336 (dotimes (_ (or arg 1)) 10337 (unless (org-get-at-bol 'org-agenda-diary-link) 10338 (let* ((m (org-get-at-bol 'org-hd-marker)) 10339 ov) 10340 (unless (org-agenda-bulk-marked-p) 10341 (unless m (user-error "Nothing to mark at point")) 10342 (push m org-agenda-bulk-marked-entries) 10343 (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) 10344 (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") 10345 (org-get-todo-face "TODO") 10346 'evaporate) 10347 (overlay-put ov 'type 'org-marked-entry-overlay)) 10348 (end-of-line 1) 10349 (or (ignore-errors 10350 (goto-char (next-single-property-change (point) 'org-hd-marker))) 10351 (beginning-of-line 2)) 10352 (while (and (get-char-property (point) 'invisible) (not (eobp))) 10353 (beginning-of-line 2))))) 10354 (message "%d entries marked for bulk action" 10355 (length org-agenda-bulk-marked-entries))) 10356 10357 (defun org-agenda-bulk-mark-all () 10358 "Mark all entries for future agenda bulk action." 10359 (interactive) 10360 (org-agenda-bulk-mark-regexp ".")) 10361 10362 (defun org-agenda-bulk-mark-regexp (regexp) 10363 "Mark entries matching REGEXP for future agenda bulk action." 10364 (interactive "sMark entries matching regexp: ") 10365 (let ((entries-marked 0) txt-at-point) 10366 (save-excursion 10367 (goto-char (point-min)) 10368 (goto-char (next-single-property-change (point) 'org-hd-marker)) 10369 (while (and (re-search-forward regexp nil t) 10370 (setq txt-at-point 10371 (get-text-property (match-beginning 0) 'txt))) 10372 (if (get-char-property (point) 'invisible) 10373 (beginning-of-line 2) 10374 (when (string-match-p regexp txt-at-point) 10375 (setq entries-marked (1+ entries-marked)) 10376 (call-interactively 'org-agenda-bulk-mark))))) 10377 (unless entries-marked 10378 (message "No entry matching this regexp.")))) 10379 10380 (defun org-agenda-bulk-unmark (&optional arg) 10381 "Unmark the entry at point for future bulk action." 10382 (interactive "P") 10383 (if arg 10384 (org-agenda-bulk-unmark-all) 10385 (cond ((org-agenda-bulk-marked-p) 10386 (org-agenda-bulk-remove-overlays 10387 (point-at-bol) (+ 2 (point-at-bol))) 10388 (setq org-agenda-bulk-marked-entries 10389 (delete (org-get-at-bol 'org-hd-marker) 10390 org-agenda-bulk-marked-entries)) 10391 (end-of-line 1) 10392 (or (ignore-errors 10393 (goto-char (next-single-property-change (point) 'txt))) 10394 (beginning-of-line 2)) 10395 (while (and (get-char-property (point) 'invisible) (not (eobp))) 10396 (beginning-of-line 2)) 10397 (message "%d entries left marked for bulk action" 10398 (length org-agenda-bulk-marked-entries))) 10399 (t (message "No entry to unmark here"))))) 10400 10401 (defun org-agenda-bulk-toggle-all () 10402 "Toggle all marks for bulk action." 10403 (interactive) 10404 (save-excursion 10405 (goto-char (point-min)) 10406 (while (ignore-errors 10407 (goto-char (next-single-property-change (point) 'org-hd-marker))) 10408 (org-agenda-bulk-toggle)))) 10409 10410 (defun org-agenda-bulk-toggle () 10411 "Toggle the mark at point for bulk action." 10412 (interactive) 10413 (if (org-agenda-bulk-marked-p) 10414 (org-agenda-bulk-unmark) 10415 (org-agenda-bulk-mark))) 10416 10417 (defun org-agenda-bulk-remove-overlays (&optional beg end) 10418 "Remove the mark overlays between BEG and END in the agenda buffer. 10419 BEG and END default to the buffer limits. 10420 10421 This only removes the overlays, it does not remove the markers 10422 from the list in `org-agenda-bulk-marked-entries'." 10423 (interactive) 10424 (mapc (lambda (ov) 10425 (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay) 10426 (delete-overlay ov))) 10427 (overlays-in (or beg (point-min)) (or end (point-max))))) 10428 10429 (defun org-agenda-bulk-unmark-all () 10430 "Remove all marks in the agenda buffer. 10431 This will remove the markers and the overlays." 10432 (interactive) 10433 (if (null org-agenda-bulk-marked-entries) 10434 (message "No entry to unmark") 10435 (setq org-agenda-bulk-marked-entries nil) 10436 (org-agenda-bulk-remove-overlays (point-min) (point-max)))) 10437 10438 (defcustom org-agenda-persistent-marks nil 10439 "Non-nil means marked items will stay marked after a bulk action. 10440 You can toggle this interactively by typing `p' when prompted for a 10441 bulk action." 10442 :group 'org-agenda 10443 :version "24.1" 10444 :type 'boolean) 10445 10446 (defcustom org-agenda-loop-over-headlines-in-active-region t 10447 "Shall some commands act upon headlines in the active region? 10448 10449 When set to t, some commands will be performed in all headlines 10450 within the active region. 10451 10452 When set to `start-level', some commands will be performed in all 10453 headlines within the active region, provided that these headlines 10454 are of the same level than the first one. 10455 10456 When set to a regular expression, those commands will be 10457 performed on the matching headlines within the active region. 10458 10459 The list of commands is: `org-agenda-schedule', 10460 `org-agenda-deadline', `org-agenda-date-prompt', 10461 `org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'. 10462 10463 See `org-loop-over-headlines-in-active-region' for the equivalent 10464 option for Org buffers." 10465 :type '(choice (const :tag "Don't loop" nil) 10466 (const :tag "All headlines in active region" t) 10467 (const :tag "In active region, headlines at the same level than the first one" start-level) 10468 (regexp :tag "Regular expression matcher")) 10469 :version "27.1" 10470 :package-version '(Org . "9.4") 10471 :group 'org-agenda) 10472 10473 (defun org-agenda-bulk-action (&optional arg) 10474 "Execute an remote-editing action on all marked entries. 10475 The prefix arg is passed through to the command if possible." 10476 (interactive "P") 10477 ;; When there is no mark, act on the agenda entry at point. 10478 (if (not org-agenda-bulk-marked-entries) 10479 (save-excursion (org-agenda-bulk-mark))) 10480 (dolist (m org-agenda-bulk-marked-entries) 10481 (unless (and (markerp m) 10482 (marker-buffer m) 10483 (buffer-live-p (marker-buffer m)) 10484 (marker-position m)) 10485 (user-error "Marker %s for bulk command is invalid" m))) 10486 10487 ;; Prompt for the bulk command. 10488 (org-unlogged-message 10489 (concat "Bulk (" (if org-agenda-persistent-marks "" "don't ") "[p]ersist marks): " 10490 "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " 10491 "[S]catter [f]unction " 10492 (and org-agenda-bulk-custom-functions 10493 (format " Custom: [%s]" 10494 (mapconcat (lambda (f) (char-to-string (car f))) 10495 org-agenda-bulk-custom-functions 10496 ""))))) 10497 (catch 'exit 10498 (let* ((org-log-refile (if org-log-refile 'time nil)) 10499 (entries (reverse org-agenda-bulk-marked-entries)) 10500 (org-overriding-default-time 10501 (and (get-text-property (point) 'org-agenda-date-header) 10502 (org-get-cursor-date))) 10503 redo-at-end 10504 cmd) 10505 (pcase (read-char-exclusive) 10506 (?p 10507 (let ((org-agenda-persistent-marks 10508 (not org-agenda-persistent-marks))) 10509 (org-agenda-bulk-action) 10510 (throw 'exit nil))) 10511 10512 (?$ 10513 (setq cmd #'org-agenda-archive)) 10514 10515 (?A 10516 (setq cmd #'org-agenda-archive-to-archive-sibling)) 10517 10518 ((or ?r ?w) 10519 (let ((refile-location 10520 (org-refile-get-location 10521 "Refile to" 10522 (marker-buffer (car entries)) 10523 org-refile-allow-creating-parent-nodes))) 10524 (when (nth 3 refile-location) 10525 (setcar (nthcdr 3 refile-location) 10526 (move-marker 10527 (make-marker) 10528 (nth 3 refile-location) 10529 (or (get-file-buffer (nth 1 refile-location)) 10530 (find-buffer-visiting (nth 1 refile-location)) 10531 (error "This should not happen"))))) 10532 10533 (setq cmd (lambda () (org-agenda-refile nil refile-location t))) 10534 (setq redo-at-end t))) 10535 10536 (?t 10537 (let ((state (completing-read 10538 "Todo state: " 10539 (with-current-buffer (marker-buffer (car entries)) 10540 (mapcar #'list org-todo-keywords-1))))) 10541 (setq cmd (lambda () 10542 (let ((org-inhibit-blocking t) 10543 (org-inhibit-logging 'note)) 10544 (org-agenda-todo state)))))) 10545 10546 ((and (or ?- ?+) action) 10547 (let ((tag (completing-read 10548 (format "Tag to %s: " (if (eq action ?+) "add" "remove")) 10549 (with-current-buffer (marker-buffer (car entries)) 10550 (delq nil 10551 (mapcar (lambda (x) (and (stringp (car x)) x)) 10552 org-current-tag-alist)))))) 10553 (setq cmd 10554 (lambda () 10555 (org-agenda-set-tags tag 10556 (if (eq action ?+) 'on 'off)))))) 10557 10558 ((and (or ?s ?d) c) 10559 (let* ((schedule? (eq c ?s)) 10560 (prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to")) 10561 (time 10562 (and (not arg) 10563 (let ((new (org-read-date 10564 nil nil nil prompt org-overriding-default-time))) 10565 ;; A "double plus" answer applies to every 10566 ;; scheduled time. Do not turn it into 10567 ;; a fixed date yet. 10568 (if (string-match-p "\\`[ \t]*\\+\\+" 10569 org-read-date-final-answer) 10570 org-read-date-final-answer 10571 new))))) 10572 ;; Make sure to not prompt for a note when bulk 10573 ;; rescheduling/resetting deadline as Org cannot cope with 10574 ;; simultaneous notes. Besides, it could be annoying 10575 ;; depending on the number of marked items. 10576 (setq cmd 10577 (if schedule? 10578 (lambda () 10579 (let ((org-log-reschedule 10580 (and org-log-reschedule 'time))) 10581 (org-agenda-schedule arg time))) 10582 (lambda () 10583 (let ((org-log-redeadline (and org-log-redeadline 'time))) 10584 (org-agenda-deadline arg time))))))) 10585 10586 (?S 10587 (unless (org-agenda-check-type nil 'agenda 'todo) 10588 (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)) 10589 (let ((days (read-number 10590 (format "Scatter tasks across how many %sdays: " 10591 (if arg "week" "")) 10592 7))) 10593 (setq cmd 10594 (lambda () 10595 (let ((distance (1+ (random days)))) 10596 (when arg 10597 (let ((dist distance) 10598 (day-of-week 10599 (calendar-day-of-week 10600 (calendar-gregorian-from-absolute (org-today))))) 10601 (dotimes (_ (1+ dist)) 10602 (while (member day-of-week org-agenda-weekend-days) 10603 (cl-incf distance) 10604 (cl-incf day-of-week) 10605 (when (= day-of-week 7) 10606 (setq day-of-week 0))) 10607 (cl-incf day-of-week) 10608 (when (= day-of-week 7) 10609 (setq day-of-week 0))))) 10610 ;; Silently fail when try to replan a sexp entry. 10611 (ignore-errors 10612 (let* ((date (calendar-gregorian-from-absolute 10613 (+ (org-today) distance))) 10614 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) 10615 (nth 2 date)))) 10616 (org-agenda-schedule nil time)))))))) 10617 10618 (?f 10619 (setq cmd 10620 (intern 10621 (completing-read "Function: " obarray #'fboundp t nil nil)))) 10622 10623 (action 10624 (setq cmd 10625 (pcase (assoc action org-agenda-bulk-custom-functions) 10626 (`(,_ ,fn) 10627 fn) 10628 (`(,_ ,fn ,arg-fn) 10629 (apply #'apply-partially fn (funcall arg-fn))) 10630 (_ 10631 (user-error "Invalid bulk action: %c" action)))) 10632 (setq redo-at-end t))) 10633 ;; Sort the markers, to make sure that parents are handled 10634 ;; before children. 10635 (setq entries (sort entries 10636 (lambda (a b) 10637 (cond 10638 ((eq (marker-buffer a) (marker-buffer b)) 10639 (< (marker-position a) (marker-position b))) 10640 (t 10641 (string< (buffer-name (marker-buffer a)) 10642 (buffer-name (marker-buffer b)))))))) 10643 10644 ;; Now loop over all markers and apply CMD. 10645 (let ((processed 0) 10646 (skipped 0)) 10647 (dolist (e entries) 10648 (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e))) 10649 (if (not pos) 10650 (progn (message "Skipping removed entry at %s" e) 10651 (cl-incf skipped)) 10652 (goto-char pos) 10653 (let (org-loop-over-headlines-in-active-region) (funcall cmd)) 10654 ;; `post-command-hook' is not run yet. We make sure any 10655 ;; pending log note is processed. 10656 (when org-log-setup (org-add-log-note)) 10657 (cl-incf processed)))) 10658 (when redo-at-end (org-agenda-redo)) 10659 (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all)) 10660 (message "Acted on %d entries%s%s" 10661 processed 10662 (if (= skipped 0) 10663 "" 10664 (format ", skipped %d (disappeared before their turn)" 10665 skipped)) 10666 (if (not org-agenda-persistent-marks) "" " (kept marked)")))))) 10667 10668 (defun org-agenda-capture (&optional with-time) 10669 "Call `org-capture' with the date at point. 10670 With a `C-1' prefix, use the HH:MM value at point (if any) or the 10671 current HH:MM time." 10672 (interactive "P") 10673 (if (not (eq major-mode 'org-agenda-mode)) 10674 (user-error "You cannot do this outside of agenda buffers") 10675 (let ((org-overriding-default-time 10676 (org-get-cursor-date (equal with-time 1)))) 10677 (call-interactively 'org-capture)))) 10678 10679 ;;; Dragging agenda lines forward/backward 10680 10681 (defun org-agenda-reapply-filters () 10682 "Re-apply all agenda filters." 10683 (mapcar 10684 (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t))) 10685 `((,org-agenda-tag-filter tag) 10686 (,org-agenda-category-filter category) 10687 (,org-agenda-regexp-filter regexp) 10688 (,org-agenda-effort-filter effort) 10689 (,(get 'org-agenda-tag-filter :preset-filter) tag) 10690 (,(get 'org-agenda-category-filter :preset-filter) category) 10691 (,(get 'org-agenda-effort-filter :preset-filter) effort) 10692 (,(get 'org-agenda-regexp-filter :preset-filter) regexp)))) 10693 10694 (defun org-agenda-drag-line-forward (arg &optional backward) 10695 "Drag an agenda line forward by ARG lines. 10696 When the optional argument `backward' is non-nil, move backward." 10697 (interactive "p") 10698 (let ((inhibit-read-only t) lst line) 10699 (if (or (not (get-text-property (point) 'txt)) 10700 (save-excursion 10701 (dotimes (_ arg) 10702 (move-beginning-of-line (if backward 0 2)) 10703 (push (not (get-text-property (point) 'txt)) lst)) 10704 (delq nil lst))) 10705 (message "Cannot move line forward") 10706 (let ((end (save-excursion (move-beginning-of-line 2) (point)))) 10707 (move-beginning-of-line 1) 10708 (setq line (buffer-substring (point) end)) 10709 (delete-region (point) end) 10710 (move-beginning-of-line (funcall (if backward '1- '1+) arg)) 10711 (insert line) 10712 (org-agenda-reapply-filters) 10713 (org-agenda-mark-clocking-task) 10714 (move-beginning-of-line 0))))) 10715 10716 (defun org-agenda-drag-line-backward (arg) 10717 "Drag an agenda line backward by ARG lines." 10718 (interactive "p") 10719 (org-agenda-drag-line-forward arg t)) 10720 10721 ;;; Flagging notes 10722 10723 (defun org-agenda-show-the-flagging-note () 10724 "Display the flagging note in the other window. 10725 When called a second time in direct sequence, offer to remove the FLAGGING 10726 tag and (if present) the flagging note." 10727 (interactive) 10728 (let ((hdmarker (org-get-at-bol 'org-hd-marker)) 10729 (win (selected-window)) 10730 note) ;; heading newhead 10731 (unless hdmarker 10732 (user-error "No linked entry at point")) 10733 (if (and (eq this-command last-command) 10734 (y-or-n-p "Unflag and remove any flagging note? ")) 10735 (progn 10736 (org-agenda-remove-flag hdmarker) 10737 (let ((win (get-buffer-window "*Flagging Note*"))) 10738 (and win (delete-window win))) 10739 (message "Entry unflagged")) 10740 (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE")) 10741 (unless note 10742 (user-error "No flagging note")) 10743 (org-kill-new note) 10744 (org-switch-to-buffer-other-window "*Flagging Note*") 10745 (erase-buffer) 10746 (insert note) 10747 (goto-char (point-min)) 10748 (while (re-search-forward "\\\\n" nil t) 10749 (replace-match "\n" t t)) 10750 (goto-char (point-min)) 10751 (select-window win) 10752 (message "%s" (substitute-command-keys "Flagging note pushed to \ 10753 kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \ 10754 tag and note"))))) 10755 10756 (defun org-agenda-remove-flag (marker) 10757 "Remove the FLAGGED tag and any flagging note in the entry." 10758 (let ((newhead 10759 (org-with-point-at marker 10760 (org-toggle-tag "FLAGGED" 'off) 10761 (org-entry-delete nil "THEFLAGGINGNOTE") 10762 (org-get-heading)))) 10763 (org-agenda-change-all-lines newhead marker) 10764 (message "Entry unflagged"))) 10765 10766 (defun org-agenda-get-any-marker (&optional pos) 10767 (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker) 10768 (get-text-property (or pos (point-at-bol)) 'org-marker))) 10769 10770 ;;; Appointment reminders 10771 10772 (defvar appt-time-msg-list) ; defined in appt.el 10773 10774 ;;;###autoload 10775 (defun org-agenda-to-appt (&optional refresh filter &rest args) 10776 "Activate appointments found in `org-agenda-files'. 10777 10778 With a `\\[universal-argument]' prefix, refresh the list of \ 10779 appointments. 10780 10781 If FILTER is t, interactively prompt the user for a regular 10782 expression, and filter out entries that don't match it. 10783 10784 If FILTER is a string, use this string as a regular expression 10785 for filtering entries out. 10786 10787 If FILTER is a function, filter out entries against which 10788 calling the function returns nil. This function takes one 10789 argument: an entry from `org-agenda-get-day-entries'. 10790 10791 FILTER can also be an alist with the car of each cell being 10792 either `headline' or `category'. For example: 10793 10794 \\='((headline \"IMPORTANT\") 10795 (category \"Work\")) 10796 10797 will only add headlines containing IMPORTANT or headlines 10798 belonging to the \"Work\" category. 10799 10800 ARGS are symbols indicating what kind of entries to consider. 10801 By default `org-agenda-to-appt' will use :deadline*, :scheduled* 10802 \(i.e., deadlines and scheduled items with a hh:mm specification) 10803 and :timestamp entries. See the docstring of `org-diary' for 10804 details and examples. 10805 10806 If an entry has a APPT_WARNTIME property, its value will be used 10807 to override `appt-message-warning-time'." 10808 (interactive "P") 10809 (when refresh (setq appt-time-msg-list nil)) 10810 (when (eq filter t) 10811 (setq filter (read-from-minibuffer "Regexp filter: "))) 10812 (let* ((cnt 0) ; count added events 10813 (scope (or args '(:deadline* :scheduled* :timestamp))) 10814 (org-agenda-new-buffers nil) 10815 (org-deadline-warning-days 0) 10816 ;; Do not use `org-today' here because appt only takes 10817 ;; time and without date as argument, so it may pass wrong 10818 ;; information otherwise 10819 (today (org-date-to-gregorian 10820 (time-to-days nil))) 10821 (org-agenda-restrict nil) 10822 (files (org-agenda-files 'unrestricted)) entries file 10823 (org-agenda-buffer nil)) 10824 ;; Get all entries which may contain an appt 10825 (org-agenda-prepare-buffers files) 10826 (while (setq file (pop files)) 10827 (setq entries 10828 (delq nil 10829 (append entries 10830 (apply #'org-agenda-get-day-entries 10831 file today scope))))) 10832 ;; Map through entries and find if we should filter them out 10833 (mapc 10834 (lambda (x) 10835 (let* ((evt (org-trim 10836 (replace-regexp-in-string 10837 org-link-bracket-re "\\2" 10838 (or (get-text-property 1 'txt x) "")))) 10839 (cat (get-text-property (1- (length x)) 'org-category x)) 10840 (tod (get-text-property 1 'time-of-day x)) 10841 (ok (or (null filter) 10842 (and (stringp filter) (string-match filter evt)) 10843 (and (functionp filter) (funcall filter x)) 10844 (and (listp filter) 10845 (let ((cat-filter (cadr (assq 'category filter))) 10846 (evt-filter (cadr (assq 'headline filter)))) 10847 (or (and (stringp cat-filter) 10848 (string-match cat-filter cat)) 10849 (and (stringp evt-filter) 10850 (string-match evt-filter evt))))))) 10851 (wrn (get-text-property 1 'warntime x))) 10852 ;; FIXME: Shall we remove text-properties for the appt text? 10853 ;; (setq evt (set-text-properties 0 (length evt) nil evt)) 10854 (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt))) 10855 (setq tod (concat "00" (number-to-string tod))) 10856 (setq tod (when (string-match 10857 "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) 10858 (concat (match-string 1 tod) ":" 10859 (match-string 2 tod)))) 10860 (when (appt-add tod evt wrn) 10861 (setq cnt (1+ cnt)))))) 10862 entries) 10863 (org-release-buffers org-agenda-new-buffers) 10864 (if (eq cnt 0) 10865 (message "No event to add") 10866 (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) 10867 10868 (defun org-agenda-today-p (date) 10869 "Non-nil when DATE means today. 10870 DATE is either a list of the form (month day year) or a number of 10871 days as returned by `calendar-absolute-from-gregorian' or 10872 `org-today'. This function considers `org-extend-today-until' 10873 when defining today." 10874 (eq (org-today) 10875 (if (consp date) (calendar-absolute-from-gregorian date) date))) 10876 10877 (defun org-agenda-todo-yesterday (&optional arg) 10878 "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday." 10879 (interactive "P") 10880 (let* ((org-use-effective-time t) 10881 (hour (nth 2 (decode-time (org-current-time)))) 10882 (org-extend-today-until (1+ hour))) 10883 (org-agenda-todo arg))) 10884 10885 (defun org-agenda-ctrl-c-ctrl-c () 10886 "Set tags in agenda buffer." 10887 (interactive) 10888 (org-agenda-set-tags)) 10889 10890 (provide 'org-agenda) 10891 10892 ;;; org-agenda.el ends here