org-agenda.el (460551B)
1 ;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2004-2023 Free Software Foundation, Inc. 4 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, wp 7 ;; URL: https://orgmode.org 8 ;; 9 ;; This file is part of GNU Emacs. 10 ;; 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 ;; 25 ;;; Commentary: 26 27 ;; This file contains the code for creating and using the Agenda for Org. 28 ;; 29 ;; The functions `org-batch-agenda', `org-batch-agenda-csv', and 30 ;; `org-batch-store-agenda-views' are implemented as macros to provide 31 ;; a convenient way for extracting agenda information from the command 32 ;; line. The Lisp does not evaluate parameters of a macro call; thus 33 ;; it is not necessary to quote the parameters passed to one of those 34 ;; functions. E.g. you can write: 35 ;; 36 ;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)' 37 ;; 38 ;; To export an agenda spanning 7 days. If `org-batch-agenda' would 39 ;; have been implemented as a regular function you'd have to quote the 40 ;; symbol org-agenda-span. Moreover: To use a symbol as parameter 41 ;; value you would have to double quote the symbol. 42 ;; 43 ;; This is a hack, but it works even when running Org byte-compiled. 44 ;; 45 46 ;;; Code: 47 48 (require 'org-macs) 49 (org-assert-version) 50 51 (require 'cl-lib) 52 (require 'ol) 53 (require 'org-fold-core) 54 (require 'org) 55 (require 'org-macs) 56 (require 'org-refile) 57 58 (declare-function diary-add-to-list "diary-lib" 59 (date string specifier &optional marker globcolor literal)) 60 (declare-function calendar-iso-to-absolute "cal-iso" (date)) 61 (declare-function calendar-astro-date-string "cal-julian" (&optional date)) 62 (declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) 63 (declare-function calendar-chinese-date-string "cal-china" (&optional date)) 64 (declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) 65 (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) 66 (declare-function calendar-french-date-string "cal-french" (&optional date)) 67 (declare-function calendar-goto-date "cal-move" (date)) 68 (declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) 69 (declare-function calendar-islamic-date-string "cal-islam" (&optional date)) 70 (declare-function calendar-iso-date-string "cal-iso" (&optional date)) 71 (declare-function calendar-iso-from-absolute "cal-iso" (date)) 72 (declare-function calendar-julian-date-string "cal-julian" (&optional date)) 73 (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) 74 (declare-function calendar-persian-date-string "cal-persia" (&optional date)) 75 (declare-function calendar-check-holidays "holidays" (date)) 76 77 (declare-function org-columns-remove-overlays "org-colview" ()) 78 (declare-function org-datetree-find-date-create "org-datetree" 79 (date &optional keep-restriction)) 80 (declare-function org-columns-quit "org-colview" ()) 81 (declare-function diary-date-display-form "diary-lib" (&optional type)) 82 (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file)) 83 (declare-function org-element-property "org-element" (property element)) 84 (declare-function org-element--cache-active-p "org-element" 85 (&optional called-from-cache-change-func-p)) 86 (declare-function org-element-lineage "org-element" 87 (datum &optional types with-self)) 88 (declare-function org-habit-insert-consistency-graphs 89 "org-habit" (&optional line)) 90 (declare-function org-is-habit-p "org-habit" (&optional pom)) 91 (declare-function org-habit-parse-todo "org-habit" (&optional pom)) 92 (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) 93 (declare-function org-agenda-columns "org-colview" ()) 94 (declare-function org-add-archive-files "org-archive" (files)) 95 (declare-function org-capture "org-capture" (&optional goto keys)) 96 (declare-function org-clock-modify-effort-estimate "org-clock" (&optional value)) 97 98 (declare-function org-element-type "org-element" (&optional element)) 99 100 (defvar calendar-mode-map) 101 (defvar org-clock-current-task) 102 (defvar org-current-tag-alist) 103 (defvar org-mobile-force-id-on-agenda-items) 104 (defvar org-habit-show-habits) 105 (defvar org-habit-show-habits-only-for-today) 106 (defvar org-habit-show-all-today) 107 (defvar org-habit-scheduled-past-days) 108 109 ;; Defined somewhere in this file, but used before definition. 110 (defvar org-agenda-buffer-name "*Org Agenda*") 111 (defvar org-agenda-title-append nil) 112 (defvar org-agenda-overriding-header) 113 ;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el 114 ;; (with-no-warnings (defvar date)) ;; unprefixed, from calendar.el 115 (defvar original-date) ; dynamically scoped, calendar.el does scope this 116 117 (defvar org-agenda-undo-list nil 118 "List of undoable operations in the agenda since last refresh.") 119 (defvar org-agenda-pending-undo-list nil 120 "In a series of undo commands, this is the list of remaining undo items.") 121 122 (defcustom org-agenda-confirm-kill 1 123 "When set, remote killing from the agenda buffer needs confirmation. 124 When t, a confirmation is always needed. When a number N, confirmation is 125 only needed when the text to be killed contains more than N non-white lines." 126 :group 'org-agenda 127 :type '(choice 128 (const :tag "Never" nil) 129 (const :tag "Always" t) 130 (integer :tag "When more than N lines"))) 131 132 (defcustom org-agenda-compact-blocks nil 133 "Non-nil means make the block agenda more compact. 134 This is done globally by leaving out lines like the agenda span 135 name and week number or the separator lines." 136 :group 'org-agenda 137 :type 'boolean) 138 139 (defcustom org-agenda-block-separator 140 (if (and (display-graphic-p) 141 (char-displayable-p ?─)) 142 ?─ 143 ?=) 144 "The separator between blocks in the agenda. 145 If this is a string, it will be used as the separator, with a newline added. 146 If it is a character, it will be repeated to fill the window width. 147 If nil the separator is disabled. In `org-agenda-custom-commands' this 148 addresses the separator between the current and the previous block." 149 :group 'org-agenda 150 :package-version '(Org . "9.6") 151 :type '(choice 152 (const :tag "Disabled" nil) 153 (character) 154 (string))) 155 156 (defgroup org-agenda-export nil 157 "Options concerning exporting agenda views in Org mode." 158 :tag "Org Agenda Export" 159 :group 'org-agenda) 160 161 (defcustom org-agenda-with-colors t 162 "Non-nil means use colors in agenda views." 163 :group 'org-agenda-export 164 :type 'boolean) 165 166 (defcustom org-agenda-exporter-settings nil 167 ;; FIXME: Do we really want to evaluate those settings and thus force 168 ;; the user to use `quote' all the time? 169 "Alist of variable/value pairs that should be active during agenda export. 170 This is a good place to set options for ps-print and for htmlize. 171 Note that the way this is implemented, the values will be evaluated 172 before assigned to the variables. So make sure to quote values you do 173 *not* want evaluated, for example 174 175 (setq org-agenda-exporter-settings 176 \\='((ps-print-color-p \\='black-white)))" 177 :group 'org-agenda-export 178 :type '(repeat 179 (list 180 (variable) 181 (sexp :tag "Value")))) 182 183 (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) 184 "Hook run in a temporary buffer before writing the agenda to an export file. 185 A useful function for this hook is `org-agenda-add-entry-text'." 186 :group 'org-agenda-export 187 :type 'hook 188 :options '(org-agenda-add-entry-text)) 189 190 (defcustom org-agenda-add-entry-text-maxlines 0 191 "Maximum number of entry text lines to be added to agenda. 192 This is only relevant when `org-agenda-add-entry-text' is part of 193 `org-agenda-before-write-hook', which is the default. 194 When this is 0, nothing will happen. When it is greater than 0, it 195 specifies the maximum number of lines that will be added for each entry 196 that is listed in the agenda view. 197 198 Note that this variable is not used during display, only when exporting 199 the agenda. For agenda display, see the variables `org-agenda-entry-text-mode' 200 and `org-agenda-entry-text-maxlines'." 201 :group 'org-agenda 202 :type 'integer) 203 204 (defcustom org-agenda-add-entry-text-descriptive-links t 205 "Non-nil means export org-links as descriptive links in agenda added text. 206 This variable applies to the text added to the agenda when 207 `org-agenda-add-entry-text-maxlines' is larger than 0. 208 When this variable is nil, the URL will (also) be shown." 209 :group 'org-agenda 210 :type 'boolean) 211 212 (defcustom org-agenda-export-html-style nil 213 "The style specification for exported HTML Agenda files. 214 If this variable contains a string, it will replace the default <style> 215 section as produced by `htmlize'. 216 Since there are different ways of setting style information, this variable 217 needs to contain the full HTML structure to provide a style, including the 218 surrounding HTML tags. The style specifications should include definitions 219 the fonts used by the agenda, here is an example: 220 221 <style type=\"text/css\"> 222 p { font-weight: normal; color: gray; } 223 .org-agenda-structure { 224 font-size: 110%; 225 color: #003399; 226 font-weight: 600; 227 } 228 .org-todo { 229 color: #cc6666; 230 font-weight: bold; 231 } 232 .org-agenda-done { 233 color: #339933; 234 } 235 .org-done { 236 color: #339933; 237 } 238 .title { text-align: center; } 239 .todo, .deadline { color: red; } 240 .done { color: green; } 241 </style> 242 243 or, if you want to keep the style in a file, 244 245 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> 246 247 As the value of this option simply gets inserted into the HTML <head> header, 248 you can \"misuse\" it to also add other text to the header." 249 :group 'org-agenda-export 250 :group 'org-export-html 251 :type '(choice 252 (const nil) 253 (string))) 254 255 (defcustom org-agenda-persistent-filter nil 256 "When set, keep filters from one agenda view to the next." 257 :group 'org-agenda 258 :type 'boolean) 259 260 (defgroup org-agenda-custom-commands nil 261 "Options concerning agenda views in Org mode." 262 :tag "Org Agenda Custom Commands" 263 :group 'org-agenda) 264 265 (defconst org-sorting-choice 266 '(choice 267 (const time-up) (const time-down) 268 (const timestamp-up) (const timestamp-down) 269 (const scheduled-up) (const scheduled-down) 270 (const deadline-up) (const deadline-down) 271 (const ts-up) (const ts-down) 272 (const tsia-up) (const tsia-down) 273 (const category-keep) (const category-up) (const category-down) 274 (const tag-down) (const tag-up) 275 (const priority-up) (const priority-down) 276 (const todo-state-up) (const todo-state-down) 277 (const effort-up) (const effort-down) 278 (const habit-up) (const habit-down) 279 (const alpha-up) (const alpha-down) 280 (const user-defined-up) (const user-defined-down)) 281 "Sorting choices.") 282 283 ;; Keep custom values for `org-agenda-filter-preset' compatible with 284 ;; the new variable `org-agenda-tag-filter-preset'. 285 (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) 286 (defvaralias 'org-agenda-filter 'org-agenda-tag-filter) 287 288 (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) 289 "List of types searched for when creating the daily/weekly agenda. 290 This variable is a list of symbols that controls the types of 291 items that appear in the daily/weekly agenda. Allowed symbols in this 292 list are 293 294 :timestamp List items containing a date stamp or date range matching 295 the selected date. This includes sexp entries in angular 296 brackets. 297 298 :sexp List entries resulting from plain diary-like sexps. 299 300 :deadline List deadline due on that date. When the date is today, 301 also list any deadlines past due, or due within 302 `org-deadline-warning-days'. 303 304 :deadline* Same as above, but only include the deadline if it has an 305 hour specification as [h]h:mm. 306 307 :scheduled List all items which are scheduled for the given date. 308 The diary for *today* also contains items which were 309 scheduled earlier and are not yet marked DONE. 310 311 :scheduled* Same as above, but only include the scheduled item if it 312 has an hour specification as [h]h:mm. 313 314 By default, all four non-starred types are turned on. 315 316 When :scheduled* or :deadline* are included, :schedule or :deadline 317 will be ignored. 318 319 Never set this variable globally using `setq', because then it 320 will apply to all future agenda commands. Instead, bind it with 321 `let' to scope it dynamically into the agenda-constructing 322 command. A good way to set it is through options in 323 `org-agenda-custom-commands'. For a more flexible (though 324 somewhat less efficient) way of determining what is included in 325 the daily/weekly agenda, see `org-agenda-skip-function'.") 326 327 (defconst org-agenda-custom-commands-local-options 328 `(repeat :tag "Local settings for this command. Remember to quote values" 329 (choice :tag "Setting" 330 (list :tag "Heading for this block" 331 (const org-agenda-overriding-header) 332 (string :tag "Headline")) 333 (list :tag "Files to be searched" 334 (const org-agenda-files) 335 (list 336 (const :format "" quote) 337 (repeat (file)))) 338 (list :tag "Sorting strategy" 339 (const org-agenda-sorting-strategy) 340 (list 341 (const :format "" quote) 342 (repeat 343 ,org-sorting-choice))) 344 (list :tag "Prefix format" 345 (const org-agenda-prefix-format :value " %-12:c%?-12t% s") 346 (string)) 347 (list :tag "Number of days in agenda" 348 (const org-agenda-span) 349 (list 350 (const :format "" quote) 351 (choice (const :tag "Day" day) 352 (const :tag "Week" week) 353 (const :tag "Fortnight" fortnight) 354 (const :tag "Month" month) 355 (const :tag "Year" year) 356 (integer :tag "Custom")))) 357 (list :tag "Fixed starting date" 358 (const org-agenda-start-day) 359 (string :value "2007-11-01")) 360 (list :tag "Start on day of week" 361 (const org-agenda-start-on-weekday) 362 (choice :value 1 363 (const :tag "Today" nil) 364 (integer :tag "Weekday No."))) 365 (list :tag "Include data from diary" 366 (const org-agenda-include-diary) 367 (boolean)) 368 (list :tag "Deadline Warning days" 369 (const org-deadline-warning-days) 370 (integer :value 1)) 371 (list :tag "Category filter preset" 372 (const org-agenda-category-filter-preset) 373 (list 374 (const :format "" quote) 375 (repeat 376 (string :tag "+category or -category")))) 377 (list :tag "Tags filter preset" 378 (const org-agenda-tag-filter-preset) 379 (list 380 (const :format "" quote) 381 (repeat 382 (string :tag "+tag or -tag")))) 383 (list :tag "Effort filter preset" 384 (const org-agenda-effort-filter-preset) 385 (list 386 (const :format "" quote) 387 (repeat 388 (string :tag "+=10 or -=10 or +<10 or ->10")))) 389 (list :tag "Regexp filter preset" 390 (const org-agenda-regexp-filter-preset) 391 (list 392 (const :format "" quote) 393 (repeat 394 (string :tag "+regexp or -regexp")))) 395 (list :tag "Set daily/weekly entry types" 396 (const org-agenda-entry-types) 397 (list 398 (const :format "" quote) 399 (set :greedy t :value ,org-agenda-entry-types 400 (const :deadline) 401 (const :scheduled) 402 (const :deadline*) 403 (const :scheduled*) 404 (const :timestamp) 405 (const :sexp)))) 406 (list :tag "Columns format" 407 (const org-overriding-columns-format) 408 (string :tag "Format")) 409 (list :tag "Standard skipping condition" 410 :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) 411 (const org-agenda-skip-function) 412 (list 413 (const :format "" quote) 414 (list 415 (choice 416 :tag "Skipping range" 417 (const :tag "Skip entry" org-agenda-skip-entry-if) 418 (const :tag "Skip subtree" org-agenda-skip-subtree-if)) 419 (repeat :inline t :tag "Conditions for skipping" 420 (choice 421 :tag "Condition type" 422 (list :tag "Regexp matches" :inline t 423 (const :format "" regexp) 424 (regexp)) 425 (list :tag "Regexp does not match" :inline t 426 (const :format "" notregexp) 427 (regexp)) 428 (list :tag "TODO state is" :inline t 429 (const todo) 430 (choice 431 (const :tag "Any not-done state" todo) 432 (const :tag "Any done state" done) 433 (const :tag "Any state" any) 434 (list :tag "Keyword list" 435 (const :format "" quote) 436 (repeat (string :tag "Keyword"))))) 437 (list :tag "TODO state is not" :inline t 438 (const nottodo) 439 (choice 440 (const :tag "Any not-done state" todo) 441 (const :tag "Any done state" done) 442 (const :tag "Any state" any) 443 (list :tag "Keyword list" 444 (const :format "" quote) 445 (repeat (string :tag "Keyword"))))) 446 (const :tag "scheduled" scheduled) 447 (const :tag "not scheduled" notscheduled) 448 (const :tag "deadline" deadline) 449 (const :tag "no deadline" notdeadline) 450 (const :tag "timestamp" timestamp) 451 (const :tag "no timestamp" nottimestamp)))))) 452 (list :tag "Non-standard skipping condition" 453 :value (org-agenda-skip-function) 454 (const org-agenda-skip-function) 455 (sexp :tag "Function or form (quoted!)")) 456 (list :tag "Any variable" 457 (variable :tag "Variable") 458 (sexp :tag "Value (sexp)")))) 459 "Selection of examples for agenda command settings. 460 This will be spliced into the custom type of 461 `org-agenda-custom-commands'.") 462 463 464 (defcustom org-agenda-custom-commands 465 '(("n" "Agenda and all TODOs" ((agenda "") (alltodo "")))) 466 "Custom commands for the agenda. 467 \\<org-mode-map> 468 These commands will be offered on the splash screen displayed by the 469 agenda dispatcher `\\[org-agenda]'. Each entry is a list like this: 470 471 (key desc type match settings files) 472 473 key The key (one or more characters as a string) to be associated 474 with the command. 475 desc A description of the command. When omitted or nil, a default 476 description is built using MATCH. 477 type The command type, any of the following symbols: 478 agenda The daily/weekly agenda. 479 agenda* Appointments for current week/day. 480 todo Entries with a specific TODO keyword, in all agenda files. 481 search Entries containing search words entry or headline. 482 tags Tags/Property/TODO match in all agenda files. 483 tags-todo Tags/P/T match in all agenda files, TODO entries only. 484 todo-tree Sparse tree of specific TODO keyword in *current* file. 485 tags-tree Sparse tree with all tags matches in *current* file. 486 occur-tree Occur sparse tree for *current* file. 487 alltodo The global TODO list. 488 stuck Stuck projects. 489 ... A user-defined function. 490 match What to search for: 491 - a single keyword for TODO keyword searches 492 - a tags/property/todo match expression for searches 493 - a word search expression for text searches. 494 - a regular expression for occur searches 495 For all other commands, this should be the empty string. 496 settings A list of option settings, similar to that in a let form, so like 497 this: ((opt1 val1) (opt2 val2) ...). The values will be 498 evaluated at the moment of execution, so quote them when needed. 499 files A list of files to write the produced agenda buffer to with 500 the command `org-store-agenda-views'. 501 If a file name ends in \".html\", an HTML version of the buffer 502 is written out. If it ends in \".ps\", a PostScript version is 503 produced. Otherwise, only the plain text is written to the file. 504 505 You can also define a set of commands, to create a composite agenda buffer. 506 In this case, an entry looks like this: 507 508 (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files) 509 510 where 511 512 desc A description string to be displayed in the dispatcher menu. 513 cmd An agenda command, similar to the above. However, tree commands 514 are not allowed. Valid commands for a set are: 515 (agenda \"\" settings) 516 (agenda* \"\" settings) 517 (alltodo \"\" settings) 518 (stuck \"\" settings) 519 (todo \"match\" settings files) 520 (search \"match\" settings files) 521 (tags \"match\" settings files) 522 (tags-todo \"match\" settings files) 523 524 Each command can carry a list of options, and another set of options can be 525 given for the whole set of commands. Individual command options take 526 precedence over the general options. 527 528 When using several characters as key to a command, the first characters 529 are prefix commands. For the dispatcher to display useful information, you 530 should provide a description for the prefix, like 531 532 (setq org-agenda-custom-commands 533 \\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" 534 (\"hl\" tags \"+HOME+Lisa\") 535 (\"hp\" tags \"+HOME+Peter\") 536 (\"hk\" tags \"+HOME+Kim\"))) 537 538 See also Info node `(org) Custom Agenda Views'." 539 :group 'org-agenda-custom-commands 540 :type `(repeat 541 (choice :value ("x" "Describe command here" tags "" nil) 542 (list :tag "Single command" 543 (string :tag "Access Key(s) ") 544 (option (string :tag "Description")) 545 (choice 546 (const :tag "Agenda" agenda) 547 (const :tag "TODO list" alltodo) 548 (const :tag "Search words" search) 549 (const :tag "Stuck projects" stuck) 550 (const :tag "Tags/Property match (all agenda files)" tags) 551 (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) 552 (const :tag "TODO keyword search (all agenda files)" todo) 553 (const :tag "Tags sparse tree (current buffer)" tags-tree) 554 (const :tag "TODO keyword tree (current buffer)" todo-tree) 555 (const :tag "Occur tree (current buffer)" occur-tree) 556 (sexp :tag "Other, user-defined function")) 557 (string :tag "Match (only for some commands)") 558 ,org-agenda-custom-commands-local-options 559 (option (repeat :tag "Export" (file :tag "Export to")))) 560 (list :tag "Command series, all agenda files" 561 (string :tag "Access Key(s)") 562 (string :tag "Description ") 563 (repeat :tag "Component" 564 (choice 565 (list :tag "Agenda" 566 (const :format "" agenda) 567 (const :tag "" :format "" "") 568 ,org-agenda-custom-commands-local-options) 569 (list :tag "TODO list (all keywords)" 570 (const :format "" alltodo) 571 (const :tag "" :format "" "") 572 ,org-agenda-custom-commands-local-options) 573 (list :tag "Search words" 574 (const :format "" search) 575 (string :tag "Match") 576 ,org-agenda-custom-commands-local-options) 577 (list :tag "Stuck projects" 578 (const :format "" stuck) 579 (const :tag "" :format "" "") 580 ,org-agenda-custom-commands-local-options) 581 (list :tag "Tags/Property match (all agenda files)" 582 (const :format "" tags) 583 (string :tag "Match") 584 ,org-agenda-custom-commands-local-options) 585 (list :tag "Tags/Property match of TODO entries (all agenda files)" 586 (const :format "" tags-todo) 587 (string :tag "Match") 588 ,org-agenda-custom-commands-local-options) 589 (list :tag "TODO keyword search" 590 (const :format "" todo) 591 (string :tag "Match") 592 ,org-agenda-custom-commands-local-options) 593 (list :tag "Other, user-defined function" 594 (symbol :tag "function") 595 (string :tag "Match") 596 ,org-agenda-custom-commands-local-options))) 597 598 (repeat :tag "Settings for entire command set" 599 (list (variable :tag "Any variable") 600 (sexp :tag "Value"))) 601 (option (repeat :tag "Export" (file :tag "Export to")))) 602 (cons :tag "Prefix key documentation" 603 (string :tag "Access Key(s)") 604 (string :tag "Description "))))) 605 606 (defcustom org-agenda-query-register ?o 607 "The register holding the current query string. 608 The purpose of this is that if you construct a query string interactively, 609 you can then use it to define a custom command." 610 :group 'org-agenda-custom-commands 611 :type 'character) 612 613 (defcustom org-stuck-projects 614 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") 615 "How to identify stuck projects. 616 This is a list of four items: 617 618 1. A tags/todo/property matcher string that is used to identify a project. 619 See Info node `(org) Matching tags and properties' for a 620 description of tag and property searches. The entire tree 621 below a headline matched by this is considered one project. 622 623 2. A list of TODO keywords identifying non-stuck projects. 624 If the project subtree contains any headline with one of these todo 625 keywords, the project is considered to be not stuck. If you specify 626 \"*\" as a keyword, any TODO keyword will mark the project unstuck. 627 628 3. A list of tags identifying non-stuck projects. 629 If the project subtree contains any headline with one of these tags, 630 the project is considered to be not stuck. If you specify \"*\" as 631 a tag, any tag will mark the project unstuck. Note that this is about 632 the explicit presence of a tag somewhere in the subtree, inherited 633 tags do not count here. If inherited tags make a project not stuck, 634 use \"-TAG\" in the tags part of the matcher under (1.) above. 635 636 4. An arbitrary regular expression matching non-stuck projects. 637 638 If the project turns out to be not stuck, search continues also in the 639 subtree to see if any of the subtasks have project status. 640 641 See also the variable `org-tags-match-list-sublevels' which applies 642 to projects matched by this search as well. 643 644 After defining this variable, you may use `org-agenda-list-stuck-projects' 645 \(bound to `\\[org-agenda] #') to produce the list." 646 :group 'org-agenda-custom-commands 647 :type '(list 648 (string :tag "Tags/TODO match to identify a project") 649 (repeat :tag "Projects are *not* stuck if they have an entry with \ 650 TODO keyword any of" (string)) 651 (repeat :tag "Projects are *not* stuck if they have an entry with \ 652 TAG being any of" (string)) 653 (regexp :tag "Projects are *not* stuck if this regexp matches inside \ 654 the subtree"))) 655 656 (defgroup org-agenda-skip nil 657 "Options concerning skipping parts of agenda files." 658 :tag "Org Agenda Skip" 659 :group 'org-agenda) 660 661 (defcustom org-agenda-skip-function-global nil 662 "Function to be called at each match during agenda construction. 663 If this function returns nil, the current match should not be skipped. 664 If the function decided to skip an agenda match, is must return the 665 buffer position from which the search should be continued. 666 This may also be a Lisp form, which will be evaluated. 667 668 This variable will be applied to every agenda match, including 669 tags/property searches and TODO lists. So try to make the test function 670 do its checking as efficiently as possible. To implement a skipping 671 condition just for specific agenda commands, use the variable 672 `org-agenda-skip-function' which can be set in the options section 673 of custom agenda commands." 674 :group 'org-agenda-skip 675 :type 'sexp) 676 677 (defgroup org-agenda-daily/weekly nil 678 "Options concerning the daily/weekly agenda." 679 :tag "Org Agenda Daily/Weekly" 680 :group 'org-agenda) 681 (defgroup org-agenda-todo-list nil 682 "Options concerning the global todo list agenda view." 683 :tag "Org Agenda Todo List" 684 :group 'org-agenda) 685 (defgroup org-agenda-match-view nil 686 "Options concerning the general tags/property/todo match agenda view." 687 :tag "Org Agenda Match View" 688 :group 'org-agenda) 689 (defgroup org-agenda-search-view nil 690 "Options concerning the search agenda view." 691 :tag "Org Agenda Search View" 692 :group 'org-agenda) 693 694 (defvar org-agenda-archives-mode nil 695 "Non-nil means the agenda will include archived items. 696 If this is the symbol `trees', trees in the selected agenda scope 697 that are marked with the ARCHIVE tag will be included anyway. When this is 698 t, also all archive files associated with the current selection of agenda 699 files will be included.") 700 701 (defcustom org-agenda-restriction-lock-highlight-subtree t 702 "Non-nil means highlight the whole subtree when restriction is active. 703 Otherwise only highlight the headline. Highlighting the whole subtree is 704 useful to ensure no edits happen beyond the restricted region." 705 :group 'org-agenda 706 :type 'boolean) 707 708 (defcustom org-agenda-skip-comment-trees t 709 "Non-nil means skip trees that start with the COMMENT keyword. 710 When nil, these trees are also scanned by agenda commands." 711 :group 'org-agenda-skip 712 :type 'boolean) 713 714 (defcustom org-agenda-todo-list-sublevels t 715 "Non-nil means check also the sublevels of a TODO entry for TODO entries. 716 When nil, the sublevels of a TODO entry are not checked, resulting in 717 potentially much shorter TODO lists." 718 :group 'org-agenda-skip 719 :group 'org-agenda-todo-list 720 :type 'boolean) 721 722 (defcustom org-agenda-todo-ignore-with-date nil 723 "Non-nil means don't show entries with a date in the global todo list. 724 You can use this if you prefer to mark mere appointments with a TODO keyword, 725 but don't want them to show up in the TODO list. 726 When this is set, it also covers deadlines and scheduled items, the settings 727 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' 728 will be ignored. 729 See also the variable `org-agenda-tags-todo-honor-ignore-options'." 730 :group 'org-agenda-skip 731 :group 'org-agenda-todo-list 732 :type 'boolean) 733 734 (defcustom org-agenda-todo-ignore-timestamp nil 735 "Non-nil means don't show entries with a timestamp. 736 This applies when creating the global todo list. 737 Valid values are: 738 739 past Don't show entries for today or in the past. 740 741 future Don't show entries with a timestamp in the future. 742 The idea behind this is that if it has a future 743 timestamp, you don't want to think about it until the 744 date. 745 746 all Don't show any entries with a timestamp in the global todo list. 747 The idea behind this is that by setting a timestamp, you 748 have already \"taken care\" of this item. 749 750 This variable can also have an integer as a value. If positive (N), 751 todos with a timestamp N or more days in the future will be ignored. If 752 negative (-N), todos with a timestamp N or more days in the past will be 753 ignored. If 0, todos with a timestamp either today or in the future will 754 be ignored. For example, a value of -1 will exclude todos with a 755 timestamp in the past (yesterday or earlier), while a value of 7 will 756 exclude todos with a timestamp a week or more in the future. 757 758 See also `org-agenda-todo-ignore-with-date'. 759 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want 760 to make his option also apply to the tags-todo list." 761 :group 'org-agenda-skip 762 :group 'org-agenda-todo-list 763 :version "24.1" 764 :type '(choice 765 (const :tag "Ignore future timestamp todos" future) 766 (const :tag "Ignore past or present timestamp todos" past) 767 (const :tag "Ignore all timestamp todos" all) 768 (const :tag "Show timestamp todos" nil) 769 (integer :tag "Ignore if N or more days in past(-) or future(+)."))) 770 771 (defcustom org-agenda-todo-ignore-scheduled nil 772 "Non-nil means, ignore some scheduled TODO items when making TODO list. 773 This applies when creating the global todo list. 774 Valid values are: 775 776 past Don't show entries scheduled today or in the past. 777 778 future Don't show entries scheduled in the future. 779 The idea behind this is that by scheduling it, you don't want to 780 think about it until the scheduled date. 781 782 all Don't show any scheduled entries in the global todo list. 783 The idea behind this is that by scheduling it, you have already 784 \"taken care\" of this item. 785 786 t Same as `all', for backward compatibility. 787 788 This variable can also have an integer as a value. See 789 `org-agenda-todo-ignore-timestamp' for more details. 790 791 See also `org-agenda-todo-ignore-with-date'. 792 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want 793 to make his option also apply to the tags-todo list." 794 :group 'org-agenda-skip 795 :group 'org-agenda-todo-list 796 :type '(choice 797 (const :tag "Ignore future-scheduled todos" future) 798 (const :tag "Ignore past- or present-scheduled todos" past) 799 (const :tag "Ignore all scheduled todos" all) 800 (const :tag "Ignore all scheduled todos (compatibility)" t) 801 (const :tag "Show scheduled todos" nil) 802 (integer :tag "Ignore if N or more days in past(-) or future(+)."))) 803 804 (defcustom org-agenda-todo-ignore-deadlines nil 805 "Non-nil means ignore some deadline TODO items when making TODO list. 806 807 There are different motivations for using different values, please think 808 carefully when configuring this variable. 809 810 This applies when creating the global TODO list. 811 812 Valid values are: 813 814 near Don't show near deadline entries. A deadline is near when it is 815 closer than `org-deadline-warning-days' days. The idea behind this 816 is that such items will appear in the agenda anyway. 817 818 far Don't show TODO entries where a deadline has been defined, but 819 is not going to happen anytime soon. This is useful if you want to use 820 the TODO list to figure out what to do now. 821 822 past Don't show entries with a deadline timestamp for today or in the past. 823 824 future Don't show entries with a deadline timestamp in the future, not even 825 when they become `near' ones. Use it with caution. 826 827 all Ignore all TODO entries that do have a deadline. 828 829 t Same as `near', for backward compatibility. 830 831 This variable can also have an integer as a value. See 832 `org-agenda-todo-ignore-timestamp' for more details. 833 834 See also `org-agenda-todo-ignore-with-date'. 835 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want 836 to make his option also apply to the tags-todo list." 837 :group 'org-agenda-skip 838 :group 'org-agenda-todo-list 839 :type '(choice 840 (const :tag "Ignore near deadlines" near) 841 (const :tag "Ignore near deadlines (compatibility)" t) 842 (const :tag "Ignore far deadlines" far) 843 (const :tag "Ignore all TODOs with a deadlines" all) 844 (const :tag "Show all TODOs, even if they have a deadline" nil) 845 (integer :tag "Ignore if N or more days in past(-) or future(+)."))) 846 847 (defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil 848 "Time unit to use when possibly ignoring an agenda item. 849 850 See the docstring of various `org-agenda-todo-ignore-*' options. 851 The default is to compare time stamps using days. An item is thus 852 considered to be in the future if it is at least one day after today. 853 Non-nil means to compare time stamps using seconds. An item is then 854 considered future if it has a time value later than current time." 855 :group 'org-agenda-skip 856 :group 'org-agenda-todo-list 857 :version "24.4" 858 :package-version '(Org . "8.0") 859 :type '(choice 860 (const :tag "Compare time with days" nil) 861 (const :tag "Compare time with seconds" t))) 862 863 (defcustom org-agenda-tags-todo-honor-ignore-options nil 864 "Non-nil means honor todo-list ignores options also in tags-todo search. 865 The variables 866 `org-agenda-todo-ignore-with-date', 867 `org-agenda-todo-ignore-timestamp', 868 `org-agenda-todo-ignore-scheduled', 869 `org-agenda-todo-ignore-deadlines' 870 make the global TODO list skip entries that have time stamps of certain 871 kinds. If this option is set, the same options will also apply for the 872 tags-todo search, which is the general tags/property matcher 873 restricted to unfinished TODO entries only." 874 :group 'org-agenda-skip 875 :group 'org-agenda-todo-list 876 :group 'org-agenda-match-view 877 :type 'boolean) 878 879 (defcustom org-agenda-skip-scheduled-if-done nil 880 "Non-nil means don't show scheduled items in agenda when they are done. 881 This is relevant for the daily/weekly agenda, not for the TODO list. It 882 applies only to the actual date of the scheduling. Warnings about an item 883 with a past scheduling dates are always turned off when the item is DONE." 884 :group 'org-agenda-skip 885 :group 'org-agenda-daily/weekly 886 :type 'boolean) 887 888 (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil 889 "Non-nil means skip scheduling line if same entry shows because of deadline. 890 891 In the agenda of today, an entry can show up multiple times 892 because it is both scheduled and has a nearby deadline, and maybe 893 a plain time stamp as well. 894 895 When this variable is nil, the entry will be shown several times. 896 897 When set to t, then only the deadline is shown and the fact that 898 the entry is scheduled today or was scheduled previously is not 899 shown. 900 901 When set to the symbol `not-today', skip scheduled previously, 902 but not scheduled today. 903 904 When set to the symbol `repeated-after-deadline', skip scheduled 905 items if they are repeated beyond the current deadline." 906 :group 'org-agenda-skip 907 :group 'org-agenda-daily/weekly 908 :type '(choice 909 (const :tag "Never" nil) 910 (const :tag "Always" t) 911 (const :tag "Not when scheduled today" not-today) 912 (const :tag "When repeated past deadline" repeated-after-deadline))) 913 914 (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil 915 "Non-nil means skip timestamp line if same entry shows because of deadline. 916 In the agenda of today, an entry can show up multiple times 917 because it has both a plain timestamp and has a nearby deadline. 918 When this variable is t, then only the deadline is shown and the 919 fact that the entry has a timestamp for or including today is not 920 shown. When this variable is nil, the entry will be shown 921 several times." 922 :group 'org-agenda-skip 923 :group 'org-agenda-daily/weekly 924 :version "24.1" 925 :type '(choice 926 (const :tag "Never" nil) 927 (const :tag "Always" t))) 928 929 (defcustom org-agenda-skip-deadline-if-done nil 930 "Non-nil means don't show deadlines when the corresponding item is done. 931 When nil, the deadline is still shown and should give you a happy feeling. 932 This is relevant for the daily/weekly agenda. It applies only to the 933 actual date of the deadline. Warnings about approaching and past-due 934 deadlines are always turned off when the item is DONE." 935 :group 'org-agenda-skip 936 :group 'org-agenda-daily/weekly 937 :type 'boolean) 938 939 (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil 940 "Non-nil means skip deadline prewarning when entry is also scheduled. 941 This will apply on all days where a prewarning for the deadline would 942 be shown, but not at the day when the entry is actually due. On that day, 943 the deadline will be shown anyway. 944 This variable may be set to nil, t, the symbol `pre-scheduled', 945 or a number which will then give the number of days before the actual 946 deadline when the prewarnings should resume. The symbol `pre-scheduled' 947 eliminates the deadline prewarning only prior to the scheduled date. 948 This can be used in a workflow where the first showing of the deadline will 949 trigger you to schedule it, and then you don't want to be reminded of it 950 because you will take care of it on the day when scheduled." 951 :group 'org-agenda-skip 952 :group 'org-agenda-daily/weekly 953 :version "24.1" 954 :type '(choice 955 (const :tag "Always show prewarning" nil) 956 (const :tag "Remove prewarning prior to scheduled date" pre-scheduled) 957 (const :tag "Remove prewarning if entry is scheduled" t) 958 (integer :tag "Restart prewarning N days before deadline"))) 959 960 (defcustom org-agenda-skip-scheduled-delay-if-deadline nil 961 "Non-nil means skip scheduled delay when entry also has a deadline. 962 This variable may be set to nil, t, the symbol `post-deadline', 963 or a number which will then give the number of days after the actual 964 scheduled date when the delay should expire. The symbol `post-deadline' 965 eliminates the schedule delay when the date is posterior to the deadline." 966 :group 'org-agenda-skip 967 :group 'org-agenda-daily/weekly 968 :version "24.4" 969 :package-version '(Org . "8.0") 970 :type '(choice 971 (const :tag "Always honor delay" nil) 972 (const :tag "Ignore delay if posterior to the deadline" post-deadline) 973 (const :tag "Ignore delay if entry has a deadline" t) 974 (integer :tag "Honor delay up until N days after the scheduled date"))) 975 976 (defcustom org-agenda-skip-additional-timestamps-same-entry nil 977 "When nil, multiple same-day timestamps in entry make multiple agenda lines. 978 When non-nil, after the search for timestamps has matched once in an 979 entry, the rest of the entry will not be searched." 980 :group 'org-agenda-skip 981 :type 'boolean) 982 983 (defcustom org-agenda-skip-timestamp-if-done nil 984 "Non-nil means don't select item by timestamp or -range if it is DONE." 985 :group 'org-agenda-skip 986 :group 'org-agenda-daily/weekly 987 :type 'boolean) 988 989 (defcustom org-agenda-dim-blocked-tasks t 990 "Non-nil means dim blocked tasks in the agenda display. 991 This causes some overhead during agenda construction, but if you 992 have turned on `org-enforce-todo-dependencies', 993 `org-enforce-todo-checkbox-dependencies', or any other blocking 994 mechanism, this will create useful feedback in the agenda. 995 996 Instead of t, this variable can also have the value `invisible'. 997 Then blocked tasks will be invisible and only become visible when 998 they become unblocked. An exemption to this behavior is when a task is 999 blocked because of unchecked checkboxes below it. Since checkboxes do 1000 not show up in the agenda views, making this task invisible you remove any 1001 trace from agenda views that there is something to do. Therefore, a task 1002 that is blocked because of checkboxes will never be made invisible, it 1003 will only be dimmed." 1004 :group 'org-agenda-daily/weekly 1005 :group 'org-agenda-todo-list 1006 :version "24.3" 1007 :type '(choice 1008 (const :tag "Do not dim" nil) 1009 (const :tag "Dim to a gray face" t) 1010 (const :tag "Make invisible" invisible))) 1011 1012 (defgroup org-agenda-startup nil 1013 "Options concerning initial settings in the Agenda in Org Mode." 1014 :tag "Org Agenda Startup" 1015 :group 'org-agenda) 1016 1017 (defcustom org-agenda-menu-show-matcher t 1018 "Non-nil means show the match string in the agenda dispatcher menu. 1019 When nil, the matcher string is not shown, but is put into the help-echo 1020 property so than moving the mouse over the command shows it. 1021 Setting it to nil is good if matcher strings are very long and/or if 1022 you want to use two-columns display (see `org-agenda-menu-two-columns')." 1023 :group 'org-agenda 1024 :version "24.1" 1025 :type 'boolean) 1026 1027 (defcustom org-agenda-menu-two-columns nil 1028 "Non-nil means, use two columns to show custom commands in the dispatcher. 1029 If you use this, you probably want to set `org-agenda-menu-show-matcher' 1030 to nil." 1031 :group 'org-agenda 1032 :version "24.1" 1033 :type 'boolean) 1034 1035 (defcustom org-agenda-finalize-hook nil 1036 "Hook run just before displaying an agenda buffer. 1037 The buffer is still writable when the hook is called. 1038 1039 You can modify some of the buffer substrings but you should be 1040 extra careful not to modify the text properties of the agenda 1041 headlines as the agenda display heavily relies on them." 1042 :group 'org-agenda-startup 1043 :type 'hook) 1044 1045 (defcustom org-agenda-filter-hook nil 1046 "Hook run just after filtering with `org-agenda-filter'." 1047 :group 'org-agenda-startup 1048 :package-version '(Org . "9.4") 1049 :type 'hook) 1050 1051 (defcustom org-agenda-mouse-1-follows-link nil 1052 "Non-nil means mouse-1 on a link will follow the link in the agenda. 1053 A longer mouse click will still set point. Needs to be set 1054 before org.el is loaded." 1055 :group 'org-agenda-startup 1056 :type 'boolean) 1057 1058 (defcustom org-agenda-start-with-follow-mode nil 1059 "The initial value of follow mode in a newly created agenda window." 1060 :group 'org-agenda-startup 1061 :type 'boolean) 1062 1063 (defcustom org-agenda-follow-indirect nil 1064 "Non-nil means `org-agenda-follow-mode' displays only the 1065 current item's tree, in an indirect buffer." 1066 :group 'org-agenda 1067 :version "24.1" 1068 :type 'boolean) 1069 1070 (defcustom org-agenda-show-outline-path t 1071 "Non-nil means show outline path in echo area after line motion. 1072 1073 If set to `title', show outline path with prepended document 1074 title. Fallback to file name is no title is present." 1075 :group 'org-agenda-startup 1076 :type '(choice 1077 (const :tag "Don't show outline path in agenda view." nil) 1078 (const :tag "Show outline path with prepended file name." t) 1079 (const :tag "Show outline path with prepended document title." title)) 1080 :package-version '(Org . "9.6")) 1081 1082 (defcustom org-agenda-start-with-entry-text-mode nil 1083 "The initial value of entry-text-mode in a newly created agenda window." 1084 :group 'org-agenda-startup 1085 :type 'boolean) 1086 1087 (defcustom org-agenda-entry-text-maxlines 5 1088 "Number of text lines to be added when `E' is pressed in the agenda. 1089 1090 Note that this variable only used during agenda display. To add entry text 1091 when exporting the agenda, configure the variable 1092 `org-agenda-add-entry-text-maxlines'." 1093 :group 'org-agenda 1094 :type 'integer) 1095 1096 (defcustom org-agenda-entry-text-exclude-regexps nil 1097 "List of regular expressions to clean up entry text. 1098 The complete matches of all regular expressions in this list will be 1099 removed from entry text before it is shown in the agenda." 1100 :group 'org-agenda 1101 :type '(repeat (regexp))) 1102 1103 (defcustom org-agenda-entry-text-leaders " > " 1104 "Text prepended to the entry text in agenda buffers." 1105 :version "24.4" 1106 :package-version '(Org . "8.0") 1107 :group 'org-agenda 1108 :type 'string) 1109 1110 (defvar org-agenda-entry-text-cleanup-hook nil 1111 "Hook that is run after basic cleanup of entry text to be shown in agenda. 1112 This cleanup is done in a temporary buffer, so the function may inspect and 1113 change the entire buffer. 1114 Some default stuff like drawers and scheduling/deadline dates will already 1115 have been removed when this is called, as will any matches for regular 1116 expressions listed in `org-agenda-entry-text-exclude-regexps'.") 1117 1118 (defvar org-agenda-include-inactive-timestamps nil 1119 "Non-nil means include inactive time stamps in agenda. 1120 Dynamically scoped.") 1121 1122 (defgroup org-agenda-windows nil 1123 "Options concerning the windows used by the Agenda in Org Mode." 1124 :tag "Org Agenda Windows" 1125 :group 'org-agenda) 1126 1127 (defcustom org-agenda-window-setup 'reorganize-frame 1128 "How the agenda buffer should be displayed. 1129 Possible values for this option are: 1130 1131 current-window Show agenda in the current window, keeping all other windows. 1132 other-window Use `switch-to-buffer-other-window' to display agenda. 1133 only-window Show agenda, deleting all other windows. 1134 reorganize-frame Show only two windows on the current frame, the current 1135 window and the agenda. 1136 other-frame Use `switch-to-buffer-other-frame' to display agenda. 1137 Also, when exiting the agenda, kill that frame. 1138 other-tab Use `switch-to-buffer-other-tab' to display the 1139 agenda, making use of the `tab-bar-mode' introduced 1140 in Emacs version 27.1. Also, kill that tab when 1141 exiting the agenda view. 1142 1143 See also the variable `org-agenda-restore-windows-after-quit'." 1144 :group 'org-agenda-windows 1145 :type '(choice 1146 (const current-window) 1147 (const other-frame) 1148 (const other-tab) 1149 (const other-window) 1150 (const only-window) 1151 (const reorganize-frame)) 1152 :package-version '(Org . "9.4")) 1153 1154 (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) 1155 "The min and max height of the agenda window as a fraction of frame height. 1156 The value of the variable is a cons cell with two numbers between 0 and 1. 1157 It only matters if `org-agenda-window-setup' is `reorganize-frame'." 1158 :group 'org-agenda-windows 1159 :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) 1160 1161 (defcustom org-agenda-restore-windows-after-quit nil 1162 "Non-nil means restore window configuration upon exiting agenda. 1163 Before the window configuration is changed for displaying the 1164 agenda, the current status is recorded. When the agenda is 1165 exited with `q' or `x' and this option is set, the old state is 1166 restored. If `org-agenda-window-setup' is `other-frame' or 1167 `other-tab', the value of this option will be ignored." 1168 :group 'org-agenda-windows 1169 :type 'boolean) 1170 1171 (defcustom org-agenda-span 'week 1172 "Number of days to include in overview display. 1173 Can be day, week, month, year, or any number of days. 1174 Custom commands can set this variable in the options section." 1175 :group 'org-agenda-daily/weekly 1176 :type '(choice (const :tag "Day" day) 1177 (const :tag "Week" week) 1178 (const :tag "Fortnight" fortnight) 1179 (const :tag "Month" month) 1180 (const :tag "Year" year) 1181 (integer :tag "Custom"))) 1182 1183 (defcustom org-agenda-start-on-weekday 1 1184 "Non-nil means start the overview always on the specified weekday. 1185 0 denotes Sunday, 1 denotes Monday, etc. 1186 When nil, always start on the current day. 1187 Custom commands can set this variable in the options section." 1188 :group 'org-agenda-daily/weekly 1189 :type '(choice (const :tag "Today" nil) 1190 (integer :tag "Weekday No."))) 1191 1192 (defcustom org-agenda-show-all-dates t 1193 "Non-nil means `org-agenda' shows every day in the selected range. 1194 When nil, only the days which actually have entries are shown." 1195 :group 'org-agenda-daily/weekly 1196 :type 'boolean) 1197 1198 (defcustom org-agenda-format-date 'org-agenda-format-date-aligned 1199 "Format string for displaying dates in the agenda. 1200 Used by the daily/weekly agenda. This should be a format string 1201 understood by `format-time-string', or a function returning the 1202 formatted date as a string. The function must take a single 1203 argument, a calendar-style date list like (month day year)." 1204 :group 'org-agenda-daily/weekly 1205 :type '(choice 1206 (string :tag "Format string") 1207 (function :tag "Function"))) 1208 1209 (defun org-agenda-end-of-line () 1210 "Go to the end of visible line." 1211 (interactive) 1212 (goto-char (line-end-position))) 1213 1214 (defun org-agenda-format-date-aligned (date) 1215 "Format a DATE string for display in the daily/weekly agenda. 1216 This function makes sure that dates are aligned for easy reading." 1217 (require 'cal-iso) 1218 (let* ((dayname (calendar-day-name date)) 1219 (day (cadr date)) 1220 (day-of-week (calendar-day-of-week date)) 1221 (month (car date)) 1222 (monthname (calendar-month-name month)) 1223 (year (nth 2 date)) 1224 (iso-week (org-days-to-iso-week 1225 (calendar-absolute-from-gregorian date))) 1226 ;; (weekyear (cond ((and (= month 1) (>= iso-week 52)) 1227 ;; (1- year)) 1228 ;; ((and (= month 12) (<= iso-week 1)) 1229 ;; (1+ year)) 1230 ;; (t year))) 1231 (weekstring (if (= day-of-week 1) 1232 (format " W%02d" iso-week) 1233 ""))) 1234 (format "%-10s %2d %s %4d%s" 1235 dayname day monthname year weekstring))) 1236 1237 (defcustom org-agenda-time-leading-zero nil 1238 "Non-nil means use leading zero for military times in agenda. 1239 For example, 9:30am would become 09:30 rather than 9:30." 1240 :group 'org-agenda-daily/weekly 1241 :version "24.1" 1242 :type 'boolean) 1243 1244 (defcustom org-agenda-timegrid-use-ampm nil 1245 "When set, show AM/PM style timestamps on the timegrid." 1246 :group 'org-agenda 1247 :version "24.1" 1248 :type 'boolean) 1249 1250 (defcustom org-agenda-clock-report-header nil 1251 "Header inserted before the table in Org agenda clock report mode. 1252 1253 See Info node `(org) Agenda Commands' for more details." 1254 :group 'org-agenda 1255 :type '(choice 1256 (string :tag "Header") 1257 (const :tag "No header" nil)) 1258 :safe #'stringp 1259 :package-version '(Org . "9.6")) 1260 1261 (defun org-agenda-time-of-day-to-ampm (time) 1262 "Convert TIME of a string like \"13:45\" to an AM/PM style time string." 1263 (let* ((hour-number (string-to-number (substring time 0 -3))) 1264 (minute (substring time -2)) 1265 (ampm "am")) 1266 (cond 1267 ((equal hour-number 12) 1268 (setq ampm "pm")) 1269 ((> hour-number 12) 1270 (setq ampm "pm") 1271 (setq hour-number (- hour-number 12)))) 1272 (concat 1273 (if org-agenda-time-leading-zero 1274 (format "%02d" hour-number) 1275 (format "%02s" (number-to-string hour-number))) 1276 ":" minute ampm))) 1277 1278 (defun org-agenda-time-of-day-to-ampm-maybe (time) 1279 "Conditionally convert TIME to AM/PM format. 1280 This is based on `org-agenda-timegrid-use-ampm'." 1281 (if org-agenda-timegrid-use-ampm 1282 (org-agenda-time-of-day-to-ampm time) 1283 time)) 1284 1285 (defcustom org-agenda-weekend-days '(6 0) 1286 "Which days are weekend? 1287 These days get the special face `org-agenda-date-weekend' in the agenda." 1288 :group 'org-agenda-daily/weekly 1289 :type '(set :greedy t 1290 (const :tag "Monday" 1) 1291 (const :tag "Tuesday" 2) 1292 (const :tag "Wednesday" 3) 1293 (const :tag "Thursday" 4) 1294 (const :tag "Friday" 5) 1295 (const :tag "Saturday" 6) 1296 (const :tag "Sunday" 0))) 1297 1298 (defcustom org-agenda-move-date-from-past-immediately-to-today t 1299 "Non-nil means jump to today when moving a past date forward in time. 1300 When using S-right in the agenda to move a date forward, and the date 1301 stamp currently points to the past, the first key press will move it 1302 to today. When nil, just move one day forward even if the date stays 1303 in the past." 1304 :group 'org-agenda-daily/weekly 1305 :version "24.1" 1306 :type 'boolean) 1307 1308 (defcustom org-agenda-diary-file 'diary-file 1309 "File to which to add new entries with the `i' key in agenda and calendar. 1310 When this is the symbol `diary-file', the functionality in the Emacs 1311 calendar will be used to add entries to the `diary-file'. But when this 1312 points to a file, `org-agenda-diary-entry' will be used instead." 1313 :group 'org-agenda 1314 :type '(choice 1315 (const :tag "The standard Emacs diary file" diary-file) 1316 (file :tag "Special Org file diary entries"))) 1317 1318 (defcustom org-agenda-include-diary nil 1319 "If non-nil, include in the agenda entries from the Emacs Calendar's diary. 1320 Custom commands can set this variable in the options section." 1321 :group 'org-agenda-daily/weekly 1322 :type 'boolean) 1323 1324 (defcustom org-agenda-include-deadlines t 1325 "If non-nil, include entries within their deadline warning period. 1326 Custom commands can set this variable in the options section." 1327 :group 'org-agenda-daily/weekly 1328 :version "24.1" 1329 :type 'boolean) 1330 1331 (defcustom org-agenda-show-future-repeats t 1332 "Non-nil shows repeated entries in the future part of the agenda. 1333 When set to the symbol `next' only the first future repeat is shown." 1334 :group 'org-agenda-daily/weekly 1335 :type '(choice 1336 (const :tag "Show all repeated entries" t) 1337 (const :tag "Show next repeated entry" next) 1338 (const :tag "Do not show repeated entries" nil)) 1339 :version "26.1" 1340 :package-version '(Org . "9.1") 1341 :safe #'symbolp) 1342 1343 (defcustom org-agenda-prefer-last-repeat nil 1344 "Non-nil sets date for repeated entries to their last repeat. 1345 1346 When nil, display SCHEDULED and DEADLINE dates at their base 1347 date, and in today's agenda, as a reminder. Display plain 1348 time-stamps, on the other hand, at every repeat date in the past 1349 in addition to the base date. 1350 1351 When non-nil, show a repeated entry at its latest repeat date, 1352 possibly being today even if it wasn't marked as done. This 1353 setting is useful if you do not always mark repeated entries as 1354 done and, yet, consider that reaching repeat date starts the task 1355 anew. 1356 1357 When set to a list of strings, prefer last repeats only for 1358 entries with these TODO keywords." 1359 :group 'org-agenda-daily/weekly 1360 :type '(choice 1361 (const :tag "Prefer last repeat" t) 1362 (const :tag "Prefer base date" nil) 1363 (repeat :tag "Prefer last repeat for entries with these TODO keywords" 1364 (string :tag "TODO keyword"))) 1365 :version "26.1" 1366 :package-version '(Org . "9.1") 1367 :safe (lambda (x) (or (booleanp x) (consp x)))) 1368 1369 (defcustom org-scheduled-past-days 10000 1370 "Number of days to continue listing scheduled items not marked DONE. 1371 When an item is scheduled on a date, it shows up in the agenda on 1372 this day and will be listed until it is marked done or for the 1373 number of days given here." 1374 :group 'org-agenda-daily/weekly 1375 :type 'integer 1376 :safe 'integerp) 1377 1378 (defcustom org-deadline-past-days 10000 1379 "Number of days to warn about missed deadlines. 1380 When an item has deadline on a date, it shows up in the agenda on 1381 this day and will appear as a reminder until it is marked DONE or 1382 for the number of days given here." 1383 :group 'org-agenda-daily/weekly 1384 :type 'integer 1385 :version "26.1" 1386 :package-version '(Org . "9.1") 1387 :safe 'integerp) 1388 1389 (defcustom org-agenda-log-mode-items '(closed clock) 1390 "List of items that should be shown in agenda log mode. 1391 \\<org-agenda-mode-map>\ 1392 This list may contain the following symbols: 1393 1394 closed Show entries that have been closed on that day. 1395 clock Show entries that have received clocked time on that day. 1396 state Show all logged state changes. 1397 Note that instead of changing this variable, you can also press \ 1398 `\\[universal-argument] \\[org-agenda-log-mode]' in 1399 the agenda to display all available LOG items temporarily." 1400 :group 'org-agenda-daily/weekly 1401 :type '(set :greedy t (const closed) (const clock) (const state))) 1402 1403 (defcustom org-agenda-clock-consistency-checks 1404 '(:max-duration "10:00" :min-duration 0 :max-gap "0:05" 1405 :gap-ok-around ("4:00") 1406 :default-face ((:background "DarkRed") (:foreground "white")) 1407 :overlap-face nil :gap-face nil :no-end-time-face nil 1408 :long-face nil :short-face nil) 1409 "This is a property list, with the following keys: 1410 1411 :max-duration Mark clocking chunks that are longer than this time. 1412 This is a time string like \"HH:MM\", or the number 1413 of minutes as an integer. 1414 1415 :min-duration Mark clocking chunks that are shorter that this. 1416 This is a time string like \"HH:MM\", or the number 1417 of minutes as an integer. 1418 1419 :max-gap Mark gaps between clocking chunks that are longer than 1420 this duration. A number of minutes, or a string 1421 like \"HH:MM\". 1422 1423 :gap-ok-around List of times during the day which are usually not working 1424 times. When a gap is detected, but the gap contains any 1425 of these times, the gap is *not* reported. For example, 1426 if this is (\"4:00\" \"13:00\") then gaps that contain 1427 4:00 in the morning (i.e. the night) and 13:00 1428 (i.e. a typical lunch time) do not cause a warning. 1429 You should have at least one time during the night in this 1430 list, or otherwise the first task each morning will trigger 1431 a warning because it follows a long gap. 1432 1433 Furthermore, the following properties can be used to define faces for 1434 issue display. 1435 1436 :default-face the default face, if the specific face is undefined 1437 :overlap-face face for overlapping clocks 1438 :gap-face face for gaps between clocks 1439 :no-end-time-face face for incomplete clocks 1440 :long-face face for clock intervals that are too long 1441 :short-face face for clock intervals that are too short" 1442 :group 'org-agenda-daily/weekly 1443 :group 'org-clock 1444 :version "24.1" 1445 :type 'plist) 1446 1447 (defcustom org-agenda-log-mode-add-notes t 1448 "Non-nil means add first line of notes to log entries in agenda views. 1449 If a log item like a state change or a clock entry is associated with 1450 notes, the first line of these notes will be added to the entry in the 1451 agenda display." 1452 :group 'org-agenda-daily/weekly 1453 :type 'boolean) 1454 1455 (defcustom org-agenda-start-with-log-mode nil 1456 "The initial value of log-mode in a newly created agenda window. 1457 See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further 1458 explanations on the possible values." 1459 :group 'org-agenda-startup 1460 :group 'org-agenda-daily/weekly 1461 :type '(choice (const :tag "Don't show log items" nil) 1462 (const :tag "Show only log items" only) 1463 (const :tag "Show all possible log items" clockcheck) 1464 (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'" 1465 (choice (const :tag "Show closed log items" closed) 1466 (const :tag "Show clocked log items" clock) 1467 (const :tag "Show all logged state changes" state))))) 1468 1469 (defcustom org-agenda-start-with-clockreport-mode nil 1470 "The initial value of clockreport-mode in a newly created agenda window." 1471 :group 'org-agenda-startup 1472 :group 'org-agenda-daily/weekly 1473 :type 'boolean) 1474 1475 (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2) 1476 "Property list with parameters for the clocktable in clockreport mode. 1477 This is the display mode that shows a clock table in the daily/weekly 1478 agenda, the properties for this dynamic block can be set here. 1479 The usual clocktable parameters are allowed here, but you cannot set 1480 the properties :name, :tstart, :tend, :block, and :scope - these will 1481 be overwritten to make sure the content accurately reflects the 1482 current display in the agenda." 1483 :group 'org-agenda-daily/weekly 1484 :type 'plist) 1485 1486 (defvaralias 'org-agenda-search-view-search-words-only 1487 'org-agenda-search-view-always-boolean) 1488 1489 (defcustom org-agenda-search-view-always-boolean nil 1490 "Non-nil means the search string is interpreted as individual parts. 1491 1492 The search string for search view can either be interpreted as a phrase, 1493 or as a list of snippets that define a boolean search for a number of 1494 strings. 1495 1496 When this is non-nil, the string will be split on whitespace, and each 1497 snippet will be searched individually, and all must match in order to 1498 select an entry. A snippet is then a single string of non-white 1499 characters, or a string in double quotes, or a regexp in {} braces. 1500 If a snippet is preceded by \"-\", the snippet must *not* match. 1501 \"+\" is syntactic sugar for positive selection. Each snippet may 1502 be found as a full word or a partial word, but see the variable 1503 `org-agenda-search-view-force-full-words'. 1504 1505 When this is nil, search will look for the entire search phrase as one, 1506 with each space character matching any amount of whitespace, including 1507 line breaks. 1508 1509 Even when this is nil, you can still switch to Boolean search dynamically 1510 by preceding the first snippet with \"+\" or \"-\". If the first snippet 1511 is a regexp marked with braces like \"{abc}\", this will also switch to 1512 boolean search." 1513 :group 'org-agenda-search-view 1514 :version "24.1" 1515 :type 'boolean) 1516 1517 (defcustom org-agenda-search-view-force-full-words nil 1518 "Non-nil means, search words must be matches as complete words. 1519 When nil, they may also match part of a word." 1520 :group 'org-agenda-search-view 1521 :version "24.1" 1522 :type 'boolean) 1523 1524 (defcustom org-agenda-search-view-max-outline-level 0 1525 "Maximum outline level to display in search view. 1526 E.g. when this is set to 1, the search view will only 1527 show headlines of level 1. When set to 0, the default 1528 value, don't limit agenda view by outline level." 1529 :group 'org-agenda-search-view 1530 :version "26.1" 1531 :package-version '(Org . "8.3") 1532 :type 'integer) 1533 1534 (defgroup org-agenda-time-grid nil 1535 "Options concerning the time grid in the Org Agenda." 1536 :tag "Org Agenda Time Grid" 1537 :group 'org-agenda) 1538 1539 (defcustom org-agenda-search-headline-for-time t 1540 "Non-nil means search headline for a time-of-day. 1541 If the headline contains a time-of-day in one format or another, it will 1542 be used to sort the entry into the time sequence of items for a day. 1543 Some people have time stamps in the headline that refer to the creation 1544 time or so, and then this produces an unwanted side effect. If this is 1545 the case for your, use this variable to turn off searching the headline 1546 for a time." 1547 :group 'org-agenda-time-grid 1548 :type 'boolean) 1549 1550 (defcustom org-agenda-use-time-grid t 1551 "Non-nil means show a time grid in the agenda schedule. 1552 A time grid is a set of lines for specific times (like every two hours between 1553 8:00 and 20:00). The items scheduled for a day at specific times are 1554 sorted in between these lines. 1555 For details about when the grid will be shown, and what it will look like, see 1556 the variable `org-agenda-time-grid'." 1557 :group 'org-agenda-time-grid 1558 :type 'boolean) 1559 1560 (defcustom org-agenda-time-grid 1561 (let ((graphical (and (display-graphic-p) 1562 (char-displayable-p ?┄)))) 1563 `((daily today require-timed) 1564 (800 1000 1200 1400 1600 1800 2000) 1565 ,(if graphical " ┄┄┄┄┄ " "......") 1566 ,(if graphical "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄" "----------------"))) 1567 "The settings for time grid for agenda display. 1568 This is a list of four items. The first item is again a list. It contains 1569 symbols specifying conditions when the grid should be displayed: 1570 1571 daily if the agenda shows a single day 1572 weekly if the agenda shows an entire week 1573 today show grid on current date, independent of daily/weekly display 1574 require-timed show grid only if at least one item has a time specification 1575 remove-match skip grid times already present in an entry 1576 1577 The second item is a list of integers, indicating the times that 1578 should have a grid line. 1579 1580 The third item is a string which will be placed right after the 1581 times that have a grid line. 1582 1583 The fourth item is a string placed after the grid times. This 1584 will align with agenda items." 1585 :group 'org-agenda-time-grid 1586 :package-version '(Org . "9.6") 1587 :type 1588 '(list 1589 (set :greedy t :tag "Grid Display Options" 1590 (const :tag "Show grid in single day agenda display" daily) 1591 (const :tag "Show grid in weekly agenda display" weekly) 1592 (const :tag "Always show grid for today" today) 1593 (const :tag "Show grid only if any timed entries are present" 1594 require-timed) 1595 (const :tag "Skip grid times already present in an entry" 1596 remove-match)) 1597 (repeat :tag "Grid Times" (integer :tag "Time")) 1598 (string :tag "Grid String (after agenda times)") 1599 (string :tag "Grid String (aligns with agenda items)"))) 1600 1601 (defcustom org-agenda-show-current-time-in-grid t 1602 "Non-nil means show the current time in the time grid." 1603 :group 'org-agenda-time-grid 1604 :version "24.1" 1605 :type 'boolean) 1606 1607 (defcustom org-agenda-current-time-string 1608 (if (and (display-graphic-p) 1609 (char-displayable-p ?←) 1610 (char-displayable-p ?─)) 1611 "← now ───────────────────────────────────────────────" 1612 "now - - - - - - - - - - - - - - - - - - - - - - - - -") 1613 "The string for the current time marker in the agenda." 1614 :group 'org-agenda-time-grid 1615 :package-version '(Org . "9.6") 1616 :type 'string) 1617 1618 (defgroup org-agenda-sorting nil 1619 "Options concerning sorting in the Org Agenda." 1620 :tag "Org Agenda Sorting" 1621 :group 'org-agenda) 1622 1623 (defcustom org-agenda-sorting-strategy 1624 '((agenda habit-down time-up priority-down category-keep) 1625 (todo priority-down category-keep) 1626 (tags priority-down category-keep) 1627 (search category-keep)) 1628 "Sorting structure for the agenda items of a single day. 1629 This is a list of symbols which will be used in sequence to determine 1630 if an entry should be listed before another entry. The following 1631 symbols are recognized: 1632 1633 time-up Put entries with time-of-day indications first, early first. 1634 time-down Put entries with time-of-day indications first, late first. 1635 timestamp-up Sort by any timestamp, early first. 1636 timestamp-down Sort by any timestamp, late first. 1637 scheduled-up Sort by scheduled timestamp, early first. 1638 scheduled-down Sort by scheduled timestamp, late first. 1639 deadline-up Sort by deadline timestamp, early first. 1640 deadline-down Sort by deadline timestamp, late first. 1641 ts-up Sort by active timestamp, early first. 1642 ts-down Sort by active timestamp, late first. 1643 tsia-up Sort by inactive timestamp, early first. 1644 tsia-down Sort by inactive timestamp, late first. 1645 category-keep Keep the default order of categories, corresponding to the 1646 sequence in `org-agenda-files'. 1647 category-up Sort alphabetically by category, A-Z. 1648 category-down Sort alphabetically by category, Z-A. 1649 tag-up Sort alphabetically by last tag, A-Z. 1650 tag-down Sort alphabetically by last tag, Z-A. 1651 priority-up Sort numerically by priority, high priority last. 1652 priority-down Sort numerically by priority, high priority first. 1653 todo-state-up Sort by todo state, tasks that are done last. 1654 todo-state-down Sort by todo state, tasks that are done first. 1655 effort-up Sort numerically by estimated effort, high effort last. 1656 effort-down Sort numerically by estimated effort, high effort first. 1657 user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. 1658 user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. 1659 habit-up Put entries that are habits first. 1660 habit-down Put entries that are habits last. 1661 alpha-up Sort headlines alphabetically. 1662 alpha-down Sort headlines alphabetically, reversed. 1663 1664 The different possibilities will be tried in sequence, and testing stops 1665 if one comparison returns a \"not-equal\". For example, 1666 (setq org-agenda-sorting-strategy 1667 \\='(time-up category-keep priority-down)) 1668 means: Pull out all entries having a specified time of day and sort them, 1669 in order to make a time schedule for the current day the first thing in the 1670 agenda listing for the day. Of the entries without a time indication, keep 1671 the grouped in categories, don't sort the categories, but keep them in 1672 the sequence given in `org-agenda-files'. Within each category sort by 1673 priority. 1674 1675 Leaving out `category-keep' would mean that items will be sorted across 1676 categories by priority. 1677 1678 Instead of a single list, this can also be a set of list for specific 1679 contents, with a context symbol in the car of the list, any of 1680 `agenda', `todo', `tags', `search' for the corresponding agenda views. 1681 1682 Custom commands can bind this variable in the options section." 1683 :group 'org-agenda-sorting 1684 :type `(choice 1685 (repeat :tag "General" ,org-sorting-choice) 1686 (list :tag "Individually" 1687 (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) 1688 (repeat ,org-sorting-choice)) 1689 (cons (const :tag "Strategy for TODO lists" todo) 1690 (repeat ,org-sorting-choice)) 1691 (cons (const :tag "Strategy for Tags matches" tags) 1692 (repeat ,org-sorting-choice)) 1693 (cons (const :tag "Strategy for search matches" search) 1694 (repeat ,org-sorting-choice))))) 1695 1696 (defcustom org-agenda-cmp-user-defined nil 1697 "A function to define the comparison `user-defined'. 1698 This function must receive two arguments, agenda entry a and b. 1699 If a>b, return +1. If a<b, return -1. If they are equal as seen by 1700 the user comparison, return nil. 1701 When this is defined, you can make `user-defined-up' and `user-defined-down' 1702 part of an agenda sorting strategy." 1703 :group 'org-agenda-sorting 1704 :type 'symbol) 1705 1706 (defcustom org-agenda-sort-notime-is-late t 1707 "Non-nil means items without time are considered late. 1708 This is only relevant for sorting. When t, items which have no explicit 1709 time like 15:30 will be considered as 99:01, i.e. later than any items which 1710 do have a time. When nil, the default time is before 0:00. You can use this 1711 option to decide if the schedule for today should come before or after timeless 1712 agenda entries." 1713 :group 'org-agenda-sorting 1714 :type 'boolean) 1715 1716 (defcustom org-agenda-sort-noeffort-is-high t 1717 "Non-nil means items without effort estimate are sorted as high effort. 1718 This also applies when filtering an agenda view with respect to the 1719 < or > effort operator. Then, tasks with no effort defined will be treated 1720 as tasks with high effort. 1721 When nil, such items are sorted as 0 minutes effort." 1722 :group 'org-agenda-sorting 1723 :type 'boolean) 1724 1725 (defgroup org-agenda-line-format nil 1726 "Options concerning the entry prefix in the Org agenda display." 1727 :tag "Org Agenda Line Format" 1728 :group 'org-agenda) 1729 1730 (defcustom org-agenda-prefix-format 1731 '((agenda . " %i %-12:c%?-12t% s") 1732 (todo . " %i %-12:c") 1733 (tags . " %i %-12:c") 1734 (search . " %i %-12:c")) 1735 "Format specifications for the prefix of items in the agenda views. 1736 1737 An alist with one entry per agenda type. The keys of the 1738 sublists are `agenda', `todo', `search' and `tags'. The values 1739 are format strings. 1740 1741 This format works similar to a printf format, with the following meaning: 1742 1743 %c the category of the item, \"Diary\" for entries from the diary, 1744 or as given by the CATEGORY keyword or derived from the file name 1745 %e the effort required by the item 1746 %l the level of the item (insert X space(s) if item is of level X) 1747 %i the icon category of the item, see `org-agenda-category-icon-alist' 1748 %T the last tag of the item (ignore inherited tags, which come first) 1749 %t the HH:MM time-of-day specification if one applies to the entry 1750 %s Scheduling/Deadline information, a short string 1751 %b show breadcrumbs, i.e., the names of the higher levels 1752 %(expression) Eval EXPRESSION and replace the control string 1753 by the result 1754 1755 All specifiers work basically like the standard `%s' of printf, but may 1756 contain two additional characters: a question mark just after the `%' 1757 and a whitespace/punctuation character just before the final letter. 1758 1759 If the first character after `%' is a question mark, the entire field 1760 will only be included if the corresponding value applies to the current 1761 entry. This is useful for fields which should have fixed width when 1762 present, but zero width when absent. For example, \"%?-12t\" will 1763 result in a 12 character time field if a time of the day is specified, 1764 but will completely disappear in entries which do not contain a time. 1765 1766 If there is punctuation or whitespace character just before the 1767 final format letter, this character will be appended to the field 1768 value if the value is not empty. For example, the format 1769 \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If 1770 the category is empty, no additional colon is inserted. 1771 1772 The default value for the agenda sublist is \" %-12:c%?-12t% s\", 1773 which means: 1774 1775 - Indent the line with two space characters 1776 - Give the category a 12 chars wide field, padded with whitespace on 1777 the right (because of `-'). Append a colon if there is a category 1778 (because of `:'). 1779 - If there is a time-of-day, put it into a 12 chars wide field. If no 1780 time, don't put in an empty field, just skip it (because of '?'). 1781 - Finally, put the scheduling information. 1782 1783 See also the variables `org-agenda-remove-times-when-in-prefix' and 1784 `org-agenda-remove-tags'. 1785 1786 Custom commands can set this variable in the options section." 1787 :type '(choice 1788 (string :tag "General format") 1789 (list :greedy t :tag "View dependent" 1790 (cons (const agenda) (string :tag "Format")) 1791 (cons (const todo) (string :tag "Format")) 1792 (cons (const tags) (string :tag "Format")) 1793 (cons (const search) (string :tag "Format")))) 1794 :group 'org-agenda-line-format 1795 :version "26.1" 1796 :package-version '(Org . "9.1")) 1797 1798 (defcustom org-agenda-breadcrumbs-separator "->" 1799 "The separator of breadcrumbs in agenda lines." 1800 :group 'org-agenda-line-format 1801 :package-version '(Org . "9.3") 1802 :type 'string 1803 :safe #'stringp) 1804 1805 (defvar org-prefix-format-compiled nil 1806 "The compiled prefix format and associated variables. 1807 This is a list where first element is a list of variable bindings, and second 1808 element is the compiled format expression. See the variable 1809 `org-agenda-prefix-format'.") 1810 1811 (defcustom org-agenda-todo-keyword-format "%-1s" 1812 "Format for the TODO keyword in agenda lines. 1813 Set this to something like \"%-12s\" if you want all TODO keywords 1814 to occupy a fixed space in the agenda display." 1815 :group 'org-agenda-line-format 1816 :type 'string) 1817 1818 (defcustom org-agenda-diary-sexp-prefix nil 1819 "A regexp that matches part of a diary sexp entry 1820 which should be treated as scheduling/deadline information in 1821 `org-agenda'. 1822 1823 For example, you can use this to extract the `diary-remind-message' from 1824 `diary-remind' entries." 1825 :group 'org-agenda-line-format 1826 :type '(choice (const :tag "None" nil) (regexp :tag "Regexp"))) 1827 1828 (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") 1829 "Text preceding timerange entries in the agenda view. 1830 This is a list with two strings. The first applies when the range 1831 is entirely on one day. The second applies if the range spans several days. 1832 The strings may have two \"%d\" format specifiers which will be filled 1833 with the sequence number of the days, and the total number of days in the 1834 range, respectively." 1835 :group 'org-agenda-line-format 1836 :type '(list 1837 (string :tag "Deadline today ") 1838 (choice :tag "Deadline relative" 1839 (string :tag "Format string") 1840 (function)))) 1841 1842 (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") 1843 "Text preceding scheduled items in the agenda view. 1844 This is a list with two strings. The first applies when the item is 1845 scheduled on the current day. The second applies when it has been scheduled 1846 previously, it may contain a %d indicating that this is the nth time that 1847 this item is scheduled, due to automatic rescheduling of unfinished items 1848 for the following day. So this number is one larger than the number of days 1849 that passed since this item was scheduled first." 1850 :group 'org-agenda-line-format 1851 :version "24.4" 1852 :package-version '(Org . "8.0") 1853 :type '(list 1854 (string :tag "Scheduled today ") 1855 (string :tag "Scheduled previously"))) 1856 1857 (defcustom org-agenda-inactive-leader "[" 1858 "Text preceding item pulled into the agenda by inactive time stamps. 1859 These entries are added to the agenda when pressing \"[\"." 1860 :group 'org-agenda-line-format 1861 :version "24.1" 1862 :type 'string) 1863 1864 (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ") 1865 "Text preceding deadline items in the agenda view. 1866 This is a list with three strings. The first applies when the item has its 1867 deadline on the current day. The second applies when the deadline is in the 1868 future, the third one when it is in the past. The strings may contain %d 1869 to capture the number of days." 1870 :group 'org-agenda-line-format 1871 :version "24.4" 1872 :package-version '(Org . "8.0") 1873 :type '(list 1874 (string :tag "Deadline today ") 1875 (string :tag "Deadline in the future ") 1876 (string :tag "Deadline in the past "))) 1877 1878 (defcustom org-agenda-remove-times-when-in-prefix t 1879 "Non-nil means remove duplicate time specifications in agenda items. 1880 When the format `org-agenda-prefix-format' contains a `%t' specifier, a 1881 time-of-day specification in a headline or diary entry is extracted and 1882 placed into the prefix. If this option is non-nil, the original specification 1883 \(a timestamp or -range, or just a plain time(range) specification like 1884 11:30-4pm) will be removed for agenda display. This makes the agenda less 1885 cluttered. 1886 The option can be t or nil. It may also be the symbol `beg', indicating 1887 that the time should only be removed when it is located at the beginning of 1888 the headline/diary entry." 1889 :group 'org-agenda-line-format 1890 :type '(choice 1891 (const :tag "Always" t) 1892 (const :tag "Never" nil) 1893 (const :tag "When at beginning of entry" beg))) 1894 1895 (defcustom org-agenda-remove-timeranges-from-blocks nil 1896 "Non-nil means remove time ranges specifications in agenda 1897 items that span on several days." 1898 :group 'org-agenda-line-format 1899 :version "24.1" 1900 :type 'boolean) 1901 1902 (defcustom org-agenda-default-appointment-duration nil 1903 "Default duration for appointments that only have a starting time. 1904 When nil, no duration is specified in such cases. 1905 When non-nil, this must be the number of minutes, e.g. 60 for one hour." 1906 :group 'org-agenda-line-format 1907 :type '(choice 1908 (integer :tag "Minutes") 1909 (const :tag "No default duration"))) 1910 1911 (defcustom org-agenda-show-inherited-tags t 1912 "Non-nil means show inherited tags in each agenda line. 1913 1914 When this option is set to `always', it takes precedence over 1915 `org-agenda-use-tag-inheritance' and inherited tags are shown 1916 in every agenda. 1917 1918 When this option is set to t (the default), inherited tags are 1919 shown when they are available, i.e. when the value of 1920 `org-agenda-use-tag-inheritance' enables tag inheritance for the 1921 given agenda type. 1922 1923 This can be set to a list of agenda types in which the agenda 1924 must display the inherited tags. Available types are `todo', 1925 `agenda' and `search'. 1926 1927 When set to nil, never show inherited tags in agenda lines." 1928 :group 'org-agenda-line-format 1929 :group 'org-agenda 1930 :version "24.3" 1931 :type '(choice 1932 (const :tag "Show inherited tags when available" t) 1933 (const :tag "Always show inherited tags" always) 1934 (repeat :tag "Show inherited tags only in selected agenda types" 1935 (symbol :tag "Agenda type")))) 1936 1937 (defcustom org-agenda-use-tag-inheritance '(todo search agenda) 1938 "List of agenda view types where to use tag inheritance. 1939 1940 In tags/tags-todo/tags-tree agenda views, tag inheritance is 1941 controlled by `org-use-tag-inheritance'. In other agenda types, 1942 `org-use-tag-inheritance' is not used for the selection of the 1943 agenda entries. Still, you may want the agenda to be aware of 1944 the inherited tags anyway, e.g. for later tag filtering. 1945 1946 Allowed value are `todo', `search' and `agenda'. 1947 1948 This variable has no effect if `org-agenda-show-inherited-tags' 1949 is set to `always'. In that case, the agenda is aware of those 1950 tags. 1951 1952 The default value sets tags in every agenda type. Setting this 1953 option to nil will speed up non-tags agenda view a lot." 1954 :group 'org-agenda 1955 :version "26.1" 1956 :package-version '(Org . "9.1") 1957 :type '(choice 1958 (const :tag "Use tag inheritance in all agenda types" t) 1959 (repeat :tag "Use tag inheritance in selected agenda types" 1960 (symbol :tag "Agenda type")))) 1961 1962 (defcustom org-agenda-hide-tags-regexp nil 1963 "Regular expression used to filter away specific tags in agenda views. 1964 This means that these tags will be present, but not be shown in the agenda 1965 line. Secondary filtering will still work on the hidden tags. 1966 Nil means don't hide any tags." 1967 :group 'org-agenda-line-format 1968 :type '(choice 1969 (const :tag "Hide none" nil) 1970 (regexp :tag "Regexp "))) 1971 1972 (defvaralias 'org-agenda-remove-tags-when-in-prefix 1973 'org-agenda-remove-tags) 1974 1975 (defcustom org-agenda-remove-tags nil 1976 "Non-nil means remove the tags from the headline copy in the agenda. 1977 When this is the symbol `prefix', only remove tags when 1978 `org-agenda-prefix-format' contains a `%T' specifier." 1979 :group 'org-agenda-line-format 1980 :type '(choice 1981 (const :tag "Always" t) 1982 (const :tag "Never" nil) 1983 (const :tag "When prefix format contains %T" prefix))) 1984 1985 (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) 1986 1987 (defcustom org-agenda-tags-column 'auto 1988 "Shift tags in agenda items to this column. 1989 If set to `auto', tags will be automatically aligned to the right 1990 edge of the window. 1991 1992 If set to a positive number, tags will be left-aligned to that 1993 column. If set to a negative number, tags will be right-aligned 1994 to that column. For example, -80 works well for a normal 80 1995 character screen." 1996 :group 'org-agenda-line-format 1997 :type '(choice 1998 (const :tag "Automatically align to right edge of window" auto) 1999 (integer :tag "Specific column" -80)) 2000 :package-version '(Org . "9.1") 2001 :version "26.1") 2002 2003 (defcustom org-agenda-fontify-priorities 'cookies 2004 "Non-nil means highlight low and high priorities in agenda. 2005 When t, the highest priority entries are bold, lowest priority italic. 2006 However, settings in `org-priority-faces' will overrule these faces. 2007 When this variable is the symbol `cookies', only fontify the 2008 cookies, not the entire task. 2009 This may also be an association list of priority faces, whose 2010 keys are the character values of `org-priority-highest', 2011 `org-priority-default', and `org-priority-lowest' (the default values 2012 are ?A, ?B, and ?C, respectively). The face may be a named face, a 2013 color as a string, or a list like `(:background \"Red\")'. 2014 If it is a color, the variable `org-faces-easy-properties' 2015 determines if it is a foreground or a background color." 2016 :group 'org-agenda-line-format 2017 :type '(choice 2018 (const :tag "Never" nil) 2019 (const :tag "Defaults" t) 2020 (const :tag "Cookies only" cookies) 2021 (repeat :tag "Specify" 2022 (list (character :tag "Priority" :value ?A) 2023 (choice :tag "Face " 2024 (string :tag "Color") 2025 (sexp :tag "Face")))))) 2026 2027 (defcustom org-agenda-day-face-function nil 2028 "Function called to determine what face should be used to display a day. 2029 The only argument passed to that function is the day. It should 2030 returns a face, or nil if does not want to specify a face and let 2031 the normal rules apply." 2032 :group 'org-agenda-line-format 2033 :version "24.1" 2034 :type '(choice (const nil) (function))) 2035 2036 (defcustom org-agenda-category-icon-alist nil 2037 "Alist of category icon to be displayed in agenda views. 2038 2039 Each entry should have the following format: 2040 2041 (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS) 2042 2043 Where CATEGORY-REGEXP is a regexp matching the categories where 2044 the icon should be displayed. 2045 FILE-OR-DATA either a file path or a string containing image data. 2046 2047 The other fields can be omitted safely if not needed: 2048 TYPE indicates the image type. 2049 DATA-P is a boolean indicating whether the FILE-OR-DATA string is 2050 image data. 2051 PROPS are additional image attributes to assign to the image, 2052 like, e.g. `:ascent center'. 2053 2054 (\"Org\" \"/path/to/icon.png\" nil nil :ascent center) 2055 2056 If you want to set the display properties yourself, just put a 2057 list as second element: 2058 2059 (CATEGORY-REGEXP (MY PROPERTY LIST)) 2060 2061 For example, to display a 16px horizontal space for Emacs 2062 category, you can use: 2063 2064 (\"Emacs\" \\='(space . (:width (16))))" 2065 :group 'org-agenda-line-format 2066 :version "24.1" 2067 :type '(alist :key-type (regexp :tag "Regexp matching category") 2068 :value-type (choice (list :tag "Icon" 2069 (string :tag "File or data") 2070 (symbol :tag "Type") 2071 (boolean :tag "Data?") 2072 (repeat :tag "Extra image properties" :inline t sexp)) 2073 (list :tag "Display properties" sexp)))) 2074 2075 (defgroup org-agenda-column-view nil 2076 "Options concerning column view in the agenda." 2077 :tag "Org Agenda Column View" 2078 :group 'org-agenda) 2079 2080 (defcustom org-agenda-view-columns-initially nil 2081 "When non-nil, switch to columns view right after creating the agenda." 2082 :group 'org-agenda-column-view 2083 :type 'boolean 2084 :version "26.1" 2085 :package-version '(Org . "9.0") 2086 :safe #'booleanp) 2087 2088 (defcustom org-agenda-columns-show-summaries t 2089 "Non-nil means show summaries for columns displayed in the agenda view." 2090 :group 'org-agenda-column-view 2091 :type 'boolean) 2092 2093 (defcustom org-agenda-columns-compute-summary-properties t 2094 "Non-nil means recompute all summary properties before column view. 2095 When column view in the agenda is listing properties that have a summary 2096 operator, it can go to all relevant buffers and recompute the summaries 2097 there. This can mean overhead for the agenda column view, but is necessary 2098 to have thing up to date. 2099 As a special case, a CLOCKSUM property also makes sure that the clock 2100 computations are current." 2101 :group 'org-agenda-column-view 2102 :type 'boolean) 2103 2104 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil 2105 "Non-nil means the duration of an appointment will add to day effort. 2106 The property to which appointment durations will be added is the one given 2107 in the option `org-effort-property'. If an appointment does not have 2108 an end time, `org-agenda-default-appointment-duration' will be used. If that 2109 is not set, an appointment without end time will not contribute to the time 2110 estimate." 2111 :group 'org-agenda-column-view 2112 :type 'boolean) 2113 2114 (defcustom org-agenda-auto-exclude-function nil 2115 "A function called with a tag to decide if it is filtered on \ 2116 \\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] RET'. 2117 The sole argument to the function, which is called once for each 2118 possible tag, is a string giving the name of the tag. The 2119 function should return either nil if the tag should be included 2120 as normal, \"-<TAG>\" to exclude the tag, or \"+<TAG>\" to exclude 2121 lines not carrying this tag. 2122 Note that for the purpose of tag filtering, only the lower-case version of 2123 all tags will be considered, so that this function will only ever see 2124 the lower-case version of all tags." 2125 :group 'org-agenda 2126 :type '(choice (const nil) (function))) 2127 2128 (defcustom org-agenda-bulk-custom-functions nil 2129 "Alist of characters and custom functions for bulk actions. 2130 For example, this makes those two functions available: 2131 2132 (setq org-agenda-bulk-custom-functions 2133 \\='((?R set-category) 2134 (?C bulk-cut))) 2135 2136 With selected entries in an agenda buffer, `B R' will call 2137 the custom function `set-category' on the selected entries. 2138 Note that functions in this alist don't need to be quoted. 2139 2140 You can also specify a function which collects arguments to be 2141 used for each call to your bulk custom function. The argument 2142 collecting function will be run once and should return a list of 2143 arguments to pass to the bulk function. For example: 2144 2145 (setq org-agenda-bulk-custom-functions 2146 \\='((?R set-category get-category))) 2147 2148 Now, `B R' will call the custom `get-category' which would prompt 2149 the user once for a category. That category is then passed as an 2150 argument to `set-category' for each entry it's called against." 2151 :type 2152 '(alist :key-type character 2153 :value-type 2154 (group (function :tag "Bulk Custom Function") 2155 (choice (function :tag "Bulk Custom Argument Function") 2156 (const :tag "No Bulk Custom Argument Function" nil)))) 2157 :package-version '(Org . "9.5") 2158 :group 'org-agenda) 2159 2160 (defmacro org-agenda-with-point-at-orig-entry (string &rest body) 2161 "Execute BODY with point at location given by `org-hd-marker' property. 2162 If STRING is non-nil, the text property will be fetched from position 0 2163 in that string. If STRING is nil, it will be fetched from the beginning 2164 of the current line." 2165 (declare (debug t) (indent 1)) 2166 (org-with-gensyms (marker) 2167 `(let ((,marker (get-text-property (if ,string 0 (line-beginning-position)) 2168 'org-hd-marker ,string))) 2169 (with-current-buffer (marker-buffer ,marker) 2170 (save-excursion 2171 (goto-char ,marker) 2172 ,@body))))) 2173 2174 (defun org-add-agenda-custom-command (entry) 2175 "Replace or add a command in `org-agenda-custom-commands'. 2176 This is mostly for hacking and trying a new command - once the command 2177 works you probably want to add it to `org-agenda-custom-commands' for good." 2178 (let ((ass (assoc (car entry) org-agenda-custom-commands))) 2179 (if ass 2180 (setcdr ass (cdr entry)) 2181 (push entry org-agenda-custom-commands)))) 2182 2183 (defmacro org-agenda--insert-overriding-header (default) 2184 "Insert header into agenda view. 2185 The inserted header depends on `org-agenda-overriding-header'. 2186 If the empty string, don't insert a header. If any other string, 2187 insert it as a header. If nil, insert DEFAULT, which should 2188 evaluate to a string. If a function, call it and insert the 2189 string that it returns." 2190 (declare (debug (form)) (indent defun)) 2191 `(cond 2192 ((not org-agenda-overriding-header) (insert ,default)) 2193 ((equal org-agenda-overriding-header "") nil) 2194 ((stringp org-agenda-overriding-header) 2195 (insert (propertize org-agenda-overriding-header 2196 'face 'org-agenda-structure) 2197 "\n")) 2198 ((functionp org-agenda-overriding-header) 2199 (insert (funcall org-agenda-overriding-header))) 2200 (t (user-error "Invalid value for `org-agenda-overriding-header': %S" 2201 org-agenda-overriding-header)))) 2202 2203 ;;; Define the org-agenda-mode 2204 2205 (defvaralias 'org-agenda-keymap 'org-agenda-mode-map) 2206 (defvar org-agenda-mode-map (make-sparse-keymap) 2207 "Keymap for `org-agenda-mode'.") 2208 2209 (org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line) 2210 2211 (defvar org-agenda-menu) ; defined later in this file. 2212 (defvar org-agenda-restrict nil 2213 "Non-nil means agenda restriction is active. 2214 This is an internal flag indicating either temporary or extended 2215 agenda restriction. Specifically, it is set to t if the agenda 2216 is restricted to an entire file, and is set to the corresponding 2217 buffer if the agenda is restricted to a part of a file, e.g. a 2218 region or a substree. In the latter case, 2219 `org-agenda-restrict-begin' and `org-agenda-restrict-end' are set 2220 to the beginning and the end of the part. 2221 2222 See also `org-agenda-set-restriction-lock'.") 2223 (defvar org-agenda-follow-mode nil) 2224 (defvar org-agenda-entry-text-mode nil) 2225 (defvar org-agenda-clockreport-mode nil) 2226 (defvar org-agenda-show-log nil 2227 "When non-nil, show the log in the agenda. 2228 Do not set this directly; instead use 2229 `org-agenda-start-with-log-mode', which see.") 2230 (defvar org-agenda-redo-command nil) 2231 (defvar org-agenda-query-string nil) 2232 (defvar org-agenda-mode-hook nil 2233 "Hook run after `org-agenda-mode' is turned on. 2234 The buffer is still writable when this hook is called.") 2235 (defvar org-agenda-type nil) 2236 (defvar org-agenda-force-single-file nil) 2237 (defvar org-agenda-bulk-marked-entries nil 2238 "List of markers that refer to marked entries in the agenda.") 2239 (defvar org-agenda-current-date nil 2240 "Active date when building the agenda.") 2241 2242 ;;; Multiple agenda buffers support 2243 2244 (defcustom org-agenda-sticky nil 2245 "Non-nil means agenda q key will bury agenda buffers. 2246 Agenda commands will then show existing buffer instead of generating new ones. 2247 When nil, `q' will kill the single agenda buffer." 2248 :group 'org-agenda 2249 :version "24.3" 2250 :type 'boolean) 2251 2252 2253 ;;;###autoload 2254 (defun org-toggle-sticky-agenda (&optional arg) 2255 "Toggle `org-agenda-sticky'." 2256 (interactive "P") 2257 (let ((new-value (if arg 2258 (> (prefix-numeric-value arg) 0) 2259 (not org-agenda-sticky)))) 2260 (if (equal new-value org-agenda-sticky) 2261 (and (called-interactively-p 'interactive) 2262 (message "Sticky agenda was already %s" 2263 (if org-agenda-sticky "enabled" "disabled"))) 2264 (setq org-agenda-sticky new-value) 2265 (org-agenda-kill-all-agenda-buffers) 2266 (and (called-interactively-p 'interactive) 2267 (message "Sticky agenda %s" 2268 (if org-agenda-sticky "enabled" "disabled")))))) 2269 2270 (defvar org-agenda-buffer nil 2271 "Agenda buffer currently being generated.") 2272 2273 (defvar org-agenda-last-prefix-arg nil) 2274 (defvar org-agenda-this-buffer-name nil) 2275 (defvar org-agenda-doing-sticky-redo nil) 2276 (defvar org-agenda-this-buffer-is-sticky nil) 2277 (defvar org-agenda-last-indirect-buffer nil 2278 "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.") 2279 2280 (defconst org-agenda-local-vars 2281 '(org-agenda-this-buffer-name 2282 org-agenda-undo-list 2283 org-agenda-pending-undo-list 2284 org-agenda-follow-mode 2285 org-agenda-entry-text-mode 2286 org-agenda-clockreport-mode 2287 org-agenda-show-log 2288 org-agenda-redo-command 2289 org-agenda-query-string 2290 org-agenda-type 2291 org-agenda-bulk-marked-entries 2292 org-agenda-undo-has-started-in 2293 org-agenda-info 2294 org-agenda-pre-window-conf 2295 org-agenda-columns-active 2296 org-agenda-tag-filter 2297 org-agenda-category-filter 2298 org-agenda-top-headline-filter 2299 org-agenda-regexp-filter 2300 org-agenda-effort-filter 2301 org-agenda-filters-preset 2302 org-agenda-markers 2303 org-agenda-last-search-view-search-was-boolean 2304 org-agenda-last-indirect-buffer 2305 org-agenda-filtered-by-category 2306 org-agenda-filter-form 2307 org-agenda-cycle-counter 2308 org-agenda-last-prefix-arg) 2309 "Variables that must be local in agenda buffers to allow multiple buffers.") 2310 2311 (defun org-agenda-mode () 2312 "Mode for time-sorted view on action items in Org files. 2313 2314 The following commands are available: 2315 2316 \\{org-agenda-mode-map}" 2317 (interactive) 2318 (ignore-errors (require 'face-remap)) 2319 (let ((agenda-local-vars-to-keep 2320 '(text-scale-mode-amount 2321 text-scale-mode 2322 text-scale-mode-lighter 2323 face-remapping-alist)) 2324 (save (buffer-local-variables))) 2325 (kill-all-local-variables) 2326 (cl-flet ((reset-saved (var-set) 2327 "Reset variables in VAR-SET to possibly stored value in SAVE." 2328 (dolist (elem save) 2329 (pcase elem 2330 (`(,var . ,val) ;ignore unbound variables 2331 (when (and val (memq var var-set)) 2332 (set var val))))))) 2333 (cond (org-agenda-doing-sticky-redo 2334 ;; Refreshing sticky agenda-buffer 2335 ;; 2336 ;; Preserve the value of `org-agenda-local-vars' variables. 2337 (mapc #'make-local-variable org-agenda-local-vars) 2338 (reset-saved org-agenda-local-vars) 2339 (setq-local org-agenda-this-buffer-is-sticky t)) 2340 (org-agenda-sticky 2341 ;; Creating a sticky Agenda buffer for the first time 2342 (mapc #'make-local-variable org-agenda-local-vars) 2343 (setq-local org-agenda-this-buffer-is-sticky t)) 2344 (t 2345 ;; Creating a non-sticky agenda buffer 2346 (setq-local org-agenda-this-buffer-is-sticky nil))) 2347 (mapc #'make-local-variable agenda-local-vars-to-keep) 2348 (reset-saved agenda-local-vars-to-keep))) 2349 (setq org-agenda-undo-list nil 2350 org-agenda-pending-undo-list nil 2351 org-agenda-bulk-marked-entries nil) 2352 (setq major-mode 'org-agenda-mode) 2353 ;; Keep global-font-lock-mode from turning on font-lock-mode 2354 (setq-local font-lock-global-modes (list 'not major-mode)) 2355 (setq mode-name "Org-Agenda") 2356 (setq indent-tabs-mode nil) 2357 (use-local-map org-agenda-mode-map) 2358 (when org-startup-truncated (setq truncate-lines t)) 2359 (setq-local line-move-visual nil) 2360 (add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local) 2361 (add-hook 'pre-command-hook #'org-unhighlight nil 'local) 2362 ;; Make sure properties are removed when copying text 2363 (if (boundp 'filter-buffer-substring-functions) 2364 (add-hook 'filter-buffer-substring-functions 2365 (lambda (fun start end delete) 2366 (substring-no-properties (funcall fun start end delete))) 2367 nil t) 2368 ;; Emacs >= 24.4. 2369 (add-function :filter-return (local 'filter-buffer-substring-function) 2370 #'substring-no-properties)) 2371 (unless org-agenda-keep-modes 2372 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode 2373 org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode 2374 org-agenda-show-log org-agenda-start-with-log-mode 2375 org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode)) 2376 (add-to-invisibility-spec '(org-filtered)) 2377 (org-fold-core-initialize `(,org-link--description-folding-spec 2378 ,org-link--link-folding-spec)) 2379 (easy-menu-change 2380 '("Agenda") "Agenda Files" 2381 (append 2382 (list 2383 (vector 2384 (if (get 'org-agenda-files 'org-restrict) 2385 "Restricted to single file" 2386 "Edit File List") 2387 '(org-edit-agenda-file-list) 2388 (not (get 'org-agenda-files 'org-restrict))) 2389 "--") 2390 (mapcar #'org-file-menu-entry (org-agenda-files)))) 2391 (org-agenda-set-mode-name) 2392 (run-mode-hooks 'org-agenda-mode-hook)) 2393 2394 (substitute-key-definition #'undo #'org-agenda-undo 2395 org-agenda-mode-map global-map) 2396 (org-defkey org-agenda-mode-map "\C-i" #'org-agenda-goto) 2397 (org-defkey org-agenda-mode-map [(tab)] #'org-agenda-goto) 2398 (org-defkey org-agenda-mode-map "\C-m" #'org-agenda-switch-to) 2399 (org-defkey org-agenda-mode-map "\C-k" #'org-agenda-kill) 2400 (org-defkey org-agenda-mode-map "\C-c\C-w" #'org-agenda-refile) 2401 (org-defkey org-agenda-mode-map [(meta down)] #'org-agenda-drag-line-forward) 2402 (org-defkey org-agenda-mode-map [(meta up)] #'org-agenda-drag-line-backward) 2403 (org-defkey org-agenda-mode-map "m" #'org-agenda-bulk-mark) 2404 (org-defkey org-agenda-mode-map "\M-m" #'org-agenda-bulk-toggle) 2405 (org-defkey org-agenda-mode-map "*" #'org-agenda-bulk-mark-all) 2406 (org-defkey org-agenda-mode-map "\M-*" #'org-agenda-bulk-toggle-all) 2407 (org-defkey org-agenda-mode-map "#" #'org-agenda-dim-blocked-tasks) 2408 (org-defkey org-agenda-mode-map "%" #'org-agenda-bulk-mark-regexp) 2409 (org-defkey org-agenda-mode-map "u" #'org-agenda-bulk-unmark) 2410 (org-defkey org-agenda-mode-map "U" #'org-agenda-bulk-unmark-all) 2411 (org-defkey org-agenda-mode-map "B" #'org-agenda-bulk-action) 2412 (org-defkey org-agenda-mode-map "k" #'org-agenda-capture) 2413 (org-defkey org-agenda-mode-map "A" #'org-agenda-append-agenda) 2414 (org-defkey org-agenda-mode-map "\C-c\C-x!" #'org-reload) 2415 (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" #'org-agenda-archive-default) 2416 (org-defkey org-agenda-mode-map "\C-c\C-xa" #'org-agenda-toggle-archive-tag) 2417 (org-defkey org-agenda-mode-map "\C-c\C-xA" #'org-agenda-archive-to-archive-sibling) 2418 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" #'org-agenda-archive) 2419 (org-defkey org-agenda-mode-map "\C-c$" #'org-agenda-archive) 2420 (org-defkey org-agenda-mode-map "$" #'org-agenda-archive) 2421 (org-defkey org-agenda-mode-map "\C-c\C-o" #'org-agenda-open-link) 2422 (org-defkey org-agenda-mode-map " " #'org-agenda-show-and-scroll-up) 2423 (org-defkey org-agenda-mode-map [backspace] #'org-agenda-show-scroll-down) 2424 (org-defkey org-agenda-mode-map "\d" #'org-agenda-show-scroll-down) 2425 (org-defkey org-agenda-mode-map [(control shift right)] #'org-agenda-todo-nextset) 2426 (org-defkey org-agenda-mode-map [(control shift left)] #'org-agenda-todo-previousset) 2427 (org-defkey org-agenda-mode-map "\C-c\C-xb" #'org-agenda-tree-to-indirect-buffer) 2428 (org-defkey org-agenda-mode-map "o" #'delete-other-windows) 2429 (org-defkey org-agenda-mode-map "L" #'org-agenda-recenter) 2430 (org-defkey org-agenda-mode-map "\C-c\C-t" #'org-agenda-todo) 2431 (org-defkey org-agenda-mode-map "t" #'org-agenda-todo) 2432 (org-defkey org-agenda-mode-map "a" #'org-agenda-archive-default-with-confirmation) 2433 (org-defkey org-agenda-mode-map ":" #'org-agenda-set-tags) 2434 (org-defkey org-agenda-mode-map "\C-c\C-q" #'org-agenda-set-tags) 2435 (org-defkey org-agenda-mode-map "." #'org-agenda-goto-today) 2436 (org-defkey org-agenda-mode-map "j" #'org-agenda-goto-date) 2437 (org-defkey org-agenda-mode-map "d" #'org-agenda-day-view) 2438 (org-defkey org-agenda-mode-map "w" #'org-agenda-week-view) 2439 (org-defkey org-agenda-mode-map "y" #'org-agenda-year-view) 2440 (org-defkey org-agenda-mode-map "\C-c\C-z" #'org-agenda-add-note) 2441 (org-defkey org-agenda-mode-map "z" #'org-agenda-add-note) 2442 (org-defkey org-agenda-mode-map [(shift right)] #'org-agenda-do-date-later) 2443 (org-defkey org-agenda-mode-map [(shift left)] #'org-agenda-do-date-earlier) 2444 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] #'org-agenda-do-date-later) 2445 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] #'org-agenda-do-date-earlier) 2446 (org-defkey org-agenda-mode-map ">" #'org-agenda-date-prompt) 2447 (org-defkey org-agenda-mode-map "\C-c\C-s" #'org-agenda-schedule) 2448 (org-defkey org-agenda-mode-map "\C-c\C-d" #'org-agenda-deadline) 2449 (let ((l '(1 2 3 4 5 6 7 8 9 0))) 2450 (while l (org-defkey org-agenda-mode-map 2451 (number-to-string (pop l)) #'digit-argument))) 2452 (org-defkey org-agenda-mode-map "F" #'org-agenda-follow-mode) 2453 (org-defkey org-agenda-mode-map "R" #'org-agenda-clockreport-mode) 2454 (org-defkey org-agenda-mode-map "E" #'org-agenda-entry-text-mode) 2455 (org-defkey org-agenda-mode-map "l" #'org-agenda-log-mode) 2456 (org-defkey org-agenda-mode-map "v" #'org-agenda-view-mode-dispatch) 2457 (org-defkey org-agenda-mode-map "D" #'org-agenda-toggle-diary) 2458 (org-defkey org-agenda-mode-map "!" #'org-agenda-toggle-deadlines) 2459 (org-defkey org-agenda-mode-map "G" #'org-agenda-toggle-time-grid) 2460 (org-defkey org-agenda-mode-map "r" #'org-agenda-redo) 2461 (org-defkey org-agenda-mode-map "g" #'org-agenda-redo-all) 2462 (org-defkey org-agenda-mode-map "e" #'org-agenda-set-effort) 2463 (org-defkey org-agenda-mode-map "\C-c\C-xe" #'org-agenda-set-effort) 2464 (org-defkey org-agenda-mode-map "\C-c\C-x\C-e" 2465 #'org-clock-modify-effort-estimate) 2466 (org-defkey org-agenda-mode-map "\C-c\C-xp" #'org-agenda-set-property) 2467 (org-defkey org-agenda-mode-map "q" #'org-agenda-quit) 2468 (org-defkey org-agenda-mode-map "Q" #'org-agenda-Quit) 2469 (org-defkey org-agenda-mode-map "x" #'org-agenda-exit) 2470 (org-defkey org-agenda-mode-map "\C-x\C-w" #'org-agenda-write) 2471 (org-defkey org-agenda-mode-map "\C-x\C-s" #'org-save-all-org-buffers) 2472 (org-defkey org-agenda-mode-map "s" #'org-save-all-org-buffers) 2473 (org-defkey org-agenda-mode-map "T" #'org-agenda-show-tags) 2474 (org-defkey org-agenda-mode-map "n" #'org-agenda-next-line) 2475 (org-defkey org-agenda-mode-map "p" #'org-agenda-previous-line) 2476 (org-defkey org-agenda-mode-map "N" #'org-agenda-next-item) 2477 (org-defkey org-agenda-mode-map "P" #'org-agenda-previous-item) 2478 (substitute-key-definition #'next-line #'org-agenda-next-line 2479 org-agenda-mode-map global-map) 2480 (substitute-key-definition #'previous-line #'org-agenda-previous-line 2481 org-agenda-mode-map global-map) 2482 (org-defkey org-agenda-mode-map "\C-c\C-a" #'org-attach) 2483 (org-defkey org-agenda-mode-map "\C-c\C-n" #'org-agenda-next-date-line) 2484 (org-defkey org-agenda-mode-map "\C-c\C-p" #'org-agenda-previous-date-line) 2485 (org-defkey org-agenda-mode-map "\C-c," #'org-agenda-priority) 2486 (org-defkey org-agenda-mode-map "," #'org-agenda-priority) 2487 (org-defkey org-agenda-mode-map "i" #'org-agenda-diary-entry) 2488 (org-defkey org-agenda-mode-map "c" #'org-agenda-goto-calendar) 2489 (org-defkey org-agenda-mode-map "C" #'org-agenda-convert-date) 2490 (org-defkey org-agenda-mode-map "M" #'org-agenda-phases-of-moon) 2491 (org-defkey org-agenda-mode-map "S" #'org-agenda-sunrise-sunset) 2492 (org-defkey org-agenda-mode-map "h" #'org-agenda-holidays) 2493 (org-defkey org-agenda-mode-map "H" #'org-agenda-holidays) 2494 (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" #'org-agenda-clock-in) 2495 (org-defkey org-agenda-mode-map "I" #'org-agenda-clock-in) 2496 (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" #'org-agenda-clock-out) 2497 (org-defkey org-agenda-mode-map "O" #'org-agenda-clock-out) 2498 (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" #'org-agenda-clock-cancel) 2499 (org-defkey org-agenda-mode-map "X" #'org-agenda-clock-cancel) 2500 (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" #'org-clock-goto) 2501 (org-defkey org-agenda-mode-map "J" #'org-agenda-clock-goto) 2502 (org-defkey org-agenda-mode-map "+" #'org-agenda-priority-up) 2503 (org-defkey org-agenda-mode-map "-" #'org-agenda-priority-down) 2504 (org-defkey org-agenda-mode-map [(shift up)] #'org-agenda-priority-up) 2505 (org-defkey org-agenda-mode-map [(shift down)] #'org-agenda-priority-down) 2506 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] #'org-agenda-priority-up) 2507 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] #'org-agenda-priority-down) 2508 (org-defkey org-agenda-mode-map "f" #'org-agenda-later) 2509 (org-defkey org-agenda-mode-map "b" #'org-agenda-earlier) 2510 (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" #'org-agenda-columns) 2511 (org-defkey org-agenda-mode-map "\C-c\C-x>" #'org-agenda-remove-restriction-lock) 2512 (org-defkey org-agenda-mode-map "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda) 2513 (org-defkey org-agenda-mode-map "[" #'org-agenda-manipulate-query-add) 2514 (org-defkey org-agenda-mode-map "]" #'org-agenda-manipulate-query-subtract) 2515 (org-defkey org-agenda-mode-map "{" #'org-agenda-manipulate-query-add-re) 2516 (org-defkey org-agenda-mode-map "}" #'org-agenda-manipulate-query-subtract-re) 2517 (org-defkey org-agenda-mode-map "\\" #'org-agenda-filter-by-tag) 2518 (org-defkey org-agenda-mode-map "_" #'org-agenda-filter-by-effort) 2519 (org-defkey org-agenda-mode-map "=" #'org-agenda-filter-by-regexp) 2520 (org-defkey org-agenda-mode-map "/" #'org-agenda-filter) 2521 (org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all) 2522 (org-defkey org-agenda-mode-map "~" #'org-agenda-limit-interactively) 2523 (org-defkey org-agenda-mode-map "<" #'org-agenda-filter-by-category) 2524 (org-defkey org-agenda-mode-map "^" #'org-agenda-filter-by-top-headline) 2525 (org-defkey org-agenda-mode-map ";" #'org-timer-set-timer) 2526 (org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop) 2527 (org-defkey org-agenda-mode-map "?" #'org-agenda-show-the-flagging-note) 2528 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" #'org-mobile-pull) 2529 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" #'org-mobile-push) 2530 (org-defkey org-agenda-mode-map "\C-c\C-xI" #'org-info-find-node) 2531 (org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse) 2532 (org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse) 2533 (org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block) 2534 (org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block) 2535 (org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c) 2536 2537 (when org-agenda-mouse-1-follows-link 2538 (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) 2539 2540 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu." 2541 '("Agenda" 2542 ("Agenda Files") 2543 "--" 2544 ("Agenda Dates" 2545 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)] 2546 ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] 2547 ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] 2548 ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)]) 2549 "--" 2550 ("View" 2551 ["Day View" org-agenda-day-view 2552 :active (org-agenda-check-type nil 'agenda) 2553 :style radio :selected (eq org-agenda-current-span 'day) 2554 :keys "v d (or just d)"] 2555 ["Week View" org-agenda-week-view 2556 :active (org-agenda-check-type nil 'agenda) 2557 :style radio :selected (eq org-agenda-current-span 'week) 2558 :keys "v w"] 2559 ["Fortnight View" org-agenda-fortnight-view 2560 :active (org-agenda-check-type nil 'agenda) 2561 :style radio :selected (eq org-agenda-current-span 'fortnight) 2562 :keys "v t"] 2563 ["Month View" org-agenda-month-view 2564 :active (org-agenda-check-type nil 'agenda) 2565 :style radio :selected (eq org-agenda-current-span 'month) 2566 :keys "v m"] 2567 ["Year View" org-agenda-year-view 2568 :active (org-agenda-check-type nil 'agenda) 2569 :style radio :selected (eq org-agenda-current-span 'year) 2570 :keys "v y"] 2571 "--" 2572 ["Include Diary" org-agenda-toggle-diary 2573 :style toggle :selected org-agenda-include-diary 2574 :active (org-agenda-check-type nil 'agenda)] 2575 ["Include Deadlines" org-agenda-toggle-deadlines 2576 :style toggle :selected org-agenda-include-deadlines 2577 :active (org-agenda-check-type nil 'agenda)] 2578 ["Use Time Grid" org-agenda-toggle-time-grid 2579 :style toggle :selected org-agenda-use-time-grid 2580 :active (org-agenda-check-type nil 'agenda)] 2581 "--" 2582 ["Show clock report" org-agenda-clockreport-mode 2583 :style toggle :selected org-agenda-clockreport-mode 2584 :active (org-agenda-check-type nil 'agenda)] 2585 ["Show some entry text" org-agenda-entry-text-mode 2586 :style toggle :selected org-agenda-entry-text-mode 2587 :active t] 2588 "--" 2589 ["Show Logbook entries" org-agenda-log-mode 2590 :style toggle :selected org-agenda-show-log 2591 :active (org-agenda-check-type nil 'agenda) 2592 :keys "v l (or just l)"] 2593 ["Include archived trees" org-agenda-archives-mode 2594 :style toggle :selected org-agenda-archives-mode :active t 2595 :keys "v a"] 2596 ["Include archive files" (org-agenda-archives-mode t) 2597 :style toggle :selected (eq org-agenda-archives-mode t) :active t 2598 :keys "v A"] 2599 "--" 2600 ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) 2601 ("Filter current view" 2602 ["with generic interface" org-agenda-filter t] 2603 "--" 2604 ["by category at cursor" org-agenda-filter-by-category t] 2605 ["by tag" org-agenda-filter-by-tag t] 2606 ["by effort" org-agenda-filter-by-effort t] 2607 ["by regexp" org-agenda-filter-by-regexp t] 2608 ["by top-level headline" org-agenda-filter-by-top-headline t] 2609 "--" 2610 ["Remove all filtering" org-agenda-filter-remove-all t] 2611 "--" 2612 ["limit" org-agenda-limit-interactively t]) 2613 ["Rebuild buffer" org-agenda-redo t] 2614 ["Write view to file" org-agenda-write t] 2615 ["Save all Org buffers" org-save-all-org-buffers t] 2616 "--" 2617 ["Show original entry" org-agenda-show t] 2618 ["Go To (other window)" org-agenda-goto t] 2619 ["Go To (this window)" org-agenda-switch-to t] 2620 ["Capture with cursor date" org-agenda-capture t] 2621 ["Follow Mode" org-agenda-follow-mode 2622 :style toggle :selected org-agenda-follow-mode :active t] 2623 ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] 2624 "--" 2625 ("TODO" 2626 ["Cycle TODO" org-agenda-todo t] 2627 ["Next TODO set" org-agenda-todo-nextset t] 2628 ["Previous TODO set" org-agenda-todo-previousset t] 2629 ["Add note" org-agenda-add-note t]) 2630 ("Archive/Refile/Delete" 2631 ["Archive default" org-agenda-archive-default t] 2632 ["Archive default" org-agenda-archive-default-with-confirmation t] 2633 ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] 2634 ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] 2635 ["Archive subtree" org-agenda-archive t] 2636 "--" 2637 ["Refile" org-agenda-refile t] 2638 "--" 2639 ["Delete subtree" org-agenda-kill t]) 2640 ("Bulk action" 2641 ["Mark entry" org-agenda-bulk-mark t] 2642 ["Mark all" org-agenda-bulk-mark-all t] 2643 ["Unmark entry" org-agenda-bulk-unmark t] 2644 ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"] 2645 ["Toggle mark" org-agenda-bulk-toggle t] 2646 ["Toggle all" org-agenda-bulk-toggle-all t] 2647 ["Mark regexp" org-agenda-bulk-mark-regexp t]) 2648 ["Act on all marked" org-agenda-bulk-action t] 2649 "--" 2650 ("Tags and Properties" 2651 ["Show all Tags" org-agenda-show-tags t] 2652 ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] 2653 ["Change tag in region" org-agenda-set-tags (org-region-active-p)] 2654 "--" 2655 ["Column View" org-columns t]) 2656 ("Deadline/Schedule" 2657 ["Schedule" org-agenda-schedule t] 2658 ["Set Deadline" org-agenda-deadline t] 2659 "--" 2660 ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)] 2661 ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)] 2662 ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"] 2663 ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"] 2664 ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"] 2665 ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"] 2666 ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)]) 2667 ("Clock and Effort" 2668 ["Clock in" org-agenda-clock-in t] 2669 ["Clock out" org-agenda-clock-out t] 2670 ["Clock cancel" org-agenda-clock-cancel t] 2671 ["Goto running clock" org-clock-goto t] 2672 "--" 2673 ["Set Effort" org-agenda-set-effort t] 2674 ["Change clocked effort" org-clock-modify-effort-estimate 2675 (org-clock-is-active)]) 2676 ("Priority" 2677 ["Set Priority" org-agenda-priority t] 2678 ["Increase Priority" org-agenda-priority-up t] 2679 ["Decrease Priority" org-agenda-priority-down t] 2680 ["Show Priority" org-priority-show t]) 2681 ("Calendar/Diary" 2682 ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)] 2683 ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)] 2684 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)] 2685 ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)] 2686 ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)] 2687 ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)] 2688 "--" 2689 ["Create iCalendar File" org-icalendar-combine-agenda-files t]) 2690 "--" 2691 ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] 2692 "--" 2693 ("MobileOrg" 2694 ["Push Files and Views" org-mobile-push t] 2695 ["Get Captured and Flagged" org-mobile-pull t] 2696 ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"] 2697 ["Show note / unflag" org-agenda-show-the-flagging-note t] 2698 "--" 2699 ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) 2700 "--" 2701 ["Quit" org-agenda-quit t] 2702 ["Exit and Release Buffers" org-agenda-exit t] 2703 )) 2704 2705 ;;; Agenda undo 2706 2707 (defvar org-agenda-allow-remote-undo t 2708 "Non-nil means allow remote undo from the agenda buffer.") 2709 (defvar org-agenda-undo-has-started-in nil 2710 "Buffers that have already seen `undo-start' in the current undo sequence.") 2711 2712 (defun org-agenda-undo () 2713 "Undo a remote editing step in the agenda. 2714 This undoes changes both in the agenda buffer and in the remote buffer 2715 that have been changed along." 2716 (interactive) 2717 (or org-agenda-allow-remote-undo 2718 (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo")) 2719 (when (not (eq this-command last-command)) 2720 (setq org-agenda-undo-has-started-in nil 2721 org-agenda-pending-undo-list org-agenda-undo-list)) 2722 (when (not org-agenda-pending-undo-list) 2723 (user-error "No further undo information")) 2724 (let* ((entry (pop org-agenda-pending-undo-list)) 2725 buf line cmd rembuf) 2726 (setq cmd (pop entry) line (pop entry)) 2727 (setq rembuf (nth 2 entry)) 2728 (org-with-remote-undo rembuf 2729 (while (bufferp (setq buf (pop entry))) 2730 (when (pop entry) 2731 (with-current-buffer buf 2732 (let (;; (last-undo-buffer buf) 2733 (inhibit-read-only t)) 2734 (unless (memq buf org-agenda-undo-has-started-in) 2735 (push buf org-agenda-undo-has-started-in) 2736 (make-local-variable 'pending-undo-list) 2737 (undo-start)) 2738 (while (and pending-undo-list 2739 (listp pending-undo-list) 2740 (not (car pending-undo-list))) 2741 (pop pending-undo-list)) 2742 (undo-more 1)))))) 2743 (org-goto-line line) 2744 (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) 2745 2746 (defun org-verify-change-for-undo (l1 l2) 2747 "Verify that a real change occurred between the undo lists L1 and L2." 2748 (while (and l1 (listp l1) (null (car l1))) (pop l1)) 2749 (while (and l2 (listp l2) (null (car l2))) (pop l2)) 2750 (not (eq l1 l2))) 2751 2752 ;;; Agenda dispatch 2753 2754 (defvar org-agenda-restrict-begin (make-marker) 2755 "Internal variable used to mark the restriction beginning. 2756 It is only relevant when `org-agenda-restrict' is a buffer.") 2757 (defvar org-agenda-restrict-end (make-marker) 2758 "Internal variable used to mark the restriction end. 2759 It is only relevant when `org-agenda-restrict' is a buffer.") 2760 (defvar org-agenda-overriding-restriction nil 2761 "Non-nil means extended agenda restriction is active. 2762 This is an internal flag set by `org-agenda-set-restriction-lock'.") 2763 2764 (defcustom org-agenda-custom-commands-contexts nil 2765 "Alist of custom agenda keys and contextual rules. 2766 2767 For example, if you have a custom agenda command \"p\" and you 2768 want this command to be accessible only from plain text files, 2769 use this: 2770 2771 (setq org-agenda-custom-commands-contexts 2772 \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\"))))) 2773 2774 Here are the available contexts definitions: 2775 2776 in-file: command displayed only in matching files 2777 in-mode: command displayed only in matching modes 2778 not-in-file: command not displayed in matching files 2779 not-in-mode: command not displayed in matching modes 2780 in-buffer: command displayed only in matching buffers 2781 not-in-buffer: command not displayed in matching buffers 2782 [function]: a custom function taking no argument 2783 2784 If you define several checks, the agenda command will be 2785 accessible if there is at least one valid check. 2786 2787 You can also bind a key to another agenda custom command 2788 depending on contextual rules. 2789 2790 (setq org-agenda-custom-commands-contexts 2791 \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\"))))) 2792 2793 Here it means: in .txt files, use \"p\" as the key for the 2794 agenda command otherwise associated with \"q\". (The command 2795 originally associated with \"q\" is not displayed to avoid 2796 duplicates.)" 2797 :version "24.3" 2798 :group 'org-agenda-custom-commands 2799 :type '(repeat (list :tag "Rule" 2800 (string :tag " Agenda key") 2801 (string :tag "Replace by command") 2802 (repeat :tag "Available when" 2803 (choice 2804 (cons :tag "Condition" 2805 (choice 2806 (const :tag "In file" in-file) 2807 (const :tag "Not in file" not-in-file) 2808 (const :tag "In buffer" in-buffer) 2809 (const :tag "Not in buffer" not-in-buffer) 2810 (const :tag "In mode" in-mode) 2811 (const :tag "Not in mode" not-in-mode)) 2812 (regexp)) 2813 (function :tag "Custom function")))))) 2814 2815 (defcustom org-agenda-max-entries nil 2816 "Maximum number of entries to display in an agenda. 2817 This can be nil (no limit) or an integer or an alist of agenda 2818 types with an associated number of entries to display in this 2819 type." 2820 :version "24.4" 2821 :package-version '(Org . "8.0") 2822 :group 'org-agenda-custom-commands 2823 :type '(choice (symbol :tag "No limit" nil) 2824 (integer :tag "Max number of entries") 2825 (repeat 2826 (cons (choice :tag "Agenda type" 2827 (const agenda) 2828 (const todo) 2829 (const tags) 2830 (const search)) 2831 (integer :tag "Max number of entries"))))) 2832 2833 (defcustom org-agenda-max-todos nil 2834 "Maximum number of TODOs to display in an agenda. 2835 This can be nil (no limit) or an integer or an alist of agenda 2836 types with an associated number of entries to display in this 2837 type." 2838 :version "24.4" 2839 :package-version '(Org . "8.0") 2840 :group 'org-agenda-custom-commands 2841 :type '(choice (symbol :tag "No limit" nil) 2842 (integer :tag "Max number of TODOs") 2843 (repeat 2844 (cons (choice :tag "Agenda type" 2845 (const agenda) 2846 (const todo) 2847 (const tags) 2848 (const search)) 2849 (integer :tag "Max number of TODOs"))))) 2850 2851 (defcustom org-agenda-max-tags nil 2852 "Maximum number of tagged entries to display in an agenda. 2853 This can be nil (no limit) or an integer or an alist of agenda 2854 types with an associated number of entries to display in this 2855 type." 2856 :version "24.4" 2857 :package-version '(Org . "8.0") 2858 :group 'org-agenda-custom-commands 2859 :type '(choice (symbol :tag "No limit" nil) 2860 (integer :tag "Max number of tagged entries") 2861 (repeat 2862 (cons (choice :tag "Agenda type" 2863 (const agenda) 2864 (const todo) 2865 (const tags) 2866 (const search)) 2867 (integer :tag "Max number of tagged entries"))))) 2868 2869 (defcustom org-agenda-max-effort nil 2870 "Maximum cumulated effort duration for the agenda. 2871 This can be nil (no limit) or a number of minutes (as an integer) 2872 or an alist of agenda types with an associated number of minutes 2873 to limit entries to in this type." 2874 :version "24.4" 2875 :package-version '(Org . "8.0") 2876 :group 'org-agenda-custom-commands 2877 :type '(choice (symbol :tag "No limit" nil) 2878 (integer :tag "Max number of minutes") 2879 (repeat 2880 (cons (choice :tag "Agenda type" 2881 (const agenda) 2882 (const todo) 2883 (const tags) 2884 (const search)) 2885 (integer :tag "Max number of minutes"))))) 2886 2887 (defvar org-agenda-keep-restricted-file-list nil) 2888 (defvar org-keys nil) 2889 (defvar org-match nil) 2890 ;;;###autoload 2891 (defun org-agenda (&optional arg keys restriction) 2892 "Dispatch agenda commands to collect entries to the agenda buffer. 2893 Prompts for a command to execute. Any prefix arg will be passed 2894 on to the selected command. The default selections are: 2895 2896 a Call `org-agenda-list' to display the agenda for current day or week. 2897 t Call `org-todo-list' to display the global todo list. 2898 T Call `org-todo-list' to display the global todo list, select only 2899 entries with a specific TODO keyword (the user gets a prompt). 2900 m Call `org-tags-view' to display headlines with tags matching 2901 a condition (the user is prompted for the condition). 2902 M Like `m', but select only TODO entries, no ordinary headlines. 2903 e Export views to associated files. 2904 s Search entries for keywords. 2905 S Search entries for keywords, only with TODO keywords. 2906 / Multi occur across all agenda files and also files listed 2907 in `org-agenda-text-search-extra-files'. 2908 < Restrict agenda commands to buffer, subtree, or region. 2909 Press several times to get the desired effect. 2910 > Remove a previous restriction. 2911 # List \"stuck\" projects. 2912 ! Configure what \"stuck\" means. 2913 C Configure custom agenda commands. 2914 2915 More commands can be added by configuring the variable 2916 `org-agenda-custom-commands'. In particular, specific tags and TODO keyword 2917 searches can be pre-defined in this way. 2918 2919 If the current buffer is in Org mode and visiting a file, you can also 2920 first press `<' once to indicate that the agenda should be temporarily 2921 \(until the next use of `\\[org-agenda]') restricted to the current file. 2922 Pressing `<' twice means to restrict to the current subtree or region 2923 \(if active)." 2924 (interactive "P") 2925 (catch 'exit 2926 (let* ((org-keys keys) 2927 (prefix-descriptions nil) 2928 (org-agenda-buffer-name org-agenda-buffer-name) 2929 (org-agenda-window-setup (if (equal (buffer-name) 2930 org-agenda-buffer-name) 2931 'current-window 2932 org-agenda-window-setup)) 2933 (org-agenda-custom-commands-orig org-agenda-custom-commands) 2934 (org-agenda-custom-commands 2935 ;; normalize different versions 2936 (delq nil 2937 (mapcar 2938 (lambda (x) 2939 (cond ((stringp (cdr x)) 2940 (push x prefix-descriptions) 2941 nil) 2942 ((stringp (nth 1 x)) x) 2943 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) 2944 (t (cons (car x) (cons "" (cdr x)))))) 2945 org-agenda-custom-commands))) 2946 (org-agenda-custom-commands 2947 (org-contextualize-keys 2948 org-agenda-custom-commands org-agenda-custom-commands-contexts)) 2949 ;; (buf (current-buffer)) 2950 (bfn (buffer-file-name (buffer-base-buffer))) 2951 entry type org-match lprops ans) ;; key 2952 ;; Turn off restriction unless there is an overriding one, 2953 (unless org-agenda-overriding-restriction 2954 (unless org-agenda-keep-restricted-file-list 2955 ;; There is a request to keep the file list in place 2956 (put 'org-agenda-files 'org-restrict nil)) 2957 (setq org-agenda-restrict nil) 2958 (move-marker org-agenda-restrict-begin nil) 2959 (move-marker org-agenda-restrict-end nil)) 2960 (unless org-keys 2961 (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) 2962 org-keys (car ans) 2963 restriction (cdr ans))) 2964 ;; If we have sticky agenda buffers, set a name for the buffer, 2965 ;; depending on the invoking keys. The user may still set this 2966 ;; as a command option, which will overwrite what we do here. 2967 (when org-agenda-sticky 2968 (setq org-agenda-buffer-name 2969 (format "*Org Agenda(%s)*" org-keys))) 2970 ;; Establish the restriction, if any 2971 (when (and (not org-agenda-overriding-restriction) restriction) 2972 (put 'org-agenda-files 'org-restrict (list bfn)) 2973 (cond 2974 ((eq restriction 'region) 2975 (setq org-agenda-restrict (current-buffer)) 2976 (move-marker org-agenda-restrict-begin (region-beginning)) 2977 (move-marker org-agenda-restrict-end (region-end))) 2978 ((eq restriction 'subtree) 2979 (save-excursion 2980 (setq org-agenda-restrict (current-buffer)) 2981 (org-back-to-heading t) 2982 (move-marker org-agenda-restrict-begin (point)) 2983 (move-marker org-agenda-restrict-end 2984 (progn (org-end-of-subtree t))))) 2985 ((eq restriction 'buffer) 2986 (if (not (buffer-narrowed-p)) 2987 (setq org-agenda-restrict t) 2988 (setq org-agenda-restrict (current-buffer)) 2989 (move-marker org-agenda-restrict-begin (point-min)) 2990 (move-marker org-agenda-restrict-end (point-max)))))) 2991 2992 ;; For example the todo list should not need it (but does...) 2993 (cond 2994 ((setq entry (assoc org-keys org-agenda-custom-commands)) 2995 (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) 2996 (progn 2997 ;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars) 2998 ;; to some of the local variables? There's no doc about 2999 ;; that for `org-agenda-custom-commands'. 3000 (setq type (nth 2 entry) org-match (eval (nth 3 entry) t) 3001 lprops (nth 4 entry)) 3002 (when org-agenda-sticky 3003 (setq org-agenda-buffer-name 3004 (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match)) 3005 (format "*Org Agenda(%s)*" org-keys)))) 3006 (cl-progv 3007 (mapcar #'car lprops) 3008 (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) 3009 (pcase type 3010 (`agenda 3011 (org-agenda-list arg)) 3012 (`agenda* 3013 (org-agenda-list arg nil nil t)) 3014 (`alltodo 3015 (org-todo-list arg)) 3016 (`search 3017 (org-search-view arg org-match nil)) 3018 (`stuck 3019 (org-agenda-list-stuck-projects arg)) 3020 (`tags 3021 (org-tags-view arg org-match)) 3022 (`tags-todo 3023 (org-tags-view '(4) org-match)) 3024 (`todo 3025 (org-todo-list org-match)) 3026 (`tags-tree 3027 (org-check-for-org-mode) 3028 (org-match-sparse-tree arg org-match)) 3029 (`todo-tree 3030 (org-check-for-org-mode) 3031 (org-occur (concat "^" org-outline-regexp "[ \t]*" 3032 (regexp-quote org-match) "\\>"))) 3033 (`occur-tree 3034 (org-check-for-org-mode) 3035 (org-occur org-match)) 3036 ((pred functionp) 3037 (funcall type org-match)) 3038 ;; FIXME: Will signal an error since it's not `functionp'! 3039 ((pred fboundp) (funcall type org-match)) 3040 (_ (user-error "Invalid custom agenda command type %s" type)))) 3041 (let ((inhibit-read-only t)) 3042 (add-text-properties (point-min) (point-max) 3043 `(org-lprops ,lprops)))) 3044 (org-agenda-run-series (nth 1 entry) (cddr entry)))) 3045 ((equal org-keys "C") 3046 (setq org-agenda-custom-commands org-agenda-custom-commands-orig) 3047 (customize-variable 'org-agenda-custom-commands)) 3048 ((equal org-keys "a") (call-interactively 'org-agenda-list)) 3049 ((equal org-keys "s") (call-interactively 'org-search-view)) 3050 ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4)))) 3051 ((equal org-keys "t") (call-interactively 'org-todo-list)) 3052 ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) 3053 ((equal org-keys "m") (call-interactively 'org-tags-view)) 3054 ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) 3055 ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) 3056 ((equal org-keys "?") (org-tags-view nil "+FLAGGED") 3057 (add-hook 3058 'post-command-hook 3059 (lambda () 3060 (unless (current-message) 3061 (let* ((m (org-agenda-get-any-marker)) 3062 (note (and m (org-entry-get m "THEFLAGGINGNOTE")))) 3063 (when note 3064 (message "FLAGGING-NOTE ([?] for more info): %s" 3065 (org-add-props 3066 (replace-regexp-in-string 3067 "\\\\n" "//" 3068 (copy-sequence note)) 3069 nil 'face 'org-warning)))))) 3070 t t)) 3071 ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) 3072 ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) 3073 ((equal org-keys "!") (customize-variable 'org-stuck-projects)) 3074 (t (user-error "Invalid agenda key")))))) 3075 3076 (defvar org-agenda-multi) 3077 3078 (defun org-agenda-append-agenda () 3079 "Append another agenda view to the current one. 3080 This function allows interactive building of block agendas. 3081 Agenda views are separated by `org-agenda-block-separator'." 3082 (interactive) 3083 (unless (derived-mode-p 'org-agenda-mode) 3084 (user-error "Can only append from within agenda buffer")) 3085 (let ((org-agenda-multi t)) 3086 (org-agenda) 3087 (widen) 3088 (org-agenda-finalize) 3089 (setq buffer-read-only t) 3090 (org-agenda-fit-window-to-buffer))) 3091 3092 (defun org-agenda-normalize-custom-commands (cmds) 3093 "Normalize custom commands CMDS." 3094 (delq nil 3095 (mapcar 3096 (lambda (x) 3097 (cond ((stringp (cdr x)) nil) 3098 ((stringp (nth 1 x)) x) 3099 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) 3100 (t (cons (car x) (cons "" (cdr x)))))) 3101 cmds))) 3102 3103 (defun org-agenda-get-restriction-and-command (prefix-descriptions) 3104 "The user interface for selecting an agenda command." 3105 (catch 'exit 3106 (let* ((bfn (buffer-file-name (buffer-base-buffer))) 3107 (restrict-ok (and bfn (derived-mode-p 'org-mode))) 3108 (region-p (org-region-active-p)) 3109 (custom org-agenda-custom-commands) 3110 (selstring "") 3111 restriction second-time 3112 c entry key type match prefixes rmheader header-end custom1 desc 3113 line lines left right n n1) 3114 (save-window-excursion 3115 (delete-other-windows) 3116 (org-switch-to-buffer-other-window " *Agenda Commands*") 3117 (erase-buffer) 3118 (insert (eval-when-compile 3119 (let ((header 3120 (copy-sequence 3121 "Press key for an agenda command: 3122 -------------------------------- < Buffer, subtree/region restriction 3123 a Agenda for current week or day > Remove restriction 3124 t List of all TODO entries e Export agenda views 3125 m Match a TAGS/PROP/TODO query T Entries with special TODO kwd 3126 s Search for keywords M Like m, but only TODO entries 3127 / Multi-occur S Like s, but only TODO entries 3128 ? Find :FLAGGED: entries C Configure custom agenda commands 3129 * Toggle sticky agenda views # List stuck projects (!=configure) 3130 ")) 3131 (start 0)) 3132 (while (string-match 3133 "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" 3134 header start) 3135 (setq start (match-end 0)) 3136 (add-text-properties (match-beginning 2) (match-end 2) 3137 '(face bold) header)) 3138 header))) 3139 (setq header-end (point-marker)) 3140 (while t 3141 (setq custom1 custom) 3142 (when (eq rmheader t) 3143 (org-goto-line 1) 3144 (re-search-forward ":" nil t) 3145 (delete-region (match-end 0) (line-end-position)) 3146 (forward-char 1) 3147 (looking-at "-+") 3148 (delete-region (match-end 0) (line-end-position)) 3149 (move-marker header-end (match-end 0))) 3150 (goto-char header-end) 3151 (delete-region (point) (point-max)) 3152 3153 ;; Produce all the lines that describe custom commands and prefixes 3154 (setq lines nil) 3155 (while (setq entry (pop custom1)) 3156 (setq key (car entry) desc (nth 1 entry) 3157 type (nth 2 entry) 3158 match (nth 3 entry)) 3159 (if (> (length key) 1) 3160 (cl-pushnew (string-to-char key) prefixes :test #'equal) 3161 (setq line 3162 (format 3163 "%-4s%-14s" 3164 (org-add-props (copy-sequence key) 3165 '(face bold)) 3166 (cond 3167 ((string-match "\\S-" desc) desc) 3168 ((eq type 'agenda) "Agenda for current week or day") 3169 ((eq type 'agenda*) "Appointments for current week or day") 3170 ((eq type 'alltodo) "List of all TODO entries") 3171 ((eq type 'search) "Word search") 3172 ((eq type 'stuck) "List of stuck projects") 3173 ((eq type 'todo) "TODO keyword") 3174 ((eq type 'tags) "Tags query") 3175 ((eq type 'tags-todo) "Tags (TODO)") 3176 ((eq type 'tags-tree) "Tags tree") 3177 ((eq type 'todo-tree) "TODO kwd tree") 3178 ((eq type 'occur-tree) "Occur tree") 3179 ((functionp type) (if (symbolp type) 3180 (symbol-name type) 3181 "Lambda expression")) 3182 (t "???")))) 3183 (cond 3184 ((not (org-string-nw-p match)) nil) 3185 (org-agenda-menu-show-matcher 3186 (setq line 3187 (concat line ": " 3188 (cond 3189 ((stringp match) 3190 (propertize match 'face 'org-warning)) 3191 ((listp type) 3192 (format "set of %d commands" (length type))))))) 3193 (t 3194 (org-add-props line nil 'help-echo (concat "Matcher: " match)))) 3195 (push line lines))) 3196 (setq lines (nreverse lines)) 3197 (when prefixes 3198 (mapc (lambda (x) 3199 (push 3200 (format "%s %s" 3201 (org-add-props (char-to-string x) 3202 nil 'face 'bold) 3203 (or (cdr (assoc (concat selstring 3204 (char-to-string x)) 3205 prefix-descriptions)) 3206 "Prefix key")) 3207 lines)) 3208 prefixes)) 3209 3210 ;; Check if we should display in two columns 3211 (if org-agenda-menu-two-columns 3212 (progn 3213 (setq n (length lines) 3214 n1 (+ (/ n 2) (mod n 2)) 3215 right (nthcdr n1 lines) 3216 left (copy-sequence lines)) 3217 (setcdr (nthcdr (1- n1) left) nil)) 3218 (setq left lines right nil)) 3219 (while left 3220 (insert "\n" (pop left)) 3221 (when right 3222 (if (< (current-column) 40) 3223 (move-to-column 40 t) 3224 (insert " ")) 3225 (insert (pop right)))) 3226 3227 ;; Make the window the right size 3228 (goto-char (point-min)) 3229 (if second-time 3230 (when (not (pos-visible-in-window-p (point-max))) 3231 (org-fit-window-to-buffer)) 3232 (setq second-time t) 3233 (org-fit-window-to-buffer)) 3234 3235 ;; Hint to navigation if window too small for all information 3236 (setq header-line-format 3237 (when (not (pos-visible-in-window-p (point-max))) 3238 "Use C-v, M-v, C-n or C-p to navigate.")) 3239 3240 ;; Ask for selection 3241 (cl-loop 3242 do (progn 3243 (message "Press key for agenda command%s:" 3244 (if (or restrict-ok org-agenda-overriding-restriction) 3245 (if org-agenda-overriding-restriction 3246 " (restriction lock active)" 3247 (if restriction 3248 (format " (restricted to %s)" restriction) 3249 " (unrestricted)")) 3250 "")) 3251 (setq c (read-char-exclusive))) 3252 until (not (memq c '(14 16 22 134217846))) 3253 do (org-scroll c)) 3254 3255 (message "") 3256 (cond 3257 ((assoc (char-to-string c) custom) 3258 (setq selstring (concat selstring (char-to-string c))) 3259 (throw 'exit (cons selstring restriction))) 3260 ((memq c prefixes) 3261 (setq selstring (concat selstring (char-to-string c)) 3262 prefixes nil 3263 rmheader (or rmheader t) 3264 custom (delq nil (mapcar 3265 (lambda (x) 3266 (if (or (= (length (car x)) 1) 3267 (/= (string-to-char (car x)) c)) 3268 nil 3269 (cons (substring (car x) 1) (cdr x)))) 3270 custom)))) 3271 ((eq c ?*) 3272 (call-interactively 'org-toggle-sticky-agenda) 3273 (sit-for 2)) 3274 ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) 3275 (message "Restriction is only possible in Org buffers") 3276 (ding) (sit-for 1)) 3277 ((eq c ?1) 3278 (org-agenda-remove-restriction-lock 'noupdate) 3279 (setq restriction 'buffer)) 3280 ((eq c ?0) 3281 (org-agenda-remove-restriction-lock 'noupdate) 3282 (setq restriction (if region-p 'region 'subtree))) 3283 ((eq c ?<) 3284 (org-agenda-remove-restriction-lock 'noupdate) 3285 (setq restriction 3286 (cond 3287 ((eq restriction 'buffer) 3288 (if region-p 'region 'subtree)) 3289 ((memq restriction '(subtree region)) 3290 nil) 3291 (t 'buffer)))) 3292 ((eq c ?>) 3293 (org-agenda-remove-restriction-lock 'noupdate) 3294 (setq restriction nil)) 3295 ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) 3296 (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) 3297 ((and (> (length selstring) 0) (eq c ?\d)) 3298 (delete-window) 3299 (org-agenda-get-restriction-and-command prefix-descriptions)) 3300 3301 ((equal c ?q) (user-error "Abort")) 3302 (t (user-error "Invalid key %c" c)))))))) 3303 3304 (defun org-agenda-fit-window-to-buffer () 3305 "Fit the window to the buffer size." 3306 (and (memq org-agenda-window-setup '(reorganize-frame)) 3307 (fboundp 'fit-window-to-buffer) 3308 (if (and (= (cdr org-agenda-window-frame-fractions) 1.0) 3309 (= (car org-agenda-window-frame-fractions) 1.0)) 3310 (delete-other-windows) 3311 (org-fit-window-to-buffer 3312 nil 3313 (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) 3314 (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))) 3315 3316 (defvar org-cmd nil) 3317 (defvar org-agenda-overriding-cmd nil) 3318 (defvar org-agenda-overriding-arguments nil) 3319 (defvar org-agenda-overriding-cmd-arguments nil) 3320 3321 (defun org-agenda-run-series (name series) 3322 "Run agenda NAME as a SERIES of agenda commands." 3323 (let* ((gprops (nth 1 series)) 3324 (gvars (mapcar #'car gprops)) 3325 (gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops))) 3326 (cl-progv gvars gvals (org-agenda-prepare name)) 3327 ;; We need to reset agenda markers here, because when constructing a 3328 ;; block agenda, the individual blocks do not do that. 3329 (org-agenda-reset-markers) 3330 (with-no-warnings 3331 (defvar match)) ;Used via the `eval' below. 3332 (let* ((org-agenda-multi t) 3333 ;; FIXME: Redo should contain lists of (FUNS . ARGS) rather 3334 ;; than expressions, so you don't need to `quote' the args 3335 ;; and you just need to `apply' instead of `eval' when using it. 3336 (redo (list 'org-agenda-run-series name (list 'quote series))) 3337 (cmds (car series)) 3338 match 3339 org-cmd type lprops) 3340 (while (setq org-cmd (pop cmds)) 3341 (setq type (car org-cmd)) 3342 (setq match (eval (nth 1 org-cmd) t)) 3343 (setq lprops (nth 2 org-cmd)) 3344 (let ((org-agenda-overriding-arguments 3345 (if (eq org-agenda-overriding-cmd org-cmd) 3346 (or org-agenda-overriding-arguments 3347 org-agenda-overriding-cmd-arguments))) 3348 (lvars (mapcar #'car lprops)) 3349 (lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops))) 3350 (cl-progv (append gvars lvars) (append gvals lvals) 3351 (pcase type 3352 (`agenda 3353 (call-interactively 'org-agenda-list)) 3354 (`agenda* 3355 (funcall 'org-agenda-list nil nil t)) 3356 (`alltodo 3357 (call-interactively 'org-todo-list)) 3358 (`search 3359 (org-search-view current-prefix-arg match nil)) 3360 (`stuck 3361 (call-interactively 'org-agenda-list-stuck-projects)) 3362 (`tags 3363 (org-tags-view current-prefix-arg match)) 3364 (`tags-todo 3365 (org-tags-view '(4) match)) 3366 (`todo 3367 (org-todo-list match)) 3368 ((pred fboundp) 3369 (funcall type match)) 3370 (_ (error "Invalid type in command series")))))) 3371 (widen) 3372 (let ((inhibit-read-only t)) 3373 (add-text-properties (point-min) (point-max) 3374 `(org-series t org-series-redo-cmd ,redo))) 3375 (setq org-agenda-redo-command redo) 3376 (goto-char (point-min))) 3377 (org-agenda-fit-window-to-buffer) 3378 (cl-progv gvars gvals (org-agenda-finalize)))) 3379 3380 (defun org-agenda--split-plist (plist) 3381 ;; We could/should arguably use `map-keys' and `map-values'. 3382 (let (keys vals) 3383 (while plist 3384 (push (pop plist) keys) 3385 (push (pop plist) vals)) 3386 (cons (nreverse keys) (nreverse vals)))) 3387 3388 ;;;###autoload 3389 (defmacro org-batch-agenda (cmd-key &rest parameters) 3390 "Run an agenda command in batch mode and send the result to STDOUT. 3391 If CMD-KEY is a string of length 1, it is used as a key in 3392 `org-agenda-custom-commands' and triggers this command. If it is a 3393 longer string it is used as a tags/todo match string. 3394 Parameters are alternating variable names and values that will be bound 3395 before running the agenda command." 3396 (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) 3397 `(org--batch-agenda ,cmd-key ',vars (list ,@exps)))) 3398 3399 (defun org--batch-agenda (cmd-key vars vals) 3400 ;; `org-batch-agenda' is a macro because every other "parameter" is 3401 ;; a variable name rather than an expression to evaluate. Yuck! 3402 (cl-progv vars vals 3403 (let (org-agenda-sticky) 3404 (if (> (length cmd-key) 1) 3405 (org-tags-view nil cmd-key) 3406 (org-agenda nil cmd-key)))) 3407 (set-buffer org-agenda-buffer-name) 3408 (princ (buffer-string))) 3409 3410 (defvar org-agenda-info nil) 3411 3412 ;;;###autoload 3413 (defmacro org-batch-agenda-csv (cmd-key &rest parameters) 3414 "Run an agenda command in batch mode and send the result to STDOUT. 3415 If CMD-KEY is a string of length 1, it is used as a key in 3416 `org-agenda-custom-commands' and triggers this command. If it is a 3417 longer string it is used as a tags/todo match string. 3418 Parameters are alternating variable names and values that will be bound 3419 before running the agenda command. 3420 3421 The output gives a line for each selected agenda item. Each 3422 item is a list of comma-separated values, like this: 3423 3424 category,head,type,todo,tags,date,time,extra,priority-l,priority-n 3425 3426 category The category of the item 3427 head The headline, without TODO kwd, TAGS and PRIORITY 3428 type The type of the agenda entry, can be 3429 todo selected in TODO match 3430 tagsmatch selected in tags match 3431 diary imported from diary 3432 deadline a deadline on given date 3433 scheduled scheduled on given date 3434 timestamp entry has timestamp on given date 3435 closed entry was closed on given date 3436 upcoming-deadline warning about deadline 3437 past-scheduled forwarded scheduled item 3438 block entry has date block including g. date 3439 todo The todo keyword, if any 3440 tags All tags including inherited ones, separated by colons 3441 date The relevant date, like 2007-2-14 3442 time The time, like 15:00-16:50 3443 extra String with extra planning info 3444 priority-l The priority letter if any was given 3445 priority-n The computed numerical priority 3446 agenda-day The day in the agenda where this is listed" 3447 (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) 3448 `(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps)))) 3449 3450 (defun org--batch-agenda-csv (cmd-key vars vals) 3451 ;; `org-batch-agenda-csv' is a macro because every other "parameter" is 3452 ;; a variable name rather than an expression to evaluate. Yuck! 3453 (let ((org-agenda-remove-tags t)) 3454 (cl-progv vars vals 3455 ;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)? 3456 (if (> (length cmd-key) 2) 3457 (org-tags-view nil cmd-key) 3458 (org-agenda nil cmd-key)))) 3459 (set-buffer org-agenda-buffer-name) 3460 (let ((lines (org-split-string (buffer-string) "\n"))) 3461 (dolist (line lines) 3462 (when (get-text-property 0 'org-category line) 3463 (setq org-agenda-info 3464 (org-fix-agenda-info (text-properties-at 0 line))) 3465 (princ 3466 (mapconcat #'org-agenda-export-csv-mapper 3467 '(org-category txt type todo tags date time extra 3468 priority-letter priority agenda-day) 3469 ",")) 3470 (princ "\n"))))) 3471 3472 (defun org-fix-agenda-info (props) 3473 "Make sure all properties on an agenda item have a canonical form. 3474 This ensures the export commands can easily use it." 3475 (let (tmp re) 3476 (when (setq tmp (plist-get props 'tags)) 3477 (setq props (plist-put props 'tags (mapconcat #'identity tmp ":")))) 3478 (when (setq tmp (plist-get props 'date)) 3479 (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) 3480 (let ((calendar-date-display-form 3481 '(year "-" (string-pad month 2 ?0 'left) "-" (string-pad day 2 ?0 'left)))) 3482 (setq tmp (calendar-date-string tmp))) 3483 (setq props (plist-put props 'date tmp))) 3484 (when (setq tmp (plist-get props 'day)) 3485 (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) 3486 (let ((calendar-date-display-form 3487 '(year "-" (string-pad month 2 ?0 'left) "-" (string-pad day 2 ?0 'left)))) 3488 (setq tmp (calendar-date-string tmp))) 3489 (setq props (plist-put props 'day tmp)) 3490 (setq props (plist-put props 'agenda-day tmp))) 3491 (when (setq tmp (plist-get props 'txt)) 3492 (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) 3493 (plist-put props 'priority-letter (match-string 1 tmp)) 3494 (setq tmp (replace-match "" t t tmp))) 3495 (when (and (setq re (plist-get props 'org-todo-regexp)) 3496 (setq re (concat "\\`\\.*" re " ?")) 3497 (let ((case-fold-search nil)) (string-match re tmp))) 3498 (plist-put props 'todo (match-string 1 tmp)) 3499 (setq tmp (replace-match "" t t tmp))) 3500 (plist-put props 'txt tmp))) 3501 props) 3502 3503 (defun org-agenda-export-csv-mapper (prop) 3504 (let ((res (plist-get org-agenda-info prop))) 3505 (setq res 3506 (cond 3507 ((not res) "") 3508 ((stringp res) res) 3509 (t (prin1-to-string res)))) 3510 (org-trim (replace-regexp-in-string "," ";" res nil t)))) 3511 3512 ;;;###autoload 3513 (defun org-store-agenda-views (&rest _parameters) 3514 "Store agenda views." 3515 (interactive) 3516 (org--batch-store-agenda-views nil nil)) 3517 3518 ;;;###autoload 3519 (defmacro org-batch-store-agenda-views (&rest parameters) 3520 "Run all custom agenda commands that have a file argument." 3521 (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) 3522 `(org--batch-store-agenda-views ',vars (list ,@exps)))) 3523 3524 (defun org--batch-store-agenda-views (vars vals) 3525 (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) 3526 (pop-up-frames nil) 3527 (dir default-directory) 3528 cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) 3529 (save-window-excursion 3530 (while cmds 3531 (setq cmd (pop cmds) 3532 thiscmdkey (car cmd) 3533 thiscmdcmd (cdr cmd) 3534 match (nth 2 thiscmdcmd) 3535 bufname (if org-agenda-sticky 3536 (or (and (stringp match) 3537 (format "*Org Agenda(%s:%s)*" thiscmdkey match)) 3538 (format "*Org Agenda(%s)*" thiscmdkey)) 3539 org-agenda-buffer-name) 3540 cmd-or-set (nth 2 cmd) 3541 opts (nth (if (listp cmd-or-set) 3 4) cmd) 3542 files (nth (if (listp cmd-or-set) 4 5) cmd)) 3543 (if (stringp files) (setq files (list files))) 3544 (when files 3545 (let* ((opts (append org-agenda-exporter-settings opts)) 3546 (vars (append (mapcar #'car opts) vars)) 3547 (vals (append (mapcar (lambda (binding) (eval (cadr binding) t)) 3548 opts) 3549 vals))) 3550 (cl-progv vars vals 3551 (org-agenda nil thiscmdkey)) 3552 (set-buffer bufname) 3553 (while files 3554 (cl-progv vars vals 3555 (org-agenda-write (expand-file-name (pop files) dir) 3556 nil t bufname)))) 3557 (and (get-buffer bufname) 3558 (kill-buffer bufname))))))) 3559 3560 (defvar org-agenda-current-span nil 3561 "The current span used in the agenda view.") ; local variable in the agenda buffer 3562 (defun org-agenda-mark-header-line (pos) 3563 "Mark the line at POS as an agenda structure header." 3564 (save-excursion 3565 (goto-char pos) 3566 (put-text-property (line-beginning-position) (line-end-position) 3567 'org-agenda-structural-header t) 3568 (when org-agenda-title-append 3569 (put-text-property (line-beginning-position) (line-end-position) 3570 'org-agenda-title-append org-agenda-title-append)))) 3571 3572 (defvar org-mobile-creating-agendas) ; defined in org-mobile.el 3573 (defvar org-agenda-write-buffer-name "Agenda View") 3574 (defun org-agenda-write (file &optional open nosettings agenda-bufname) 3575 "Write the current buffer (an agenda view) as a file. 3576 3577 Depending on the extension of the file name, plain text (.txt), 3578 HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced. 3579 If the extension is .ics, translate visible agenda into iCalendar 3580 format. If the extension is .org, collect all subtrees 3581 corresponding to the agenda entries and add them in an .org file. 3582 3583 With prefix argument OPEN, open the new file immediately. If 3584 NOSETTINGS is given, do not scope the settings of 3585 `org-agenda-exporter-settings' into the export commands. This is 3586 used when the settings have already been scoped and we do not 3587 wish to overrule other, higher priority settings. If 3588 AGENDA-BUFFER-NAME is provided, use this as the buffer name for 3589 the agenda to write." 3590 (interactive "FWrite agenda to file: \nP") 3591 (if (or (not (file-writable-p file)) 3592 (and (file-exists-p file) 3593 (if (called-interactively-p 'any) 3594 (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) 3595 (user-error "Cannot write agenda to file %s" file)) 3596 (cl-progv 3597 (if nosettings nil (mapcar #'car org-agenda-exporter-settings)) 3598 (if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t)) 3599 org-agenda-exporter-settings)) 3600 (save-excursion 3601 (save-window-excursion 3602 (let ((bs (copy-sequence (buffer-string))) 3603 (extension (file-name-extension file)) 3604 (default-directory (file-name-directory file)) 3605 ) ;; beg content 3606 (with-temp-buffer 3607 (rename-buffer org-agenda-write-buffer-name t) 3608 (set-buffer-modified-p nil) 3609 (insert bs) 3610 (org-agenda-remove-marked-text 'invisible 'org-filtered) 3611 (run-hooks 'org-agenda-before-write-hook) 3612 (cond 3613 ((bound-and-true-p org-mobile-creating-agendas) 3614 (org-mobile-write-agenda-for-mobile file)) 3615 ((string= "org" extension) 3616 (let (content p m message-log-max) 3617 (goto-char (point-min)) 3618 (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) 3619 (goto-char p) 3620 (setq m (get-text-property (point) 'org-hd-marker)) 3621 (when m 3622 (push (with-current-buffer (marker-buffer m) 3623 (goto-char m) 3624 (org-copy-subtree 1 nil t t) 3625 org-subtree-clip) 3626 content))) 3627 (find-file file) 3628 (erase-buffer) 3629 (dolist (s content) (org-paste-subtree 1 s)) 3630 (write-file file) 3631 (kill-buffer (current-buffer)) 3632 (message "Org file written to %s" file))) 3633 ((member extension '("html" "htm")) 3634 (or (require 'htmlize nil t) 3635 (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) 3636 (declare-function htmlize-buffer "htmlize" (&optional buffer)) 3637 (set-buffer (htmlize-buffer (current-buffer))) 3638 (when org-agenda-export-html-style 3639 ;; replace <style> section with org-agenda-export-html-style 3640 (goto-char (point-min)) 3641 (kill-region (- (search-forward "<style") 6) 3642 (search-forward "</style>")) 3643 (insert org-agenda-export-html-style)) 3644 (write-file file) 3645 (kill-buffer (current-buffer)) 3646 (message "HTML written to %s" file)) 3647 ((string= "ps" extension) 3648 (require 'ps-print) 3649 (ps-print-buffer-with-faces file) 3650 (message "Postscript written to %s" file)) 3651 ((string= "pdf" extension) 3652 (require 'ps-print) 3653 (ps-print-buffer-with-faces 3654 (concat (file-name-sans-extension file) ".ps")) 3655 (call-process "ps2pdf" nil nil nil 3656 (expand-file-name 3657 (concat (file-name-sans-extension file) ".ps")) 3658 (expand-file-name file)) 3659 (delete-file (concat (file-name-sans-extension file) ".ps")) 3660 (message "PDF written to %s" file)) 3661 ((string= "ics" extension) 3662 (require 'ox-icalendar) 3663 (declare-function org-icalendar-export-current-agenda 3664 "ox-icalendar" (file)) 3665 (org-icalendar-export-current-agenda (expand-file-name file))) 3666 (t 3667 (let ((bs (buffer-string))) 3668 (find-file file) 3669 (erase-buffer) 3670 (insert bs) 3671 (save-buffer 0) 3672 (kill-buffer (current-buffer)) 3673 (message "Plain text written to %s" file)))))))) 3674 (set-buffer (or agenda-bufname 3675 ;; FIXME: I'm pretty sure called-interactively-p 3676 ;; doesn't do what we want here! 3677 (and (called-interactively-p 'any) (buffer-name)) 3678 org-agenda-buffer-name))) 3679 (when open (org-open-file file))) 3680 3681 (defun org-agenda-remove-marked-text (property &optional value) 3682 "Delete all text marked with VALUE of PROPERTY. 3683 VALUE defaults to t." 3684 (let (beg) 3685 (setq value (or value t)) 3686 (while (setq beg (text-property-any (point-min) (point-max) 3687 property value)) 3688 (delete-region 3689 beg (or (next-single-property-change beg property) 3690 (point-max)))))) 3691 3692 (defun org-agenda-add-entry-text () 3693 "Add entry text to agenda lines. 3694 This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the 3695 entry text following headings shown in the agenda. 3696 Drawers will be excluded, also the line with scheduling/deadline info." 3697 (when (and (> org-agenda-add-entry-text-maxlines 0) 3698 (not (bound-and-true-p org-mobile-creating-agendas))) 3699 (let (m txt) 3700 (goto-char (point-min)) 3701 (while (not (eobp)) 3702 (if (not (setq m (org-get-at-bol 'org-hd-marker))) 3703 (beginning-of-line 2) 3704 (setq txt (org-agenda-get-some-entry-text 3705 m org-agenda-add-entry-text-maxlines " > ")) 3706 (end-of-line 1) 3707 (if (string-match "\\S-" txt) 3708 (insert "\n" txt) 3709 (or (eobp) (forward-char 1)))))))) 3710 3711 (defun org-agenda-get-some-entry-text (marker n-lines &optional indent 3712 &rest keep) 3713 "Extract entry text from MARKER, at most N-LINES lines. 3714 This will ignore drawers etc, just get the text. 3715 If INDENT is given, prefix every line with this string. If KEEP is 3716 given, it is a list of symbols, defining stuff that should not be 3717 removed from the entry content. Currently only `planning' is allowed here." 3718 (let (txt drawer-re kwd-time-re ind) 3719 (save-excursion 3720 (with-current-buffer (marker-buffer marker) 3721 (if (not (derived-mode-p 'org-mode)) 3722 (setq txt "") 3723 (org-with-wide-buffer 3724 (goto-char marker) 3725 (end-of-line 1) 3726 (setq txt (buffer-substring 3727 (min (1+ (point)) (point-max)) 3728 (progn (outline-next-heading) (point))) 3729 drawer-re org-drawer-regexp 3730 kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp 3731 ".*\n?")) 3732 (with-temp-buffer 3733 (insert txt) 3734 (when org-agenda-add-entry-text-descriptive-links 3735 (goto-char (point-min)) 3736 (while (org-activate-links (point-max)) 3737 (goto-char (match-end 0)))) 3738 (goto-char (point-min)) 3739 (while (re-search-forward org-link-bracket-re (point-max) t) 3740 (set-text-properties (match-beginning 0) (match-end 0) 3741 nil)) 3742 (goto-char (point-min)) 3743 (while (re-search-forward drawer-re nil t) 3744 (delete-region 3745 (match-beginning 0) 3746 (progn (re-search-forward 3747 "^[ \t]*:END:.*\n?" nil 'move) 3748 (point)))) 3749 (unless (member 'planning keep) 3750 (goto-char (point-min)) 3751 (while (re-search-forward kwd-time-re nil t) 3752 (replace-match ""))) 3753 (goto-char (point-min)) 3754 (when org-agenda-entry-text-exclude-regexps 3755 (let ((re-list org-agenda-entry-text-exclude-regexps) re) 3756 (while (setq re (pop re-list)) 3757 (goto-char (point-min)) 3758 (while (re-search-forward re nil t) 3759 (replace-match ""))))) 3760 (goto-char (point-max)) 3761 (skip-chars-backward " \t\n") 3762 (when (looking-at "[ \t\n]+\\'") (replace-match "")) 3763 3764 ;; find and remove min common indentation 3765 (goto-char (point-min)) 3766 (untabify (point-min) (point-max)) 3767 (setq ind (org-current-text-indentation)) 3768 (while (not (eobp)) 3769 (unless (looking-at "[ \t]*$") 3770 (setq ind (min ind (org-current-text-indentation)))) 3771 (beginning-of-line 2)) 3772 (goto-char (point-min)) 3773 (while (not (eobp)) 3774 (unless (looking-at "[ \t]*$") 3775 (move-to-column ind) 3776 (delete-region (line-beginning-position) (point))) 3777 (beginning-of-line 2)) 3778 3779 (run-hooks 'org-agenda-entry-text-cleanup-hook) 3780 3781 (goto-char (point-min)) 3782 (when indent 3783 (while (and (not (eobp)) (re-search-forward "^" nil t)) 3784 (replace-match indent t t))) 3785 (goto-char (point-min)) 3786 (while (looking-at "[ \t]*\n") (replace-match "")) 3787 (goto-char (point-max)) 3788 (when (> (org-current-line) 3789 n-lines) 3790 (org-goto-line (1+ n-lines)) 3791 (backward-char 1)) 3792 (setq txt (buffer-substring (point-min) (point)))))))) 3793 txt)) 3794 3795 (defun org-check-for-org-mode () 3796 "Make sure current buffer is in Org mode. Error if not." 3797 (or (derived-mode-p 'org-mode) 3798 (error "Cannot execute Org agenda command on buffer in %s" 3799 major-mode))) 3800 3801 ;;; Agenda prepare and finalize 3802 3803 (defvar org-agenda-multi nil) ; dynamically scoped 3804 (defvar org-agenda-pre-window-conf nil) 3805 (defvar org-agenda-columns-active nil) 3806 (defvar org-agenda-name nil) 3807 (defvar org-agenda-tag-filter nil) 3808 (defvar org-agenda-category-filter nil) 3809 (defvar org-agenda-regexp-filter nil) 3810 (defvar org-agenda-effort-filter nil) 3811 (defvar org-agenda-top-headline-filter nil) 3812 3813 (defvar org-agenda-represented-categories nil 3814 "Cache for the list of all categories in the agenda.") 3815 (defvar org-agenda-represented-tags nil 3816 "Cache for the list of all categories in the agenda.") 3817 (defvar org-agenda-tag-filter-preset nil 3818 "A preset of the tags filter used for secondary agenda filtering. 3819 This must be a list of strings, each string must be a single tag preceded 3820 by \"+\" or \"-\". 3821 This variable should not be set directly, but agenda custom commands can 3822 bind it in the options section. The preset filter is a global property of 3823 the entire agenda view. In a block agenda, it will not work reliably to 3824 define a filter for one of the individual blocks. You need to set it in 3825 the global options and expect it to be applied to the entire view.") 3826 3827 (defvar org-agenda-filters-preset nil 3828 "Alist of filter types and associated preset of filters. 3829 This variable is local in `org-agenda' buffers. See `org-agenda-local-vars'.") 3830 3831 (defconst org-agenda-filter-variables 3832 '((category . org-agenda-category-filter) 3833 (tag . org-agenda-tag-filter) 3834 (effort . org-agenda-effort-filter) 3835 (regexp . org-agenda-regexp-filter)) 3836 "Alist of filter types and associated variables.") 3837 (defun org-agenda-filter-any () 3838 "Is any filter active?" 3839 (cl-some (lambda (x) 3840 (or (symbol-value (cdr x)) 3841 (assoc-default (car x) org-agenda-filters-preset))) 3842 org-agenda-filter-variables)) 3843 3844 (defvar org-agenda-category-filter-preset nil 3845 "A preset of the category filter used for secondary agenda filtering. 3846 This must be a list of strings, each string must be a single category 3847 preceded by \"+\" or \"-\". 3848 This variable should not be set directly, but agenda custom commands can 3849 bind it in the options section. The preset filter is a global property of 3850 the entire agenda view. In a block agenda, it will not work reliably to 3851 define a filter for one of the individual blocks. You need to set it in 3852 the global options and expect it to be applied to the entire view.") 3853 3854 (defvar org-agenda-regexp-filter-preset nil 3855 "A preset of the regexp filter used for secondary agenda filtering. 3856 This must be a list of strings, each string must be a single regexp 3857 preceded by \"+\" or \"-\". 3858 This variable should not be set directly, but agenda custom commands can 3859 bind it in the options section. The preset filter is a global property of 3860 the entire agenda view. In a block agenda, it will not work reliably to 3861 define a filter for one of the individual blocks. You need to set it in 3862 the global options and expect it to be applied to the entire view.") 3863 3864 (defvar org-agenda-effort-filter-preset nil 3865 "A preset of the effort condition used for secondary agenda filtering. 3866 This must be a list of strings, each string must be a single regexp 3867 preceded by \"+\" or \"-\". 3868 This variable should not be set directly, but agenda custom commands can 3869 bind it in the options section. The preset filter is a global property of 3870 the entire agenda view. In a block agenda, it will not work reliably to 3871 define a filter for one of the individual blocks. You need to set it in 3872 the global options and expect it to be applied to the entire view.") 3873 3874 (defun org-agenda-use-sticky-p () 3875 "Return non-nil if an agenda buffer named 3876 `org-agenda-buffer-name' exists and should be shown instead of 3877 generating a new one." 3878 (and 3879 ;; turned off by user 3880 org-agenda-sticky 3881 ;; For multi-agenda buffer already exists 3882 (not org-agenda-multi) 3883 ;; buffer found 3884 (get-buffer org-agenda-buffer-name) 3885 ;; C-u parameter is same as last call 3886 (with-current-buffer (get-buffer org-agenda-buffer-name) 3887 (and 3888 (equal current-prefix-arg 3889 org-agenda-last-prefix-arg) 3890 ;; In case user turned stickiness on, while having existing 3891 ;; Agenda buffer active, don't reuse that buffer, because it 3892 ;; does not have org variables local 3893 org-agenda-this-buffer-is-sticky)))) 3894 3895 (defvar org-agenda-buffer-tmp-name nil) 3896 3897 (defun org-agenda--get-buffer-name (sticky-name) 3898 (or org-agenda-buffer-tmp-name 3899 (and org-agenda-doing-sticky-redo org-agenda-buffer-name) 3900 sticky-name 3901 "*Org Agenda*")) 3902 3903 (defun org-agenda-prepare-window (abuf filter-alist) 3904 "Setup agenda buffer in the window. 3905 ABUF is the buffer for the agenda window. 3906 FILTER-ALIST is an alist of filters we need to apply when 3907 `org-agenda-persistent-filter' is non-nil." 3908 (let* ((awin (get-buffer-window abuf)) wconf) 3909 (cond 3910 ((equal (current-buffer) abuf) nil) 3911 (awin (select-window awin)) 3912 ((not (setq wconf (current-window-configuration)))) 3913 ((eq org-agenda-window-setup 'current-window) 3914 (pop-to-buffer-same-window abuf)) 3915 ((eq org-agenda-window-setup 'other-window) 3916 (org-switch-to-buffer-other-window abuf)) 3917 ((eq org-agenda-window-setup 'other-frame) 3918 (switch-to-buffer-other-frame abuf)) 3919 ((eq org-agenda-window-setup 'other-tab) 3920 (if (fboundp 'switch-to-buffer-other-tab) 3921 (switch-to-buffer-other-tab abuf) 3922 (user-error "Your version of Emacs does not have tab bar support"))) 3923 ((eq org-agenda-window-setup 'only-window) 3924 (delete-other-windows) 3925 (pop-to-buffer-same-window abuf)) 3926 ((eq org-agenda-window-setup 'reorganize-frame) 3927 (delete-other-windows) 3928 (org-switch-to-buffer-other-window abuf))) 3929 (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist))) 3930 (setq org-agenda-category-filter (cdr (assq 'cat filter-alist))) 3931 (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist))) 3932 (setq org-agenda-regexp-filter (cdr (assq 're filter-alist))) 3933 ;; Additional test in case agenda is invoked from within agenda 3934 ;; buffer via elisp link. 3935 (unless (equal (current-buffer) abuf) 3936 (pop-to-buffer-same-window abuf)) 3937 (setq org-agenda-pre-window-conf 3938 (or wconf org-agenda-pre-window-conf)))) 3939 3940 (defun org-agenda-prepare (&optional name) 3941 (let ((filter-alist (when org-agenda-persistent-filter 3942 (with-current-buffer 3943 (get-buffer-create org-agenda-buffer-name) 3944 `((tag . ,org-agenda-tag-filter) 3945 (re . ,org-agenda-regexp-filter) 3946 (effort . ,org-agenda-effort-filter) 3947 (cat . ,org-agenda-category-filter)))))) 3948 (if (org-agenda-use-sticky-p) 3949 (progn 3950 ;; Popup existing buffer 3951 (org-agenda-prepare-window (get-buffer org-agenda-buffer-name) 3952 filter-alist) 3953 (message "Sticky Agenda buffer, use `r' to refresh") 3954 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 3955 (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) 3956 (setq org-todo-keywords-for-agenda nil) 3957 (if org-agenda-multi 3958 (progn 3959 (setq buffer-read-only nil) 3960 (goto-char (point-max)) 3961 (unless (or (bobp) org-agenda-compact-blocks 3962 (not org-agenda-block-separator)) 3963 (insert "\n" 3964 (if (stringp org-agenda-block-separator) 3965 org-agenda-block-separator 3966 (make-string (window-max-chars-per-line) org-agenda-block-separator)) 3967 "\n")) 3968 (narrow-to-region (point) (point-max))) 3969 (setq org-done-keywords-for-agenda nil) 3970 ;; Setting any org variables that are in org-agenda-local-vars 3971 ;; list need to be done after the prepare call 3972 (org-agenda-prepare-window 3973 (get-buffer-create org-agenda-buffer-name) filter-alist) 3974 (setq buffer-read-only nil) 3975 (org-agenda-reset-markers) 3976 (let ((inhibit-read-only t)) (erase-buffer)) 3977 (org-agenda-mode) 3978 (setq org-agenda-buffer (current-buffer)) 3979 (setq org-agenda-contributing-files nil) 3980 (setq org-agenda-columns-active nil) 3981 (setq org-agenda-filters-preset 3982 `((tag . ,org-agenda-tag-filter-preset) 3983 (category . ,org-agenda-category-filter-preset) 3984 (regexp . ,org-agenda-regexp-filter-preset) 3985 (effort . ,org-agenda-effort-filter-preset))) 3986 (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) 3987 (setq org-todo-keywords-for-agenda 3988 (org-uniquify org-todo-keywords-for-agenda)) 3989 (setq org-done-keywords-for-agenda 3990 (org-uniquify org-done-keywords-for-agenda)) 3991 (setq org-agenda-last-prefix-arg current-prefix-arg) 3992 (setq org-agenda-this-buffer-name org-agenda-buffer-name) 3993 (and name (not org-agenda-name) 3994 (setq-local org-agenda-name name))) 3995 (setq buffer-read-only nil)))) 3996 3997 (defvar org-overriding-columns-format) 3998 (defvar org-local-columns-format) 3999 (defun org-agenda-finalize () 4000 "Finishing touch for the agenda buffer. 4001 This function is called just before displaying the agenda. If 4002 you want to add your own functions to the finalization of the 4003 agenda display, configure `org-agenda-finalize-hook'." 4004 (unless org-agenda-multi 4005 (let ((inhibit-read-only t)) 4006 (save-excursion 4007 (goto-char (point-min)) 4008 (save-excursion 4009 (while (org-activate-links (point-max)) 4010 (goto-char (match-end 0)))) 4011 (unless (eq org-agenda-remove-tags t) 4012 (org-agenda-align-tags)) 4013 (unless org-agenda-with-colors 4014 (remove-text-properties (point-min) (point-max) '(face nil))) 4015 (when (bound-and-true-p org-overriding-columns-format) 4016 (setq-local org-local-columns-format 4017 org-overriding-columns-format)) 4018 (when org-agenda-view-columns-initially 4019 (org-agenda-columns)) 4020 (when org-agenda-fontify-priorities 4021 (org-agenda-fontify-priorities)) 4022 (when (and org-agenda-dim-blocked-tasks org-blocker-hook) 4023 (org-agenda-dim-blocked-tasks)) 4024 (org-agenda-mark-clocking-task) 4025 (when org-agenda-entry-text-mode 4026 (org-agenda-entry-text-hide) 4027 (org-agenda-entry-text-show)) 4028 (when (and (featurep 'org-habit) 4029 (save-excursion (next-single-property-change (point-min) 'org-habit-p))) 4030 (org-habit-insert-consistency-graphs)) 4031 (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) 4032 (unless (or (eq org-agenda-show-inherited-tags 'always) 4033 (and (listp org-agenda-show-inherited-tags) 4034 (memq org-agenda-type org-agenda-show-inherited-tags)) 4035 (and (eq org-agenda-show-inherited-tags t) 4036 (or (eq org-agenda-use-tag-inheritance t) 4037 (and (listp org-agenda-use-tag-inheritance) 4038 (not (memq org-agenda-type 4039 org-agenda-use-tag-inheritance)))))) 4040 (let (mrk) 4041 (save-excursion 4042 (goto-char (point-min)) 4043 (while (equal (forward-line) 0) 4044 (when (setq mrk (get-text-property (point) 'org-hd-marker)) 4045 (put-text-property (line-beginning-position) (line-end-position) 4046 'tags 4047 (org-with-point-at mrk 4048 (org-get-tags)))))))) 4049 (setq org-agenda-represented-tags nil 4050 org-agenda-represented-categories nil) 4051 (when org-agenda-top-headline-filter 4052 (org-agenda-filter-top-headline-apply 4053 org-agenda-top-headline-filter)) 4054 (when org-agenda-tag-filter 4055 (org-agenda-filter-apply org-agenda-tag-filter 'tag t)) 4056 (when (assoc-default 'tag org-agenda-filters-preset) 4057 (org-agenda-filter-apply 4058 (assoc-default 'tag org-agenda-filters-preset) 'tag t)) 4059 (when org-agenda-category-filter 4060 (org-agenda-filter-apply org-agenda-category-filter 'category)) 4061 (when (assoc-default 'category org-agenda-filters-preset) 4062 (org-agenda-filter-apply 4063 (assoc-default 'category org-agenda-filters-preset) 'category)) 4064 (when org-agenda-regexp-filter 4065 (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) 4066 (when (assoc-default 'regexp org-agenda-filters-preset) 4067 (org-agenda-filter-apply 4068 (assoc-default 'regexp org-agenda-filters-preset) 'regexp)) 4069 (when org-agenda-effort-filter 4070 (org-agenda-filter-apply org-agenda-effort-filter 'effort)) 4071 (when (assoc-default 'effort org-agenda-filters-preset) 4072 (org-agenda-filter-apply 4073 (assoc-default 'effort org-agenda-filters-preset) 'effort)) 4074 (add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local)) 4075 (run-hooks 'org-agenda-finalize-hook)))) 4076 4077 (defun org-agenda-mark-clocking-task () 4078 "Mark the current clock entry in the agenda if it is present." 4079 ;; We need to widen when `org-agenda-finalize' is called from 4080 ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in'). 4081 (when (bound-and-true-p org-clock-current-task) 4082 (save-restriction 4083 (widen) 4084 (org-agenda-unmark-clocking-task) 4085 (when (marker-buffer org-clock-hd-marker) 4086 (save-excursion 4087 (goto-char (point-min)) 4088 (let (s ov) 4089 (while (setq s (next-single-property-change (point) 'org-hd-marker)) 4090 (goto-char s) 4091 (when (equal (org-get-at-bol 'org-hd-marker) 4092 org-clock-hd-marker) 4093 (setq ov (make-overlay (line-beginning-position) 4094 (1+ (line-end-position)))) 4095 (overlay-put ov 'type 'org-agenda-clocking) 4096 (overlay-put ov 'face 'org-agenda-clocking) 4097 (overlay-put ov 'help-echo 4098 "The clock is running in this item"))))))))) 4099 4100 (defun org-agenda-unmark-clocking-task () 4101 "Unmark the current clocking task." 4102 (mapc (lambda (o) 4103 (when (eq (overlay-get o 'type) 'org-agenda-clocking) 4104 (delete-overlay o))) 4105 (overlays-in (point-min) (point-max)))) 4106 4107 (defun org-agenda-fontify-priorities () 4108 "Make highest priority lines bold, and lowest italic." 4109 (interactive) 4110 (mapc (lambda (o) (when (eq (overlay-get o 'org-type) 'org-priority) 4111 (delete-overlay o))) 4112 (overlays-in (point-min) (point-max))) 4113 (save-excursion 4114 (let (b e p ov h l) 4115 (goto-char (point-min)) 4116 (while (re-search-forward org-priority-regexp nil t) 4117 (setq h (or (get-char-property (point) 'org-priority-highest) 4118 org-priority-highest) 4119 l (or (get-char-property (point) 'org-priority-lowest) 4120 org-priority-lowest) 4121 p (string-to-char (match-string 2)) 4122 b (match-beginning 1) 4123 e (if (eq org-agenda-fontify-priorities 'cookies) 4124 (1+ (match-end 2)) 4125 (line-end-position)) 4126 ov (make-overlay b e)) 4127 (overlay-put 4128 ov 'face 4129 (let ((special-face 4130 (cond ((org-face-from-face-or-color 4131 'priority 'org-priority 4132 (cdr (assoc p org-priority-faces)))) 4133 ((and (listp org-agenda-fontify-priorities) 4134 (org-face-from-face-or-color 4135 'priority 'org-priority 4136 (cdr (assoc p org-agenda-fontify-priorities))))) 4137 ((equal p l) 'italic) 4138 ((equal p h) 'bold)))) 4139 (if special-face (list special-face 'org-priority) 'org-priority))) 4140 (overlay-put ov 'org-type 'org-priority))))) 4141 4142 (defvar org-depend-tag-blocked) 4143 4144 (defun org-agenda-dim-blocked-tasks (&optional _invisible) 4145 "Dim currently blocked TODOs in the agenda display. 4146 When INVISIBLE is non-nil, hide currently blocked TODO instead of 4147 dimming them." ;FIXME: The arg isn't used, actually! 4148 (interactive "P") 4149 (when (called-interactively-p 'interactive) 4150 (message "Dim or hide blocked tasks...")) 4151 (dolist (o (overlays-in (point-min) (point-max))) 4152 (when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face) 4153 (delete-overlay o))) 4154 (save-excursion 4155 (let ((inhibit-read-only t)) 4156 (goto-char (point-min)) 4157 (while (let ((pos (text-property-not-all 4158 (point) (point-max) 'org-todo-blocked nil))) 4159 (when pos (goto-char pos))) 4160 (let* ((invisible 4161 (eq (org-get-at-bol 'org-todo-blocked) 'invisible)) 4162 (todo-blocked 4163 (eq (org-get-at-bol 'org-filter-type) 'todo-blocked)) 4164 (ov (make-overlay (if invisible 4165 (line-end-position 0) 4166 (line-beginning-position)) 4167 (line-end-position)))) 4168 (when todo-blocked 4169 (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) 4170 (when invisible 4171 (org-agenda-filter-hide-line 'todo-blocked))) 4172 (if (= (point-max) (line-end-position)) 4173 (goto-char (point-max)) 4174 (move-beginning-of-line 2))))) 4175 (when (called-interactively-p 'interactive) 4176 (message "Dim or hide blocked tasks...done"))) 4177 4178 (defun org-agenda--mark-blocked-entry (entry) 4179 "If ENTRY is blocked, mark it for fontification or invisibility. 4180 4181 If the header at `org-hd-marker' is blocked according to 4182 `org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is 4183 `invisible' and the header is not blocked by checkboxes, set the 4184 text property `org-todo-blocked' to `invisible', otherwise set it 4185 to t." 4186 (when (get-text-property 0 'todo-state entry) 4187 (let ((entry-marker (get-text-property 0 'org-hd-marker entry)) 4188 (org-blocked-by-checkboxes nil) 4189 ;; Necessary so that `org-entry-blocked-p' does not change 4190 ;; the buffer. 4191 (org-depend-tag-blocked nil)) 4192 (when entry-marker 4193 (let ((blocked 4194 (with-current-buffer (marker-buffer entry-marker) 4195 (save-excursion 4196 (goto-char entry-marker) 4197 (org-entry-blocked-p))))) 4198 (when blocked 4199 (let ((really-invisible 4200 (and (not org-blocked-by-checkboxes) 4201 (eq org-agenda-dim-blocked-tasks 'invisible)))) 4202 (put-text-property 4203 0 (length entry) 'org-todo-blocked 4204 (if really-invisible 'invisible t) 4205 entry) 4206 (put-text-property 4207 0 (length entry) 'org-filter-type 'todo-blocked entry))))))) 4208 entry) 4209 4210 (defvar org-agenda-skip-function nil 4211 "Function to be called at each match during agenda construction. 4212 If this function returns nil, the current match should not be skipped. 4213 Otherwise, the function must return a position from where the search 4214 should be continued. 4215 4216 This may also be a Lisp form that will be evaluated. Useful 4217 forms include `org-agenda-skip-entry-if' and 4218 `org-agenda-skip-subtree-if'. See the Info node `(org) Special 4219 Agenda Views' for more details and examples. 4220 4221 Never set this variable using `setq' or similar, because then it 4222 will apply to all future agenda commands. If you want a global 4223 skipping condition, use the option `org-agenda-skip-function-global' 4224 instead. 4225 4226 The correct way to use `org-agenda-skip-function' is to bind it with `let' 4227 to scope it dynamically into the agenda-constructing command. 4228 A good way to set it is through options in `org-agenda-custom-commands'.") 4229 4230 (defun org-agenda-skip (&optional element) 4231 "Throw to `:skip' in places that should be skipped. 4232 Also moves point to the end of the skipped region, so that search can 4233 continue from there. 4234 4235 Optional argument ELEMENT contains element at point." 4236 (when (or 4237 (if element 4238 (eq (org-element-type element) 'comment) 4239 (save-excursion 4240 (goto-char (line-beginning-position)) 4241 (looking-at comment-start-skip))) 4242 (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) 4243 (or (and (save-match-data (org-in-archived-heading-p nil element)) 4244 (org-end-of-subtree t element)) 4245 (and (member org-archive-tag org-file-tags) 4246 (goto-char (point-max))))) 4247 (and org-agenda-skip-comment-trees 4248 (org-in-commented-heading-p nil element) 4249 (org-end-of-subtree t element)) 4250 (let ((to (or (org-agenda-skip-eval org-agenda-skip-function-global) 4251 (org-agenda-skip-eval org-agenda-skip-function)))) 4252 (and to (goto-char to))) 4253 (org-in-src-block-p t element)) 4254 (throw :skip t))) 4255 4256 (defun org-agenda-skip-eval (form) 4257 "If FORM is a function or a list, call (or eval) it and return the result. 4258 `save-excursion' and `save-match-data' are wrapped around the call, so point 4259 and match data are returned to the previous state no matter what these 4260 functions do." 4261 (let (fp) 4262 (and form 4263 (or (setq fp (functionp form)) 4264 (consp form)) 4265 (save-excursion 4266 (save-match-data 4267 (if fp 4268 (funcall form) 4269 (eval form t))))))) 4270 4271 (defvar org-agenda-markers nil 4272 "List of all currently active markers created by `org-agenda'.") 4273 (defvar org-agenda-last-marker-time (float-time) 4274 "Creation time of the last agenda marker.") 4275 4276 (defun org-agenda-new-marker (&optional pos) 4277 "Return a new agenda marker. 4278 Marker is at point, or at POS if non-nil. Org mode keeps a list 4279 of these markers and resets them when they are no longer in use." 4280 (let ((m (copy-marker (or pos (point)) t))) 4281 (setq org-agenda-last-marker-time (float-time)) 4282 (if (and org-agenda-buffer (buffer-live-p org-agenda-buffer)) 4283 (with-current-buffer org-agenda-buffer 4284 (push m org-agenda-markers)) 4285 (push m org-agenda-markers)) 4286 m)) 4287 4288 (defun org-agenda-reset-markers () 4289 "Reset markers created by `org-agenda'." 4290 (while org-agenda-markers 4291 (move-marker (pop org-agenda-markers) nil))) 4292 4293 (defun org-agenda-save-markers-for-cut-and-paste (beg end) 4294 "Save relative positions of markers in region. 4295 This check for agenda markers in all agenda buffers currently active." 4296 (dolist (buf (buffer-list)) 4297 (with-current-buffer buf 4298 (when (eq major-mode 'org-agenda-mode) 4299 (mapc (lambda (m) (org-check-and-save-marker m beg end)) 4300 org-agenda-markers))))) 4301 4302 ;;; Entry text mode 4303 4304 (defun org-agenda-entry-text-show-here () 4305 "Add some text from the entry as context to the current line." 4306 (let (m txt o) 4307 (setq m (org-get-at-bol 'org-hd-marker)) 4308 (unless (marker-buffer m) 4309 (error "No marker points to an entry here")) 4310 (setq txt (concat "\n" (org-no-properties 4311 (org-agenda-get-some-entry-text 4312 m org-agenda-entry-text-maxlines 4313 org-agenda-entry-text-leaders)))) 4314 (when (string-match "\\S-" txt) 4315 (setq o (make-overlay (line-beginning-position) (line-end-position))) 4316 (overlay-put o 'evaporate t) 4317 (overlay-put o 'org-overlay-type 'agenda-entry-content) 4318 (overlay-put o 'after-string txt)))) 4319 4320 (defun org-agenda-entry-text-show () 4321 "Add entry context for all agenda lines." 4322 (interactive) 4323 (save-excursion 4324 (goto-char (point-max)) 4325 (beginning-of-line 1) 4326 (while (not (bobp)) 4327 (when (org-get-at-bol 'org-hd-marker) 4328 (org-agenda-entry-text-show-here)) 4329 (beginning-of-line 0)))) 4330 4331 (defun org-agenda-entry-text-hide () 4332 "Remove any shown entry context." 4333 (mapc (lambda (o) 4334 (when (eq (overlay-get o 'org-overlay-type) 4335 'agenda-entry-content) 4336 (delete-overlay o))) 4337 (overlays-in (point-min) (point-max)))) 4338 4339 (defun org-agenda-get-day-face (date) 4340 "Return the face DATE should be displayed with." 4341 (cond ((and (functionp org-agenda-day-face-function) 4342 (funcall org-agenda-day-face-function date))) 4343 ((and (org-agenda-today-p date) 4344 (memq (calendar-day-of-week date) org-agenda-weekend-days)) 4345 'org-agenda-date-weekend-today) 4346 ((org-agenda-today-p date) 'org-agenda-date-today) 4347 ((memq (calendar-day-of-week date) org-agenda-weekend-days) 4348 'org-agenda-date-weekend) 4349 (t 'org-agenda-date))) 4350 4351 (defvar org-agenda-show-log-scoped) 4352 4353 ;;; Agenda Daily/Weekly 4354 4355 (defvar org-agenda-start-day nil ; dynamically scoped parameter 4356 "Start day for the agenda view. 4357 Custom commands can set this variable in the options section. 4358 This is usually a string like \"2007-11-01\", \"+2d\" or any other 4359 input allowed when reading a date through the Org calendar. 4360 See the docstring of `org-read-date' for details.") 4361 (defvar org-starting-day nil) ; local variable in the agenda buffer 4362 (defvar org-arg-loc nil) ; local variable 4363 4364 ;;;###autoload 4365 (defun org-agenda-list (&optional arg start-day span with-hour) 4366 "Produce a daily/weekly view from all files in variable `org-agenda-files'. 4367 The view will be for the current day or week, but from the overview buffer 4368 you will be able to go to other days/weeks. 4369 4370 With a numeric prefix argument in an interactive call, the agenda will 4371 span ARG days. Lisp programs should instead specify SPAN to change 4372 the number of days. SPAN defaults to `org-agenda-span'. 4373 4374 START-DAY defaults to TODAY, or to the most recent match for the weekday 4375 given in `org-agenda-start-on-weekday'. 4376 4377 When WITH-HOUR is non-nil, only include scheduled and deadline 4378 items if they have an hour specification like [h]h:mm." 4379 (interactive "P") 4380 (when org-agenda-overriding-arguments 4381 (setq arg (car org-agenda-overriding-arguments) 4382 start-day (nth 1 org-agenda-overriding-arguments) 4383 span (nth 2 org-agenda-overriding-arguments))) 4384 (when (and (integerp arg) (> arg 0)) 4385 (setq span arg arg nil)) 4386 (when (numberp span) 4387 (unless (< 0 span) 4388 (user-error "Agenda creation impossible for this span(=%d days)" span))) 4389 (catch 'exit 4390 (setq org-agenda-buffer-name 4391 (org-agenda--get-buffer-name 4392 (and org-agenda-sticky 4393 (cond ((and org-keys (stringp org-match)) 4394 (format "*Org Agenda(%s:%s)*" org-keys org-match)) 4395 (org-keys 4396 (format "*Org Agenda(%s)*" org-keys)) 4397 (t "*Org Agenda(a)*"))))) 4398 (org-agenda-prepare "Day/Week") 4399 (setq start-day (or start-day org-agenda-start-day)) 4400 (when (stringp start-day) 4401 ;; Convert to an absolute day number 4402 (setq start-day (time-to-days (org-read-date nil t start-day)))) 4403 (org-compile-prefix-format 'agenda) 4404 (org-set-sorting-strategy 'agenda) 4405 (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span))) 4406 (today (org-today)) 4407 (sd (or start-day today)) 4408 (ndays (org-agenda-span-to-ndays span sd)) 4409 (org-agenda-start-on-weekday 4410 (and (or (eq ndays 7) (eq ndays 14)) 4411 org-agenda-start-on-weekday)) 4412 (thefiles (org-agenda-files nil 'ifmode)) 4413 (files thefiles) 4414 (start (if (or (null org-agenda-start-on-weekday) 4415 (< ndays 7)) 4416 sd 4417 (let* ((nt (calendar-day-of-week 4418 (calendar-gregorian-from-absolute sd))) 4419 (n1 org-agenda-start-on-weekday) 4420 (d (- nt n1))) 4421 (- sd (+ (if (< d 0) 7 0) d))))) 4422 (day-numbers (list start)) 4423 (day-cnt 0) 4424 ;; FIXME: This may cause confusion when users are trying to 4425 ;; debug agenda. The debugger will not trigger without 4426 ;; redisplay. 4427 (inhibit-redisplay (not debug-on-error)) 4428 (org-agenda-show-log-scoped org-agenda-show-log) 4429 s rtn rtnall file date d start-pos end-pos todayp ;; e 4430 clocktable-start clocktable-end) ;; filter 4431 (setq org-agenda-redo-command 4432 (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour)) 4433 (dotimes (_ (1- ndays)) 4434 (push (1+ (car day-numbers)) day-numbers)) 4435 (setq day-numbers (nreverse day-numbers)) 4436 (setq clocktable-start (car day-numbers) 4437 clocktable-end (1+ (or (org-last day-numbers) 0))) 4438 (setq-local org-starting-day (car day-numbers)) 4439 (setq-local org-arg-loc arg) 4440 (setq-local org-agenda-current-span (org-agenda-ndays-to-span span)) 4441 (unless org-agenda-compact-blocks 4442 (let* ((d1 (car day-numbers)) 4443 (d2 (org-last day-numbers)) 4444 (w1 (org-days-to-iso-week d1)) 4445 (w2 (org-days-to-iso-week d2))) 4446 (setq s (point)) 4447 (org-agenda--insert-overriding-header 4448 (concat (org-agenda-span-name span) 4449 "-agenda" 4450 (cond ((<= 350 (- d2 d1)) "") 4451 ((= w1 w2) (format " (W%02d)" w1)) 4452 (t (format " (W%02d-W%02d)" w1 w2))) 4453 ":\n"))) 4454 ;; Add properties if we actually inserted a header. 4455 (when (> (point) s) 4456 (add-text-properties s (1- (point)) 4457 (list 'face 'org-agenda-structure 4458 'org-date-line t)) 4459 (org-agenda-mark-header-line s))) 4460 (while (setq d (pop day-numbers)) 4461 (setq date (calendar-gregorian-from-absolute d) 4462 s (point)) 4463 (if (or (setq todayp (= d today)) 4464 (and (not start-pos) (= d sd))) 4465 (setq start-pos (point)) 4466 (when (and start-pos (not end-pos)) 4467 (setq end-pos (point)))) 4468 (setq files thefiles 4469 rtnall nil) 4470 (while (setq file (pop files)) 4471 (catch 'nextfile 4472 (org-check-agenda-file file) 4473 (let ((org-agenda-entry-types org-agenda-entry-types)) 4474 ;; Starred types override non-starred equivalents 4475 (when (member :deadline* org-agenda-entry-types) 4476 (setq org-agenda-entry-types 4477 (delq :deadline org-agenda-entry-types))) 4478 (when (member :scheduled* org-agenda-entry-types) 4479 (setq org-agenda-entry-types 4480 (delq :scheduled org-agenda-entry-types))) 4481 ;; Honor with-hour 4482 (when with-hour 4483 (when (member :deadline org-agenda-entry-types) 4484 (setq org-agenda-entry-types 4485 (delq :deadline org-agenda-entry-types)) 4486 (push :deadline* org-agenda-entry-types)) 4487 (when (member :scheduled org-agenda-entry-types) 4488 (setq org-agenda-entry-types 4489 (delq :scheduled org-agenda-entry-types)) 4490 (push :scheduled* org-agenda-entry-types))) 4491 (unless org-agenda-include-deadlines 4492 (setq org-agenda-entry-types 4493 (delq :deadline* (delq :deadline org-agenda-entry-types)))) 4494 (cond 4495 ((memq org-agenda-show-log-scoped '(only clockcheck)) 4496 (setq rtn (org-agenda-get-day-entries 4497 file date :closed))) 4498 (org-agenda-show-log-scoped 4499 (setq rtn (apply #'org-agenda-get-day-entries 4500 file date 4501 (append '(:closed) org-agenda-entry-types)))) 4502 (t 4503 (setq rtn (apply #'org-agenda-get-day-entries 4504 file date 4505 org-agenda-entry-types))))) 4506 (setq rtnall (append rtnall rtn)))) ;; all entries 4507 (when org-agenda-include-diary 4508 (let ((org-agenda-search-headline-for-time t)) 4509 (require 'diary-lib) 4510 (setq rtn (org-get-entries-from-diary date)) 4511 (setq rtnall (append rtnall rtn)))) 4512 (when (or rtnall org-agenda-show-all-dates) 4513 (setq day-cnt (1+ day-cnt)) 4514 (insert 4515 (if (stringp org-agenda-format-date) 4516 (format-time-string org-agenda-format-date 4517 (org-time-from-absolute date)) 4518 (funcall org-agenda-format-date date)) 4519 "\n") 4520 (put-text-property s (1- (point)) 'face 4521 (org-agenda-get-day-face date)) 4522 (put-text-property s (1- (point)) 'org-date-line t) 4523 (put-text-property s (1- (point)) 'org-agenda-date-header t) 4524 (put-text-property s (1- (point)) 'org-day-cnt day-cnt) 4525 (when todayp 4526 (put-text-property s (1- (point)) 'org-today t)) 4527 (setq rtnall 4528 (org-agenda-add-time-grid-maybe rtnall ndays todayp)) 4529 (when rtnall (insert ;; all entries 4530 (org-agenda-finalize-entries rtnall 'agenda) 4531 "\n")) 4532 (put-text-property s (1- (point)) 'day d) 4533 (put-text-property s (1- (point)) 'org-day-cnt day-cnt))) 4534 (when (and org-agenda-clockreport-mode clocktable-start) 4535 (let ((org-agenda-files (org-agenda-files nil 'ifmode)) 4536 ;; the above line is to ensure the restricted range! 4537 (p (copy-sequence org-agenda-clockreport-parameter-plist)) 4538 tbl) 4539 (setq p (org-plist-delete p :block)) 4540 (setq p (plist-put p :tstart clocktable-start)) 4541 (setq p (plist-put p :tend clocktable-end)) 4542 (setq p (plist-put p :scope 'agenda)) 4543 (setq tbl (apply #'org-clock-get-clocktable p)) 4544 (when org-agenda-clock-report-header 4545 (insert (propertize org-agenda-clock-report-header 'face 'org-agenda-structure)) 4546 (unless (string-suffix-p "\n" org-agenda-clock-report-header) 4547 (insert "\n"))) 4548 (insert tbl))) 4549 (goto-char (point-min)) 4550 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 4551 (unless (or (not (get-buffer-window org-agenda-buffer-name)) 4552 (and (pos-visible-in-window-p (point-min)) 4553 (pos-visible-in-window-p (point-max)))) 4554 (goto-char (1- (point-max))) 4555 (recenter -1) 4556 (when (not (pos-visible-in-window-p (or start-pos 1))) 4557 (goto-char (or start-pos 1)) 4558 (recenter 1))) 4559 (goto-char (or start-pos 1)) 4560 (add-text-properties (point-min) (point-max) 4561 `(org-agenda-type agenda 4562 org-last-args (,arg ,start-day ,span) 4563 org-redo-cmd ,org-agenda-redo-command 4564 org-series-cmd ,org-cmd)) 4565 (when (eq org-agenda-show-log-scoped 'clockcheck) 4566 (org-agenda-show-clocking-issues)) 4567 (org-agenda-finalize) 4568 (setq buffer-read-only t) 4569 (message "")))) 4570 4571 (defun org-agenda-ndays-to-span (n) 4572 "Return a span symbol for a span of N days, or N if none matches." 4573 (cond ((symbolp n) n) 4574 ((= n 1) 'day) 4575 ((= n 7) 'week) 4576 ((= n 14) 'fortnight) 4577 (t n))) 4578 4579 (defun org-agenda-span-to-ndays (span &optional start-day) 4580 "Return ndays from SPAN, possibly starting at START-DAY. 4581 START-DAY is an absolute time value." 4582 (cond ((numberp span) span) 4583 ((eq span 'day) 1) 4584 ((eq span 'week) 7) 4585 ((eq span 'fortnight) 14) 4586 ((eq span 'month) 4587 (let ((date (calendar-gregorian-from-absolute start-day))) 4588 (calendar-last-day-of-month (car date) (cl-caddr date)))) 4589 ((eq span 'year) 4590 (let ((date (calendar-gregorian-from-absolute start-day))) 4591 (if (calendar-leap-year-p (cl-caddr date)) 366 365))))) 4592 4593 (defun org-agenda-span-name (span) 4594 "Return a SPAN name." 4595 (if (null span) 4596 "" 4597 (if (symbolp span) 4598 (capitalize (symbol-name span)) 4599 (format "%d days" span)))) 4600 4601 ;;; Agenda word search 4602 4603 (defvar org-agenda-search-history nil) 4604 4605 (defvar org-search-syntax-table nil 4606 "Special syntax table for Org search. 4607 In this table, we have single quotes not as word constituents, to 4608 that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") 4609 4610 (defvar org-mode-syntax-table) ; From org.el 4611 (defun org-search-syntax-table () 4612 (unless org-search-syntax-table 4613 (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) 4614 (modify-syntax-entry ?' "." org-search-syntax-table) 4615 (modify-syntax-entry ?` "." org-search-syntax-table)) 4616 org-search-syntax-table) 4617 4618 (defvar org-agenda-last-search-view-search-was-boolean nil) 4619 4620 ;;;###autoload 4621 (defun org-search-view (&optional todo-only string edit-at) 4622 "Show all entries that contain a phrase or words or regular expressions. 4623 4624 With optional prefix argument TODO-ONLY, only consider entries that are 4625 TODO entries. The argument STRING can be used to pass a default search 4626 string into this function. If EDIT-AT is non-nil, it means that the 4627 user should get a chance to edit this string, with cursor at position 4628 EDIT-AT. 4629 4630 The search string can be viewed either as a phrase that should be found as 4631 is, or it can be broken into a number of snippets, each of which must match 4632 in a Boolean way to select an entry. The default depends on the variable 4633 `org-agenda-search-view-always-boolean'. 4634 Even if this is turned off (the default) you can always switch to 4635 Boolean search dynamically by preceding the first word with \"+\" or \"-\". 4636 4637 The default is a direct search of the whole phrase, where each space in 4638 the search string can expand to an arbitrary amount of whitespace, 4639 including newlines. 4640 4641 If using a Boolean search, the search string is split on whitespace and 4642 each snippet is searched separately, with logical AND to select an entry. 4643 Words prefixed with a minus must *not* occur in the entry. Words without 4644 a prefix or prefixed with a plus must occur in the entry. Matching is 4645 case-insensitive. Words are enclosed by word delimiters (i.e. they must 4646 match whole words, not parts of a word) if 4647 `org-agenda-search-view-force-full-words' is set (default is nil). 4648 4649 Boolean search snippets enclosed by curly braces are interpreted as 4650 regular expressions that must or (when preceded with \"-\") must not 4651 match in the entry. Snippets enclosed into double quotes will be taken 4652 as a whole, to include whitespace. 4653 4654 - If the search string starts with an asterisk, search only in headlines. 4655 - If (possibly after the leading star) the search string starts with an 4656 exclamation mark, this also means to look at TODO entries only, an effect 4657 that can also be achieved with a prefix argument. 4658 - If (possibly after star and exclamation mark) the search string starts 4659 with a colon, this will mean that the (non-regexp) snippets of the 4660 Boolean search must match as full words. 4661 4662 This command searches the agenda files, and in addition the files 4663 listed in `org-agenda-text-search-extra-files' unless a restriction lock 4664 is active." 4665 (interactive "P") 4666 (when org-agenda-overriding-arguments 4667 (setq todo-only (car org-agenda-overriding-arguments) 4668 string (nth 1 org-agenda-overriding-arguments) 4669 edit-at (nth 2 org-agenda-overriding-arguments))) 4670 (let* ((props (list 'face nil 4671 'done-face 'org-agenda-done 4672 'org-not-done-regexp org-not-done-regexp 4673 'org-todo-regexp org-todo-regexp 4674 'org-complex-heading-regexp org-complex-heading-regexp 4675 'mouse-face 'highlight 4676 'help-echo "mouse-2 or RET jump to location")) 4677 (full-words org-agenda-search-view-force-full-words) 4678 (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) 4679 regexp rtn rtnall files file pos inherited-tags 4680 marker category level tags c neg re boolean 4681 ee txt beg end last-search-end words regexps+ regexps- hdl-only buffer beg1 str) 4682 (unless (and (not edit-at) 4683 (stringp string) 4684 (string-match "\\S-" string)) 4685 (setq string (read-string 4686 (if org-agenda-search-view-always-boolean 4687 "[+-]Word/{Regexp} ...: " 4688 "Phrase or [+-]Word/{Regexp} ...: ") 4689 (cond 4690 ((integerp edit-at) (cons string edit-at)) 4691 (edit-at string)) 4692 'org-agenda-search-history))) 4693 (catch 'exit 4694 (setq org-agenda-buffer-name 4695 (org-agenda--get-buffer-name 4696 (and org-agenda-sticky 4697 (if (stringp string) 4698 (format "*Org Agenda(%s:%s)*" 4699 (or org-keys (or (and todo-only "S") "s")) 4700 string) 4701 (format "*Org Agenda(%s)*" 4702 (or (and todo-only "S") "s")))))) 4703 (org-agenda-prepare "SEARCH") 4704 (org-compile-prefix-format 'search) 4705 (org-set-sorting-strategy 'search) 4706 (setq org-agenda-redo-command 4707 (list 'org-search-view (if todo-only t nil) 4708 (list 'if 'current-prefix-arg nil string))) 4709 (setq org-agenda-query-string string) 4710 (if (equal (string-to-char string) ?*) 4711 (setq hdl-only t 4712 words (substring string 1)) 4713 (setq words string)) 4714 (when (equal (string-to-char words) ?!) 4715 (setq todo-only t 4716 words (substring words 1))) 4717 (when (equal (string-to-char words) ?:) 4718 (setq full-words t 4719 words (substring words 1))) 4720 (when (or org-agenda-search-view-always-boolean 4721 (member (string-to-char words) '(?- ?+ ?\{))) 4722 (setq boolean t)) 4723 (setq words (split-string words)) 4724 (let (www w) 4725 (while (setq w (pop words)) 4726 (while (and (string-match "\\\\\\'" w) words) 4727 (setq w (concat (substring w 0 -1) " " (pop words)))) 4728 (push w www)) 4729 (setq words (nreverse www) www nil) 4730 (while (setq w (pop words)) 4731 (when (and (string-match "\\`[-+]?{" w) 4732 (not (string-match "}\\'" w))) 4733 (while (and words (not (string-match "}\\'" (car words)))) 4734 (setq w (concat w " " (pop words)))) 4735 (setq w (concat w " " (pop words)))) 4736 (push w www)) 4737 (setq words (nreverse www))) 4738 (setq org-agenda-last-search-view-search-was-boolean boolean) 4739 (when boolean 4740 (let (wds w) 4741 (while (setq w (pop words)) 4742 (when (or (equal (substring w 0 1) "\"") 4743 (and (> (length w) 1) 4744 (member (substring w 0 1) '("+" "-")) 4745 (equal (substring w 1 2) "\""))) 4746 (while (and words (not (equal (substring w -1) "\""))) 4747 (setq w (concat w " " (pop words))))) 4748 (and (string-match "\\`\\([-+]?\\)\"" w) 4749 (setq w (replace-match "\\1" nil nil w))) 4750 (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) 4751 (push w wds)) 4752 (setq words (nreverse wds)))) 4753 (if boolean 4754 (mapc (lambda (w) 4755 (setq c (string-to-char w)) 4756 (if (equal c ?-) 4757 (setq neg t w (substring w 1)) 4758 (if (equal c ?+) 4759 (setq neg nil w (substring w 1)) 4760 (setq neg nil))) 4761 (if (string-match "\\`{.*}\\'" w) 4762 (setq re (substring w 1 -1)) 4763 (if full-words 4764 (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) 4765 (setq re (regexp-quote (downcase w))))) 4766 (if neg (push re regexps-) (push re regexps+))) 4767 words) 4768 (push (mapconcat #'regexp-quote words "\\s-+") 4769 regexps+)) 4770 (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) 4771 (if (not regexps+) 4772 (setq regexp org-outline-regexp-bol) 4773 (setq regexp (pop regexps+)) 4774 (when hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" 4775 regexp)))) 4776 (setq files (org-agenda-files nil 'ifmode)) 4777 ;; Add `org-agenda-text-search-extra-files' unless there is some 4778 ;; restriction. 4779 (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) 4780 (pop org-agenda-text-search-extra-files) 4781 (unless (get 'org-agenda-files 'org-restrict) 4782 (setq files (org-add-archive-files files)))) 4783 ;; Uniquify files. However, let `org-check-agenda-file' handle 4784 ;; non-existent ones. 4785 (setq files (cl-remove-duplicates 4786 (append files org-agenda-text-search-extra-files) 4787 :test (lambda (a b) 4788 (and (file-exists-p a) 4789 (file-exists-p b) 4790 (file-equal-p a b)))) 4791 rtnall nil) 4792 (while (setq file (pop files)) 4793 (setq ee nil) 4794 (catch 'nextfile 4795 (org-check-agenda-file file) 4796 (setq buffer (if (file-exists-p file) 4797 (org-get-agenda-file-buffer file) 4798 (error "No such file %s" file))) 4799 (unless buffer 4800 ;; If file does not exist, make sure an error message is sent 4801 (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" 4802 file)))) 4803 (with-current-buffer buffer 4804 (with-syntax-table (org-search-syntax-table) 4805 (unless (derived-mode-p 'org-mode) 4806 (error "Agenda file %s is not in Org mode" file)) 4807 (let ((case-fold-search t)) 4808 (save-excursion 4809 (save-restriction 4810 (if (eq buffer org-agenda-restrict) 4811 (narrow-to-region org-agenda-restrict-begin 4812 org-agenda-restrict-end) 4813 (widen)) 4814 (goto-char (point-min)) 4815 (unless (or (org-at-heading-p) 4816 (outline-next-heading)) 4817 (throw 'nextfile t)) 4818 (goto-char (max (point-min) (1- (point)))) 4819 (while (re-search-forward regexp nil t) 4820 (setq last-search-end (point)) 4821 (org-back-to-heading t) 4822 (while (and (not (zerop org-agenda-search-view-max-outline-level)) 4823 (> (org-reduced-level (org-outline-level)) 4824 org-agenda-search-view-max-outline-level) 4825 (forward-line -1) 4826 (org-back-to-heading t))) 4827 (skip-chars-forward "* ") 4828 (setq beg (line-beginning-position) 4829 beg1 (point) 4830 end (progn 4831 (outline-next-heading) 4832 (while (and (not (zerop org-agenda-search-view-max-outline-level)) 4833 (> (org-reduced-level (org-outline-level)) 4834 org-agenda-search-view-max-outline-level) 4835 (forward-line 1) 4836 (outline-next-heading))) 4837 (point))) 4838 4839 (catch :skip 4840 (goto-char beg) 4841 (org-agenda-skip) 4842 (setq str (buffer-substring-no-properties 4843 (line-beginning-position) 4844 (if hdl-only (line-end-position) end))) 4845 (mapc (lambda (wr) (when (string-match wr str) 4846 (goto-char (1- end)) 4847 (throw :skip t))) 4848 regexps-) 4849 (mapc (lambda (wr) (unless (string-match wr str) 4850 (goto-char (1- end)) 4851 (throw :skip t))) 4852 (if todo-only 4853 (cons (concat "^\\*+[ \t]+" 4854 org-not-done-regexp) 4855 regexps+) 4856 regexps+)) 4857 (goto-char beg) 4858 (setq marker (org-agenda-new-marker (point)) 4859 category (org-get-category) 4860 level (make-string (org-reduced-level (org-outline-level)) ? ) 4861 inherited-tags 4862 (or (eq org-agenda-show-inherited-tags 'always) 4863 (and (listp org-agenda-show-inherited-tags) 4864 (memq 'todo org-agenda-show-inherited-tags)) 4865 (and (eq org-agenda-show-inherited-tags t) 4866 (or (eq org-agenda-use-tag-inheritance t) 4867 (memq 'todo org-agenda-use-tag-inheritance)))) 4868 tags (org-get-tags nil (not inherited-tags)) 4869 txt (org-agenda-format-item 4870 "" 4871 (buffer-substring-no-properties 4872 beg1 (line-end-position)) 4873 level category tags t)) 4874 (org-add-props txt props 4875 'org-marker marker 'org-hd-marker marker 4876 'org-todo-regexp org-todo-regexp 4877 'level level 4878 'org-complex-heading-regexp org-complex-heading-regexp 4879 'priority 1000 4880 'type "search") 4881 (push txt ee) 4882 (goto-char (max (1- end) last-search-end)))))))))) 4883 (setq rtn (nreverse ee)) 4884 (setq rtnall (append rtnall rtn))) 4885 (org-agenda--insert-overriding-header 4886 (with-temp-buffer 4887 (insert "Search words: ") 4888 (add-text-properties (point-min) (1- (point)) 4889 (list 'face 'org-agenda-structure)) 4890 (setq pos (point)) 4891 (insert string "\n") 4892 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter)) 4893 (setq pos (point)) 4894 (unless org-agenda-multi 4895 (insert (substitute-command-keys "\\<org-agenda-mode-map>\ 4896 Press `\\[org-agenda-manipulate-query-add]', \ 4897 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \ 4898 `\\[org-agenda-manipulate-query-add-re]', \ 4899 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \ 4900 `\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n")) 4901 (add-text-properties pos (1- (point)) 4902 (list 'face 'org-agenda-structure-secondary))) 4903 (buffer-string))) 4904 (org-agenda-mark-header-line (point-min)) 4905 (when rtnall 4906 (insert (org-agenda-finalize-entries rtnall 'search) "\n")) 4907 (goto-char (point-min)) 4908 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 4909 (add-text-properties (point-min) (point-max) 4910 `(org-agenda-type search 4911 org-last-args (,todo-only ,string ,edit-at) 4912 org-redo-cmd ,org-agenda-redo-command 4913 org-series-cmd ,org-cmd)) 4914 (org-agenda-finalize) 4915 (setq buffer-read-only t)))) 4916 4917 ;;; Agenda TODO list 4918 4919 (defun org-agenda-propertize-selected-todo-keywords (keywords) 4920 "Use `org-todo-keyword-faces' for the selected todo KEYWORDS." 4921 (concat 4922 (if (or (equal keywords "ALL") (not keywords)) 4923 (propertize "ALL" 'face 'org-agenda-structure-filter) 4924 (mapconcat 4925 (lambda (kw) 4926 (propertize kw 'face (list (org-get-todo-face kw) 'org-agenda-structure))) 4927 (org-split-string keywords "|") 4928 "|")) 4929 "\n")) 4930 4931 (defvar org-select-this-todo-keyword nil) 4932 (defvar org-last-arg nil) 4933 4934 (defvar crm-separator) 4935 4936 ;;;###autoload 4937 (defun org-todo-list (&optional arg) 4938 "Show all (not done) TODO entries from all agenda files in a single list. 4939 The prefix arg can be used to select a specific TODO keyword and limit 4940 the list to these. When using `\\[universal-argument]', you will be prompted 4941 for a keyword. A numeric prefix directly selects the Nth keyword in 4942 `org-todo-keywords-1'." 4943 (interactive "P") 4944 (when org-agenda-overriding-arguments 4945 (setq arg org-agenda-overriding-arguments)) 4946 (when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) 4947 (let* ((today (org-today)) 4948 (date (calendar-gregorian-from-absolute today)) 4949 (completion-ignore-case t) 4950 kwds org-select-this-todo-keyword rtn rtnall files file pos) 4951 (catch 'exit 4952 (setq org-agenda-buffer-name 4953 (org-agenda--get-buffer-name 4954 (and org-agenda-sticky 4955 (if (stringp org-select-this-todo-keyword) 4956 (format "*Org Agenda(%s:%s)*" (or org-keys "t") 4957 org-select-this-todo-keyword) 4958 (format "*Org Agenda(%s)*" (or org-keys "t")))))) 4959 (org-agenda-prepare "TODO") 4960 (setq kwds org-todo-keywords-for-agenda 4961 org-select-this-todo-keyword (if (stringp arg) arg 4962 (and (integerp arg) 4963 (> arg 0) 4964 (nth (1- arg) kwds)))) 4965 (when (equal arg '(4)) 4966 (setq org-select-this-todo-keyword 4967 (mapconcat #'identity 4968 (let ((crm-separator "|")) 4969 (completing-read-multiple 4970 "Keyword (or KWD1|KWD2|...): " 4971 (mapcar #'list kwds) nil nil)) 4972 "|"))) 4973 (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) 4974 (org-compile-prefix-format 'todo) 4975 (org-set-sorting-strategy 'todo) 4976 (setq org-agenda-redo-command 4977 `(org-todo-list (or (and (numberp current-prefix-arg) 4978 current-prefix-arg) 4979 ,org-select-this-todo-keyword 4980 current-prefix-arg ,arg))) 4981 (setq files (org-agenda-files nil 'ifmode) 4982 rtnall nil) 4983 (while (setq file (pop files)) 4984 (catch 'nextfile 4985 (org-check-agenda-file file) 4986 (setq rtn (org-agenda-get-day-entries file date :todo)) 4987 (setq rtnall (append rtnall rtn)))) 4988 (org-agenda--insert-overriding-header 4989 (with-temp-buffer 4990 (insert "Global list of TODO items of type: ") 4991 (add-text-properties (point-min) (1- (point)) 4992 (list 'face 'org-agenda-structure 4993 'short-heading 4994 (concat "ToDo: " 4995 (or org-select-this-todo-keyword "ALL")))) 4996 (org-agenda-mark-header-line (point-min)) 4997 (insert (org-agenda-propertize-selected-todo-keywords 4998 org-select-this-todo-keyword)) 4999 (setq pos (point)) 5000 (unless org-agenda-multi 5001 (insert (substitute-command-keys "Press \ 5002 \\<org-agenda-mode-map>`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \ 5003 to search again: (0)[ALL]")) 5004 (let ((n 0)) 5005 (dolist (k kwds) 5006 (let ((s (format "(%d)%s" (cl-incf n) k))) 5007 (when (> (+ (current-column) (string-width s) 1) (window-max-chars-per-line)) 5008 (insert "\n ")) 5009 (insert " " s)))) 5010 (insert "\n")) 5011 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary)) 5012 (buffer-string))) 5013 (org-agenda-mark-header-line (point-min)) 5014 (when rtnall 5015 (insert (org-agenda-finalize-entries rtnall 'todo) "\n")) 5016 (goto-char (point-min)) 5017 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 5018 (add-text-properties (point-min) (point-max) 5019 `(org-agenda-type todo 5020 org-last-args ,arg 5021 org-redo-cmd ,org-agenda-redo-command 5022 org-series-cmd ,org-cmd)) 5023 (org-agenda-finalize) 5024 (setq buffer-read-only t)))) 5025 5026 ;;; Agenda tags match 5027 5028 ;;;###autoload 5029 (defun org-tags-view (&optional todo-only match) 5030 "Show all headlines for all `org-agenda-files' matching a TAGS criterion. 5031 The prefix arg TODO-ONLY limits the search to TODO entries." 5032 (interactive "P") 5033 (when org-agenda-overriding-arguments 5034 (setq todo-only (car org-agenda-overriding-arguments) 5035 match (nth 1 org-agenda-overriding-arguments))) 5036 (let* ((org-tags-match-list-sublevels 5037 org-tags-match-list-sublevels) 5038 (completion-ignore-case t) 5039 (org--matcher-tags-todo-only todo-only) 5040 rtn rtnall files file pos matcher 5041 buffer) 5042 (when (and (stringp match) (not (string-match "\\S-" match))) 5043 (setq match nil)) 5044 (catch 'exit 5045 (setq org-agenda-buffer-name 5046 (org-agenda--get-buffer-name 5047 (and org-agenda-sticky 5048 (if (stringp match) 5049 (format "*Org Agenda(%s:%s)*" 5050 (or org-keys (or (and todo-only "M") "m")) 5051 match) 5052 (format "*Org Agenda(%s)*" 5053 (or (and todo-only "M") "m")))))) 5054 (setq matcher (org-make-tags-matcher match)) 5055 ;; Prepare agendas (and `org-tag-alist-for-agenda') before 5056 ;; expanding tags within `org-make-tags-matcher' 5057 (org-agenda-prepare (concat "TAGS " match)) 5058 (setq match (car matcher) 5059 matcher (cdr matcher)) 5060 (org-compile-prefix-format 'tags) 5061 (org-set-sorting-strategy 'tags) 5062 (setq org-agenda-query-string match) 5063 (setq org-agenda-redo-command 5064 (list 'org-tags-view 5065 `(quote ,org--matcher-tags-todo-only) 5066 `(if current-prefix-arg nil ,org-agenda-query-string))) 5067 (setq files (org-agenda-files nil 'ifmode) 5068 rtnall nil) 5069 (while (setq file (pop files)) 5070 (catch 'nextfile 5071 (org-check-agenda-file file) 5072 (setq buffer (if (file-exists-p file) 5073 (org-get-agenda-file-buffer file) 5074 (error "No such file %s" file))) 5075 (if (not buffer) 5076 ;; If file does not exist, error message to agenda 5077 (setq rtn (list 5078 (format "ORG-AGENDA-ERROR: No such org-file %s" file)) 5079 rtnall (append rtnall rtn)) 5080 (with-current-buffer buffer 5081 (unless (derived-mode-p 'org-mode) 5082 (error "Agenda file %s is not in Org mode" file)) 5083 (save-excursion 5084 (save-restriction 5085 (if (eq buffer org-agenda-restrict) 5086 (narrow-to-region org-agenda-restrict-begin 5087 org-agenda-restrict-end) 5088 (widen)) 5089 (setq rtn (org-scan-tags 'agenda 5090 matcher 5091 org--matcher-tags-todo-only)) 5092 (setq rtnall (append rtnall rtn)))))))) 5093 (org-agenda--insert-overriding-header 5094 (with-temp-buffer 5095 (insert "Headlines with TAGS match: ") 5096 (add-text-properties (point-min) (1- (point)) 5097 (list 'face 'org-agenda-structure 5098 'short-heading 5099 (concat "Match: " match))) 5100 (setq pos (point)) 5101 (insert match "\n") 5102 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter)) 5103 (setq pos (point)) 5104 (unless org-agenda-multi 5105 (insert (substitute-command-keys 5106 "Press \ 5107 \\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \ 5108 to search again\n"))) 5109 (add-text-properties pos (1- (point)) 5110 (list 'face 'org-agenda-structure-secondary)) 5111 (buffer-string))) 5112 (org-agenda-mark-header-line (point-min)) 5113 (when rtnall 5114 (insert (org-agenda-finalize-entries rtnall 'tags) "\n")) 5115 (goto-char (point-min)) 5116 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 5117 (add-text-properties 5118 (point-min) (point-max) 5119 `(org-agenda-type tags 5120 org-last-args (,org--matcher-tags-todo-only ,match) 5121 org-redo-cmd ,org-agenda-redo-command 5122 org-series-cmd ,org-cmd)) 5123 (org-agenda-finalize) 5124 (setq buffer-read-only t)))) 5125 5126 ;;; Agenda Finding stuck projects 5127 5128 (defvar org-agenda-skip-regexp nil 5129 "Regular expression used in skipping subtrees for the agenda. 5130 This is basically a temporary global variable that can be set and then 5131 used by user-defined selections using `org-agenda-skip-function'.") 5132 5133 (defvar org-agenda-overriding-header nil 5134 "When set during agenda, todo and tags searches it replaces the header. 5135 If an empty string, no header will be inserted. If any other 5136 string, it will be inserted as a header. If a function, insert 5137 the string returned by the function as a header. If nil, a 5138 header will be generated automatically according to the command. 5139 This variable should not be set directly, but custom commands can 5140 bind it in the options section.") 5141 5142 (defun org-agenda-skip-entry-if (&rest conditions) 5143 "Skip entry if any of CONDITIONS is true. 5144 See `org-agenda-skip-if' for details about CONDITIONS. 5145 5146 This function can be put into `org-agenda-skip-function' for the 5147 duration of a command." 5148 (org-agenda-skip-if nil conditions)) 5149 5150 (defun org-agenda-skip-subtree-if (&rest conditions) 5151 "Skip subtree if any of CONDITIONS is true. 5152 See `org-agenda-skip-if' for details about CONDITIONS. 5153 5154 This function can be put into `org-agenda-skip-function' for the 5155 duration of a command." 5156 (org-agenda-skip-if t conditions)) 5157 5158 (defun org-agenda-skip-if (subtree conditions) 5159 "Check current entity for CONDITIONS. 5160 If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only 5161 the entry (i.e. the text before the next heading) is checked. 5162 5163 CONDITIONS is a list of symbols, boolean OR is used to combine the results 5164 from different tests. Valid conditions are: 5165 5166 scheduled Check if there is a scheduled cookie 5167 notscheduled Check if there is no scheduled cookie 5168 deadline Check if there is a deadline 5169 notdeadline Check if there is no deadline 5170 timestamp Check if there is a timestamp (also deadline or scheduled) 5171 nottimestamp Check if there is no timestamp (also deadline or scheduled) 5172 regexp Check if regexp matches 5173 notregexp Check if regexp does not match. 5174 todo Check if TODO keyword matches 5175 nottodo Check if TODO keyword does not match 5176 5177 The regexp is taken from the conditions list, and must come right 5178 after the `regexp' or `notregexp' element. 5179 5180 `todo' and `nottodo' accept as an argument a list of todo 5181 keywords, which may include \"*\" to match any todo keyword. 5182 5183 (org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\")) 5184 5185 would skip all entries with \"TODO\" or \"WAITING\" keywords. 5186 5187 Instead of a list, a keyword class may be given. For example: 5188 5189 (org-agenda-skip-entry-if \\='nottodo \\='done) 5190 5191 would skip entries that haven't been marked with any of \"DONE\" 5192 keywords. Possible classes are: `todo', `done', `any'. 5193 5194 If any of these conditions is met, this function returns the end point of 5195 the entity, causing the search to continue from there. This is a function 5196 that can be put into `org-agenda-skip-function' for the duration of a command." 5197 (org-back-to-heading t) 5198 (let* (;; (beg (point)) 5199 (end (if subtree (save-excursion (org-end-of-subtree t) (point)) 5200 (org-entry-end-position))) 5201 (planning-end (if subtree end (line-end-position 2))) 5202 m) 5203 (and 5204 (or (and (memq 'scheduled conditions) 5205 (re-search-forward org-scheduled-time-regexp planning-end t)) 5206 (and (memq 'notscheduled conditions) 5207 (not 5208 (save-excursion 5209 (re-search-forward org-scheduled-time-regexp planning-end t)))) 5210 (and (memq 'deadline conditions) 5211 (re-search-forward org-deadline-time-regexp planning-end t)) 5212 (and (memq 'notdeadline conditions) 5213 (not 5214 (save-excursion 5215 (re-search-forward org-deadline-time-regexp planning-end t)))) 5216 (and (memq 'timestamp conditions) 5217 (re-search-forward org-ts-regexp end t)) 5218 (and (memq 'nottimestamp conditions) 5219 (not (save-excursion (re-search-forward org-ts-regexp end t)))) 5220 (and (setq m (memq 'regexp conditions)) 5221 (stringp (nth 1 m)) 5222 (re-search-forward (nth 1 m) end t)) 5223 (and (setq m (memq 'notregexp conditions)) 5224 (stringp (nth 1 m)) 5225 (not (save-excursion (re-search-forward (nth 1 m) end t)))) 5226 (and (or 5227 (setq m (memq 'nottodo conditions)) 5228 (setq m (memq 'todo-unblocked conditions)) 5229 (setq m (memq 'nottodo-unblocked conditions)) 5230 (setq m (memq 'todo conditions))) 5231 (org-agenda-skip-if-todo m end))) 5232 end))) 5233 5234 (defun org-agenda-skip-if-todo (args end) 5235 "Helper function for `org-agenda-skip-if', do not use it directly. 5236 ARGS is a list with first element either `todo', `nottodo', 5237 `todo-unblocked' or `nottodo-unblocked'. The remainder is either 5238 a list of TODO keywords, or a state symbol `todo' or `done' or 5239 `any'." 5240 (let ((todo-re 5241 (concat "^\\*+[ \t]+" 5242 (regexp-opt 5243 (pcase args 5244 (`(,_ todo) 5245 (org-delete-all org-done-keywords 5246 (copy-sequence org-todo-keywords-1))) 5247 (`(,_ done) org-done-keywords) 5248 (`(,_ any) org-todo-keywords-1) 5249 (`(,_ ,(pred atom)) 5250 (error "Invalid TODO class or type: %S" args)) 5251 (`(,_ ,(pred (member "*"))) org-todo-keywords-1) 5252 (`(,_ ,todo-list) todo-list)) 5253 'words)))) 5254 (pcase args 5255 (`(todo . ,_) 5256 (let (case-fold-search) (re-search-forward todo-re end t))) 5257 (`(nottodo . ,_) 5258 (not (let (case-fold-search) (re-search-forward todo-re end t)))) 5259 (`(todo-unblocked . ,_) 5260 (catch :unblocked 5261 (while (let (case-fold-search) (re-search-forward todo-re end t)) 5262 (when (org-entry-blocked-p) (throw :unblocked t))) 5263 nil)) 5264 (`(nottodo-unblocked . ,_) 5265 (catch :unblocked 5266 (while (let (case-fold-search) (re-search-forward todo-re end t)) 5267 (when (org-entry-blocked-p) (throw :unblocked nil))) 5268 t)) 5269 (`(,type . ,_) (error "Unknown TODO skip type: %S" type))))) 5270 5271 ;;;###autoload 5272 (defun org-agenda-list-stuck-projects (&rest _ignore) 5273 "Create agenda view for projects that are stuck. 5274 Stuck projects are project that have no next actions. For the definitions 5275 of what a project is and how to check if it stuck, customize the variable 5276 `org-stuck-projects'." 5277 (interactive) 5278 (let* ((org-agenda-overriding-header 5279 (or org-agenda-overriding-header "List of stuck projects: ")) 5280 (matcher (nth 0 org-stuck-projects)) 5281 (todo (nth 1 org-stuck-projects)) 5282 (tags (nth 2 org-stuck-projects)) 5283 (gen-re (org-string-nw-p (nth 3 org-stuck-projects))) 5284 (todo-wds 5285 (if (not (member "*" todo)) todo 5286 (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) 5287 (org-delete-all org-done-keywords-for-agenda 5288 (copy-sequence org-todo-keywords-for-agenda)))) 5289 (todo-re (and todo 5290 (format "^\\*+[ \t]+\\(%s\\)\\>" 5291 (mapconcat #'identity todo-wds "\\|")))) 5292 (tags-re (cond ((null tags) nil) 5293 ((member "*" tags) org-tag-line-re) 5294 (tags 5295 (let ((other-tags (format "\\(?:%s:\\)*" org-tag-re))) 5296 (concat org-outline-regexp-bol 5297 ".*?[ \t]:" 5298 other-tags 5299 (regexp-opt tags t) 5300 ":" other-tags "[ \t]*$"))) 5301 (t nil))) 5302 (re-list (delq nil (list todo-re tags-re gen-re))) 5303 (skip-re 5304 (if (null re-list) 5305 (error "Missing information to identify unstuck projects") 5306 (mapconcat #'identity re-list "\\|"))) 5307 (org-agenda-skip-function 5308 ;; Skip entry if `org-agenda-skip-regexp' matches anywhere 5309 ;; in the subtree. 5310 (lambda () 5311 (and (save-excursion 5312 (let ((case-fold-search nil)) 5313 (re-search-forward 5314 skip-re (save-excursion (org-end-of-subtree t)) t))) 5315 (progn (outline-next-heading) (point)))))) 5316 (org-tags-view nil matcher) 5317 (setq org-agenda-buffer-name (buffer-name)) 5318 (with-current-buffer org-agenda-buffer-name 5319 (setq org-agenda-redo-command 5320 `(org-agenda-list-stuck-projects ,current-prefix-arg)) 5321 (let ((inhibit-read-only t)) 5322 (add-text-properties 5323 (point-min) (point-max) 5324 `(org-redo-cmd ,org-agenda-redo-command)))))) 5325 5326 ;;; Diary integration 5327 5328 (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. 5329 (defvar diary-list-entries-hook) 5330 (defvar diary-time-regexp) 5331 (defvar diary-modify-entry-list-string-function) 5332 (defvar diary-file-name-prefix) 5333 (defvar diary-display-function) 5334 5335 (defun org-get-entries-from-diary (date) 5336 "Get the (Emacs Calendar) diary entries for DATE." 5337 (require 'diary-lib) 5338 (declare-function diary-fancy-display "diary-lib" ()) 5339 (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") 5340 (diary-display-function #'diary-fancy-display) 5341 (pop-up-frames nil) 5342 (diary-list-entries-hook 5343 (cons 'org-diary-default-entry diary-list-entries-hook)) 5344 (diary-file-name-prefix nil) ; turn this feature off 5345 (diary-modify-entry-list-string-function 5346 #'org-modify-diary-entry-string) 5347 (diary-time-regexp (concat "^" diary-time-regexp)) 5348 entries 5349 (org-disable-agenda-to-diary t)) 5350 (save-excursion 5351 (save-window-excursion 5352 (diary-list-entries date 1))) 5353 (if (not (get-buffer diary-fancy-buffer)) 5354 (setq entries nil) 5355 (with-current-buffer diary-fancy-buffer 5356 (setq buffer-read-only nil) 5357 (if (zerop (buffer-size)) 5358 ;; No entries 5359 (setq entries nil) 5360 ;; Omit the date and other unnecessary stuff 5361 (org-agenda-cleanup-fancy-diary) 5362 ;; Add prefix to each line and extend the text properties 5363 (if (zerop (buffer-size)) 5364 (setq entries nil) 5365 (setq entries (buffer-substring (point-min) (- (point-max) 1))) 5366 (setq entries 5367 (with-temp-buffer 5368 (insert entries) (goto-char (point-min)) 5369 (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t) 5370 (unless (save-match-data (string-match diary-time-regexp (match-string 1))) 5371 (replace-match (concat "; " (match-string 1))))) 5372 (buffer-string))))) 5373 (set-buffer-modified-p nil) 5374 (kill-buffer diary-fancy-buffer))) 5375 (when entries 5376 (setq entries (org-split-string entries "\n")) 5377 (setq entries 5378 (mapcar 5379 (lambda (x) 5380 (setq x (org-agenda-format-item "" x nil "Diary" nil 'time)) 5381 ;; Extend the text properties to the beginning of the line 5382 (org-add-props x (text-properties-at (1- (length x)) x) 5383 'type "diary" 'date date 'face 'org-agenda-diary)) 5384 entries))))) 5385 5386 (defvar org-agenda-cleanup-fancy-diary-hook nil 5387 "Hook run when the fancy diary buffer is cleaned up.") 5388 5389 (defun org-agenda-cleanup-fancy-diary () 5390 "Remove unwanted stuff in buffer created by `diary-fancy-display'. 5391 This gets rid of the date, the underline under the date, and the 5392 dummy entry installed by Org mode to ensure non-empty diary for 5393 each date. It also removes lines that contain only whitespace." 5394 (goto-char (point-min)) 5395 (if (looking-at ".*?:[ \t]*") 5396 (progn 5397 (replace-match "") 5398 (re-search-forward "\n=+$" nil t) 5399 (replace-match "") 5400 (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) 5401 (re-search-forward "\n=+$" nil t) 5402 (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) 5403 (goto-char (point-min)) 5404 (while (re-search-forward "^ +\n" nil t) 5405 (replace-match "")) 5406 (goto-char (point-min)) 5407 (when (re-search-forward "^Org mode dummy\n?" nil t) 5408 (replace-match "")) 5409 (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) 5410 5411 (defun org-modify-diary-entry-string (string) 5412 "Add text properties to string, allowing Org to act on it." 5413 (org-add-props string nil 5414 'mouse-face 'highlight 5415 'help-echo (if buffer-file-name 5416 (format "mouse-2 or RET jump to diary file %s" 5417 (abbreviate-file-name buffer-file-name)) 5418 "") 5419 'org-agenda-diary-link t 5420 'org-marker (org-agenda-new-marker (line-beginning-position)))) 5421 5422 (defun org-diary-default-entry () 5423 "Add a dummy entry to the diary. 5424 Needed to avoid empty dates which mess up holiday display." 5425 ;; Catch the error if dealing with the new add-to-diary-alist 5426 (when org-disable-agenda-to-diary 5427 (diary-add-to-list original-date "Org mode dummy" ""))) 5428 5429 (defvar org-diary-last-run-time nil) 5430 5431 ;;;###autoload 5432 (defun org-diary (&rest args) 5433 "Return diary information from org files. 5434 This function can be used in a \"sexp\" diary entry in the Emacs calendar. 5435 It accesses org files and extracts information from those files to be 5436 listed in the diary. The function accepts arguments specifying what 5437 items should be listed. For a list of arguments allowed here, see the 5438 variable `org-agenda-entry-types'. 5439 5440 The call in the diary file should look like this: 5441 5442 &%%(org-diary) ~/path/to/some/orgfile.org 5443 5444 Use a separate line for each org file to check. Or, if you omit the file name, 5445 all files listed in `org-agenda-files' will be checked automatically: 5446 5447 &%%(org-diary) 5448 5449 If you don't give any arguments (as in the example above), the default value 5450 of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). 5451 So the example above may also be written as 5452 5453 &%%(org-diary :deadline :timestamp :sexp :scheduled) 5454 5455 The function expects the lisp variables `entry' and `date' to be provided 5456 by the caller, because this is how the calendar works. Don't use this 5457 function from a program - use `org-agenda-get-day-entries' instead." 5458 (with-no-warnings (defvar date) (defvar entry)) 5459 (when (> (- (float-time) 5460 org-agenda-last-marker-time) 5461 5) 5462 ;; I am not sure if this works with sticky agendas, because the marker 5463 ;; list is then no longer a global variable. 5464 (org-agenda-reset-markers)) 5465 (org-compile-prefix-format 'agenda) 5466 (org-set-sorting-strategy 'agenda) 5467 (setq args (or args org-agenda-entry-types)) 5468 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) 5469 (list entry) 5470 (org-agenda-files t))) 5471 (time (float-time)) 5472 file rtn results) 5473 (when (or (not org-diary-last-run-time) 5474 (> (- time 5475 org-diary-last-run-time) 5476 3)) 5477 (org-agenda-prepare-buffers files)) 5478 (setq org-diary-last-run-time time) 5479 ;; If this is called during org-agenda, don't return any entries to 5480 ;; the calendar. Org Agenda will list these entries itself. 5481 (when org-disable-agenda-to-diary (setq files nil)) 5482 (while (setq file (pop files)) 5483 (setq rtn (apply #'org-agenda-get-day-entries file date args)) 5484 (setq results (append results rtn))) 5485 (when results 5486 (setq results 5487 (mapcar (lambda (i) (replace-regexp-in-string 5488 org-link-bracket-re "\\2" i)) 5489 results)) 5490 (concat (org-agenda-finalize-entries results) "\n")))) 5491 5492 ;;; Agenda entry finders 5493 5494 (defun org-agenda--timestamp-to-absolute (&rest args) 5495 "Call `org-time-string-to-absolute' with ARGS. 5496 However, throw `:skip' whenever an error is raised." 5497 (condition-case e 5498 (apply #'org-time-string-to-absolute args) 5499 (org-diary-sexp-no-match (throw :skip nil)) 5500 (error 5501 (message "%s; Skipping entry" (error-message-string e)) 5502 (throw :skip nil)))) 5503 5504 (defun org-agenda-get-day-entries (file date &rest args) 5505 "Does the work for `org-diary' and `org-agenda'. 5506 FILE is the path to a file to be checked for entries. DATE is date like 5507 the one returned by `calendar-current-date'. ARGS are symbols indicating 5508 which kind of entries should be extracted. For details about these, see 5509 the documentation of `org-diary'." 5510 (let* ((org-startup-folded nil) 5511 (org-startup-align-all-tables nil) 5512 (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file) 5513 (error "No such file %s" file)))) 5514 (if (not buffer) 5515 ;; If file does not exist, signal it in diary nonetheless. 5516 (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) 5517 (with-current-buffer buffer 5518 (unless (derived-mode-p 'org-mode) 5519 (error "Agenda file %s is not in Org mode" file)) 5520 (setq org-agenda-buffer (or org-agenda-buffer buffer)) 5521 (setf org-agenda-current-date date) 5522 (save-excursion 5523 (save-restriction 5524 (if (eq buffer org-agenda-restrict) 5525 (narrow-to-region org-agenda-restrict-begin 5526 org-agenda-restrict-end) 5527 (widen)) 5528 ;; Rationalize ARGS. Also make sure `:deadline' comes 5529 ;; first in order to populate DEADLINES before passing it. 5530 ;; 5531 ;; We use `delq' since `org-uniquify' duplicates ARGS, 5532 ;; guarding us from modifying `org-agenda-entry-types'. 5533 (setf args (org-uniquify (or args org-agenda-entry-types))) 5534 (when (and (memq :scheduled args) (memq :scheduled* args)) 5535 (setf args (delq :scheduled* args))) 5536 (cond 5537 ((memq :deadline args) 5538 (setf args (cons :deadline 5539 (delq :deadline (delq :deadline* args))))) 5540 ((memq :deadline* args) 5541 (setf args (cons :deadline* (delq :deadline* args))))) 5542 ;; Collect list of headlines. Return them flattened. 5543 (let ((case-fold-search nil) results deadlines) 5544 (org-dlet 5545 ((date date)) 5546 (dolist (arg args (apply #'nconc (nreverse results))) 5547 (pcase arg 5548 ((and :todo (guard (org-agenda-today-p date))) 5549 (push (org-agenda-get-todos) results)) 5550 (:timestamp 5551 (push (org-agenda-get-blocks) results) 5552 (push (org-agenda-get-timestamps deadlines) results)) 5553 (:sexp 5554 (push (org-agenda-get-sexps) results)) 5555 (:scheduled 5556 (push (org-agenda-get-scheduled deadlines) results)) 5557 (:scheduled* 5558 (push (org-agenda-get-scheduled deadlines t) results)) 5559 (:closed 5560 (push (org-agenda-get-progress) results)) 5561 (:deadline 5562 (setf deadlines (org-agenda-get-deadlines)) 5563 (push deadlines results)) 5564 (:deadline* 5565 (setf deadlines (org-agenda-get-deadlines t)) 5566 (push deadlines results)))))))))))) 5567 5568 (defsubst org-em (x y list) 5569 "Is X or Y a member of LIST?" 5570 (or (memq x list) (memq y list))) 5571 5572 (defvar org-heading-keyword-regexp-format) ; defined in org.el 5573 (defvar org-agenda-sorting-strategy-selected nil) 5574 5575 (defun org-agenda-entry-get-agenda-timestamp (pom) 5576 "Retrieve timestamp information for sorting agenda views. 5577 Given a point or marker POM, returns a cons cell of the timestamp 5578 and the timestamp type relevant for the sorting strategy in 5579 `org-agenda-sorting-strategy-selected'." 5580 (let (ts ts-date-type) 5581 (save-match-data 5582 (cond ((org-em 'scheduled-up 'scheduled-down 5583 org-agenda-sorting-strategy-selected) 5584 (setq ts (org-entry-get pom "SCHEDULED") 5585 ts-date-type " scheduled")) 5586 ((org-em 'deadline-up 'deadline-down 5587 org-agenda-sorting-strategy-selected) 5588 (setq ts (org-entry-get pom "DEADLINE") 5589 ts-date-type " deadline")) 5590 ((org-em 'ts-up 'ts-down 5591 org-agenda-sorting-strategy-selected) 5592 (setq ts (org-entry-get pom "TIMESTAMP") 5593 ts-date-type " timestamp")) 5594 ((org-em 'tsia-up 'tsia-down 5595 org-agenda-sorting-strategy-selected) 5596 (setq ts (org-entry-get pom "TIMESTAMP_IA") 5597 ts-date-type " timestamp_ia")) 5598 ((org-em 'timestamp-up 'timestamp-down 5599 org-agenda-sorting-strategy-selected) 5600 (setq ts (or (org-entry-get pom "SCHEDULED") 5601 (org-entry-get pom "DEADLINE") 5602 (org-entry-get pom "TIMESTAMP") 5603 (org-entry-get pom "TIMESTAMP_IA")) 5604 ts-date-type "")) 5605 (t (setq ts-date-type ""))) 5606 (cons (when ts (ignore-errors (org-time-string-to-absolute ts))) 5607 ts-date-type)))) 5608 5609 (defun org-agenda-get-todos () 5610 "Return the TODO information for agenda display." 5611 (let* ((props (list 'face nil 5612 'done-face 'org-agenda-done 5613 'org-not-done-regexp org-not-done-regexp 5614 'org-todo-regexp org-todo-regexp 5615 'org-complex-heading-regexp org-complex-heading-regexp 5616 'mouse-face 'highlight 5617 'help-echo 5618 (format "mouse-2 or RET jump to org file %s" 5619 (abbreviate-file-name buffer-file-name)))) 5620 (case-fold-search nil) 5621 (regexp (format org-heading-keyword-regexp-format 5622 (cond 5623 ((and org-select-this-todo-keyword 5624 (equal org-select-this-todo-keyword "*")) 5625 org-todo-regexp) 5626 (org-select-this-todo-keyword 5627 (concat "\\(" 5628 (mapconcat #'identity 5629 (org-split-string 5630 org-select-this-todo-keyword 5631 "|") 5632 "\\|") 5633 "\\)")) 5634 (t org-not-done-regexp)))) 5635 marker priority category level tags todo-state 5636 ts-date ts-date-type ts-date-pair 5637 ee txt beg end inherited-tags todo-state-end-pos 5638 effort effort-minutes) 5639 (goto-char (point-min)) 5640 (while (re-search-forward regexp nil t) 5641 (catch :skip 5642 (save-match-data 5643 (beginning-of-line) 5644 (org-agenda-skip) 5645 (setq beg (point) end (save-excursion (outline-next-heading) (point))) 5646 (unless (and (setq todo-state (org-get-todo-state)) 5647 (setq todo-state-end-pos (match-end 2))) 5648 (goto-char end) 5649 (throw :skip nil)) 5650 (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end) 5651 (goto-char (1+ beg)) 5652 (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) 5653 (throw :skip nil))) 5654 (goto-char (match-beginning 2)) 5655 (setq marker (org-agenda-new-marker (match-beginning 0)) 5656 category (org-get-category) 5657 effort (save-match-data (or (get-text-property (point) 'effort) 5658 (org-entry-get (point) org-effort-property))) 5659 effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))) 5660 ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) 5661 ts-date (car ts-date-pair) 5662 ts-date-type (cdr ts-date-pair) 5663 txt (org-trim (buffer-substring (match-beginning 2) (match-end 0))) 5664 inherited-tags 5665 (or (eq org-agenda-show-inherited-tags 'always) 5666 (and (listp org-agenda-show-inherited-tags) 5667 (memq 'todo org-agenda-show-inherited-tags)) 5668 (and (eq org-agenda-show-inherited-tags t) 5669 (or (eq org-agenda-use-tag-inheritance t) 5670 (memq 'todo org-agenda-use-tag-inheritance)))) 5671 tags (org-get-tags nil (not inherited-tags)) 5672 level (make-string (org-reduced-level (org-outline-level)) ? ) 5673 txt (org-agenda-format-item "" 5674 (org-add-props txt nil 5675 'effort effort 5676 'effort-minutes effort-minutes) 5677 level category tags t) 5678 priority (1+ (org-get-priority txt))) 5679 (org-add-props txt props 5680 'org-marker marker 'org-hd-marker marker 5681 'priority priority 5682 'effort effort 'effort-minutes effort-minutes 5683 'level level 5684 'ts-date ts-date 5685 'type (concat "todo" ts-date-type) 'todo-state todo-state) 5686 (push txt ee) 5687 (if org-agenda-todo-list-sublevels 5688 (goto-char todo-state-end-pos) 5689 (org-end-of-subtree 'invisible)))) 5690 (nreverse ee))) 5691 5692 (defun org-agenda-todo-custom-ignore-p (time n) 5693 "Check whether timestamp is farther away than n number of days. 5694 This function is invoked if `org-agenda-todo-ignore-deadlines', 5695 `org-agenda-todo-ignore-scheduled' or 5696 `org-agenda-todo-ignore-timestamp' is set to an integer." 5697 (let ((days (org-time-stamp-to-now 5698 time org-agenda-todo-ignore-time-comparison-use-seconds))) 5699 (if (>= n 0) 5700 (>= days n) 5701 (<= days n)))) 5702 5703 ;;;###autoload 5704 (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item 5705 (&optional end) 5706 "Do we have a reason to ignore this TODO entry because it has a time stamp?" 5707 (when (or org-agenda-todo-ignore-with-date 5708 org-agenda-todo-ignore-scheduled 5709 org-agenda-todo-ignore-deadlines 5710 org-agenda-todo-ignore-timestamp) 5711 (setq end (or end (save-excursion (outline-next-heading) (point)))) 5712 (save-excursion 5713 (or (and org-agenda-todo-ignore-with-date 5714 (re-search-forward org-ts-regexp end t)) 5715 (and org-agenda-todo-ignore-scheduled 5716 (re-search-forward org-scheduled-time-regexp end t) 5717 (cond 5718 ((eq org-agenda-todo-ignore-scheduled 'future) 5719 (> (org-time-stamp-to-now 5720 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5721 0)) 5722 ((eq org-agenda-todo-ignore-scheduled 'past) 5723 (<= (org-time-stamp-to-now 5724 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5725 0)) 5726 ((numberp org-agenda-todo-ignore-scheduled) 5727 (org-agenda-todo-custom-ignore-p 5728 (match-string 1) org-agenda-todo-ignore-scheduled)) 5729 (t))) 5730 (and org-agenda-todo-ignore-deadlines 5731 (re-search-forward org-deadline-time-regexp end t) 5732 (cond 5733 ((eq org-agenda-todo-ignore-deadlines 'all) t) 5734 ((eq org-agenda-todo-ignore-deadlines 'far) 5735 (not (org-deadline-close-p (match-string 1)))) 5736 ((eq org-agenda-todo-ignore-deadlines 'future) 5737 (> (org-time-stamp-to-now 5738 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5739 0)) 5740 ((eq org-agenda-todo-ignore-deadlines 'past) 5741 (<= (org-time-stamp-to-now 5742 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5743 0)) 5744 ((numberp org-agenda-todo-ignore-deadlines) 5745 (org-agenda-todo-custom-ignore-p 5746 (match-string 1) org-agenda-todo-ignore-deadlines)) 5747 (t (org-deadline-close-p (match-string 1))))) 5748 (and org-agenda-todo-ignore-timestamp 5749 (let ((buffer (current-buffer)) 5750 (regexp 5751 (concat 5752 org-scheduled-time-regexp "\\|" org-deadline-time-regexp)) 5753 (start (point))) 5754 ;; Copy current buffer into a temporary one 5755 (with-temp-buffer 5756 (insert-buffer-substring buffer start end) 5757 (goto-char (point-min)) 5758 ;; Delete SCHEDULED and DEADLINE items 5759 (while (re-search-forward regexp end t) 5760 (delete-region (match-beginning 0) (match-end 0))) 5761 (goto-char (point-min)) 5762 ;; No search for timestamp left 5763 (when (re-search-forward org-ts-regexp nil t) 5764 (cond 5765 ((eq org-agenda-todo-ignore-timestamp 'future) 5766 (> (org-time-stamp-to-now 5767 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5768 0)) 5769 ((eq org-agenda-todo-ignore-timestamp 'past) 5770 (<= (org-time-stamp-to-now 5771 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5772 0)) 5773 ((numberp org-agenda-todo-ignore-timestamp) 5774 (org-agenda-todo-custom-ignore-p 5775 (match-string 1) org-agenda-todo-ignore-timestamp)) 5776 (t)))))))))) 5777 5778 (defun org-agenda-get-timestamps (&optional deadlines) 5779 "Return the date stamp information for agenda display. 5780 Optional argument DEADLINES is a list of deadline items to be 5781 displayed in agenda view." 5782 (with-no-warnings (defvar date)) 5783 (let* ((props (list 'face 'org-agenda-calendar-event 5784 'org-not-done-regexp org-not-done-regexp 5785 'org-todo-regexp org-todo-regexp 5786 'org-complex-heading-regexp org-complex-heading-regexp 5787 'mouse-face 'highlight 5788 'help-echo 5789 (format "mouse-2 or RET jump to Org file %s" 5790 (abbreviate-file-name buffer-file-name)))) 5791 (current (calendar-absolute-from-gregorian date)) 5792 (today (org-today)) 5793 (deadline-position-alist 5794 (mapcar (lambda (d) 5795 (let ((m (get-text-property 0 'org-hd-marker d))) 5796 (and m (marker-position m)))) 5797 deadlines)) 5798 ;; Match time-stamps set to current date, time-stamps with 5799 ;; a repeater, and S-exp time-stamps. 5800 (regexp 5801 (concat 5802 (if org-agenda-include-inactive-timestamps "[[<]" "<") 5803 (regexp-quote 5804 (substring 5805 (format-time-string 5806 (org-time-stamp-format) 5807 (org-encode-time ; DATE bound by calendar 5808 0 0 0 (nth 1 date) (car date) (nth 2 date))) 5809 1 11)) 5810 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" 5811 "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) 5812 timestamp-items) 5813 (goto-char (point-min)) 5814 (while (re-search-forward regexp nil t) 5815 ;; Skip date ranges, scheduled and deadlines, which are handled 5816 ;; specially. Also skip time-stamps before first headline as 5817 ;; there would be no entry to add to the agenda. Eventually, 5818 ;; ignore clock entries. 5819 (catch :skip 5820 (save-match-data 5821 (when (or (org-at-date-range-p) 5822 (org-at-planning-p) 5823 (org-before-first-heading-p) 5824 (and org-agenda-include-inactive-timestamps 5825 (org-at-clock-log-p)) 5826 (not (org-at-timestamp-p 'agenda))) 5827 (throw :skip nil)) 5828 (org-agenda-skip (org-element-at-point))) 5829 (let* ((pos (match-beginning 0)) 5830 (repeat (match-string 1)) 5831 (sexp-entry (match-string 3)) 5832 (time-stamp (if (or repeat sexp-entry) (match-string 0) 5833 (save-excursion 5834 (goto-char pos) 5835 (looking-at org-ts-regexp-both) 5836 (match-string 0)))) 5837 (todo-state (org-get-todo-state)) 5838 (warntime (get-text-property (point) 'org-appt-warntime)) 5839 (done? (member todo-state org-done-keywords))) 5840 ;; Possibly skip done tasks. 5841 (when (and done? org-agenda-skip-timestamp-if-done) 5842 (throw :skip t)) 5843 ;; S-exp entry doesn't match current day: skip it. 5844 (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date))) 5845 (throw :skip nil)) 5846 (when repeat 5847 (let* ((past 5848 ;; A repeating time stamp is shown at its base 5849 ;; date and every repeated date up to TODAY. If 5850 ;; `org-agenda-prefer-last-repeat' is non-nil, 5851 ;; however, only the last repeat before today 5852 ;; (inclusive) is shown. 5853 (org-agenda--timestamp-to-absolute 5854 repeat 5855 (if (or (> current today) 5856 (eq org-agenda-prefer-last-repeat t) 5857 (member todo-state org-agenda-prefer-last-repeat)) 5858 today 5859 current) 5860 'past (current-buffer) pos)) 5861 (future 5862 ;; Display every repeated date past TODAY 5863 ;; (exclusive) unless 5864 ;; `org-agenda-show-future-repeats' is nil. If 5865 ;; this variable is set to `next', only display 5866 ;; the first repeated date after TODAY 5867 ;; (exclusive). 5868 (cond 5869 ((<= current today) past) 5870 ((not org-agenda-show-future-repeats) past) 5871 (t 5872 (let ((base (if (eq org-agenda-show-future-repeats 'next) 5873 (1+ today) 5874 current))) 5875 (org-agenda--timestamp-to-absolute 5876 repeat base 'future (current-buffer) pos)))))) 5877 (when (and (/= current past) (/= current future)) 5878 (throw :skip nil)))) 5879 (save-excursion 5880 (re-search-backward org-outline-regexp-bol nil t) 5881 ;; Possibly skip time-stamp when a deadline is set. 5882 (when (and org-agenda-skip-timestamp-if-deadline-is-shown 5883 (assq (point) deadline-position-alist)) 5884 (throw :skip nil)) 5885 (let* ((category (org-get-category pos)) 5886 (effort (org-entry-get pos org-effort-property)) 5887 (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 5888 (inherited-tags 5889 (or (eq org-agenda-show-inherited-tags 'always) 5890 (and (consp org-agenda-show-inherited-tags) 5891 (memq 'agenda org-agenda-show-inherited-tags)) 5892 (and (eq org-agenda-show-inherited-tags t) 5893 (or (eq org-agenda-use-tag-inheritance t) 5894 (memq 'agenda 5895 org-agenda-use-tag-inheritance))))) 5896 (tags (org-get-tags nil (not inherited-tags))) 5897 (level (make-string (org-reduced-level (org-outline-level)) 5898 ?\s)) 5899 (head (and (looking-at "\\*+[ \t]+\\(.*\\)") 5900 (match-string 1))) 5901 (inactive? (= (char-after pos) ?\[)) 5902 (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p))) 5903 (item 5904 (org-agenda-format-item 5905 (and inactive? org-agenda-inactive-leader) 5906 (org-add-props head nil 5907 'effort effort 5908 'effort-minutes effort-minutes) 5909 level category tags time-stamp org-ts-regexp habit?))) 5910 (org-add-props item props 5911 'priority (if habit? 5912 (org-habit-get-priority (org-habit-parse-todo)) 5913 (org-get-priority item)) 5914 'org-marker (org-agenda-new-marker pos) 5915 'org-hd-marker (org-agenda-new-marker) 5916 'date date 5917 'level level 5918 'effort effort 'effort-minutes effort-minutes 5919 'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat) 5920 current) 5921 'todo-state todo-state 5922 'warntime warntime 5923 'type "timestamp") 5924 (push item timestamp-items)))) 5925 (when org-agenda-skip-additional-timestamps-same-entry 5926 (outline-next-heading)))) 5927 (nreverse timestamp-items))) 5928 5929 (defun org-agenda-get-sexps () 5930 "Return the sexp information for agenda display." 5931 (require 'diary-lib) 5932 (with-no-warnings (defvar date) (defvar entry)) 5933 (let* ((props (list 'face 'org-agenda-calendar-sexp 5934 'mouse-face 'highlight 5935 'help-echo 5936 (format "mouse-2 or RET jump to org file %s" 5937 (abbreviate-file-name buffer-file-name)))) 5938 (regexp "^&?%%(") 5939 ;; FIXME: Is this `entry' binding intended to be dynamic, 5940 ;; so as to "hide" any current binding for it? 5941 marker category extra level ee txt tags entry 5942 result beg b sexp sexp-entry todo-state warntime inherited-tags 5943 effort effort-minutes) 5944 (goto-char (point-min)) 5945 (while (re-search-forward regexp nil t) 5946 (catch :skip 5947 ;; We do not run `org-agenda-skip' right away because every single sexp 5948 ;; in the buffer is matched here, unlike day-specific search 5949 ;; in ordinary timestamps. Most of the sexps will not match 5950 ;; the agenda day and it is quicker to run `org-agenda-skip' only for 5951 ;; matching sexps later on. 5952 (setq beg (match-beginning 0)) 5953 (goto-char (1- (match-end 0))) 5954 (setq b (point)) 5955 (forward-sexp 1) 5956 (setq sexp (buffer-substring b (point))) 5957 (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)") 5958 (buffer-substring 5959 (match-beginning 1) 5960 (save-excursion 5961 (goto-char (match-end 1)) 5962 (skip-chars-backward "[:blank:]") 5963 (point))) 5964 "")) 5965 (setq result (org-diary-sexp-entry sexp sexp-entry date)) 5966 (when result 5967 ;; Only check if entry should be skipped on matching sexps. 5968 (org-agenda-skip (org-element-at-point)) 5969 (setq marker (org-agenda-new-marker beg) 5970 level (make-string (org-reduced-level (org-outline-level)) ? ) 5971 category (org-get-category beg) 5972 effort (save-match-data (or (get-text-property (point) 'effort) 5973 (org-entry-get (point) org-effort-property))) 5974 inherited-tags 5975 (or (eq org-agenda-show-inherited-tags 'always) 5976 (and (listp org-agenda-show-inherited-tags) 5977 (memq 'agenda org-agenda-show-inherited-tags)) 5978 (and (eq org-agenda-show-inherited-tags t) 5979 (or (eq org-agenda-use-tag-inheritance t) 5980 (memq 'agenda org-agenda-use-tag-inheritance)))) 5981 tags (org-get-tags nil (not inherited-tags)) 5982 todo-state (org-get-todo-state) 5983 warntime (get-text-property (point) 'org-appt-warntime) 5984 extra nil) 5985 (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 5986 5987 (dolist (r (if (stringp result) 5988 (list result) 5989 result)) ;; we expect a list here 5990 (when (and org-agenda-diary-sexp-prefix 5991 (string-match org-agenda-diary-sexp-prefix r)) 5992 (setq extra (match-string 0 r) 5993 r (replace-match "" nil nil r))) 5994 (if (string-match "\\S-" r) 5995 (setq txt r) 5996 (setq txt "SEXP entry returned empty string")) 5997 (setq txt (org-agenda-format-item extra 5998 (org-add-props txt nil 5999 'effort effort 6000 'effort-minutes effort-minutes) 6001 level category tags 'time)) 6002 (org-add-props txt props 'org-marker marker 6003 'date date 'todo-state todo-state 6004 'effort effort 'effort-minutes effort-minutes 6005 'level level 'type "sexp" 'warntime warntime) 6006 (push txt ee))))) 6007 (nreverse ee))) 6008 6009 ;; Calendar sanity: define some functions that are independent of 6010 ;; `calendar-date-style'. 6011 (defun org-anniversary (year month day &optional mark) 6012 "Like `diary-anniversary', but with fixed (ISO) order of arguments." 6013 (with-no-warnings 6014 (let ((calendar-date-style 'iso)) 6015 (diary-anniversary year month day mark)))) 6016 (defun org-cyclic (N year month day &optional mark) 6017 "Like `diary-cyclic', but with fixed (ISO) order of arguments." 6018 (with-no-warnings 6019 (let ((calendar-date-style 'iso)) 6020 (diary-cyclic N year month day mark)))) 6021 (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark) 6022 "Like `diary-block', but with fixed (ISO) order of arguments." 6023 (with-no-warnings 6024 (let ((calendar-date-style 'iso)) 6025 (diary-block Y1 M1 D1 Y2 M2 D2 mark)))) 6026 (defun org-date (year month day &optional mark) 6027 "Like `diary-date', but with fixed (ISO) order of arguments." 6028 (with-no-warnings 6029 (let ((calendar-date-style 'iso)) 6030 (diary-date year month day mark)))) 6031 6032 ;; Define the `org-class' function 6033 (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks) 6034 "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. 6035 DAYNAME is a number between 0 (Sunday) and 6 (Saturday). 6036 SKIP-WEEKS is any number of ISO weeks in the block period for which the 6037 item should be skipped. If any of the SKIP-WEEKS arguments is the symbol 6038 `holidays', then any date that is known by the Emacs calendar to be a 6039 holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings, 6040 then those holidays will be skipped." 6041 (with-no-warnings (defvar date) (defvar entry)) 6042 (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1))) 6043 (date2 (calendar-absolute-from-gregorian (list m2 d2 y2))) 6044 (d (calendar-absolute-from-gregorian date)) 6045 (h (when skip-weeks (calendar-check-holidays date)))) 6046 (and 6047 (<= date1 d) 6048 (<= d date2) 6049 (= (calendar-day-of-week date) dayname) 6050 (or (not skip-weeks) 6051 (progn 6052 (require 'cal-iso) 6053 (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) 6054 (not (or (and h (memq 'holidays skip-weeks)) 6055 (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) 6056 entry))) 6057 6058 (defalias 'org-get-closed #'org-agenda-get-progress) 6059 (defun org-agenda-get-progress () 6060 "Return the logged TODO entries for agenda display." 6061 (with-no-warnings (defvar date)) 6062 (let* ((props (list 'mouse-face 'highlight 6063 'org-not-done-regexp org-not-done-regexp 6064 'org-todo-regexp org-todo-regexp 6065 'org-complex-heading-regexp org-complex-heading-regexp 6066 'help-echo 6067 (format "mouse-2 or RET jump to org file %s" 6068 (abbreviate-file-name buffer-file-name)))) 6069 (items (if (consp org-agenda-show-log-scoped) 6070 org-agenda-show-log-scoped 6071 (if (eq org-agenda-show-log-scoped 'clockcheck) 6072 '(clock) 6073 org-agenda-log-mode-items))) 6074 (parts 6075 (delq nil 6076 (list 6077 (when (memq 'closed items) (concat "\\<" org-closed-string)) 6078 (when (memq 'clock items) (concat "\\<" org-clock-string)) 6079 (when (memq 'state items) 6080 (format "- +State \"%s\".*?" org-todo-regexp))))) 6081 (parts-re (if parts (mapconcat #'identity parts "\\|") 6082 (error "`org-agenda-log-mode-items' is empty"))) 6083 (regexp (concat 6084 "\\(" parts-re "\\)" 6085 " *\\[" 6086 (regexp-quote 6087 (substring 6088 (format-time-string 6089 (org-time-stamp-format) 6090 (org-encode-time ; DATE bound by calendar 6091 0 0 0 (nth 1 date) (car date) (nth 2 date))) 6092 1 11)))) 6093 (org-agenda-search-headline-for-time nil) 6094 marker hdmarker priority category level tags closedp type 6095 statep clockp state ee txt extra timestr rest clocked inherited-tags 6096 effort effort-minutes) 6097 (goto-char (point-min)) 6098 (while (re-search-forward regexp nil t) 6099 (catch :skip 6100 (org-agenda-skip) 6101 (setq marker (org-agenda-new-marker (match-beginning 0)) 6102 closedp (equal (match-string 1) org-closed-string) 6103 statep (equal (string-to-char (match-string 1)) ?-) 6104 clockp (not (or closedp statep)) 6105 state (and statep (match-string 2)) 6106 category (org-get-category (match-beginning 0)) 6107 timestr (buffer-substring (match-beginning 0) (line-end-position)) 6108 effort (save-match-data (or (get-text-property (point) 'effort) 6109 (org-entry-get (point) org-effort-property)))) 6110 (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6111 (when (string-match "\\]" timestr) 6112 ;; substring should only run to end of time stamp 6113 (setq rest (substring timestr (match-end 0)) 6114 timestr (substring timestr 0 (match-end 0))) 6115 (if (and (not closedp) (not statep) 6116 (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" 6117 rest)) 6118 (progn (setq timestr (concat (substring timestr 0 -1) 6119 "-" (match-string 1 rest) "]")) 6120 (setq clocked (match-string 2 rest))) 6121 (setq clocked "-"))) 6122 (save-excursion 6123 (setq extra 6124 (cond 6125 ((not org-agenda-log-mode-add-notes) nil) 6126 (statep 6127 (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") 6128 (match-string 1))) 6129 (clockp 6130 (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") 6131 (match-string 1))))) 6132 (if (not (re-search-backward org-outline-regexp-bol nil t)) 6133 (throw :skip nil) 6134 (goto-char (match-beginning 0)) 6135 (setq hdmarker (org-agenda-new-marker) 6136 inherited-tags 6137 (or (eq org-agenda-show-inherited-tags 'always) 6138 (and (listp org-agenda-show-inherited-tags) 6139 (memq 'todo org-agenda-show-inherited-tags)) 6140 (and (eq org-agenda-show-inherited-tags t) 6141 (or (eq org-agenda-use-tag-inheritance t) 6142 (memq 'todo org-agenda-use-tag-inheritance)))) 6143 tags (org-get-tags nil (not inherited-tags)) 6144 level (make-string (org-reduced-level (org-outline-level)) ? )) 6145 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 6146 (setq txt (match-string 1)) 6147 (when extra 6148 (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt) 6149 (setq txt (concat (substring txt 0 (match-beginning 1)) 6150 " - " extra " " (match-string 2 txt))) 6151 (setq txt (concat txt " - " extra)))) 6152 (setq txt (org-agenda-format-item 6153 (cond 6154 (closedp "Closed: ") 6155 (statep (concat "State: (" state ")")) 6156 (t (concat "Clocked: (" clocked ")"))) 6157 (org-add-props txt nil 6158 'effort effort 6159 'effort-minutes effort-minutes) 6160 level category tags timestr))) 6161 (setq type (cond (closedp "closed") 6162 (statep "state") 6163 (t "clock"))) 6164 (setq priority 100000) 6165 (org-add-props txt props 6166 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 6167 'priority priority 'level level 6168 'effort effort 'effort-minutes effort-minutes 6169 'type type 'date date 6170 'undone-face 'org-warning 'done-face 'org-agenda-done) 6171 (push txt ee)) 6172 (goto-char (line-end-position)))) 6173 (nreverse ee))) 6174 6175 (defun org-agenda-show-clocking-issues () 6176 "Add overlays, showing issues with clocking. 6177 See also the user option `org-agenda-clock-consistency-checks'." 6178 (interactive) 6179 (let* ((pl org-agenda-clock-consistency-checks) 6180 (re (concat "^[ \t]*" 6181 org-clock-string 6182 "[ \t]+" 6183 "\\(\\[.*?\\]\\)" ; group 1 is first stamp 6184 "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second 6185 (tlstart 0.) 6186 (tlend 0.) 6187 (maxtime (org-duration-to-minutes 6188 (or (plist-get pl :max-duration) "24:00"))) 6189 (mintime (org-duration-to-minutes 6190 (or (plist-get pl :min-duration) 0))) 6191 (maxgap (org-duration-to-minutes 6192 ;; default 30:00 means never complain 6193 (or (plist-get pl :max-gap) "30:00"))) 6194 (gapok (mapcar #'org-duration-to-minutes 6195 (plist-get pl :gap-ok-around))) 6196 (def-face (or (plist-get pl :default-face) 6197 '((:background "DarkRed") (:foreground "white")))) 6198 issue face m te ts dt ov) 6199 (goto-char (point-min)) 6200 (while (re-search-forward " Clocked: +(\\(?:-\\|\\([0-9]+:[0-9]+\\)\\))" nil t) 6201 (setq issue nil face def-face) 6202 (catch 'next 6203 (setq m (org-get-at-bol 'org-marker) 6204 te nil ts nil) 6205 (unless (and m (markerp m)) 6206 (setq issue "No valid clock line") (throw 'next t)) 6207 (org-with-point-at m 6208 (save-excursion 6209 (goto-char (line-beginning-position)) 6210 (unless (looking-at re) 6211 (error "No valid Clock line") 6212 (throw 'next t)) 6213 (unless (match-end 3) 6214 (setq issue 6215 (format 6216 "No end time: (%s)" 6217 (org-duration-from-minutes 6218 (floor 6219 (- (float-time (org-current-time)) 6220 (float-time (org-time-string-to-time (match-string 1)))) 6221 60))) 6222 face (or (plist-get pl :no-end-time-face) face)) 6223 (throw 'next t)) 6224 (setq ts (match-string 1) 6225 te (match-string 3) 6226 ts (float-time (org-time-string-to-time ts)) 6227 te (float-time (org-time-string-to-time te)) 6228 dt (- te ts)))) 6229 (cond 6230 ((> dt (* 60 maxtime)) 6231 ;; a very long clocking chunk 6232 (setq issue (format "Clocking interval is very long: %s" 6233 (org-duration-from-minutes (floor dt 60))) 6234 face (or (plist-get pl :long-face) face))) 6235 ((< dt (* 60 mintime)) 6236 ;; a very short clocking chunk 6237 (setq issue (format "Clocking interval is very short: %s" 6238 (org-duration-from-minutes (floor dt 60))) 6239 face (or (plist-get pl :short-face) face))) 6240 ((and (> tlend 0) (< ts tlend)) 6241 ;; Two clock entries are overlapping 6242 (setq issue (format "Clocking overlap: %d minutes" 6243 (/ (- tlend ts) 60)) 6244 face (or (plist-get pl :overlap-face) face))) 6245 ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap)))) 6246 ;; There is a gap, lets see if we need to report it 6247 (unless (org-agenda-check-clock-gap tlend ts gapok) 6248 (setq issue (format "Clocking gap: %d minutes" 6249 (/ (- ts tlend) 60)) 6250 face (or (plist-get pl :gap-face) face)))) 6251 (t nil))) 6252 (setq tlend (or te tlend) tlstart (or ts tlstart)) 6253 (when issue 6254 ;; OK, there was some issue, add an overlay to show the issue 6255 (setq ov (make-overlay (line-beginning-position) (line-end-position))) 6256 (overlay-put ov 'before-string 6257 (concat 6258 (org-add-props 6259 (format "%-43s" (concat " " issue)) 6260 nil 6261 'face face) 6262 "\n")) 6263 (overlay-put ov 'evaporate t))))) 6264 6265 (defun org-agenda-check-clock-gap (t1 t2 ok-list) 6266 "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values." 6267 (catch 'exit 6268 (unless ok-list 6269 ;; there are no OK times for gaps... 6270 (throw 'exit nil)) 6271 (when (> (- (/ t2 36000) (/ t1 36000)) 24) 6272 ;; This is more than 24 hours, so it is OK. 6273 ;; because we have at least one OK time, that must be in the 6274 ;; 24 hour interval. 6275 (throw 'exit t)) 6276 ;; We have a shorter gap. 6277 ;; Now we have to get the minute of the day when these times are 6278 (let* ((t1dec (decode-time t1)) 6279 (t2dec (decode-time t2)) 6280 ;; compute the minute on the day 6281 (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec)))) 6282 (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec))))) 6283 (when (< min2 min1) 6284 ;; if min2 is smaller than min1, this means it is on the next day. 6285 ;; Wrap it to after midnight. 6286 (setq min2 (+ min2 1440))) 6287 ;; Now check if any of the OK times is in the gap 6288 (mapc (lambda (x) 6289 ;; Wrap the time to after midnight if necessary 6290 (when (< x min1) (setq x (+ x 1440))) 6291 ;; Check if in interval 6292 (and (<= min1 x) (>= min2 x) (throw 'exit t))) 6293 ok-list) 6294 ;; Nope, this gap is not OK 6295 nil))) 6296 6297 (defun org-agenda-get-deadlines (&optional with-hour) 6298 "Return the deadline information for agenda display. 6299 When WITH-HOUR is non-nil, only return deadlines with an hour 6300 specification like [h]h:mm." 6301 (with-no-warnings (defvar date)) 6302 (let* ((props (list 'mouse-face 'highlight 6303 'org-not-done-regexp org-not-done-regexp 6304 'org-todo-regexp org-todo-regexp 6305 'org-complex-heading-regexp org-complex-heading-regexp 6306 'help-echo 6307 (format "mouse-2 or RET jump to org file %s" 6308 (abbreviate-file-name buffer-file-name)))) 6309 (regexp (if with-hour 6310 org-deadline-time-hour-regexp 6311 org-deadline-time-regexp)) 6312 (today (org-today)) 6313 (today? (org-agenda-today-p date)) ; DATE bound by calendar. 6314 (current (calendar-absolute-from-gregorian date)) 6315 deadline-items) 6316 (goto-char (point-min)) 6317 (if (org-element--cache-active-p) 6318 (org-element-cache-map 6319 (lambda (el) 6320 (when (and (org-element-property :deadline el) 6321 (or (not with-hour) 6322 (org-element-property 6323 :hour-start 6324 (org-element-property :deadline el)) 6325 (org-element-property 6326 :hour-end 6327 (org-element-property :deadline el)))) 6328 (goto-char (org-element-property :contents-begin el)) 6329 (catch :skip 6330 (org-agenda-skip el) 6331 (let* ((s (substring (org-element-property 6332 :raw-value 6333 (org-element-property :deadline el)) 6334 1 -1)) 6335 (pos (save-excursion 6336 (goto-char (org-element-property :contents-begin el)) 6337 ;; We intentionally leave NOERROR 6338 ;; argument in `re-search-forward' nil. If 6339 ;; the search fails here, something went 6340 ;; wrong and we are looking at 6341 ;; non-matching headline. 6342 (re-search-forward regexp (line-end-position)) 6343 (1- (match-beginning 1)))) 6344 (todo-state (org-element-property :todo-keyword el)) 6345 (done? (eq 'done (org-element-property :todo-type el))) 6346 (sexp? (eq 'diary 6347 (org-element-property 6348 :type (org-element-property :deadline el)))) 6349 ;; DEADLINE is the deadline date for the entry. It is 6350 ;; either the base date or the last repeat, according 6351 ;; to `org-agenda-prefer-last-repeat'. 6352 (deadline 6353 (cond 6354 (sexp? (org-agenda--timestamp-to-absolute s current)) 6355 ((or (eq org-agenda-prefer-last-repeat t) 6356 (member todo-state org-agenda-prefer-last-repeat)) 6357 (org-agenda--timestamp-to-absolute 6358 s today 'past (current-buffer) pos)) 6359 (t (org-agenda--timestamp-to-absolute s)))) 6360 ;; REPEAT is the future repeat closest from CURRENT, 6361 ;; according to `org-agenda-show-future-repeats'. If 6362 ;; the latter is nil, or if the time stamp has no 6363 ;; repeat part, default to DEADLINE. 6364 (repeat 6365 (cond 6366 (sexp? deadline) 6367 ((<= current today) deadline) 6368 ((not org-agenda-show-future-repeats) deadline) 6369 (t 6370 (let ((base (if (eq org-agenda-show-future-repeats 'next) 6371 (1+ today) 6372 current))) 6373 (org-agenda--timestamp-to-absolute 6374 s base 'future (current-buffer) pos))))) 6375 (diff (- deadline current)) 6376 (suppress-prewarning 6377 (let ((scheduled 6378 (and org-agenda-skip-deadline-prewarning-if-scheduled 6379 (org-element-property 6380 :raw-value 6381 (org-element-property :scheduled el))))) 6382 (cond 6383 ((not scheduled) nil) 6384 ;; The current item has a scheduled date, so 6385 ;; evaluate its prewarning lead time. 6386 ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) 6387 ;; Use global prewarning-restart lead time. 6388 org-agenda-skip-deadline-prewarning-if-scheduled) 6389 ((eq org-agenda-skip-deadline-prewarning-if-scheduled 6390 'pre-scheduled) 6391 ;; Set pre-warning to no earlier than SCHEDULED. 6392 (min (- deadline 6393 (org-agenda--timestamp-to-absolute scheduled)) 6394 org-deadline-warning-days)) 6395 ;; Set pre-warning to deadline. 6396 (t 0)))) 6397 (wdays (or suppress-prewarning (org-get-wdays s)))) 6398 (cond 6399 ;; Only display deadlines at their base date, at future 6400 ;; repeat occurrences or in today agenda. 6401 ((= current deadline) nil) 6402 ((= current repeat) nil) 6403 ((not today?) (throw :skip nil)) 6404 ;; Upcoming deadline: display within warning period WDAYS. 6405 ((> deadline current) (when (> diff wdays) (throw :skip nil))) 6406 ;; Overdue deadline: warn about it for 6407 ;; `org-deadline-past-days' duration. 6408 (t (when (< org-deadline-past-days (- diff)) (throw :skip nil)))) 6409 ;; Possibly skip done tasks. 6410 (when (and done? 6411 (or org-agenda-skip-deadline-if-done 6412 (/= deadline current))) 6413 (throw :skip nil)) 6414 (save-excursion 6415 (goto-char (org-element-property :begin el)) 6416 (let* ((category (org-get-category)) 6417 (effort (save-match-data (or (get-text-property (point) 'effort) 6418 (org-element-property (intern (concat ":" (upcase org-effort-property))) el)))) 6419 (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6420 (level (make-string (org-element-property :level el) 6421 ?\s)) 6422 (head (save-excursion 6423 (goto-char (org-element-property :begin el)) 6424 (re-search-forward org-outline-regexp-bol) 6425 (buffer-substring-no-properties (point) (line-end-position)))) 6426 (inherited-tags 6427 (or (eq org-agenda-show-inherited-tags 'always) 6428 (and (listp org-agenda-show-inherited-tags) 6429 (memq 'agenda org-agenda-show-inherited-tags)) 6430 (and (eq org-agenda-show-inherited-tags t) 6431 (or (eq org-agenda-use-tag-inheritance t) 6432 (memq 'agenda 6433 org-agenda-use-tag-inheritance))))) 6434 (tags (org-get-tags el (not inherited-tags))) 6435 (time 6436 (cond 6437 ;; No time of day designation if it is only 6438 ;; a reminder. 6439 ((and (/= current deadline) (/= current repeat)) nil) 6440 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 6441 (concat (substring s (match-beginning 1)) " ")) 6442 (t 'time))) 6443 (item 6444 (org-agenda-format-item 6445 ;; Insert appropriate suffixes before deadlines. 6446 ;; Those only apply to today agenda. 6447 (pcase-let ((`(,now ,future ,past) 6448 org-agenda-deadline-leaders)) 6449 (cond 6450 ((and today? (< deadline today)) (format past (- diff))) 6451 ((and today? (> deadline today)) (format future diff)) 6452 (t now))) 6453 (org-add-props head nil 6454 'effort effort 6455 'effort-minutes effort-minutes) 6456 level category tags time)) 6457 (face (org-agenda-deadline-face 6458 (- 1 (/ (float diff) (max wdays 1))))) 6459 (upcoming? (and today? (> deadline today))) 6460 (warntime (get-text-property (point) 'org-appt-warntime))) 6461 (org-add-props item props 6462 'org-marker (org-agenda-new-marker pos) 6463 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 6464 'warntime warntime 6465 'level level 6466 'effort effort 'effort-minutes effort-minutes 6467 'ts-date deadline 6468 'priority 6469 ;; Adjust priority to today reminders about deadlines. 6470 ;; Overdue deadlines get the highest priority 6471 ;; increase, then imminent deadlines and eventually 6472 ;; more distant deadlines. 6473 (let ((adjust (if today? (- diff) 0))) 6474 (+ adjust (org-get-priority item))) 6475 'todo-state todo-state 6476 'type (if upcoming? "upcoming-deadline" "deadline") 6477 'date (if upcoming? date deadline) 6478 'face (if done? 'org-agenda-done face) 6479 'undone-face face 6480 'done-face 'org-agenda-done) 6481 (push item deadline-items))))))) 6482 :next-re regexp 6483 :fail-re regexp 6484 :narrow t) 6485 (while (re-search-forward regexp nil t) 6486 (catch :skip 6487 (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) 6488 (org-agenda-skip) 6489 (let* ((s (match-string 1)) 6490 (pos (1- (match-beginning 1))) 6491 (todo-state (save-match-data (org-get-todo-state))) 6492 (done? (member todo-state org-done-keywords)) 6493 (sexp? (string-prefix-p "%%" s)) 6494 ;; DEADLINE is the deadline date for the entry. It is 6495 ;; either the base date or the last repeat, according 6496 ;; to `org-agenda-prefer-last-repeat'. 6497 (deadline 6498 (cond 6499 (sexp? (org-agenda--timestamp-to-absolute s current)) 6500 ((or (eq org-agenda-prefer-last-repeat t) 6501 (member todo-state org-agenda-prefer-last-repeat)) 6502 (org-agenda--timestamp-to-absolute 6503 s today 'past (current-buffer) pos)) 6504 (t (org-agenda--timestamp-to-absolute s)))) 6505 ;; REPEAT is the future repeat closest from CURRENT, 6506 ;; according to `org-agenda-show-future-repeats'. If 6507 ;; the latter is nil, or if the time stamp has no 6508 ;; repeat part, default to DEADLINE. 6509 (repeat 6510 (cond 6511 (sexp? deadline) 6512 ((<= current today) deadline) 6513 ((not org-agenda-show-future-repeats) deadline) 6514 (t 6515 (let ((base (if (eq org-agenda-show-future-repeats 'next) 6516 (1+ today) 6517 current))) 6518 (org-agenda--timestamp-to-absolute 6519 s base 'future (current-buffer) pos))))) 6520 (diff (- deadline current)) 6521 (suppress-prewarning 6522 (let ((scheduled 6523 (and org-agenda-skip-deadline-prewarning-if-scheduled 6524 (org-entry-get nil "SCHEDULED")))) 6525 (cond 6526 ((not scheduled) nil) 6527 ;; The current item has a scheduled date, so 6528 ;; evaluate its prewarning lead time. 6529 ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) 6530 ;; Use global prewarning-restart lead time. 6531 org-agenda-skip-deadline-prewarning-if-scheduled) 6532 ((eq org-agenda-skip-deadline-prewarning-if-scheduled 6533 'pre-scheduled) 6534 ;; Set pre-warning to no earlier than SCHEDULED. 6535 (min (- deadline 6536 (org-agenda--timestamp-to-absolute scheduled)) 6537 org-deadline-warning-days)) 6538 ;; Set pre-warning to deadline. 6539 (t 0)))) 6540 (wdays (or suppress-prewarning (org-get-wdays s)))) 6541 (cond 6542 ;; Only display deadlines at their base date, at future 6543 ;; repeat occurrences or in today agenda. 6544 ((= current deadline) nil) 6545 ((= current repeat) nil) 6546 ((not today?) (throw :skip nil)) 6547 ;; Upcoming deadline: display within warning period WDAYS. 6548 ((> deadline current) (when (> diff wdays) (throw :skip nil))) 6549 ;; Overdue deadline: warn about it for 6550 ;; `org-deadline-past-days' duration. 6551 (t (when (< org-deadline-past-days (- diff)) (throw :skip nil)))) 6552 ;; Possibly skip done tasks. 6553 (when (and done? 6554 (or org-agenda-skip-deadline-if-done 6555 (/= deadline current))) 6556 (throw :skip nil)) 6557 (save-excursion 6558 (re-search-backward "^\\*+[ \t]+" nil t) 6559 (goto-char (match-end 0)) 6560 (let* ((category (org-get-category)) 6561 (effort (save-match-data (or (get-text-property (point) 'effort) 6562 (org-entry-get (point) org-effort-property)))) 6563 (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6564 (level (make-string (org-reduced-level (org-outline-level)) 6565 ?\s)) 6566 (head (buffer-substring-no-properties 6567 (point) (line-end-position))) 6568 (inherited-tags 6569 (or (eq org-agenda-show-inherited-tags 'always) 6570 (and (listp org-agenda-show-inherited-tags) 6571 (memq 'agenda org-agenda-show-inherited-tags)) 6572 (and (eq org-agenda-show-inherited-tags t) 6573 (or (eq org-agenda-use-tag-inheritance t) 6574 (memq 'agenda 6575 org-agenda-use-tag-inheritance))))) 6576 (tags (org-get-tags nil (not inherited-tags))) 6577 (time 6578 (cond 6579 ;; No time of day designation if it is only 6580 ;; a reminder. 6581 ((and (/= current deadline) (/= current repeat)) nil) 6582 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 6583 (concat (substring s (match-beginning 1)) " ")) 6584 (t 'time))) 6585 (item 6586 (org-agenda-format-item 6587 ;; Insert appropriate suffixes before deadlines. 6588 ;; Those only apply to today agenda. 6589 (pcase-let ((`(,now ,future ,past) 6590 org-agenda-deadline-leaders)) 6591 (cond 6592 ((and today? (< deadline today)) (format past (- diff))) 6593 ((and today? (> deadline today)) (format future diff)) 6594 (t now))) 6595 (org-add-props head nil 6596 'effort effort 6597 'effort-minutes effort-minutes) 6598 level category tags time)) 6599 (face (org-agenda-deadline-face 6600 (- 1 (/ (float diff) (max wdays 1))))) 6601 (upcoming? (and today? (> deadline today))) 6602 (warntime (get-text-property (point) 'org-appt-warntime))) 6603 (org-add-props item props 6604 'org-marker (org-agenda-new-marker pos) 6605 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 6606 'warntime warntime 6607 'level level 6608 'effort effort 'effort-minutes effort-minutes 6609 'ts-date deadline 6610 'priority 6611 ;; Adjust priority to today reminders about deadlines. 6612 ;; Overdue deadlines get the highest priority 6613 ;; increase, then imminent deadlines and eventually 6614 ;; more distant deadlines. 6615 (let ((adjust (if today? (- diff) 0))) 6616 (+ adjust (org-get-priority item))) 6617 'todo-state todo-state 6618 'type (if upcoming? "upcoming-deadline" "deadline") 6619 'date (if upcoming? date deadline) 6620 'face (if done? 'org-agenda-done face) 6621 'undone-face face 6622 'done-face 'org-agenda-done) 6623 (push item deadline-items))))))) 6624 (nreverse deadline-items))) 6625 6626 (defun org-agenda-deadline-face (fraction) 6627 "Return the face to displaying a deadline item. 6628 FRACTION is what fraction of the head-warning time has passed." 6629 (assoc-default fraction org-agenda-deadline-faces #'<=)) 6630 6631 (defun org-agenda-get-scheduled (&optional deadlines with-hour) 6632 "Return the scheduled information for agenda display. 6633 Optional argument DEADLINES is a list of deadline items to be 6634 displayed in agenda view. When WITH-HOUR is non-nil, only return 6635 scheduled items with an hour specification like [h]h:mm." 6636 (with-no-warnings (defvar date)) 6637 (let* ((props (list 'org-not-done-regexp org-not-done-regexp 6638 'org-todo-regexp org-todo-regexp 6639 'org-complex-heading-regexp org-complex-heading-regexp 6640 'done-face 'org-agenda-done 6641 'mouse-face 'highlight 6642 'help-echo 6643 (format "mouse-2 or RET jump to Org file %s" 6644 (abbreviate-file-name buffer-file-name)))) 6645 (regexp (if with-hour 6646 org-scheduled-time-hour-regexp 6647 org-scheduled-time-regexp)) 6648 (today (org-today)) 6649 (todayp (org-agenda-today-p date)) ; DATE bound by calendar. 6650 (current (calendar-absolute-from-gregorian date)) 6651 (deadline-pos 6652 (mapcar (lambda (d) 6653 (let ((m (get-text-property 0 'org-hd-marker d))) 6654 (and m (marker-position m)))) 6655 deadlines)) 6656 scheduled-items) 6657 (goto-char (point-min)) 6658 (if (org-element--cache-active-p) 6659 (org-element-cache-map 6660 (lambda (el) 6661 (when (and (org-element-property :scheduled el) 6662 (or (not with-hour) 6663 (org-element-property 6664 :hour-start 6665 (org-element-property :scheduled el)) 6666 (org-element-property 6667 :hour-end 6668 (org-element-property :scheduled el)))) 6669 (goto-char (org-element-property :contents-begin el)) 6670 (catch :skip 6671 (org-agenda-skip el) 6672 (let* ((s (substring (org-element-property 6673 :raw-value 6674 (org-element-property :scheduled el)) 6675 1 -1)) 6676 (pos (save-excursion 6677 (goto-char (org-element-property :contents-begin el)) 6678 ;; We intentionally leave NOERROR 6679 ;; argument in `re-search-forward' nil. If 6680 ;; the search fails here, something went 6681 ;; wrong and we are looking at 6682 ;; non-matching headline. 6683 (re-search-forward regexp (line-end-position)) 6684 (1- (match-beginning 1)))) 6685 (todo-state (org-element-property :todo-keyword el)) 6686 (donep (eq 'done (org-element-property :todo-type el))) 6687 (sexp? (eq 'diary 6688 (org-element-property 6689 :type (org-element-property :scheduled el)))) 6690 ;; SCHEDULE is the scheduled date for the entry. It is 6691 ;; either the bare date or the last repeat, according 6692 ;; to `org-agenda-prefer-last-repeat'. 6693 (schedule 6694 (cond 6695 (sexp? (org-agenda--timestamp-to-absolute s current)) 6696 ((or (eq org-agenda-prefer-last-repeat t) 6697 (member todo-state org-agenda-prefer-last-repeat)) 6698 (org-agenda--timestamp-to-absolute 6699 s today 'past (current-buffer) pos)) 6700 (t (org-agenda--timestamp-to-absolute s)))) 6701 ;; REPEAT is the future repeat closest from CURRENT, 6702 ;; according to `org-agenda-show-future-repeats'. If 6703 ;; the latter is nil, or if the time stamp has no 6704 ;; repeat part, default to SCHEDULE. 6705 (repeat 6706 (cond 6707 (sexp? schedule) 6708 ((<= current today) schedule) 6709 ((not org-agenda-show-future-repeats) schedule) 6710 (t 6711 (let ((base (if (eq org-agenda-show-future-repeats 'next) 6712 (1+ today) 6713 current))) 6714 (org-agenda--timestamp-to-absolute 6715 s base 'future (current-buffer) pos))))) 6716 (diff (- current schedule)) 6717 (warntime (get-text-property (point) 'org-appt-warntime)) 6718 (pastschedp (< schedule today)) 6719 (futureschedp (> schedule today)) 6720 (habitp (and (fboundp 'org-is-habit-p) 6721 (string= "habit" (org-element-property :STYLE el)))) 6722 (suppress-delay 6723 (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline 6724 (org-element-property 6725 :raw-value 6726 (org-element-property :deadline el))))) 6727 (cond 6728 ((not deadline) nil) 6729 ;; The current item has a deadline date, so 6730 ;; evaluate its delay time. 6731 ((integerp org-agenda-skip-scheduled-delay-if-deadline) 6732 ;; Use global delay time. 6733 (- org-agenda-skip-scheduled-delay-if-deadline)) 6734 ((eq org-agenda-skip-scheduled-delay-if-deadline 6735 'post-deadline) 6736 ;; Set delay to no later than DEADLINE. 6737 (min (- schedule 6738 (org-agenda--timestamp-to-absolute deadline)) 6739 org-scheduled-delay-days)) 6740 (t 0)))) 6741 (ddays 6742 (cond 6743 ;; Nullify delay when a repeater triggered already 6744 ;; and the delay is of the form --Xd. 6745 ((and (string-match-p "--[0-9]+[hdwmy]" s) 6746 (> schedule (org-agenda--timestamp-to-absolute s))) 6747 0) 6748 (suppress-delay 6749 (let ((org-scheduled-delay-days suppress-delay)) 6750 (org-get-wdays s t t))) 6751 (t (org-get-wdays s t))))) 6752 ;; Display scheduled items at base date (SCHEDULE), today if 6753 ;; scheduled before the current date, and at any repeat past 6754 ;; today. However, skip delayed items and items that have 6755 ;; been displayed for more than `org-scheduled-past-days'. 6756 (unless (and todayp 6757 habitp 6758 (bound-and-true-p org-habit-show-all-today)) 6759 (when (or (and (> ddays 0) (< diff ddays)) 6760 (> diff (or (and habitp org-habit-scheduled-past-days) 6761 org-scheduled-past-days)) 6762 (> schedule current) 6763 (and (/= current schedule) 6764 (/= current today) 6765 (/= current repeat))) 6766 (throw :skip nil))) 6767 ;; Possibly skip done tasks. 6768 (when (and donep 6769 (or org-agenda-skip-scheduled-if-done 6770 (/= schedule current))) 6771 (throw :skip nil)) 6772 ;; Skip entry if it already appears as a deadline, per 6773 ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This 6774 ;; doesn't apply to habits. 6775 (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown 6776 ((guard 6777 (or (not (memq (line-beginning-position 0) deadline-pos)) 6778 habitp)) 6779 nil) 6780 (`repeated-after-deadline 6781 (let ((deadline (time-to-days 6782 (when (org-element-property :deadline el) 6783 (org-time-string-to-time 6784 (org-element-property :deadline el)))))) 6785 (and (<= schedule deadline) (> current deadline)))) 6786 (`not-today pastschedp) 6787 (`t t) 6788 (_ nil)) 6789 (throw :skip nil)) 6790 ;; Skip habits if `org-habit-show-habits' is nil, or if we 6791 ;; only show them for today. Also skip done habits. 6792 (when (and habitp 6793 (or donep 6794 (not (bound-and-true-p org-habit-show-habits)) 6795 (and (not todayp) 6796 (bound-and-true-p 6797 org-habit-show-habits-only-for-today)))) 6798 (throw :skip nil)) 6799 (save-excursion 6800 (goto-char (org-element-property :begin el)) 6801 (let* ((category (org-get-category)) 6802 (effort (save-match-data 6803 (or (get-text-property (point) 'effort) 6804 (org-element-property (intern (concat ":" (upcase org-effort-property))) el)))) 6805 (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6806 (inherited-tags 6807 (or (eq org-agenda-show-inherited-tags 'always) 6808 (and (listp org-agenda-show-inherited-tags) 6809 (memq 'agenda org-agenda-show-inherited-tags)) 6810 (and (eq org-agenda-show-inherited-tags t) 6811 (or (eq org-agenda-use-tag-inheritance t) 6812 (memq 'agenda 6813 org-agenda-use-tag-inheritance))))) 6814 (tags (org-get-tags el (not inherited-tags))) 6815 (level (make-string (org-element-property :level el) 6816 ?\s)) 6817 (head (save-excursion 6818 (goto-char (org-element-property :begin el)) 6819 (re-search-forward org-outline-regexp-bol) 6820 (buffer-substring (point) (line-end-position)))) 6821 (time 6822 (cond 6823 ;; No time of day designation if it is only a 6824 ;; reminder, except for habits, which always show 6825 ;; the time of day. Habits are an exception 6826 ;; because if there is a time of day, that is 6827 ;; interpreted to mean they should usually happen 6828 ;; then, even if doing the habit was missed. 6829 ((and 6830 (not habitp) 6831 (/= current schedule) 6832 (/= current repeat)) 6833 nil) 6834 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 6835 (concat (substring s (match-beginning 1)) " ")) 6836 (t 'time))) 6837 (item 6838 (org-agenda-format-item 6839 (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders)) 6840 ;; Show a reminder of a past scheduled today. 6841 (if (and todayp pastschedp) 6842 (format past diff) 6843 first)) 6844 (org-add-props head nil 6845 'effort effort 6846 'effort-minutes effort-minutes) 6847 level category tags time nil habitp)) 6848 (face (cond ((and (not habitp) pastschedp) 6849 'org-scheduled-previously) 6850 ((and habitp futureschedp) 6851 'org-agenda-done) 6852 (todayp 'org-scheduled-today) 6853 (t 'org-scheduled))) 6854 (habitp (and habitp (org-habit-parse-todo (org-element-property :begin el))))) 6855 (org-add-props item props 6856 'undone-face face 6857 'face (if donep 'org-agenda-done face) 6858 'org-marker (org-agenda-new-marker pos) 6859 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 6860 'type (if pastschedp "past-scheduled" "scheduled") 6861 'date (if pastschedp schedule date) 6862 'ts-date schedule 6863 'warntime warntime 6864 'level level 6865 'effort effort 'effort-minutes effort-minutes 6866 'priority (if habitp (org-habit-get-priority habitp) 6867 (+ 99 diff (org-get-priority item))) 6868 'org-habit-p habitp 6869 'todo-state todo-state) 6870 (push item scheduled-items))))))) 6871 :next-re regexp 6872 :fail-re regexp 6873 :narrow t) 6874 (while (re-search-forward regexp nil t) 6875 (catch :skip 6876 (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) 6877 (org-agenda-skip) 6878 (let* ((s (match-string 1)) 6879 (pos (1- (match-beginning 1))) 6880 (todo-state (save-match-data (org-get-todo-state))) 6881 (donep (member todo-state org-done-keywords)) 6882 (sexp? (string-prefix-p "%%" s)) 6883 ;; SCHEDULE is the scheduled date for the entry. It is 6884 ;; either the bare date or the last repeat, according 6885 ;; to `org-agenda-prefer-last-repeat'. 6886 (schedule 6887 (cond 6888 (sexp? (org-agenda--timestamp-to-absolute s current)) 6889 ((or (eq org-agenda-prefer-last-repeat t) 6890 (member todo-state org-agenda-prefer-last-repeat)) 6891 (org-agenda--timestamp-to-absolute 6892 s today 'past (current-buffer) pos)) 6893 (t (org-agenda--timestamp-to-absolute s)))) 6894 ;; REPEAT is the future repeat closest from CURRENT, 6895 ;; according to `org-agenda-show-future-repeats'. If 6896 ;; the latter is nil, or if the time stamp has no 6897 ;; repeat part, default to SCHEDULE. 6898 (repeat 6899 (cond 6900 (sexp? schedule) 6901 ((<= current today) schedule) 6902 ((not org-agenda-show-future-repeats) schedule) 6903 (t 6904 (let ((base (if (eq org-agenda-show-future-repeats 'next) 6905 (1+ today) 6906 current))) 6907 (org-agenda--timestamp-to-absolute 6908 s base 'future (current-buffer) pos))))) 6909 (diff (- current schedule)) 6910 (warntime (get-text-property (point) 'org-appt-warntime)) 6911 (pastschedp (< schedule today)) 6912 (futureschedp (> schedule today)) 6913 (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p))) 6914 (suppress-delay 6915 (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline 6916 (org-entry-get nil "DEADLINE")))) 6917 (cond 6918 ((not deadline) nil) 6919 ;; The current item has a deadline date, so 6920 ;; evaluate its delay time. 6921 ((integerp org-agenda-skip-scheduled-delay-if-deadline) 6922 ;; Use global delay time. 6923 (- org-agenda-skip-scheduled-delay-if-deadline)) 6924 ((eq org-agenda-skip-scheduled-delay-if-deadline 6925 'post-deadline) 6926 ;; Set delay to no later than DEADLINE. 6927 (min (- schedule 6928 (org-agenda--timestamp-to-absolute deadline)) 6929 org-scheduled-delay-days)) 6930 (t 0)))) 6931 (ddays 6932 (cond 6933 ;; Nullify delay when a repeater triggered already 6934 ;; and the delay is of the form --Xd. 6935 ((and (string-match-p "--[0-9]+[hdwmy]" s) 6936 (> schedule (org-agenda--timestamp-to-absolute s))) 6937 0) 6938 (suppress-delay 6939 (let ((org-scheduled-delay-days suppress-delay)) 6940 (org-get-wdays s t t))) 6941 (t (org-get-wdays s t))))) 6942 ;; Display scheduled items at base date (SCHEDULE), today if 6943 ;; scheduled before the current date, and at any repeat past 6944 ;; today. However, skip delayed items and items that have 6945 ;; been displayed for more than `org-scheduled-past-days'. 6946 (unless (and todayp 6947 habitp 6948 (bound-and-true-p org-habit-show-all-today)) 6949 (when (or (and (> ddays 0) (< diff ddays)) 6950 (> diff (or (and habitp org-habit-scheduled-past-days) 6951 org-scheduled-past-days)) 6952 (> schedule current) 6953 (and (/= current schedule) 6954 (/= current today) 6955 (/= current repeat))) 6956 (throw :skip nil))) 6957 ;; Possibly skip done tasks. 6958 (when (and donep 6959 (or org-agenda-skip-scheduled-if-done 6960 (/= schedule current))) 6961 (throw :skip nil)) 6962 ;; Skip entry if it already appears as a deadline, per 6963 ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This 6964 ;; doesn't apply to habits. 6965 (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown 6966 ((guard 6967 (or (not (memq (line-beginning-position 0) deadline-pos)) 6968 habitp)) 6969 nil) 6970 (`repeated-after-deadline 6971 (let ((deadline (time-to-days 6972 (org-get-deadline-time (point))))) 6973 (and (<= schedule deadline) (> current deadline)))) 6974 (`not-today pastschedp) 6975 (`t t) 6976 (_ nil)) 6977 (throw :skip nil)) 6978 ;; Skip habits if `org-habit-show-habits' is nil, or if we 6979 ;; only show them for today. Also skip done habits. 6980 (when (and habitp 6981 (or donep 6982 (not (bound-and-true-p org-habit-show-habits)) 6983 (and (not todayp) 6984 (bound-and-true-p 6985 org-habit-show-habits-only-for-today)))) 6986 (throw :skip nil)) 6987 (save-excursion 6988 (re-search-backward "^\\*+[ \t]+" nil t) 6989 (goto-char (match-end 0)) 6990 (let* ((category (org-get-category)) 6991 (effort (save-match-data (or (get-text-property (point) 'effort) 6992 (org-entry-get (point) org-effort-property)))) 6993 (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6994 (inherited-tags 6995 (or (eq org-agenda-show-inherited-tags 'always) 6996 (and (listp org-agenda-show-inherited-tags) 6997 (memq 'agenda org-agenda-show-inherited-tags)) 6998 (and (eq org-agenda-show-inherited-tags t) 6999 (or (eq org-agenda-use-tag-inheritance t) 7000 (memq 'agenda 7001 org-agenda-use-tag-inheritance))))) 7002 (tags (org-get-tags nil (not inherited-tags))) 7003 (level (make-string (org-reduced-level (org-outline-level)) 7004 ?\s)) 7005 (head (buffer-substring (point) (line-end-position))) 7006 (time 7007 (cond 7008 ;; No time of day designation if it is only a 7009 ;; reminder, except for habits, which always show 7010 ;; the time of day. Habits are an exception 7011 ;; because if there is a time of day, that is 7012 ;; interpreted to mean they should usually happen 7013 ;; then, even if doing the habit was missed. 7014 ((and 7015 (not habitp) 7016 (/= current schedule) 7017 (/= current repeat)) 7018 nil) 7019 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 7020 (concat (substring s (match-beginning 1)) " ")) 7021 (t 'time))) 7022 (item 7023 (org-agenda-format-item 7024 (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders)) 7025 ;; Show a reminder of a past scheduled today. 7026 (if (and todayp pastschedp) 7027 (format past diff) 7028 first)) 7029 (org-add-props head nil 7030 'effort effort 7031 'effort-minutes effort-minutes) 7032 level category tags time nil habitp)) 7033 (face (cond ((and (not habitp) pastschedp) 7034 'org-scheduled-previously) 7035 ((and habitp futureschedp) 7036 'org-agenda-done) 7037 (todayp 'org-scheduled-today) 7038 (t 'org-scheduled))) 7039 (habitp (and habitp (org-habit-parse-todo)))) 7040 (org-add-props item props 7041 'undone-face face 7042 'face (if donep 'org-agenda-done face) 7043 'org-marker (org-agenda-new-marker pos) 7044 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 7045 'type (if pastschedp "past-scheduled" "scheduled") 7046 'date (if pastschedp schedule date) 7047 'ts-date schedule 7048 'warntime warntime 7049 'level level 7050 'effort effort 'effort-minutes effort-minutes 7051 'priority (if habitp (org-habit-get-priority habitp) 7052 (+ 99 diff (org-get-priority item))) 7053 'org-habit-p habitp 7054 'todo-state todo-state) 7055 (push item scheduled-items))))))) 7056 (nreverse scheduled-items))) 7057 7058 (defun org-agenda-get-blocks () 7059 "Return the date-range information for agenda display." 7060 (with-no-warnings (defvar date)) 7061 (let* ((props (list 'face nil 7062 'org-not-done-regexp org-not-done-regexp 7063 'org-todo-regexp org-todo-regexp 7064 'org-complex-heading-regexp org-complex-heading-regexp 7065 'mouse-face 'highlight 7066 'help-echo 7067 (format "mouse-2 or RET jump to org file %s" 7068 (abbreviate-file-name buffer-file-name)))) 7069 (regexp org-tr-regexp) 7070 (d0 (calendar-absolute-from-gregorian date)) 7071 marker hdmarker ee txt d1 d2 s1 s2 category 7072 level todo-state tags pos head donep inherited-tags 7073 effort effort-minutes) 7074 (goto-char (point-min)) 7075 (while (re-search-forward regexp nil t) 7076 (catch :skip 7077 (org-agenda-skip) 7078 (setq pos (point)) 7079 (let ((start-time (match-string 1)) 7080 (end-time (match-string 2))) 7081 (setq s1 (match-string 1) 7082 s2 (match-string 2) 7083 d1 (time-to-days 7084 (condition-case err 7085 (org-time-string-to-time s1) 7086 (error 7087 (error 7088 "Bad timestamp %S at %d in buffer %S\nError was: %s" 7089 s1 7090 pos 7091 (current-buffer) 7092 (error-message-string err))))) 7093 d2 (time-to-days 7094 (condition-case err 7095 (org-time-string-to-time s2) 7096 (error 7097 (error 7098 "Bad timestamp %S at %d in buffer %S\nError was: %s" 7099 s2 7100 pos 7101 (current-buffer) 7102 (error-message-string err)))))) 7103 (when (and (> (- d0 d1) -1) (> (- d2 d0) -1)) 7104 ;; Only allow days between the limits, because the normal 7105 ;; date stamps will catch the limits. 7106 (save-excursion 7107 (setq todo-state (org-get-todo-state)) 7108 (setq donep (member todo-state org-done-keywords)) 7109 (when (and donep org-agenda-skip-timestamp-if-done) 7110 (throw :skip t)) 7111 (setq marker (org-agenda-new-marker (point)) 7112 category (org-get-category)) 7113 (setq effort (save-match-data (or (get-text-property (point) 'effort) 7114 (org-entry-get (point) org-effort-property)))) 7115 (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 7116 (if (not (re-search-backward org-outline-regexp-bol nil t)) 7117 (throw :skip nil) 7118 (goto-char (match-beginning 0)) 7119 (setq hdmarker (org-agenda-new-marker (point)) 7120 inherited-tags 7121 (or (eq org-agenda-show-inherited-tags 'always) 7122 (and (listp org-agenda-show-inherited-tags) 7123 (memq 'agenda org-agenda-show-inherited-tags)) 7124 (and (eq org-agenda-show-inherited-tags t) 7125 (or (eq org-agenda-use-tag-inheritance t) 7126 (memq 'agenda org-agenda-use-tag-inheritance)))) 7127 tags (org-get-tags nil (not inherited-tags))) 7128 (setq level (make-string (org-reduced-level (org-outline-level)) ? )) 7129 (looking-at "\\*+[ \t]+\\(.*\\)") 7130 (setq head (match-string 1)) 7131 (let ((remove-re 7132 (if org-agenda-remove-timeranges-from-blocks 7133 (concat 7134 "<" (regexp-quote s1) ".*?>" 7135 "--" 7136 "<" (regexp-quote s2) ".*?>") 7137 nil))) 7138 (setq txt (org-agenda-format-item 7139 (format 7140 (nth (if (= d1 d2) 0 1) 7141 org-agenda-timerange-leaders) 7142 (1+ (- d0 d1)) (1+ (- d2 d1))) 7143 (org-add-props head nil 7144 'effort effort 7145 'effort-minutes effort-minutes) 7146 level category tags 7147 (save-match-data 7148 (let ((hhmm1 (and (string-match org-ts-regexp1 s1) 7149 (match-string 6 s1))) 7150 (hhmm2 (and (string-match org-ts-regexp1 s2) 7151 (match-string 6 s2)))) 7152 (cond ((string= hhmm1 hhmm2) 7153 (concat "<" start-time ">--<" end-time ">")) 7154 ((and (= d1 d0) (= d2 d0)) 7155 (concat "<" start-time ">--<" end-time ">")) 7156 ((= d1 d0) 7157 (concat "<" start-time ">")) 7158 ((= d2 d0) 7159 (concat "<" end-time ">"))))) 7160 remove-re)))) 7161 (org-add-props txt props 7162 'org-marker marker 'org-hd-marker hdmarker 7163 'type "block" 'date date 7164 'level level 7165 'effort effort 'effort-minutes effort-minutes 7166 'todo-state todo-state 7167 'priority (org-get-priority txt)) 7168 (push txt ee)))) 7169 (goto-char pos))) 7170 ;; Sort the entries by expiration date. 7171 (nreverse ee))) 7172 7173 ;;; Agenda presentation and sorting 7174 7175 (defvar org-prefix-has-time nil 7176 "A flag, set by `org-compile-prefix-format'. 7177 The flag is set if the currently compiled format contains a `%t'.") 7178 (defvar org-prefix-has-tag nil 7179 "A flag, set by `org-compile-prefix-format'. 7180 The flag is set if the currently compiled format contains a `%T'.") 7181 (defvar org-prefix-has-effort nil 7182 "A flag, set by `org-compile-prefix-format'. 7183 The flag is set if the currently compiled format contains a `%e'.") 7184 (defvar org-prefix-has-breadcrumbs nil 7185 "A flag, set by `org-compile-prefix-format'. 7186 The flag is set if the currently compiled format contains a `%b'.") 7187 (defvar org-prefix-category-length nil 7188 "Used by `org-compile-prefix-format' to remember the category field width.") 7189 (defvar org-prefix-category-max-length nil 7190 "Used by `org-compile-prefix-format' to remember the category field width.") 7191 7192 (defun org-agenda-get-category-icon (category) 7193 "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." 7194 (cl-dolist (entry org-agenda-category-icon-alist) 7195 (when (string-match-p (car entry) category) 7196 (if (listp (cadr entry)) 7197 (cl-return (cadr entry)) 7198 (cl-return (apply #'create-image (cdr entry))))))) 7199 7200 (defun org-agenda-format-item (extra txt &optional with-level with-category tags dotime 7201 remove-re habitp) 7202 "Format TXT to be inserted into the agenda buffer. 7203 In particular, add the prefix and corresponding text properties. 7204 7205 EXTRA must be a string to replace the `%s' specifier in the prefix format. 7206 WITH-LEVEL may be a string to replace the `%l' specifier. 7207 WITH-CATEGORY (a string, a symbol or nil) may be used to overrule the default 7208 category taken from local variable or file name. It will replace the `%c' 7209 specifier in the format. 7210 DOTIME, when non-nil, indicates that a time-of-day should be extracted from 7211 TXT for sorting of this entry, and for the `%t' specifier in the format. 7212 When DOTIME is a string, this string is searched for a time before TXT is. 7213 TAGS can be the tags of the headline. 7214 Any match of REMOVE-RE will be removed from TXT." 7215 ;; We keep the org-prefix-* variable values along with a compiled 7216 ;; formatter, so that multiple agendas existing at the same time do 7217 ;; not step on each other toes. 7218 ;; 7219 ;; It was inconvenient to make these variables buffer local in 7220 ;; Agenda buffers, because this function expects to be called with 7221 ;; the buffer where item comes from being current, and not agenda 7222 ;; buffer 7223 (let* ((bindings (car org-prefix-format-compiled)) 7224 (formatter (cadr org-prefix-format-compiled))) 7225 (cl-loop for (var value) in bindings 7226 do (set var value)) 7227 (save-match-data 7228 ;; Diary entries sometimes have extra whitespace at the beginning 7229 (setq txt (org-trim txt)) 7230 7231 ;; Fix the tags part in txt 7232 (setq txt (org-agenda-fix-displayed-tags 7233 txt tags 7234 org-agenda-show-inherited-tags 7235 org-agenda-hide-tags-regexp)) 7236 7237 (with-no-warnings 7238 ;; `time', `tag', `effort' are needed for the eval of the prefix format. 7239 ;; Based on what I see in `org-compile-prefix-format', I added 7240 ;; a few more. 7241 (defvar breadcrumbs) (defvar category) (defvar category-icon) 7242 (defvar effort) (defvar extra) 7243 (defvar level) (defvar tag) (defvar time)) 7244 (let* ((category (or with-category 7245 (if buffer-file-name 7246 (file-name-sans-extension 7247 (file-name-nondirectory buffer-file-name)) 7248 ""))) 7249 (category-icon (org-agenda-get-category-icon category)) 7250 (category-icon (if category-icon 7251 (propertize " " 'display category-icon) 7252 "")) 7253 (effort (and (not (string= txt "")) 7254 (get-text-property 1 'effort txt))) 7255 (tag (if tags (nth (1- (length tags)) tags) "")) 7256 (time-grid-trailing-characters (nth 2 org-agenda-time-grid)) 7257 (extra (or (and (not habitp) extra) "")) 7258 time 7259 (ts (when dotime (concat 7260 (if (stringp dotime) dotime "") 7261 (and org-agenda-search-headline-for-time txt)))) 7262 (time-of-day (and dotime (org-get-time-of-day ts))) 7263 stamp plain s0 s1 s2 rtn srp l 7264 duration breadcrumbs) 7265 (and (derived-mode-p 'org-mode) buffer-file-name 7266 (add-to-list 'org-agenda-contributing-files buffer-file-name)) 7267 (when (and dotime time-of-day) 7268 ;; Extract starting and ending time and move them to prefix 7269 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) 7270 (setq plain (string-match org-plain-time-of-day-regexp ts))) 7271 (setq s0 (match-string 0 ts) 7272 srp (and stamp (match-end 3)) 7273 s1 (match-string (if plain 1 2) ts) 7274 s2 (match-string (if plain 8 (if srp 4 6)) ts)) 7275 7276 ;; If the times are in TXT (not in DOTIMES), and the prefix will list 7277 ;; them, we might want to remove them there to avoid duplication. 7278 ;; The user can turn this off with a variable. 7279 (when (and org-prefix-has-time 7280 org-agenda-remove-times-when-in-prefix (or stamp plain) 7281 (string-match (concat (regexp-quote s0) " *") txt) 7282 (not (equal ?\] (string-to-char (substring txt (match-end 0))))) 7283 (if (eq org-agenda-remove-times-when-in-prefix 'beg) 7284 (= (match-beginning 0) 0) 7285 t)) 7286 (setq txt (replace-match "" nil nil txt)))) 7287 ;; Normalize the time(s) to 24 hour. 7288 (when s1 (setq s1 (org-get-time-of-day s1 t))) 7289 (when s2 (setq s2 (org-get-time-of-day s2 t))) 7290 ;; Try to set s2 if s1 and 7291 ;; `org-agenda-default-appointment-duration' are set 7292 (when (and s1 (not s2) org-agenda-default-appointment-duration) 7293 (setq s2 7294 (org-duration-from-minutes 7295 (+ (org-duration-to-minutes s1 t) 7296 org-agenda-default-appointment-duration) 7297 nil t))) 7298 ;; Compute the duration 7299 (when s2 7300 (setq duration (- (org-duration-to-minutes s2) 7301 (org-duration-to-minutes s1)))) 7302 ;; Format S1 and S2 for display. 7303 (when s1 (setq s1 (format "%5s" (org-get-time-of-day s1 'overtime)))) 7304 (when s2 (setq s2 (org-get-time-of-day s2 'overtime)))) 7305 (when (string-match org-tag-group-re txt) 7306 ;; Tags are in the string 7307 (if (or (eq org-agenda-remove-tags t) 7308 (and org-agenda-remove-tags 7309 org-prefix-has-tag)) 7310 (setq txt (replace-match "" t t txt)) 7311 (setq txt (replace-match 7312 (concat (make-string (max (- 50 (length txt)) 1) ?\ ) 7313 (match-string 1 txt)) 7314 t t txt)))) 7315 7316 (when remove-re 7317 (while (string-match remove-re txt) 7318 (setq txt (replace-match "" t t txt)))) 7319 7320 ;; Set org-heading property on `txt' to mark the start of the 7321 ;; heading. 7322 (add-text-properties 0 (length txt) '(org-heading t) txt) 7323 7324 ;; Prepare the variables needed in the eval of the compiled format 7325 (when org-prefix-has-breadcrumbs 7326 (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker) 7327 (let ((s (org-format-outline-path (org-get-outline-path) 7328 (1- (frame-width)) 7329 nil org-agenda-breadcrumbs-separator))) 7330 (if (eq "" s) "" (concat s org-agenda-breadcrumbs-separator)))))) 7331 (setq time (cond (s2 (concat 7332 (org-agenda-time-of-day-to-ampm-maybe s1) 7333 "-" (org-agenda-time-of-day-to-ampm-maybe s2) 7334 (when org-agenda-timegrid-use-ampm " "))) 7335 (s1 (concat 7336 (org-agenda-time-of-day-to-ampm-maybe s1) 7337 (if org-agenda-timegrid-use-ampm 7338 (concat time-grid-trailing-characters " ") 7339 time-grid-trailing-characters))) 7340 (t "")) 7341 category (if (symbolp category) (symbol-name category) category) 7342 level (or with-level "")) 7343 (if (string-match org-link-bracket-re category) 7344 (progn 7345 (setq l (string-width (or (match-string 2) (match-string 1)))) 7346 (when (< l (or org-prefix-category-length 0)) 7347 (setq category (copy-sequence category)) 7348 (org-add-props category nil 7349 'extra-space (make-string 7350 (- org-prefix-category-length l 1) ?\ )))) 7351 (when (and org-prefix-category-max-length 7352 (>= (length category) org-prefix-category-max-length)) 7353 (setq category (substring category 0 (1- org-prefix-category-max-length))))) 7354 ;; Evaluate the compiled format 7355 (setq rtn (concat (eval formatter t) txt)) 7356 7357 ;; And finally add the text properties 7358 (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) 7359 (org-add-props rtn nil 7360 'org-category category 7361 'tags tags 7362 'org-priority-highest org-priority-highest 7363 'org-priority-lowest org-priority-lowest 7364 'time-of-day time-of-day 7365 'duration duration 7366 'breadcrumbs breadcrumbs 7367 'txt txt 7368 'level level 7369 'time time 7370 'extra extra 7371 'format org-prefix-format-compiled 7372 'dotime dotime))))) 7373 7374 (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) 7375 "Remove tags string from TXT, and add a modified list of tags. 7376 The modified list may contain inherited tags, and tags matched by 7377 `org-agenda-hide-tags-regexp' will be removed." 7378 (when (or add-inherited hide-re) 7379 (when (string-match org-tag-group-re txt) 7380 (setq txt (substring txt 0 (match-beginning 0)))) 7381 (setq tags 7382 (delq nil 7383 (mapcar (lambda (tg) 7384 (if (or (and hide-re (string-match hide-re tg)) 7385 (and (not add-inherited) 7386 (get-text-property 0 'inherited tg))) 7387 nil 7388 tg)) 7389 tags))) 7390 (when tags 7391 (let ((have-i (get-text-property 0 'inherited (car tags))) 7392 i) 7393 (setq txt (concat txt " :" 7394 (mapconcat 7395 (lambda (x) 7396 (setq i (get-text-property 0 'inherited x)) 7397 (if (and have-i (not i)) 7398 (progn 7399 (setq have-i nil) 7400 (concat ":" x)) 7401 x)) 7402 tags ":") 7403 (if have-i "::" ":")))))) 7404 txt) 7405 7406 (defvar org-agenda-sorting-strategy) ;; because the def is in a let form 7407 7408 (defun org-agenda-add-time-grid-maybe (list ndays todayp) 7409 "Add a time-grid for agenda items which need it. 7410 7411 LIST is the list of agenda items formatted by `org-agenda-list'. 7412 NDAYS is the span of the current agenda view. 7413 TODAYP is t when the current agenda view is on today." 7414 (catch 'exit 7415 (cond ((not org-agenda-use-time-grid) (throw 'exit list)) 7416 ((and todayp (member 'today (car org-agenda-time-grid)))) 7417 ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) 7418 ((member 'weekly (car org-agenda-time-grid))) 7419 (t (throw 'exit list))) 7420 (let* ((have (delq nil (mapcar 7421 (lambda (x) (get-text-property 1 'time-of-day x)) 7422 list))) 7423 (string (nth 3 org-agenda-time-grid)) 7424 (gridtimes (nth 1 org-agenda-time-grid)) 7425 (req (car org-agenda-time-grid)) 7426 (remove (member 'remove-match req)) 7427 new time) 7428 (when (and (member 'require-timed req) (not have)) 7429 ;; don't show empty grid 7430 (throw 'exit list)) 7431 (while (setq time (pop gridtimes)) 7432 (unless (and remove (member time have)) 7433 (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) 7434 (push (org-agenda-format-item 7435 nil string nil "" nil 7436 (concat (substring time 0 -2) ":" (substring time -2))) 7437 new) 7438 (put-text-property 7439 2 (length (car new)) 'face 'org-time-grid (car new)))) 7440 (when (and todayp org-agenda-show-current-time-in-grid) 7441 (push (org-agenda-format-item 7442 nil org-agenda-current-time-string nil "" nil 7443 (format-time-string "%H:%M ")) 7444 new) 7445 (put-text-property 7446 2 (length (car new)) 'face 'org-agenda-current-time (car new))) 7447 7448 (if (member 'time-up org-agenda-sorting-strategy-selected) 7449 (append new list) 7450 (append list new))))) 7451 7452 (defun org-compile-prefix-format (key) 7453 "Compile the prefix format into a Lisp form that can be evaluated. 7454 KEY is the agenda type (see `org-agenda-prefix-format'). 7455 The resulting form and associated variable bindings is returned 7456 and stored in the variable `org-prefix-format-compiled'." 7457 (setq org-prefix-has-time nil 7458 org-prefix-has-tag nil 7459 org-prefix-category-length nil 7460 org-prefix-has-effort nil 7461 org-prefix-has-breadcrumbs nil) 7462 (let ((s (cond 7463 ((stringp org-agenda-prefix-format) 7464 org-agenda-prefix-format) 7465 ((assq key org-agenda-prefix-format) 7466 (cdr (assq key org-agenda-prefix-format))) 7467 (t " %-12:c%?-12t% s"))) 7468 (start 0) 7469 varform vars var c f opt) ;; e 7470 (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)" 7471 s start) 7472 (setq var (or (cdr (assoc (match-string 4 s) 7473 '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) 7474 ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs)))) 7475 'eval) 7476 c (or (match-string 3 s) "") 7477 opt (match-beginning 1) 7478 start (1+ (match-beginning 0))) 7479 (cl-case var 7480 (time (setq org-prefix-has-time t)) 7481 (tag (setq org-prefix-has-tag t)) 7482 (effort (setq org-prefix-has-effort t)) 7483 (breadcrumbs (setq org-prefix-has-breadcrumbs t))) 7484 (setq f (concat "%" (match-string 2 s) "s")) 7485 (when (eq var 'category) 7486 (setq org-prefix-category-length 7487 (floor (abs (string-to-number (match-string 2 s))))) 7488 (setq org-prefix-category-max-length 7489 (let ((x (match-string 2 s))) 7490 (save-match-data 7491 (and (string-match "\\.[0-9]+" x) 7492 (string-to-number (substring (match-string 0 x) 1))))))) 7493 (if (eq var 'eval) 7494 (setq varform `(format ,f (org-eval ,(read (substring s (match-beginning 4)))))) 7495 (if opt 7496 (setq varform 7497 `(if (member ,var '("" nil)) 7498 "" 7499 (format ,f (concat ,var ,c)))) 7500 (setq varform 7501 `(format ,f (if (member ,var '("" nil)) "" 7502 (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) 7503 (if (eq var 'eval) 7504 (setf (substring s (match-beginning 0) 7505 (+ (match-beginning 4) 7506 (length (format "%S" (read (substring s (match-beginning 4))))))) 7507 "%s") 7508 (setq s (replace-match "%s" t nil s))) 7509 (push varform vars)) 7510 (setq vars (nreverse vars)) 7511 (with-current-buffer (or org-agenda-buffer (current-buffer)) 7512 (setq org-prefix-format-compiled 7513 (list 7514 `((org-prefix-has-time ,org-prefix-has-time) 7515 (org-prefix-has-tag ,org-prefix-has-tag) 7516 (org-prefix-category-length ,org-prefix-category-length) 7517 (org-prefix-has-effort ,org-prefix-has-effort) 7518 (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs)) 7519 `(format ,s ,@vars)))))) 7520 7521 (defun org-set-sorting-strategy (key) 7522 (setq org-agenda-sorting-strategy-selected 7523 (if (symbolp (car org-agenda-sorting-strategy)) 7524 ;; the old format 7525 org-agenda-sorting-strategy 7526 (or (cdr (assq key org-agenda-sorting-strategy)) 7527 (cdr (assq 'agenda org-agenda-sorting-strategy)) 7528 '(time-up category-keep priority-down))))) 7529 7530 (defun org-get-time-of-day (s &optional string) 7531 "Check string S for a time of day. 7532 7533 If found, return it as a military time number between 0 and 2400. 7534 If not found, return nil. 7535 7536 The optional STRING argument forces conversion into a 5 character wide string 7537 HH:MM. When it is `overtime', any time above 24:00 is turned into \"+H:MM\" 7538 where H:MM is the duration above midnight." 7539 (let ((case-fold-search t) 7540 (time-regexp 7541 (rx word-start 7542 (group (opt (any "012")) digit) ;group 1: hours 7543 (or (and ":" (group (any "012345") digit) ;group 2: minutes 7544 (opt (group (or "am" "pm")))) ;group 3: am/pm 7545 ;; Special "HHam/pm" case. 7546 (group-n 3 (or "am" "pm"))) 7547 word-end))) 7548 (save-match-data 7549 (when (and (string-match time-regexp s) 7550 (not (eq 'org-link (get-text-property 1 'face s)))) 7551 (let ((hours 7552 (let* ((ampm (and (match-end 3) (downcase (match-string 3 s)))) 7553 (am-p (equal ampm "am"))) 7554 (pcase (string-to-number (match-string 1 s)) 7555 ((and (guard (not ampm)) h) h) 7556 (12 (if am-p 0 12)) 7557 (h (+ h (if am-p 0 12)))))) 7558 (minutes 7559 (if (match-end 2) 7560 (string-to-number (match-string 2 s)) 7561 0))) 7562 (pcase string 7563 (`nil (+ minutes (* hours 100))) 7564 ((and `overtime 7565 (guard (or (> hours 24) 7566 (and (= hours 24) 7567 (> minutes 0))))) 7568 (format "+%d:%02d" (- hours 24) minutes)) 7569 ((guard org-agenda-time-leading-zero) 7570 (format "%02d:%02d" hours minutes)) 7571 (_ 7572 (format "%d:%02d" hours minutes)))))))) 7573 7574 (defvar org-agenda-before-sorting-filter-function nil 7575 "Function to be applied to agenda items prior to sorting. 7576 Prior to sorting also means just before they are inserted into the agenda. 7577 7578 To aid sorting, you may revisit the original entries and add more text 7579 properties which will later be used by the sorting functions. 7580 7581 The function should take a string argument, an agenda line. 7582 It has access to the text properties in that line, which contain among 7583 other things, the property `org-hd-marker' that points to the entry 7584 where the line comes from. Note that not all lines going into the agenda 7585 have this property, only most. 7586 7587 The function should return the modified string. It is probably best 7588 to ONLY change text properties. 7589 7590 You can also use this function as a filter, by returning nil for lines 7591 you don't want to have in the agenda at all. For this application, you 7592 could bind the variable in the options section of a custom command.") 7593 7594 (defun org-agenda-finalize-entries (list &optional type) 7595 "Sort, limit and concatenate the LIST of agenda items. 7596 The optional argument TYPE tells the agenda type." 7597 (let ((max-effort (cond ((listp org-agenda-max-effort) 7598 (cdr (assoc type org-agenda-max-effort))) 7599 (t org-agenda-max-effort))) 7600 (max-todo (cond ((listp org-agenda-max-todos) 7601 (cdr (assoc type org-agenda-max-todos))) 7602 (t org-agenda-max-todos))) 7603 (max-tags (cond ((listp org-agenda-max-tags) 7604 (cdr (assoc type org-agenda-max-tags))) 7605 (t org-agenda-max-tags))) 7606 (max-entries (cond ((listp org-agenda-max-entries) 7607 (cdr (assoc type org-agenda-max-entries))) 7608 (t org-agenda-max-entries)))) 7609 (when org-agenda-before-sorting-filter-function 7610 (setq list 7611 (delq nil 7612 (mapcar 7613 org-agenda-before-sorting-filter-function list)))) 7614 (setq list (mapcar #'org-agenda-highlight-todo list) 7615 list (mapcar #'identity (sort list #'org-entries-lessp))) 7616 (when max-effort 7617 (setq list (org-agenda-limit-entries 7618 list 'effort-minutes max-effort 7619 (lambda (e) (or e (if org-agenda-sort-noeffort-is-high 7620 32767 -1)))))) 7621 (when max-todo 7622 (setq list (org-agenda-limit-entries list 'todo-state max-todo))) 7623 (when max-tags 7624 (setq list (org-agenda-limit-entries list 'tags max-tags))) 7625 (when max-entries 7626 (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) 7627 (when (and org-agenda-dim-blocked-tasks org-blocker-hook) 7628 (setq list (mapcar #'org-agenda--mark-blocked-entry list))) 7629 (mapconcat #'identity list "\n"))) 7630 7631 (defun org-agenda-limit-entries (list prop limit &optional fn) 7632 "Limit the number of agenda entries." 7633 (let ((include (and limit (< limit 0)))) 7634 (if limit 7635 (let ((fun (or fn (lambda (p) (when p 1)))) 7636 (lim 0)) 7637 (delq nil 7638 (mapcar 7639 (lambda (e) 7640 (let ((pval (funcall 7641 fun (get-text-property (1- (length e)) 7642 prop e)))) 7643 (when pval (setq lim (+ lim pval))) 7644 (cond ((and pval (<= lim (abs limit))) e) 7645 ((and include (not pval)) e)))) 7646 list))) 7647 list))) 7648 7649 (defun org-agenda-limit-interactively (remove) 7650 "In agenda, interactively limit entries to various maximums." 7651 (interactive "P") 7652 (if remove 7653 (progn (setq org-agenda-max-entries nil 7654 org-agenda-max-todos nil 7655 org-agenda-max-tags nil 7656 org-agenda-max-effort nil) 7657 (org-agenda-redo)) 7658 (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) 7659 (msg (cond ((= max ?E) "How many minutes? ") 7660 ((= max ?e) "How many entries? ") 7661 ((= max ?t) "How many TODO entries? ") 7662 ((= max ?T) "How many tagged entries? ") 7663 (t (user-error "Wrong input")))) 7664 (num (string-to-number (read-from-minibuffer msg)))) 7665 (cond ((equal max ?e) 7666 (let ((org-agenda-max-entries num)) (org-agenda-redo))) 7667 ((equal max ?t) 7668 (let ((org-agenda-max-todos num)) (org-agenda-redo))) 7669 ((equal max ?T) 7670 (let ((org-agenda-max-tags num)) (org-agenda-redo))) 7671 ((equal max ?E) 7672 (let ((org-agenda-max-effort num)) (org-agenda-redo)))))) 7673 (org-agenda-fit-window-to-buffer)) 7674 7675 (defun org-agenda-highlight-todo (x) 7676 (let ((org-done-keywords org-done-keywords-for-agenda) 7677 (case-fold-search nil) 7678 re) 7679 (if (eq x 'line) 7680 (save-excursion 7681 (beginning-of-line 1) 7682 (setq re (org-get-at-bol 'org-todo-regexp)) 7683 (goto-char (or (text-property-any (line-beginning-position) 7684 (line-end-position) 7685 'org-heading t) 7686 (point))) 7687 (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) 7688 (add-text-properties (match-beginning 0) (match-end 1) 7689 (list 'face (org-get-todo-face 1))) 7690 (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) 7691 (delete-region (match-beginning 1) (1- (match-end 0))) 7692 (goto-char (match-beginning 1)) 7693 (insert (format org-agenda-todo-keyword-format s))))) 7694 (let ((pl (text-property-any 0 (length x) 'org-heading t x))) 7695 (setq re (get-text-property 0 'org-todo-regexp x)) 7696 (when (and re 7697 ;; Test `pl' because if there's no heading content, 7698 ;; there's no point matching to highlight. Note 7699 ;; that if we didn't test `pl' first, and there 7700 ;; happened to be no keyword from `org-todo-regexp' 7701 ;; on this heading line, then the `equal' comparison 7702 ;; afterwards would spuriously succeed in the case 7703 ;; where `pl' is nil -- causing an args-out-of-range 7704 ;; error when we try to add text properties to text 7705 ;; that isn't there. 7706 pl 7707 (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") 7708 x pl) 7709 pl)) 7710 (add-text-properties 7711 (or (match-end 1) (match-end 0)) (match-end 0) 7712 (list 'face (org-get-todo-face (match-string 2 x))) 7713 x) 7714 (when (match-end 1) 7715 (setq x 7716 (concat 7717 (substring x 0 (match-end 1)) 7718 (unless (string= org-agenda-todo-keyword-format "") 7719 (format org-agenda-todo-keyword-format 7720 (match-string 2 x))) 7721 (unless (string= org-agenda-todo-keyword-format "") 7722 ;; Remove `display' property as the icon could leak 7723 ;; on the white space. 7724 (org-add-props " " (org-plist-delete (text-properties-at 0 x) 7725 'display))) 7726 (substring x (match-end 3))))))) 7727 x))) 7728 7729 (defsubst org-cmp-values (a b property) 7730 "Compare the numeric value of text PROPERTY for string A and B." 7731 (let ((pa (or (get-text-property (1- (length a)) property a) 0)) 7732 (pb (or (get-text-property (1- (length b)) property b) 0))) 7733 (cond ((> pa pb) +1) 7734 ((< pa pb) -1)))) 7735 7736 (defsubst org-cmp-effort (a b) 7737 "Compare the effort values of string A and B." 7738 (let* ((def (if org-agenda-sort-noeffort-is-high 32767 -1)) 7739 ;; `effort-minutes' property is not directly accessible from 7740 ;; the strings, but is stored as a property in `txt'. 7741 (ea (or (get-text-property 7742 0 'effort-minutes (get-text-property 0 'txt a)) 7743 def)) 7744 (eb (or (get-text-property 7745 0 'effort-minutes (get-text-property 0 'txt b)) 7746 def))) 7747 (cond ((> ea eb) +1) 7748 ((< ea eb) -1)))) 7749 7750 (defsubst org-cmp-category (a b) 7751 "Compare the string values of categories of strings A and B." 7752 (let ((ca (or (get-text-property (1- (length a)) 'org-category a) "")) 7753 (cb (or (get-text-property (1- (length b)) 'org-category b) ""))) 7754 (cond ((string-lessp ca cb) -1) 7755 ((string-lessp cb ca) +1)))) 7756 7757 (defsubst org-cmp-todo-state (a b) 7758 "Compare the todo states of strings A and B." 7759 (let* ((ma (or (get-text-property 1 'org-marker a) 7760 (get-text-property 1 'org-hd-marker a))) 7761 (mb (or (get-text-property 1 'org-marker b) 7762 (get-text-property 1 'org-hd-marker b))) 7763 (fa (and ma (marker-buffer ma))) 7764 (fb (and mb (marker-buffer mb))) 7765 (todo-kwds 7766 (or (and fa (with-current-buffer fa org-todo-keywords-1)) 7767 (and fb (with-current-buffer fb org-todo-keywords-1)))) 7768 (ta (or (get-text-property 1 'todo-state a) "")) 7769 (tb (or (get-text-property 1 'todo-state b) "")) 7770 (la (- (length (member ta todo-kwds)))) 7771 (lb (- (length (member tb todo-kwds)))) 7772 (donepa (member ta org-done-keywords-for-agenda)) 7773 (donepb (member tb org-done-keywords-for-agenda))) 7774 (cond ((and donepa (not donepb)) -1) 7775 ((and (not donepa) donepb) +1) 7776 ((< la lb) -1) 7777 ((< lb la) +1)))) 7778 7779 (defsubst org-cmp-alpha (a b) 7780 "Compare the headlines, alphabetically." 7781 (let* ((pla (text-property-any 0 (length a) 'org-heading t a)) 7782 (plb (text-property-any 0 (length b) 'org-heading t b)) 7783 (ta (and pla (substring a pla))) 7784 (tb (and plb (substring b plb))) 7785 (case-fold-search nil)) 7786 (when pla 7787 (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") 7788 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") 7789 ta) 7790 (setq ta (substring ta (match-end 0)))) 7791 (setq ta (downcase ta))) 7792 (when plb 7793 (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") 7794 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") 7795 tb) 7796 (setq tb (substring tb (match-end 0)))) 7797 (setq tb (downcase tb))) 7798 (cond ((not (or ta tb)) nil) 7799 ((not ta) +1) 7800 ((not tb) -1) 7801 ((string-lessp ta tb) -1) 7802 ((string-lessp tb ta) +1)))) 7803 7804 (defsubst org-cmp-tag (a b) 7805 "Compare the string values of the first tags of A and B." 7806 (let ((ta (car (last (get-text-property 1 'tags a)))) 7807 (tb (car (last (get-text-property 1 'tags b))))) 7808 (cond ((not (or ta tb)) nil) 7809 ((not ta) +1) 7810 ((not tb) -1) 7811 ((string-lessp ta tb) -1) 7812 ((string-lessp tb ta) +1)))) 7813 7814 (defsubst org-cmp-time (a b) 7815 "Compare the time-of-day values of strings A and B." 7816 (let* ((def (if org-agenda-sort-notime-is-late 9901 -1)) 7817 (ta (or (get-text-property 1 'time-of-day a) def)) 7818 (tb (or (get-text-property 1 'time-of-day b) def))) 7819 (cond ((< ta tb) -1) 7820 ((< tb ta) +1)))) 7821 7822 (defsubst org-cmp-ts (a b type) 7823 "Compare the timestamps values of entries A and B. 7824 When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or 7825 \"timestamp_ia\", compare within each of these type. When TYPE 7826 is the empty string, compare all timestamps without respect of 7827 their type." 7828 (let* ((def (if org-agenda-sort-notime-is-late 99999999 -1)) 7829 (ta (or (and (string-match type (or (get-text-property 1 'type a) "")) 7830 (get-text-property 1 'ts-date a)) 7831 def)) 7832 (tb (or (and (string-match type (or (get-text-property 1 'type b) "")) 7833 (get-text-property 1 'ts-date b)) 7834 def))) 7835 (cond ((if ta (and tb (< ta tb)) tb) -1) 7836 ((if tb (and ta (< tb ta)) ta) +1)))) 7837 7838 (defsubst org-cmp-habit-p (a b) 7839 "Compare the todo states of strings A and B." 7840 (let ((ha (get-text-property 1 'org-habit-p a)) 7841 (hb (get-text-property 1 'org-habit-p b))) 7842 (cond ((and ha (not hb)) -1) 7843 ((and (not ha) hb) +1)))) 7844 7845 (defun org-entries-lessp (a b) 7846 "Predicate for sorting agenda entries." 7847 ;; The following variables will be used when the form is evaluated. 7848 ;; So even though the compiler complains, keep them. 7849 (let ((ss org-agenda-sorting-strategy-selected)) 7850 (org-dlet 7851 ((timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) 7852 (org-cmp-ts a b ""))) 7853 (timestamp-down (if timestamp-up (- timestamp-up) nil)) 7854 (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) 7855 (org-cmp-ts a b "scheduled"))) 7856 (scheduled-down (if scheduled-up (- scheduled-up) nil)) 7857 (deadline-up (and (org-em 'deadline-up 'deadline-down ss) 7858 (org-cmp-ts a b "deadline"))) 7859 (deadline-down (if deadline-up (- deadline-up) nil)) 7860 (tsia-up (and (org-em 'tsia-up 'tsia-down ss) 7861 (org-cmp-ts a b "timestamp_ia"))) 7862 (tsia-down (if tsia-up (- tsia-up) nil)) 7863 (ts-up (and (org-em 'ts-up 'ts-down ss) 7864 (org-cmp-ts a b "timestamp"))) 7865 (ts-down (if ts-up (- ts-up) nil)) 7866 (time-up (and (org-em 'time-up 'time-down ss) 7867 (org-cmp-time a b))) 7868 (time-down (if time-up (- time-up) nil)) 7869 (stats-up (and (org-em 'stats-up 'stats-down ss) 7870 (org-cmp-values a b 'org-stats))) 7871 (stats-down (if stats-up (- stats-up) nil)) 7872 (priority-up (and (org-em 'priority-up 'priority-down ss) 7873 (org-cmp-values a b 'priority))) 7874 (priority-down (if priority-up (- priority-up) nil)) 7875 (effort-up (and (org-em 'effort-up 'effort-down ss) 7876 (org-cmp-effort a b))) 7877 (effort-down (if effort-up (- effort-up) nil)) 7878 (category-up (and (or (org-em 'category-up 'category-down ss) 7879 (memq 'category-keep ss)) 7880 (org-cmp-category a b))) 7881 (category-down (if category-up (- category-up) nil)) 7882 (category-keep (if category-up +1 nil)) 7883 (tag-up (and (org-em 'tag-up 'tag-down ss) 7884 (org-cmp-tag a b))) 7885 (tag-down (if tag-up (- tag-up) nil)) 7886 (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) 7887 (org-cmp-todo-state a b))) 7888 (todo-state-down (if todo-state-up (- todo-state-up) nil)) 7889 (habit-up (and (org-em 'habit-up 'habit-down ss) 7890 (org-cmp-habit-p a b))) 7891 (habit-down (if habit-up (- habit-up) nil)) 7892 (alpha-up (and (org-em 'alpha-up 'alpha-down ss) 7893 (org-cmp-alpha a b))) 7894 (alpha-down (if alpha-up (- alpha-up) nil)) 7895 (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) 7896 user-defined-up user-defined-down) 7897 (when (and need-user-cmp org-agenda-cmp-user-defined 7898 (functionp org-agenda-cmp-user-defined)) 7899 (setq user-defined-up 7900 (funcall org-agenda-cmp-user-defined a b) 7901 user-defined-down (if user-defined-up (- user-defined-up) nil))) 7902 (cdr (assoc 7903 (eval (cons 'or org-agenda-sorting-strategy-selected) t) 7904 '((-1 . t) (1 . nil) (nil . nil))))))) 7905 7906 ;;; Agenda restriction lock 7907 7908 (defvar org-agenda-restriction-lock-overlay (make-overlay 1 1) 7909 "Overlay to mark the headline to which agenda commands are restricted.") 7910 (overlay-put org-agenda-restriction-lock-overlay 7911 'face 'org-agenda-restriction-lock) 7912 (overlay-put org-agenda-restriction-lock-overlay 7913 'help-echo "Agendas are currently limited to this subtree.") 7914 (delete-overlay org-agenda-restriction-lock-overlay) 7915 7916 (defun org-agenda-set-restriction-lock-from-agenda (arg) 7917 "Set the restriction lock to the agenda item at point from within the agenda. 7918 When called with a `\\[universal-argument]' prefix, restrict to 7919 the file which contains the item. 7920 Argument ARG is the prefix argument." 7921 (interactive "P") 7922 (unless (derived-mode-p 'org-agenda-mode) 7923 (user-error "Not in an Org agenda buffer")) 7924 (let* ((marker (or (org-get-at-bol 'org-marker) 7925 (org-agenda-error))) 7926 (buffer (marker-buffer marker)) 7927 (pos (marker-position marker))) 7928 (with-current-buffer buffer 7929 (goto-char pos) 7930 (org-agenda-set-restriction-lock arg)))) 7931 7932 ;;;###autoload 7933 (defun org-agenda-set-restriction-lock (&optional type) 7934 "Set restriction lock for agenda to current subtree or file. 7935 When in a restricted subtree, remove it. 7936 7937 The restriction will span over the entire file if TYPE is `file', 7938 or if TYPE is (4), or if the cursor is before the first headline 7939 in the file. Otherwise, only apply the restriction to the current 7940 subtree." 7941 (interactive "P") 7942 (if (and org-agenda-overriding-restriction 7943 (member org-agenda-restriction-lock-overlay 7944 (overlays-at (point))) 7945 (equal (overlay-start org-agenda-restriction-lock-overlay) 7946 (point))) 7947 (org-agenda-remove-restriction-lock 'noupdate) 7948 (org-agenda-remove-restriction-lock 'noupdate) 7949 (and (equal type '(4)) (setq type 'file)) 7950 (setq type (cond 7951 (type type) 7952 ((org-at-heading-p) 'subtree) 7953 ((condition-case nil (org-back-to-heading t) (error nil)) 7954 'subtree) 7955 (t 'file))) 7956 (if (eq type 'subtree) 7957 (progn 7958 (setq org-agenda-restrict (current-buffer)) 7959 (setq org-agenda-overriding-restriction 'subtree) 7960 (put 'org-agenda-files 'org-restrict 7961 (list (buffer-file-name (buffer-base-buffer)))) 7962 (org-back-to-heading t) 7963 (move-overlay org-agenda-restriction-lock-overlay 7964 (point) 7965 (if org-agenda-restriction-lock-highlight-subtree 7966 (save-excursion (org-end-of-subtree t t) (point)) 7967 (line-end-position))) 7968 (move-marker org-agenda-restrict-begin (point)) 7969 (move-marker org-agenda-restrict-end 7970 (save-excursion (org-end-of-subtree t t))) 7971 (message "Locking agenda restriction to subtree")) 7972 (put 'org-agenda-files 'org-restrict 7973 (list (buffer-file-name (buffer-base-buffer)))) 7974 (setq org-agenda-restrict t) 7975 (setq org-agenda-overriding-restriction 'file) 7976 (move-marker org-agenda-restrict-begin nil) 7977 (move-marker org-agenda-restrict-end nil) 7978 (message "Locking agenda restriction to file")) 7979 (setq current-prefix-arg nil)) 7980 (org-agenda-maybe-redo)) 7981 7982 (defun org-agenda-remove-restriction-lock (&optional noupdate) 7983 "Remove agenda restriction lock." 7984 (interactive "P") 7985 (if (not org-agenda-restrict) 7986 (message "No agenda restriction to remove.") 7987 (delete-overlay org-agenda-restriction-lock-overlay) 7988 (delete-overlay org-speedbar-restriction-lock-overlay) 7989 (setq org-agenda-overriding-restriction nil) 7990 (setq org-agenda-restrict nil) 7991 (put 'org-agenda-files 'org-restrict nil) 7992 (move-marker org-agenda-restrict-begin nil) 7993 (move-marker org-agenda-restrict-end nil) 7994 (setq current-prefix-arg nil) 7995 (message "Agenda restriction lock removed") 7996 (or noupdate (org-agenda-maybe-redo)))) 7997 7998 (defun org-agenda-maybe-redo () 7999 "If there is any window showing the agenda view, update it." 8000 (let ((w (get-buffer-window (or org-agenda-this-buffer-name 8001 org-agenda-buffer-name) 8002 t)) 8003 (w0 (selected-window))) 8004 (when w 8005 (select-window w) 8006 (org-agenda-redo) 8007 (select-window w0) 8008 (if org-agenda-overriding-restriction 8009 (message "Agenda view shifted to new %s restriction" 8010 org-agenda-overriding-restriction) 8011 (message "Agenda restriction lock removed"))))) 8012 8013 ;;; Agenda commands 8014 8015 (defun org-agenda-check-type (error &rest types) 8016 "Check if agenda buffer or component is of allowed type. 8017 If ERROR is non-nil, throw an error, otherwise just return nil. 8018 Allowed types are `agenda' `todo' `tags' `search'." 8019 (cond ((not org-agenda-type) 8020 (error "No Org agenda currently displayed")) 8021 ((memq org-agenda-type types) t) 8022 (error 8023 (error "Not allowed in '%s'-type agenda buffer or component" org-agenda-type)) 8024 (t nil))) 8025 8026 (defun org-agenda-Quit () 8027 "Exit the agenda, killing the agenda buffer. 8028 Like `org-agenda-quit', but kill the buffer even when 8029 `org-agenda-sticky' is non-nil." 8030 (interactive) 8031 (org-agenda--quit)) 8032 8033 (defun org-agenda-quit () 8034 "Exit the agenda. 8035 8036 When `org-agenda-sticky' is non-nil, bury the agenda buffer 8037 instead of killing it. 8038 8039 When `org-agenda-restore-windows-after-quit' is non-nil, restore 8040 the pre-agenda window configuration. 8041 8042 When column view is active, exit column view instead of the 8043 agenda." 8044 (interactive) 8045 (org-agenda--quit org-agenda-sticky)) 8046 8047 (defun org-agenda--quit (&optional bury) 8048 (if org-agenda-columns-active 8049 (org-columns-quit) 8050 (let ((wconf org-agenda-pre-window-conf) 8051 (buf (current-buffer)) 8052 (org-agenda-last-indirect-window 8053 (and (eq org-indirect-buffer-display 'other-window) 8054 org-agenda-last-indirect-buffer 8055 (get-buffer-window org-agenda-last-indirect-buffer)))) 8056 (cond 8057 ((eq org-agenda-window-setup 'other-frame) 8058 (delete-frame)) 8059 ((eq org-agenda-window-setup 'other-tab) 8060 (if (fboundp 'tab-bar-close-tab) 8061 (tab-bar-close-tab) 8062 (user-error "Your version of Emacs does not have tab bar mode support"))) 8063 ((and org-agenda-restore-windows-after-quit 8064 wconf) 8065 ;; Maybe restore the pre-agenda window configuration. Reset 8066 ;; `org-agenda-pre-window-conf' before running 8067 ;; `set-window-configuration', which loses the current buffer. 8068 (setq org-agenda-pre-window-conf nil) 8069 (set-window-configuration wconf)) 8070 (t 8071 (when org-agenda-last-indirect-window 8072 (delete-window org-agenda-last-indirect-window)) 8073 (and (not (eq org-agenda-window-setup 'current-window)) 8074 (not (one-window-p)) 8075 (delete-window)))) 8076 (if bury 8077 ;; Set the agenda buffer as the current buffer instead of 8078 ;; passing it as an argument to `bury-buffer' so that 8079 ;; `bury-buffer' removes it from the window. 8080 (with-current-buffer buf 8081 (bury-buffer)) 8082 (kill-buffer buf) 8083 (setq org-agenda-archives-mode nil 8084 org-agenda-buffer nil))))) 8085 8086 (defun org-agenda-exit () 8087 "Exit the agenda, killing Org buffers loaded by the agenda. 8088 Like `org-agenda-Quit', but kill any buffers that were created by 8089 the agenda. Org buffers visited directly by the user will not be 8090 touched. Also, exit the agenda even if it is in column view." 8091 (interactive) 8092 (when org-agenda-columns-active 8093 (org-columns-quit)) 8094 (org-release-buffers org-agenda-new-buffers) 8095 (setq org-agenda-new-buffers nil) 8096 (org-agenda-Quit)) 8097 8098 (defun org-agenda-kill-all-agenda-buffers () 8099 "Kill all buffers in `org-agenda-mode'. 8100 This is used when toggling sticky agendas." 8101 (interactive) 8102 (let (blist) 8103 (dolist (buf (buffer-list)) 8104 (when (with-current-buffer buf (eq major-mode 'org-agenda-mode)) 8105 (push buf blist))) 8106 (mapc #'kill-buffer blist))) 8107 8108 (defun org-agenda-execute (arg) 8109 "Execute another agenda command, keeping same window. 8110 So this is just a shortcut for \\<global-map>`\\[org-agenda]', available 8111 in the agenda." 8112 (interactive "P") 8113 (let ((org-agenda-window-setup 'current-window)) 8114 (org-agenda arg))) 8115 8116 (defun org-agenda-redo (&optional all) 8117 "Rebuild possibly ALL agenda view(s) in the current buffer." 8118 (interactive "P") 8119 (defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used? 8120 (let* ((p (or (and (looking-at "\\'") (1- (point))) (point))) 8121 (cpa (unless (eq all t) current-prefix-arg)) 8122 (org-agenda-doing-sticky-redo org-agenda-sticky) 8123 (org-agenda-sticky nil) 8124 (org-agenda-buffer-name (or org-agenda-this-buffer-name 8125 org-agenda-buffer-name)) 8126 (org-agenda-keep-modes t) 8127 (tag-filter org-agenda-tag-filter) 8128 (tag-preset (assoc-default 'tag org-agenda-filters-preset)) 8129 (top-hl-filter org-agenda-top-headline-filter) 8130 (cat-filter org-agenda-category-filter) 8131 (cat-preset (assoc-default 'category org-agenda-filters-preset)) 8132 (re-filter org-agenda-regexp-filter) 8133 (re-preset (assoc-default 'regexp org-agenda-filters-preset)) 8134 (effort-filter org-agenda-effort-filter) 8135 (effort-preset (assoc-default 'effort org-agenda-filters-preset)) 8136 (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) 8137 (cols org-agenda-columns-active) 8138 (line (org-current-line)) 8139 (window-line (- line (org-current-line (window-start)))) 8140 (lprops (get-text-property p 'org-lprops)) 8141 (redo-cmd (get-text-property p 'org-redo-cmd)) 8142 (last-args (get-text-property p 'org-last-args)) 8143 (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd)) 8144 (org-agenda-overriding-cmd-arguments 8145 (unless (eq all t) 8146 (cond ((listp last-args) 8147 (cons (or cpa (car last-args)) (cdr last-args))) 8148 ((stringp last-args) 8149 last-args)))) 8150 (series-redo-cmd (get-text-property p 'org-series-redo-cmd))) 8151 (and cols (org-columns-quit)) 8152 (message "Rebuilding agenda buffer...") 8153 (if series-redo-cmd 8154 (eval series-redo-cmd t) 8155 (cl-progv 8156 (mapcar #'car lprops) 8157 (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) 8158 (eval redo-cmd t)) 8159 (let ((inhibit-read-only t)) 8160 (add-text-properties (point-min) (point-max) `(org-lprops ,lprops)))) 8161 (setq org-agenda-undo-list nil 8162 org-agenda-pending-undo-list nil 8163 org-agenda-tag-filter tag-filter 8164 org-agenda-category-filter cat-filter 8165 org-agenda-regexp-filter re-filter 8166 org-agenda-effort-filter effort-filter 8167 org-agenda-top-headline-filter top-hl-filter) 8168 (message "Rebuilding agenda buffer...done") 8169 (let ((tag (or tag-filter tag-preset)) 8170 (cat (or cat-filter cat-preset)) 8171 (effort (or effort-filter effort-preset)) 8172 (re (or re-filter re-preset))) 8173 (when tag (org-agenda-filter-apply tag 'tag t)) 8174 (when cat (org-agenda-filter-apply cat 'category)) 8175 (when effort (org-agenda-filter-apply effort 'effort)) 8176 (when re (org-agenda-filter-apply re 'regexp))) 8177 (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) 8178 (and cols (called-interactively-p 'any) (org-agenda-columns)) 8179 (org-goto-line line) 8180 (when (called-interactively-p 'any) (recenter window-line)))) 8181 8182 (defun org-agenda-redo-all (&optional exhaustive) 8183 "Rebuild all agenda views in the current buffer. 8184 With a prefix argument, do so in all agenda buffers." 8185 (interactive "P") 8186 (if exhaustive 8187 (dolist (buffer (buffer-list)) 8188 (with-current-buffer buffer 8189 (when (derived-mode-p 'org-agenda-mode) 8190 (org-agenda-redo t)))) 8191 (org-agenda-redo t))) 8192 8193 (defvar org-global-tags-completion-table nil) 8194 (defvar org-agenda-filter-form nil) 8195 (defvar org-agenda-filtered-by-category nil) 8196 8197 (defsubst org-agenda-get-category () 8198 "Return the category of the agenda line." 8199 (org-get-at-bol 'org-category)) 8200 8201 (defun org-agenda-filter-by-category (strip) 8202 "Filter lines in the agenda buffer that have a specific category. 8203 The category is that of the current line. 8204 With a `\\[universal-argument]' prefix argument, exclude the lines of that category. 8205 When there is already a category filter in place, this command removes the 8206 filter." 8207 (interactive "P") 8208 (if (and org-agenda-filtered-by-category 8209 org-agenda-category-filter) 8210 (org-agenda-filter-show-all-cat) 8211 (let ((cat (org-no-properties (org-get-at-eol 'org-category 1)))) 8212 (cond 8213 ((and cat strip) 8214 (org-agenda-filter-apply 8215 (push (concat "-" cat) org-agenda-category-filter) 'category)) 8216 (cat 8217 (org-agenda-filter-apply 8218 (setq org-agenda-category-filter 8219 (list (concat "+" cat))) 8220 'category)) 8221 (t (error "No category at point")))))) 8222 8223 (defun org-find-top-headline (&optional pos) 8224 "Find the topmost parent headline and return it. 8225 POS when non-nil is the marker or buffer position to start the 8226 search from." 8227 (save-excursion 8228 (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) 8229 (when pos (goto-char pos)) 8230 ;; Skip up to the topmost parent. 8231 (while (org-up-heading-safe)) 8232 (ignore-errors 8233 (replace-regexp-in-string 8234 "^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" "" 8235 (nth 4 (org-heading-components))))))) 8236 8237 (defvar org-agenda-filtered-by-top-headline nil) 8238 (defun org-agenda-filter-by-top-headline (strip) 8239 "Keep only those lines that are descendants from the same top headline. 8240 The top headline is that of the current line. With prefix arg STRIP, hide 8241 all lines of the category at point." 8242 (interactive "P") 8243 (if org-agenda-filtered-by-top-headline 8244 (progn 8245 (setq org-agenda-filtered-by-top-headline nil 8246 org-agenda-top-headline-filter nil) 8247 (org-agenda-filter-show-all-top-filter)) 8248 (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker)))) 8249 (if toph (org-agenda-filter-top-headline-apply toph strip) 8250 (error "No top-level headline at point"))))) 8251 8252 (defvar org-agenda-regexp-filter nil) 8253 (defun org-agenda-filter-by-regexp (strip-or-accumulate) 8254 "Filter agenda entries by a regular expressions. 8255 You will be prompted for the regular expression, and the agenda 8256 view will only show entries that are matched by that expression. 8257 8258 With one `\\[universal-argument]' prefix argument, hide entries matching the regexp. 8259 When there is already a regexp filter active, this command removed the 8260 filter. However, with two `\\[universal-argument]' prefix arguments, add a new condition to 8261 an already existing regexp filter." 8262 (interactive "P") 8263 (let* ((strip (equal strip-or-accumulate '(4))) 8264 (accumulate (equal strip-or-accumulate '(16)))) 8265 (cond 8266 ((and org-agenda-regexp-filter (not accumulate)) 8267 (org-agenda-filter-show-all-re) 8268 (message "Regexp filter removed")) 8269 (t (let ((flt (concat (if strip "-" "+") 8270 (read-from-minibuffer 8271 (if strip 8272 "Hide entries matching regexp: " 8273 "Narrow to entries matching regexp: "))))) 8274 (push flt org-agenda-regexp-filter) 8275 (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)))))) 8276 8277 (defvar org-agenda-effort-filter nil) 8278 (defun org-agenda-filter-by-effort (strip-or-accumulate) 8279 "Filter agenda entries by effort. 8280 With no `\\[universal-argument]' prefix argument, keep entries matching the effort condition. 8281 With one `\\[universal-argument]' prefix argument, filter out entries matching the condition. 8282 With two `\\[universal-argument]' prefix arguments, add a second condition to the existing filter. 8283 This last option is in practice not very useful, but it is available for 8284 consistency with the other filter commands." 8285 (interactive "P") 8286 (let* ((efforts (split-string 8287 (or (cdr (assoc-string (concat org-effort-property "_ALL") 8288 org-global-properties 8289 t)) 8290 "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00"))) 8291 ;; XXX: the following handles only up to 10 different 8292 ;; effort values. 8293 (allowed-keys (if (null efforts) nil 8294 (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0 8295 (number-sequence 1 (length efforts))))) 8296 (keep (equal strip-or-accumulate '(16))) 8297 (negative (equal strip-or-accumulate '(4))) 8298 (current org-agenda-effort-filter) 8299 (op nil)) 8300 (while (not (memq op '(?< ?> ?= ?_))) 8301 (setq op (read-char-exclusive 8302 "Effort operator? (> = or <) or press `_' again to remove filter"))) 8303 ;; Select appropriate duration. Ignore non-digit characters. 8304 (if (eq op ?_) 8305 (progn 8306 (org-agenda-filter-show-all-effort) 8307 (message "Effort filter removed")) 8308 (let ((prompt 8309 (apply #'format 8310 (concat "Effort %c " 8311 (mapconcat (lambda (s) (concat "[%d]" s)) 8312 efforts 8313 " ")) 8314 op allowed-keys)) 8315 (eff -1)) 8316 (while (not (memq eff allowed-keys)) 8317 (message prompt) 8318 (setq eff (- (read-char-exclusive) 48))) 8319 (org-agenda-filter-show-all-effort) 8320 (setq org-agenda-effort-filter 8321 (append 8322 (list (concat (if negative "-" "+") 8323 (char-to-string op) 8324 ;; Numbering is 1 2 3 ... 9 0, but we want 8325 ;; 0 1 2 ... 8 9. 8326 (nth (mod (1- eff) 10) efforts))) 8327 (if keep current nil))) 8328 (org-agenda-filter-apply org-agenda-effort-filter 'effort))))) 8329 8330 (defun org-agenda-filter (&optional strip-or-accumulate) 8331 "Prompt for a general filter string and apply it to the agenda. 8332 8333 The string may contain filter elements like 8334 8335 +category 8336 +tag 8337 +<effort > and = are also allowed as effort operators 8338 +/regexp/ 8339 8340 Instead of `+', `-' is allowed to strip the agenda of matching entries. 8341 `+' is optional if it is not required to separate two string parts. 8342 Multiple filter elements can be concatenated without spaces, for example 8343 8344 +work-John<0:10-/plot/ 8345 8346 selects entries with category `work' and effort estimates below 10 minutes, 8347 and deselects entries with tag `John' or matching the regexp `plot'. 8348 8349 During entry of the filter, completion for tags, categories and effort 8350 values is offered. Since the syntax for categories and tags is identical 8351 there should be no overlap between categories and tags. If there is, tags 8352 get priority. 8353 8354 A single `\\[universal-argument]' prefix arg STRIP-OR-ACCUMULATE will negate the 8355 entire filter, which can be useful in connection with the prompt history. 8356 8357 A double `\\[universal-argument] \\[universal-argument]' prefix arg will add the new filter elements to the 8358 existing ones. A shortcut for this is to add an additional `+' at the 8359 beginning of the string, like `+-John'. 8360 8361 With a triple prefix argument, execute the computed filtering defined in 8362 the variable `org-agenda-auto-exclude-function'." 8363 (interactive "P") 8364 (if (equal strip-or-accumulate '(64)) 8365 ;; Execute the auto-exclude action 8366 (if (not org-agenda-auto-exclude-function) 8367 (user-error "`org-agenda-auto-exclude-function' is undefined") 8368 (org-agenda-filter-show-all-tag) 8369 (setq org-agenda-tag-filter nil) 8370 (dolist (tag (org-agenda-get-represented-tags)) 8371 (let ((modifier (funcall org-agenda-auto-exclude-function tag))) 8372 (when modifier 8373 (push modifier org-agenda-tag-filter)))) 8374 (unless (null org-agenda-tag-filter) 8375 (org-agenda-filter-apply org-agenda-tag-filter 'tag 'expand))) 8376 ;; Prompt for a filter and act 8377 (let* ((tag-list (org-agenda-get-represented-tags)) 8378 (category-list (org-agenda-get-represented-categories)) 8379 (negate (equal strip-or-accumulate '(4))) 8380 (cf (mapconcat #'identity org-agenda-category-filter "")) 8381 (tf (mapconcat #'identity org-agenda-tag-filter "")) 8382 ;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) "")))) 8383 (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) ""))) 8384 (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) ""))) 8385 (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/")))) 8386 (f-string (completing-read 8387 (concat 8388 (if negate "Negative filter" "Filter") 8389 " [+cat-tag<0:10-/regexp/]: ") 8390 #'org-agenda-filter-completion-function 8391 nil nil ff)) 8392 (keep (or (if (string-match "^\\+[+-]" f-string) 8393 (progn (setq f-string (substring f-string 1)) t)) 8394 (equal strip-or-accumulate '(16)))) 8395 (fc (if keep org-agenda-category-filter)) 8396 (ft (if keep org-agenda-tag-filter)) 8397 (fe (if keep org-agenda-effort-filter)) 8398 (fr (if keep org-agenda-regexp-filter)) 8399 pm s) 8400 ;; If the filter contains a double-quoted string, replace a 8401 ;; single hyphen by the arbitrary and temporary string "~~~" 8402 ;; to disambiguate such hyphens from syntactic ones. 8403 (setq f-string (replace-regexp-in-string 8404 "\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string)) 8405 (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string) 8406 (setq pm (if (match-beginning 1) (match-string 1 f-string) "+")) 8407 (when negate 8408 (setq pm (if (equal pm "+") "-" "+"))) 8409 (cond 8410 ((match-beginning 3) 8411 ;; category or tag 8412 (setq s (replace-regexp-in-string ; Remove the temporary special string. 8413 "~~~" "-" (match-string 3 f-string))) 8414 (cond 8415 ((member s tag-list) 8416 (org-pushnew-to-end (concat pm s) ft)) 8417 ((member s category-list) 8418 (org-pushnew-to-end (concat pm ; Remove temporary double quotes. 8419 (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s)) 8420 fc)) 8421 (t (message 8422 "`%s%s' filter ignored because tag/category is not represented" 8423 pm s)))) 8424 ((match-beginning 4) 8425 ;; effort 8426 (org-pushnew-to-end (concat pm (match-string 4 f-string)) fe)) 8427 ((match-beginning 5) 8428 ;; regexp 8429 (org-pushnew-to-end (concat pm (match-string 6 f-string)) fr))) 8430 (setq f-string (substring f-string (match-end 0)))) 8431 (org-agenda-filter-remove-all) 8432 (and fc (org-agenda-filter-apply 8433 (setq org-agenda-category-filter fc) 'category)) 8434 (and ft (org-agenda-filter-apply 8435 (setq org-agenda-tag-filter ft) 'tag 'expand)) 8436 (and fe (org-agenda-filter-apply 8437 (setq org-agenda-effort-filter fe) 'effort)) 8438 (and fr (org-agenda-filter-apply 8439 (setq org-agenda-regexp-filter fr) 'regexp)) 8440 (run-hooks 'org-agenda-filter-hook)))) 8441 8442 (defun org-agenda-filter-completion-function (string _predicate &optional flag) 8443 "Complete a complex filter string. 8444 FLAG specifies the type of completion operation to perform. This 8445 function is passed as a collection function to `completing-read', 8446 which see." 8447 (let ((completion-ignore-case t) ;tags are case-sensitive 8448 (confirm (lambda (x) (stringp x))) 8449 (prefix "") 8450 (operator "") 8451 table) 8452 (when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string) 8453 (setq prefix (match-string 1 string) 8454 operator (match-string 2 string) 8455 string (match-string 3 string))) 8456 (cond 8457 ((member operator '("+" "-" "" nil)) 8458 (setq table (append (org-agenda-get-represented-categories) 8459 (org-agenda-get-represented-tags)))) 8460 ((member operator '("<" ">" "=")) 8461 (setq table (split-string 8462 (or (cdr (assoc-string (concat org-effort-property "_ALL") 8463 org-global-properties 8464 t)) 8465 "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00") 8466 " +"))) 8467 (t (setq table nil))) 8468 (pcase flag 8469 (`t (all-completions string table confirm)) 8470 (`lambda (assoc string table)) ;exact match? 8471 (`nil 8472 (pcase (try-completion string table confirm) 8473 ((and completion (pred stringp)) 8474 (concat prefix completion)) 8475 (completion completion))) 8476 (_ nil)))) 8477 8478 (defun org-agenda-filter-remove-all () 8479 "Remove all filters from the current agenda buffer." 8480 (interactive) 8481 (when org-agenda-tag-filter 8482 (org-agenda-filter-show-all-tag)) 8483 (when org-agenda-category-filter 8484 (org-agenda-filter-show-all-cat)) 8485 (when org-agenda-regexp-filter 8486 (org-agenda-filter-show-all-re)) 8487 (when org-agenda-top-headline-filter 8488 (org-agenda-filter-show-all-top-filter)) 8489 (when org-agenda-effort-filter 8490 (org-agenda-filter-show-all-effort)) 8491 (org-agenda-finalize) 8492 (when (called-interactively-p 'interactive) 8493 (message "All agenda filters removed"))) 8494 8495 (defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude) 8496 "Keep only those lines in the agenda buffer that have a specific tag. 8497 8498 The tag is selected with its fast selection letter, as configured. 8499 8500 With a `\\[universal-argument]' prefix, apply the filter negatively, stripping all matches. 8501 8502 With a `\\[universal-argument] \\[universal-argument]' prefix, add the new tag to the existing filter 8503 instead of replacing it. 8504 8505 With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \ 8506 i.e. don't 8507 filter on all its group members. 8508 8509 A Lisp caller can specify CHAR. EXCLUDE means that the new tag 8510 should be used to exclude the search - the interactive user can 8511 also press `-' or `+' to switch between filtering and excluding." 8512 (interactive "P") 8513 (let* ((alist org-tag-alist-for-agenda) 8514 (seen-chars nil) 8515 (tag-chars (mapconcat 8516 (lambda (x) (if (and (not (symbolp (car x))) 8517 (cdr x) 8518 (not (member (cdr x) seen-chars))) 8519 (progn 8520 (push (cdr x) seen-chars) 8521 (char-to-string (cdr x))) 8522 "")) 8523 org-tag-alist-for-agenda "")) 8524 (valid-char-list (append '(?\t ?\r ?\\ ?. ?\s ?q) 8525 (string-to-list tag-chars))) 8526 (exclude (or exclude (equal strip-or-accumulate '(4)))) 8527 (accumulate (equal strip-or-accumulate '(16))) 8528 (expand (not (equal strip-or-accumulate '(64)))) 8529 (inhibit-read-only t) 8530 (current org-agenda-tag-filter) 8531 a tag) ;; n 8532 (unless char 8533 (while (not (memq char valid-char-list)) 8534 (org-unlogged-message 8535 "%s by tag%s: [%s ]tag-char [TAB]tag %s[\\]off [q]uit" 8536 (if exclude "Exclude[+]" "Filter[-]") 8537 (if expand "" " (no grouptag expand)") 8538 tag-chars 8539 (if org-agenda-auto-exclude-function "[RET] " "")) 8540 (setq char (read-char-exclusive)) 8541 ;; Excluding or filtering down 8542 (cond ((eq char ?-) (setq exclude t)) 8543 ((eq char ?+) (setq exclude nil))))) 8544 (when (eq char ?\t) 8545 (unless (local-variable-p 'org-global-tags-completion-table) 8546 (setq-local org-global-tags-completion-table 8547 (org-global-tags-completion-table))) 8548 (let ((completion-ignore-case t)) 8549 (setq tag (completing-read 8550 "Tag: " org-global-tags-completion-table nil t)))) 8551 (cond 8552 ((eq char ?\r) 8553 (org-agenda-filter-show-all-tag) 8554 (when org-agenda-auto-exclude-function 8555 (setq org-agenda-tag-filter nil) 8556 (dolist (tag (org-agenda-get-represented-tags)) 8557 (let ((modifier (funcall org-agenda-auto-exclude-function tag))) 8558 (when modifier 8559 (push modifier org-agenda-tag-filter)))) 8560 (unless (null org-agenda-tag-filter) 8561 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))) 8562 ((eq char ?\\) 8563 (org-agenda-filter-show-all-tag) 8564 (when (assoc-default 'tag org-agenda-filters-preset) 8565 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))) 8566 ((eq char ?.) 8567 (setq org-agenda-tag-filter 8568 (mapcar (lambda(tag) (concat "+" tag)) 8569 (org-get-at-bol 'tags))) 8570 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)) 8571 ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...) 8572 ((or (eq char ?\s) 8573 (setq a (rassoc char alist)) 8574 (and tag (setq a (cons tag nil)))) 8575 (org-agenda-filter-show-all-tag) 8576 (setq tag (car a)) 8577 (setq org-agenda-tag-filter 8578 (cons (concat (if exclude "-" "+") tag) 8579 (if accumulate current nil))) 8580 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)) 8581 (t (error "Invalid tag selection character %c" char))))) 8582 8583 (defun org-agenda-get-represented-categories () 8584 "Return a list of all categories used in this agenda buffer." 8585 (or org-agenda-represented-categories 8586 (when (derived-mode-p 'org-agenda-mode) 8587 (let ((pos (point-min)) categories) 8588 (while (and (< pos (point-max)) 8589 (setq pos (next-single-property-change 8590 pos 'org-category nil (point-max)))) 8591 (push (get-text-property pos 'org-category) categories)) 8592 (setq org-agenda-represented-categories 8593 ;; Enclose category names with a hyphen in double 8594 ;; quotes to process them specially in `org-agenda-filter'. 8595 (mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s)) 8596 (nreverse (org-uniquify (delq nil categories))))))))) 8597 8598 (defvar org-tag-groups-alist-for-agenda) 8599 (defun org-agenda-get-represented-tags () 8600 "Return a list of all tags used in this agenda buffer. 8601 These will be lower-case, for filtering." 8602 (or org-agenda-represented-tags 8603 (when (derived-mode-p 'org-agenda-mode) 8604 (let ((pos (point-min)) tags-lists tt) 8605 (while (and (< pos (point-max)) 8606 (setq pos (next-single-property-change 8607 pos 'tags nil (point-max)))) 8608 (setq tt (get-text-property pos 'tags)) 8609 (if tt (push tt tags-lists))) 8610 (setq tags-lists 8611 (nreverse (org-uniquify 8612 (delq nil (apply #'append tags-lists))))) 8613 (dolist (tag tags-lists) 8614 (mapc 8615 (lambda (group) 8616 (when (member tag group) 8617 (push (car group) tags-lists))) 8618 org-tag-groups-alist-for-agenda)) 8619 (setq org-agenda-represented-tags tags-lists))))) 8620 8621 (defun org-agenda-filter-make-matcher (filter type &optional expand) 8622 "Create the form that tests a line for agenda filter. 8623 Optional argument EXPAND can be used for the TYPE tag and will 8624 expand the tags in the FILTER if any of the tags in FILTER are 8625 grouptags." 8626 (let ((multi-pos-cats 8627 (and (eq type 'category) 8628 (string-match-p "\\+.*\\+" 8629 (mapconcat (lambda (cat) (substring cat 0 1)) 8630 filter "")))) 8631 f f1) 8632 (cond 8633 ;; Tag filter 8634 ((eq type 'tag) 8635 (setq filter 8636 (delete-dups 8637 (append (assoc-default 'tag org-agenda-filters-preset) 8638 filter))) 8639 (dolist (x filter) 8640 (let ((op (string-to-char x))) 8641 (if expand (setq x (org-agenda-filter-expand-tags (list x) t)) 8642 (setq x (list x))) 8643 (setq f1 (org-agenda-filter-make-matcher-tag-exp x op)) 8644 (push f1 f)))) 8645 ;; Category filter 8646 ((eq type 'category) 8647 (setq filter 8648 (delete-dups 8649 (append (assoc-default 'category org-agenda-filters-preset) 8650 filter))) 8651 (dolist (x filter) 8652 (if (equal "-" (substring x 0 1)) 8653 (setq f1 (list 'not (list 'equal (substring x 1) 'cat))) 8654 (setq f1 (list 'equal (substring x 1) 'cat))) 8655 (push f1 f))) 8656 ;; Regexp filter 8657 ((eq type 'regexp) 8658 (setq filter 8659 (delete-dups 8660 (append (assoc-default 'regexp org-agenda-filters-preset) 8661 filter))) 8662 (dolist (x filter) 8663 (if (equal "-" (substring x 0 1)) 8664 (setq f1 (list 'not (list 'string-match (substring x 1) 'txt))) 8665 (setq f1 (list 'string-match (substring x 1) 'txt))) 8666 (push f1 f))) 8667 ;; Effort filter 8668 ((eq type 'effort) 8669 (setq filter 8670 (delete-dups 8671 (append (assoc-default 'effort org-agenda-filters-preset) 8672 filter))) 8673 (dolist (x filter) 8674 (push (org-agenda-filter-effort-form x) f)))) 8675 (cons (if multi-pos-cats 'or 'and) (nreverse f)))) 8676 8677 (defun org-agenda-filter-make-matcher-tag-exp (tags op) 8678 "Return a form associated to tag-expression TAGS. 8679 Build a form testing a line for agenda filter for 8680 tag-expressions. OP is an operator of type CHAR that allows the 8681 function to set the right switches in the returned form." 8682 (let (form) 8683 ;; Any of the expressions can match if OP is +, all must match if 8684 ;; the operator is -. 8685 (dolist (x tags (cons (if (eq op ?-) 'and 'or) form)) 8686 (let* ((tag (substring x 1)) 8687 (f (cond 8688 ((string= "" tag) 'tags) 8689 ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag)) 8690 ;; TAG is a regexp. 8691 (list 'org-match-any-p (substring tag 1 -1) 'tags)) 8692 (t (list 'member tag 'tags))))) 8693 (push (if (eq op ?-) (list 'not f) f) form))))) 8694 8695 (defun org-agenda-filter-effort-form (e) 8696 "Return the form to compare the effort of the current line with what E says. 8697 E looks like \"+<2:25\"." 8698 (let (op) 8699 (setq e (substring e 1)) 8700 (setq op (string-to-char e) e (substring e 1)) 8701 (setq op (cond ((equal op ?<) '<=) 8702 ((equal op ?>) '>=) 8703 ((equal op ??) op) 8704 (t '=))) 8705 (list 'org-agenda-compare-effort (list 'quote op) 8706 (org-duration-to-minutes e)))) 8707 8708 (defun org-agenda-compare-effort (op value) 8709 "Compare the effort of the current line with VALUE, using OP. 8710 If the line does not have an effort defined, return nil." 8711 ;; `effort-minutes' property cannot be extracted directly from 8712 ;; current line but is stored as a property in `txt'. 8713 (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt)))) 8714 (funcall op 8715 (or effort (if org-agenda-sort-noeffort-is-high 32767 -1)) 8716 value))) 8717 8718 (defun org-agenda-filter-expand-tags (filter &optional no-operator) 8719 "Expand group tags in FILTER for the agenda. 8720 When NO-OPERATOR is non-nil, do not add the + operator to 8721 returned tags." 8722 (if org-group-tags 8723 (let (case-fold-search rtn) 8724 (mapc 8725 (lambda (f) 8726 (let (f0 dir) 8727 (if (string-match "^\\([+-]\\)\\(.+\\)" f) 8728 (setq dir (match-string 1 f) f0 (match-string 2 f)) 8729 (setq dir (if no-operator "" "+") f0 f)) 8730 (setq rtn (append (mapcar (lambda(f1) (concat dir f1)) 8731 (org-tags-expand f0 t)) 8732 rtn)))) 8733 filter) 8734 (reverse rtn)) 8735 filter)) 8736 8737 (defun org-agenda-filter-apply (filter type &optional expand) 8738 "Set FILTER as the new agenda filter and apply it. 8739 Optional argument EXPAND can be used for the TYPE tag and will 8740 expand the tags in the FILTER if any of the tags in FILTER are 8741 grouptags." 8742 ;; Deactivate `org-agenda-entry-text-mode' when filtering 8743 (when org-agenda-entry-text-mode (org-agenda-entry-text-mode)) 8744 (setq org-agenda-filter-form (org-agenda-filter-make-matcher 8745 filter type expand)) 8746 ;; Only set `org-agenda-filtered-by-category' to t when a unique 8747 ;; category is used as the filter: 8748 (setq org-agenda-filtered-by-category 8749 (and (eq type 'category) 8750 (not (equal (substring (car filter) 0 1) "-")))) 8751 (org-agenda-set-mode-name) 8752 (save-excursion 8753 (goto-char (point-min)) 8754 (while (not (eobp)) 8755 (when (or (org-get-at-bol 'org-hd-marker) 8756 (org-get-at-bol 'org-marker)) 8757 (org-dlet 8758 ((tags (org-get-at-bol 'tags)) 8759 (cat (org-agenda-get-category)) 8760 (txt (or (org-get-at-bol 'txt) ""))) 8761 (unless (eval org-agenda-filter-form t) 8762 (org-agenda-filter-hide-line type)))) 8763 (beginning-of-line 2))) 8764 (when (get-char-property (point) 'invisible) 8765 (ignore-errors (org-agenda-previous-line)))) 8766 8767 (defun org-agenda-filter-top-headline-apply (hl &optional negative) 8768 "Filter by top headline HL." 8769 (org-agenda-set-mode-name) 8770 (save-excursion 8771 (goto-char (point-min)) 8772 (while (not (eobp)) 8773 (let* ((pos (org-get-at-bol 'org-hd-marker)) 8774 (tophl (and pos (org-find-top-headline pos)))) 8775 (when (and tophl (funcall (if negative 'identity 'not) 8776 (string= hl tophl))) 8777 (org-agenda-filter-hide-line 'top-headline))) 8778 (beginning-of-line 2))) 8779 (when (get-char-property (point) 'invisible) 8780 (org-agenda-previous-line)) 8781 (setq org-agenda-top-headline-filter hl 8782 org-agenda-filtered-by-top-headline t)) 8783 8784 (defun org-agenda-filter-hide-line (type) 8785 "If current line is TYPE, hide it in the agenda buffer." 8786 (let* (buffer-invisibility-spec 8787 (beg (max (point-min) (1- (line-beginning-position)))) 8788 (end (line-end-position))) 8789 (let ((inhibit-read-only t)) 8790 (add-text-properties 8791 beg end `(invisible org-filtered org-filter-type ,type))))) 8792 8793 (defun org-agenda-remove-filter (type) 8794 "Remove filter of type TYPE from the agenda buffer." 8795 (interactive) 8796 (save-excursion 8797 (goto-char (point-min)) 8798 (let ((inhibit-read-only t) pos) 8799 (while (setq pos (text-property-any (point) (point-max) 8800 'org-filter-type type)) 8801 (goto-char pos) 8802 (remove-text-properties 8803 (point) (next-single-property-change (point) 'org-filter-type) 8804 `(invisible org-filtered org-filter-type ,type)))) 8805 (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil) 8806 (setq org-agenda-filter-form nil) 8807 (org-agenda-set-mode-name) 8808 (org-agenda-finalize))) 8809 8810 (defun org-agenda-filter-show-all-tag nil 8811 (org-agenda-remove-filter 'tag)) 8812 (defun org-agenda-filter-show-all-re nil 8813 (org-agenda-remove-filter 'regexp)) 8814 (defun org-agenda-filter-show-all-effort nil 8815 (org-agenda-remove-filter 'effort)) 8816 (defun org-agenda-filter-show-all-cat nil 8817 (org-agenda-remove-filter 'category)) 8818 (defun org-agenda-filter-show-all-top-filter nil 8819 (org-agenda-remove-filter 'top-headline)) 8820 8821 (defun org-agenda-manipulate-query-add () 8822 "Manipulate the query by adding a search term with positive selection. 8823 Positive selection means the term must be matched for selection of an entry." 8824 (interactive) 8825 (org-agenda-manipulate-query ?\[)) 8826 (defun org-agenda-manipulate-query-subtract () 8827 "Manipulate the query by adding a search term with negative selection. 8828 Negative selection means term must not be matched for selection of an entry." 8829 (interactive) 8830 (org-agenda-manipulate-query ?\])) 8831 (defun org-agenda-manipulate-query-add-re () 8832 "Manipulate the query by adding a search regexp with positive selection. 8833 Positive selection means the regexp must match for selection of an entry." 8834 (interactive) 8835 (org-agenda-manipulate-query ?\{)) 8836 (defun org-agenda-manipulate-query-subtract-re () 8837 "Manipulate the query by adding a search regexp with negative selection. 8838 Negative selection means regexp must not match for selection of an entry." 8839 (interactive) 8840 (org-agenda-manipulate-query ?\})) 8841 (defun org-agenda-manipulate-query (char) 8842 (cond 8843 ((eq org-agenda-type 'agenda) 8844 (let ((org-agenda-include-inactive-timestamps t)) 8845 (org-agenda-redo)) 8846 (message "Display now includes inactive timestamps as well")) 8847 ((eq org-agenda-type 'search) 8848 (org-add-to-string 8849 'org-agenda-query-string 8850 (if org-agenda-last-search-view-search-was-boolean 8851 (cdr (assoc char '((?\[ . " +") (?\] . " -") 8852 (?\{ . " +{}") (?\} . " -{}")))) 8853 " ")) 8854 (setq org-agenda-redo-command 8855 (list 'org-search-view 8856 (car (get-text-property (min (1- (point-max)) (point)) 8857 'org-last-args)) 8858 org-agenda-query-string 8859 (+ (length org-agenda-query-string) 8860 (if (member char '(?\{ ?\})) 0 1)))) 8861 (set-register org-agenda-query-register org-agenda-query-string) 8862 (let ((org-agenda-overriding-arguments 8863 (cdr org-agenda-redo-command))) 8864 (org-agenda-redo))) 8865 (t (error "Cannot manipulate query for %s-type agenda buffers" 8866 org-agenda-type)))) 8867 8868 (defun org-add-to-string (var string) 8869 (set var (concat (symbol-value var) string))) 8870 8871 (defun org-agenda-goto-date (date) 8872 "Jump to DATE in the agenda buffer. 8873 8874 When called interactively, prompt for the date. 8875 When called from Lisp, DATE should be a date as returned by 8876 `org-read-date'. 8877 8878 See also: 8879 `org-agenda-earlier' (\\[org-agenda-earlier]) 8880 `org-agenda-later' (\\[org-agenda-later]) 8881 `org-agenda-goto-today' (\\[org-agenda-goto-today])" 8882 (interactive 8883 (list 8884 (let ((org-read-date-prefer-future org-agenda-jump-prefer-future)) 8885 (org-read-date)))) 8886 (let* ((day (time-to-days (org-time-string-to-time date))) 8887 (org-agenda-sticky-orig org-agenda-sticky) 8888 (org-agenda-buffer-tmp-name (buffer-name)) 8889 (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8890 (0-arg (or current-prefix-arg (car args))) 8891 (2-arg (nth 2 args)) 8892 (with-hour-p (nth 4 org-agenda-redo-command)) 8893 (newcmd (list 'org-agenda-list 0-arg date 8894 (org-agenda-span-to-ndays 8895 2-arg (org-time-string-to-absolute date)) 8896 with-hour-p)) 8897 (newargs (cdr newcmd)) 8898 (inhibit-read-only t) 8899 org-agenda-sticky) 8900 (if (not (org-agenda-check-type t 'agenda)) 8901 (error "Not available in non-agenda views") 8902 (add-text-properties (point-min) (point-max) 8903 `(org-redo-cmd ,newcmd org-last-args ,newargs)) 8904 (org-agenda-redo) 8905 (goto-char (point-min)) 8906 (while (not (or (= (or (get-text-property (point) 'day) 0) day) 8907 (save-excursion (move-beginning-of-line 2) (eobp)))) 8908 (move-beginning-of-line 2)) 8909 (setq org-agenda-sticky org-agenda-sticky-orig 8910 org-agenda-this-buffer-is-sticky org-agenda-sticky)))) 8911 8912 (defun org-agenda-goto-today () 8913 "Go to today's date in the agenda buffer. 8914 8915 See also: 8916 `org-agenda-later' (\\[org-agenda-later]) 8917 `org-agenda-earlier' (\\[org-agenda-earlier]) 8918 `org-agenda-goto-date' (\\[org-agenda-goto-date])" 8919 (interactive) 8920 (org-agenda-check-type t 'agenda) 8921 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8922 (curspan (nth 2 args)) 8923 (tdpos (text-property-any (point-min) (point-max) 'org-today t))) 8924 (cond 8925 (tdpos (goto-char tdpos)) 8926 ((eq org-agenda-type 'agenda) 8927 (let* ((sd (org-agenda-compute-starting-span 8928 (org-today) (or curspan org-agenda-span))) 8929 (org-agenda-overriding-arguments args)) 8930 (setf (nth 1 org-agenda-overriding-arguments) sd) 8931 (org-agenda-redo) 8932 (org-agenda-find-same-or-today-or-agenda))) 8933 (t (error "Cannot find today"))))) 8934 8935 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt) 8936 (goto-char 8937 (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) 8938 (text-property-any (point-min) (point-max) 'org-today t) 8939 (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) 8940 (and (get-text-property (min (1- (point-max)) (point)) 'org-series) 8941 (org-agenda-backward-block)) 8942 (point-min)))) 8943 8944 (defun org-agenda-backward-block () 8945 "Move backward by one agenda block." 8946 (interactive) 8947 (org-agenda-forward-block 'backward)) 8948 8949 (defun org-agenda-forward-block (&optional backward) 8950 "Move forward by one agenda block. 8951 When optional argument BACKWARD is set, go backward." 8952 (interactive) 8953 (cond ((not (derived-mode-p 'org-agenda-mode)) 8954 (user-error 8955 "Cannot execute this command outside of org-agenda-mode buffers")) 8956 ((looking-at (if backward "\\`" "\\'")) 8957 (message "Already at the %s block" (if backward "first" "last"))) 8958 (t (let ((_pos (prog1 (point) 8959 (ignore-errors (if backward (backward-char 1) 8960 (move-end-of-line 1))))) 8961 (f (if backward 8962 #'previous-single-property-change 8963 #'next-single-property-change)) 8964 moved dest) 8965 (while (and (setq dest (funcall 8966 f (point) 'org-agenda-structural-header)) 8967 (not (get-text-property 8968 (point) 'org-agenda-structural-header))) 8969 (setq moved t) 8970 (goto-char dest)) 8971 (if moved (move-beginning-of-line 1) 8972 (goto-char (if backward (point-min) (point-max))) 8973 (move-beginning-of-line 1) 8974 (message "No %s block" (if backward "previous" "further"))))))) 8975 8976 (defun org-agenda-later (arg) 8977 "Go forward in time by the current span in the agenda buffer. 8978 With prefix ARG, go forward that many times the current span. 8979 8980 See also: 8981 `org-agenda-earlier' (\\[org-agenda-earlier]) 8982 `org-agenda-goto-today' (\\[org-agenda-goto-today]) 8983 `org-agenda-goto-date' (\\[org-agenda-goto-date])" 8984 (interactive "p") 8985 (org-agenda-check-type t 'agenda) 8986 (let* ((wstart (window-start)) 8987 (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8988 (span (or (nth 2 args) org-agenda-current-span)) 8989 (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day)) 8990 (greg (calendar-gregorian-from-absolute sd)) 8991 (cnt (org-get-at-bol 'org-day-cnt)) 8992 greg2) 8993 (cond 8994 ((numberp span) 8995 (setq sd (+ (* span arg) sd))) 8996 ((eq span 'day) 8997 (setq sd (+ arg sd))) 8998 ((eq span 'week) 8999 (setq sd (+ (* 7 arg) sd))) 9000 ((eq span 'fortnight) 9001 (setq sd (+ (* 14 arg) sd))) 9002 ((eq span 'month) 9003 (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) 9004 sd (calendar-absolute-from-gregorian greg2)) 9005 (setcar greg2 (1+ (car greg2)))) 9006 ((eq span 'year) 9007 (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) 9008 sd (calendar-absolute-from-gregorian greg2)) 9009 (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) 9010 (t 9011 (setq sd (+ (* span arg) sd)))) 9012 (let ((org-agenda-overriding-cmd 9013 ;; `cmd' may have been set by `org-agenda-run-series' which 9014 ;; uses `org-agenda-overriding-cmd' to decide whether 9015 ;; overriding is allowed for `cmd' 9016 (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) 9017 (org-agenda-overriding-arguments 9018 (list (car args) sd span))) 9019 (org-agenda-redo) 9020 (org-agenda-find-same-or-today-or-agenda cnt)) 9021 (set-window-start nil wstart))) 9022 9023 (defun org-agenda-earlier (arg) 9024 "Go backward in time by the current span in the agenda buffer. 9025 With prefix ARG, go backward that many times the current span. 9026 9027 See also: 9028 `org-agenda-later' (\\[org-agenda-later]) 9029 `org-agenda-goto-today' (\\[org-agenda-goto-today]) 9030 `org-agenda-goto-date' (\\[org-agenda-goto-date])" 9031 (interactive "p") 9032 (org-agenda-later (- arg))) 9033 9034 (defun org-agenda-view-mode-dispatch () 9035 "Call one of the view mode commands." 9036 (interactive) 9037 (org-unlogged-message 9038 "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort 9039 time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck 9040 [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") 9041 (pcase (read-char-exclusive) 9042 (?\ (call-interactively 'org-agenda-reset-view)) 9043 (?d (call-interactively 'org-agenda-day-view)) 9044 (?w (call-interactively 'org-agenda-week-view)) 9045 (?t (call-interactively 'org-agenda-fortnight-view)) 9046 (?m (call-interactively 'org-agenda-month-view)) 9047 (?y (call-interactively 'org-agenda-year-view)) 9048 (?l (call-interactively 'org-agenda-log-mode)) 9049 (?L (org-agenda-log-mode '(4))) 9050 (?c (org-agenda-log-mode 'clockcheck)) 9051 ((or ?F ?f) (call-interactively 'org-agenda-follow-mode)) 9052 (?a (call-interactively 'org-agenda-archives-mode)) 9053 (?A (org-agenda-archives-mode 'files)) 9054 ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode)) 9055 ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode)) 9056 (?G (call-interactively 'org-agenda-toggle-time-grid)) 9057 (?D (call-interactively 'org-agenda-toggle-diary)) 9058 (?\! (call-interactively 'org-agenda-toggle-deadlines)) 9059 (?\[ (let ((org-agenda-include-inactive-timestamps t)) 9060 (org-agenda-check-type t 'agenda) 9061 (org-agenda-redo)) 9062 (message "Display now includes inactive timestamps as well")) 9063 (?q (message "Abort")) 9064 (key (user-error "Invalid key: %s" key)))) 9065 9066 (defun org-agenda-reset-view () 9067 "Switch to default view for agenda." 9068 (interactive) 9069 (org-agenda-change-time-span org-agenda-span)) 9070 9071 (defun org-agenda-day-view (&optional day-of-month) 9072 "Switch to daily view for agenda. 9073 With argument DAY-OF-MONTH, switch to that day of the month." 9074 (interactive "P") 9075 (org-agenda-change-time-span 'day day-of-month)) 9076 9077 (defun org-agenda-week-view (&optional iso-week) 9078 "Switch to weekly view for agenda. 9079 With argument ISO-WEEK, switch to the corresponding ISO week. 9080 If ISO-WEEK has more then 2 digits, only the last two encode 9081 the week. Any digits before this encode a year. So 200712 9082 means week 12 of year 2007. Years ranging from 70 years ago 9083 to 30 years in the future can also be written as 2-digit years." 9084 (interactive "P") 9085 (org-agenda-change-time-span 'week iso-week)) 9086 9087 (defun org-agenda-fortnight-view (&optional iso-week) 9088 "Switch to fortnightly view for agenda. 9089 With argument ISO-WEEK, switch to the corresponding ISO week. 9090 If ISO-WEEK has more then 2 digits, only the last two encode 9091 the week. Any digits before this encode a year. So 200712 9092 means week 12 of year 2007. Years ranging from 70 years ago 9093 to 30 years in the future can also be written as 2-digit years." 9094 (interactive "P") 9095 (org-agenda-change-time-span 'fortnight iso-week)) 9096 9097 (defun org-agenda-month-view (&optional month) 9098 "Switch to monthly view for agenda. 9099 With argument MONTH, switch to that month. If MONTH has more 9100 then 2 digits, only the last two encode the month. Any digits 9101 before this encode a year. So 200712 means December year 2007. 9102 Years ranging from 70 years ago to 30 years in the future can 9103 also be written as 2-digit years." 9104 (interactive "P") 9105 (org-agenda-change-time-span 'month month)) 9106 9107 (defun org-agenda-year-view (&optional year) 9108 "Switch to yearly view for agenda. 9109 With argument YEAR, switch to that year. Years ranging from 70 9110 years ago to 30 years in the future can also be written as 9111 2-digit years." 9112 (interactive "P") 9113 (when year 9114 (setq year (org-small-year-to-year year))) 9115 (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") 9116 (org-agenda-change-time-span 'year year) 9117 (error "Abort"))) 9118 9119 (defun org-agenda-change-time-span (span &optional n) 9120 "Change the agenda view to SPAN. 9121 SPAN may be `day', `week', `fortnight', `month', `year'." 9122 (org-agenda-check-type t 'agenda) 9123 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 9124 (curspan (nth 2 args))) 9125 (when (and (not n) (equal curspan span)) 9126 (error "Viewing span is already \"%s\"" span)) 9127 (let* ((sd (or (org-get-at-bol 'day) 9128 (nth 1 args) 9129 org-starting-day)) 9130 (sd (org-agenda-compute-starting-span sd span n)) 9131 (org-agenda-overriding-cmd 9132 (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) 9133 (org-agenda-overriding-arguments 9134 (list (car args) sd span))) 9135 (org-agenda-redo) 9136 (org-agenda-find-same-or-today-or-agenda)) 9137 (org-agenda-set-mode-name) 9138 (message "Switched to %s view" span))) 9139 9140 (defun org-agenda-compute-starting-span (sd span &optional n) 9141 "Compute starting date for agenda. 9142 SPAN may be `day', `week', `fortnight', `month', `year'. The return value 9143 is a cons cell with the starting date and the number of days, 9144 so that the date SD will be in that range." 9145 (let* ((greg (calendar-gregorian-from-absolute sd)) 9146 ;; (dg (nth 1 greg)) 9147 (mg (car greg)) 9148 (yg (nth 2 greg))) 9149 (cond 9150 ((eq span 'day) 9151 (when n 9152 (setq sd (+ (calendar-absolute-from-gregorian 9153 (list mg 1 yg)) 9154 n -1)))) 9155 ((or (eq span 'week) (eq span 'fortnight)) 9156 (let* ((nt (calendar-day-of-week 9157 (calendar-gregorian-from-absolute sd))) 9158 (d (if org-agenda-start-on-weekday 9159 (- nt org-agenda-start-on-weekday) 9160 0)) 9161 y1) 9162 (setq sd (- sd (+ (if (< d 0) 7 0) d))) 9163 (when n 9164 (require 'cal-iso) 9165 (when (> n 99) 9166 (setq y1 (org-small-year-to-year (/ n 100)) 9167 n (mod n 100))) 9168 (setq sd 9169 (calendar-iso-to-absolute 9170 (list n 1 9171 (or y1 (nth 2 (calendar-iso-from-absolute sd))))))))) 9172 ((eq span 'month) 9173 (let (y1) 9174 (when (and n (> n 99)) 9175 (setq y1 (org-small-year-to-year (/ n 100)) 9176 n (mod n 100))) 9177 (setq sd (calendar-absolute-from-gregorian 9178 (list (or n mg) 1 (or y1 yg)))))) 9179 ((eq span 'year) 9180 (setq sd (calendar-absolute-from-gregorian 9181 (list 1 1 (or n yg)))))) 9182 sd)) 9183 9184 (defun org-agenda-next-date-line (&optional arg) 9185 "Jump to the next line indicating a date in agenda buffer." 9186 (interactive "p") 9187 (org-agenda-check-type t 'agenda) 9188 (beginning-of-line 1) 9189 ;; This does not work if user makes date format that starts with a blank 9190 (when (looking-at-p "^\\S-") (forward-char 1)) 9191 (unless (re-search-forward "^\\S-" nil t arg) 9192 (backward-char 1) 9193 (error "No next date after this line in this buffer")) 9194 (goto-char (match-beginning 0))) 9195 9196 (defun org-agenda-previous-date-line (&optional arg) 9197 "Jump to the previous line indicating a date in agenda buffer." 9198 (interactive "p") 9199 (org-agenda-check-type t 'agenda) 9200 (beginning-of-line 1) 9201 (unless (re-search-backward "^\\S-" nil t arg) 9202 (error "No previous date before this line in this buffer"))) 9203 9204 ;; Initialize the highlight 9205 (defvar org-hl (make-overlay 1 1)) 9206 (overlay-put org-hl 'face 'highlight) 9207 9208 (defun org-highlight (begin end &optional buffer) 9209 "Highlight a region with overlay." 9210 (move-overlay org-hl begin end (or buffer (current-buffer)))) 9211 9212 (defun org-unhighlight () 9213 "Detach overlay INDEX." 9214 (delete-overlay org-hl)) 9215 9216 (defun org-unhighlight-once () 9217 "Remove the highlight from its position, and this function from the hook." 9218 (remove-hook 'pre-command-hook #'org-unhighlight-once) 9219 (org-unhighlight)) 9220 9221 (defvar org-agenda-pre-follow-window-conf nil) 9222 (defun org-agenda-follow-mode () 9223 "Toggle follow mode in an agenda buffer." 9224 (interactive) 9225 (unless org-agenda-follow-mode 9226 (setq org-agenda-pre-follow-window-conf 9227 (current-window-configuration))) 9228 (setq org-agenda-follow-mode (not org-agenda-follow-mode)) 9229 (unless org-agenda-follow-mode 9230 (set-window-configuration org-agenda-pre-follow-window-conf)) 9231 (org-agenda-set-mode-name) 9232 (org-agenda-do-context-action) 9233 (message "Follow mode is %s" 9234 (if org-agenda-follow-mode "on" "off"))) 9235 9236 (defun org-agenda-entry-text-mode (&optional arg) 9237 "Toggle entry text mode in an agenda buffer." 9238 (interactive "P") 9239 (if (or org-agenda-tag-filter 9240 org-agenda-category-filter 9241 org-agenda-regexp-filter 9242 org-agenda-top-headline-filter) 9243 (user-error "Can't show entry text in filtered views") 9244 (setq org-agenda-entry-text-mode (or (integerp arg) 9245 (not org-agenda-entry-text-mode))) 9246 (org-agenda-entry-text-hide) 9247 (and org-agenda-entry-text-mode 9248 (let ((org-agenda-entry-text-maxlines 9249 (if (integerp arg) arg org-agenda-entry-text-maxlines))) 9250 (org-agenda-entry-text-show))) 9251 (org-agenda-set-mode-name) 9252 (message "Entry text mode is %s%s" 9253 (if org-agenda-entry-text-mode "on" "off") 9254 (if (not org-agenda-entry-text-mode) "" 9255 (format " (maximum number of lines is %d)" 9256 (if (integerp arg) arg org-agenda-entry-text-maxlines)))))) 9257 9258 (defun org-agenda-clockreport-mode () 9259 "Toggle clocktable mode in an agenda buffer." 9260 (interactive) 9261 (org-agenda-check-type t 'agenda) 9262 (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)) 9263 (org-agenda-set-mode-name) 9264 (org-agenda-redo) 9265 (message "Clocktable mode is %s" 9266 (if org-agenda-clockreport-mode "on" "off"))) 9267 9268 (defun org-agenda-log-mode (&optional special) 9269 "Toggle log mode in an agenda buffer. 9270 9271 With argument SPECIAL, show all possible log items, not only the ones 9272 configured in `org-agenda-log-mode-items'. 9273 9274 With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ 9275 log items, nothing else." 9276 (interactive "P") 9277 (org-agenda-check-type t 'agenda) 9278 (setq org-agenda-show-log 9279 (cond 9280 ((equal special '(16)) 'only) 9281 ((eq special 'clockcheck) 9282 (if (eq org-agenda-show-log 'clockcheck) 9283 nil 'clockcheck)) 9284 (special '(closed clock state)) 9285 (t (not org-agenda-show-log)))) 9286 (org-agenda-set-mode-name) 9287 (org-agenda-redo) 9288 (message "Log mode is %s" (if org-agenda-show-log "on" "off"))) 9289 9290 (defun org-agenda-archives-mode (&optional with-files) 9291 "Toggle inclusion of items in trees marked with :ARCHIVE:. 9292 When called with a prefix argument, include all archive files as well." 9293 (interactive "P") 9294 (setq org-agenda-archives-mode 9295 (cond ((and with-files (eq org-agenda-archives-mode t)) nil) 9296 (with-files t) 9297 (org-agenda-archives-mode nil) 9298 (t 'trees))) 9299 (org-agenda-set-mode-name) 9300 (org-agenda-redo) 9301 (message 9302 "%s" 9303 (cond 9304 ((eq org-agenda-archives-mode nil) 9305 "No archives are included") 9306 ((eq org-agenda-archives-mode 'trees) 9307 (format "Trees with :%s: tag are included" org-archive-tag)) 9308 ((eq org-agenda-archives-mode t) 9309 (format "Trees with :%s: tag and all active archive files are included" 9310 org-archive-tag))))) 9311 9312 (defun org-agenda-toggle-diary () 9313 "Toggle diary inclusion in an agenda buffer." 9314 (interactive) 9315 (org-agenda-check-type t 'agenda) 9316 (setq org-agenda-include-diary (not org-agenda-include-diary)) 9317 (org-agenda-redo) 9318 (org-agenda-set-mode-name) 9319 (message "Diary inclusion turned %s" 9320 (if org-agenda-include-diary "on" "off"))) 9321 9322 (defun org-agenda-toggle-deadlines () 9323 "Toggle inclusion of entries with a deadline in an agenda buffer." 9324 (interactive) 9325 (org-agenda-check-type t 'agenda) 9326 (setq org-agenda-include-deadlines (not org-agenda-include-deadlines)) 9327 (org-agenda-redo) 9328 (org-agenda-set-mode-name) 9329 (message "Deadlines inclusion turned %s" 9330 (if org-agenda-include-deadlines "on" "off"))) 9331 9332 (defun org-agenda-toggle-time-grid () 9333 "Toggle time grid in an agenda buffer." 9334 (interactive) 9335 (org-agenda-check-type t 'agenda) 9336 (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) 9337 (org-agenda-redo) 9338 (org-agenda-set-mode-name) 9339 (message "Time-grid turned %s" 9340 (if org-agenda-use-time-grid "on" "off"))) 9341 9342 (defun org-agenda-set-mode-name () 9343 "Set the mode name to indicate all the small mode settings." 9344 (setq mode-name 9345 (list "Org-Agenda" 9346 (if (get 'org-agenda-files 'org-restrict) " []" "") 9347 " " 9348 '(:eval (org-agenda-span-name org-agenda-current-span)) 9349 (if org-agenda-follow-mode " Follow" "") 9350 (if org-agenda-entry-text-mode " ETxt" "") 9351 (if org-agenda-include-diary " Diary" "") 9352 (if org-agenda-include-deadlines " Ddl" "") 9353 (if org-agenda-use-time-grid " Grid" "") 9354 (if (and (boundp 'org-habit-show-habits) 9355 org-habit-show-habits) 9356 " Habit" "") 9357 (cond 9358 ((consp org-agenda-show-log) " LogAll") 9359 ((eq org-agenda-show-log 'clockcheck) " ClkCk") 9360 (org-agenda-show-log " Log") 9361 (t "")) 9362 (if (org-agenda-filter-any) " " "") 9363 (if (or org-agenda-category-filter 9364 (assoc-default 'category org-agenda-filters-preset)) 9365 '(:eval (propertize 9366 (concat "[" 9367 (mapconcat 9368 #'identity 9369 (append 9370 (assoc-default 'category org-agenda-filters-preset) 9371 org-agenda-category-filter) 9372 "") 9373 "]") 9374 'face 'org-agenda-filter-category 9375 'help-echo "Category used in filtering")) 9376 "") 9377 (if (or org-agenda-tag-filter 9378 (assoc-default 'tag org-agenda-filters-preset)) 9379 '(:eval (propertize 9380 (concat (mapconcat 9381 #'identity 9382 (append 9383 (assoc-default 'tag org-agenda-filters-preset) 9384 org-agenda-tag-filter) 9385 "")) 9386 'face 'org-agenda-filter-tags 9387 'help-echo "Tags used in filtering")) 9388 "") 9389 (if (or org-agenda-effort-filter 9390 (assoc-default 'effort org-agenda-filters-preset)) 9391 '(:eval (propertize 9392 (concat (mapconcat 9393 #'identity 9394 (append 9395 (assoc-default 'effort org-agenda-filters-preset) 9396 org-agenda-effort-filter) 9397 "")) 9398 'face 'org-agenda-filter-effort 9399 'help-echo "Effort conditions used in filtering")) 9400 "") 9401 (if (or org-agenda-regexp-filter 9402 (assoc-default 'regexp org-agenda-filters-preset)) 9403 '(:eval (propertize 9404 (concat (mapconcat 9405 (lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/")) 9406 (append 9407 (assoc-default 'regexp org-agenda-filters-preset) 9408 org-agenda-regexp-filter) 9409 "")) 9410 'face 'org-agenda-filter-regexp 9411 'help-echo "Regexp used in filtering")) 9412 "") 9413 (if org-agenda-archives-mode 9414 (if (eq org-agenda-archives-mode t) 9415 " Archives" 9416 (format " :%s:" org-archive-tag)) 9417 "") 9418 (if org-agenda-clockreport-mode " Clock" ""))) 9419 (force-mode-line-update)) 9420 9421 (defun org-agenda-update-agenda-type () 9422 "Update the agenda type after each command." 9423 (setq org-agenda-type 9424 (or (get-text-property (point) 'org-agenda-type) 9425 (get-text-property (max (point-min) (1- (point))) 'org-agenda-type)))) 9426 9427 (defun org-agenda-next-line () 9428 "Move cursor to the next line, and show if follow mode is active." 9429 (interactive) 9430 (call-interactively 'next-line) 9431 (org-agenda-do-context-action)) 9432 9433 (defun org-agenda-previous-line () 9434 "Move cursor to the previous line, and show if follow-mode is active." 9435 (interactive) 9436 (call-interactively 'previous-line) 9437 (org-agenda-do-context-action)) 9438 9439 (defun org-agenda-next-item (n) 9440 "Move cursor to next agenda item." 9441 (interactive "p") 9442 (let ((col (current-column))) 9443 (dotimes (_ n) 9444 (when (next-single-property-change (line-end-position) 'org-marker) 9445 (move-end-of-line 1) 9446 (goto-char (next-single-property-change (point) 'org-marker)))) 9447 (org-move-to-column col)) 9448 (org-agenda-do-context-action)) 9449 9450 (defun org-agenda-previous-item (n) 9451 "Move cursor to next agenda item." 9452 (interactive "p") 9453 (dotimes (_ n) 9454 (let ((col (current-column)) 9455 (goto (save-excursion 9456 (move-end-of-line 0) 9457 (previous-single-property-change (point) 'org-marker)))) 9458 (when goto (goto-char goto)) 9459 (org-move-to-column col))) 9460 (org-agenda-do-context-action)) 9461 9462 (defun org-agenda-do-context-action () 9463 "Show outline path and, maybe, follow mode window." 9464 (let ((m (org-get-at-bol 'org-marker))) 9465 (when (and (markerp m) (marker-buffer m)) 9466 (and org-agenda-follow-mode 9467 (if org-agenda-follow-indirect 9468 (org-agenda-tree-to-indirect-buffer nil) 9469 (org-agenda-show))) 9470 (and org-agenda-show-outline-path 9471 (org-with-point-at m (org-display-outline-path org-agenda-show-outline-path)))))) 9472 9473 (defun org-agenda-show-tags () 9474 "Show the tags applicable to the current item." 9475 (interactive) 9476 (let* ((tags (org-get-at-bol 'tags))) 9477 (if tags 9478 (message "Tags are :%s:" 9479 (org-no-properties (mapconcat #'identity tags ":"))) 9480 (message "No tags associated with this line")))) 9481 9482 (defun org-agenda-goto (&optional highlight) 9483 "Go to the entry at point in the corresponding Org file." 9484 (interactive) 9485 (let* ((marker (or (org-get-at-bol 'org-marker) 9486 (org-agenda-error))) 9487 (buffer (marker-buffer marker)) 9488 (pos (marker-position marker))) 9489 ;; FIXME: use `org-switch-to-buffer-other-window'? 9490 (switch-to-buffer-other-window buffer) 9491 (widen) 9492 (push-mark) 9493 (goto-char pos) 9494 (when (derived-mode-p 'org-mode) 9495 (org-fold-show-context 'agenda) 9496 (recenter (/ (window-height) 2)) 9497 (org-back-to-heading t) 9498 (let ((case-fold-search nil)) 9499 (when (re-search-forward org-complex-heading-regexp nil t) 9500 (goto-char (match-beginning 4))))) 9501 (run-hooks 'org-agenda-after-show-hook) 9502 (and highlight (org-highlight (line-beginning-position) 9503 (line-end-position))))) 9504 9505 (defvar org-agenda-after-show-hook nil 9506 "Normal hook run after an item has been shown from the agenda. 9507 Point is in the buffer where the item originated.") 9508 9509 ;; Defined later in org-agenda.el 9510 (defvar org-agenda-loop-over-headlines-in-active-region nil) 9511 9512 (defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete) 9513 "Between region BEG and END, call agenda command CMD. 9514 When optional argument ARG is non-nil or FORCE-ARG is t, pass 9515 ARG to CMD. When optional argument DELETE is non-nil, assume CMD 9516 deletes the agenda entry and don't move to the next entry." 9517 (save-excursion 9518 (goto-char beg) 9519 (let ((mend (move-marker (make-marker) end)) 9520 (all (eq org-agenda-loop-over-headlines-in-active-region t)) 9521 (match (and (stringp org-agenda-loop-over-headlines-in-active-region) 9522 org-agenda-loop-over-headlines-in-active-region)) 9523 (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level) 9524 (org-get-at-bol 'level)))) 9525 (while (< (point) mend) 9526 (let ((ov (make-overlay (point) (line-end-position)))) 9527 (if (not (or all 9528 (and match (looking-at-p match)) 9529 (eq level (org-get-at-bol 'level)))) 9530 (org-agenda-next-item 1) 9531 (overlay-put ov 'face 'region) 9532 (if (or arg force-arg) (funcall cmd arg) (funcall cmd)) 9533 (when (not delete) (org-agenda-next-item 1)) 9534 (delete-overlay ov))))))) 9535 9536 ;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*, 9537 ;; kill,set-property,set-effort] commands may loop over agenda 9538 ;; entries. Commands `org-agenda-set-tags' and `org-agenda-bulk-mark' 9539 ;; use their own mechanisms on active regions. 9540 (defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body) 9541 "Maybe loop over agenda entries and perform CMD. 9542 Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." 9543 (declare (debug t)) 9544 `(if (and (called-interactively-p 'any) 9545 org-agenda-loop-over-headlines-in-active-region 9546 (org-region-active-p)) 9547 (org-agenda-do-in-region 9548 (region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete) 9549 ,@body)) 9550 9551 (defun org-agenda-kill () 9552 "Kill the entry or subtree belonging to the current agenda entry." 9553 (interactive) 9554 (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) 9555 (org-agenda-maybe-loop 9556 #'org-agenda-kill nil nil t 9557 (let* ((bufname-orig (buffer-name)) 9558 (marker (or (org-get-at-bol 'org-marker) 9559 (org-agenda-error))) 9560 (buffer (marker-buffer marker)) 9561 (pos (marker-position marker)) 9562 (type (org-get-at-bol 'type)) 9563 dbeg dend (n 0)) 9564 (org-with-remote-undo buffer 9565 (with-current-buffer buffer 9566 (save-excursion 9567 (goto-char pos) 9568 (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) 9569 (setq dbeg (progn (org-back-to-heading t) (point)) 9570 dend (org-end-of-subtree t t)) 9571 (setq dbeg (line-beginning-position) 9572 dend (min (point-max) (1+ (line-end-position))))) 9573 (goto-char dbeg) 9574 (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) 9575 (when (or (eq t org-agenda-confirm-kill) 9576 (and (numberp org-agenda-confirm-kill) 9577 (> n org-agenda-confirm-kill))) 9578 (let ((win-conf (current-window-configuration))) 9579 (unwind-protect 9580 (and 9581 (prog2 9582 (org-agenda-tree-to-indirect-buffer nil) 9583 (not (y-or-n-p 9584 (format "Delete entry with %d lines in buffer \"%s\"? " 9585 n (buffer-name buffer)))) 9586 (kill-buffer org-last-indirect-buffer)) 9587 (error "Abort")) 9588 (set-window-configuration win-conf)))) 9589 (let ((org-agenda-buffer-name bufname-orig)) 9590 (org-remove-subtree-entries-from-agenda buffer dbeg dend)) 9591 (with-current-buffer buffer (delete-region dbeg dend)) 9592 (message "Agenda item and source killed"))))) 9593 9594 (defvar org-archive-default-command) ; defined in org-archive.el 9595 (defun org-agenda-archive-default () 9596 "Archive the entry or subtree belonging to the current agenda entry." 9597 (interactive) 9598 (require 'org-archive) 9599 (funcall-interactively 9600 #'org-agenda-archive-with org-archive-default-command)) 9601 9602 (defun org-agenda-archive-default-with-confirmation () 9603 "Archive the entry or subtree belonging to the current agenda entry." 9604 (interactive) 9605 (require 'org-archive) 9606 (funcall-interactively 9607 #'org-agenda-archive-with org-archive-default-command 'confirm)) 9608 9609 (defun org-agenda-archive () 9610 "Archive the entry or subtree belonging to the current agenda entry." 9611 (interactive) 9612 (funcall-interactively 9613 #'org-agenda-archive-with 'org-archive-subtree)) 9614 9615 (defun org-agenda-archive-to-archive-sibling () 9616 "Move the entry to the archive sibling." 9617 (interactive) 9618 (funcall-interactively 9619 #'org-agenda-archive-with 'org-archive-to-archive-sibling)) 9620 9621 (defvar org-archive-from-agenda) 9622 9623 (defun org-agenda-archive-with (cmd &optional confirm) 9624 "Move the entry to the archive sibling." 9625 (interactive) 9626 (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) 9627 (org-agenda-maybe-loop 9628 #'org-agenda-archive-with cmd nil t 9629 (let* ((bufname-orig (buffer-name)) 9630 (marker (or (org-get-at-bol 'org-marker) 9631 (org-agenda-error))) 9632 (buffer (marker-buffer marker)) 9633 (pos (marker-position marker))) 9634 (org-with-remote-undo buffer 9635 (with-current-buffer buffer 9636 (if (derived-mode-p 'org-mode) 9637 (if (and confirm 9638 (not (y-or-n-p "Archive this subtree or entry? "))) 9639 (error "Abort") 9640 (save-window-excursion 9641 (goto-char pos) 9642 (let ((org-agenda-buffer-name bufname-orig)) 9643 (org-remove-subtree-entries-from-agenda)) 9644 (org-back-to-heading t) 9645 (let ((org-archive-from-agenda t)) 9646 (funcall cmd)))) 9647 (error "Archiving works only in Org files"))))))) 9648 9649 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end) 9650 "Remove all lines in the agenda that correspond to a given subtree. 9651 The subtree is the one in buffer BUF, starting at BEG and ending at END. 9652 If this information is not given, the function uses the tree at point." 9653 (let ((buf (or buf (current-buffer))) m p) 9654 (save-excursion 9655 (unless (and beg end) 9656 (org-back-to-heading t) 9657 (setq beg (point)) 9658 (org-end-of-subtree t) 9659 (setq end (point))) 9660 (set-buffer (get-buffer org-agenda-buffer-name)) 9661 (save-excursion 9662 (goto-char (point-max)) 9663 (beginning-of-line 1) 9664 (while (not (bobp)) 9665 (when (and (setq m (org-get-at-bol 'org-marker)) 9666 (equal buf (marker-buffer m)) 9667 (setq p (marker-position m)) 9668 (>= p beg) 9669 (< p end)) 9670 (let ((inhibit-read-only t)) 9671 (delete-region (line-beginning-position) 9672 (1+ (line-end-position))))) 9673 (beginning-of-line 0)))))) 9674 9675 (defun org-agenda-refile (&optional goto rfloc no-update) 9676 "Refile the item at point. 9677 9678 When called with `\\[universal-argument] \\[universal-argument]', \ 9679 go to the location of the last 9680 refiled item. 9681 9682 When called with `\\[universal-argument] \\[universal-argument] \ 9683 \\[universal-argument]' prefix or when GOTO is 0, clear 9684 the refile cache. 9685 9686 RFLOC can be a refile location obtained in a different way. 9687 9688 When NO-UPDATE is non-nil, don't redo the agenda buffer." 9689 (interactive "P") 9690 (cond 9691 ((member goto '(0 (64))) 9692 (org-refile-cache-clear)) 9693 ((equal goto '(16)) 9694 (org-refile-goto-last-stored)) 9695 (t 9696 (let* ((buffer-orig (buffer-name)) 9697 (marker (or (org-get-at-bol 'org-hd-marker) 9698 (org-agenda-error))) 9699 (buffer (marker-buffer marker)) 9700 ;; (pos (marker-position marker)) 9701 (rfloc (or rfloc 9702 (org-refile-get-location 9703 (if goto "Goto" "Refile to") buffer 9704 org-refile-allow-creating-parent-nodes)))) 9705 (with-current-buffer buffer 9706 (org-with-wide-buffer 9707 (goto-char marker) 9708 (let ((org-agenda-buffer-name buffer-orig)) 9709 (org-remove-subtree-entries-from-agenda)) 9710 (org-refile goto buffer rfloc)))) 9711 (unless no-update (org-agenda-redo))))) 9712 9713 (defun org-agenda-open-link (&optional arg) 9714 "Open the link(s) in the current entry, if any. 9715 This looks for a link in the displayed line in the agenda. 9716 It also looks at the text of the entry itself." 9717 (interactive "P") 9718 (let* ((marker (or (org-get-at-bol 'org-hd-marker) 9719 (org-get-at-bol 'org-marker))) 9720 (buffer (and marker (marker-buffer marker))) 9721 (prefix (buffer-substring (line-beginning-position) 9722 (line-end-position))) 9723 (lkall (and buffer (org-offer-links-in-entry 9724 buffer marker arg prefix))) 9725 (lk0 (car lkall)) 9726 (lk (if (stringp lk0) (list lk0) lk0)) 9727 (lkend (cdr lkall)) 9728 trg) 9729 (cond 9730 ((and buffer lk) 9731 (mapcar (lambda(l) 9732 (with-current-buffer buffer 9733 (setq trg (and (string-match org-link-bracket-re l) 9734 (match-string 1 l))) 9735 (if (or (not trg) (string-match org-link-any-re trg)) 9736 ;; Don't use `org-with-wide-buffer' here as 9737 ;; opening the link may result in moving the point 9738 (save-restriction 9739 (widen) 9740 (goto-char marker) 9741 (when (search-forward l nil lkend) 9742 (goto-char (match-beginning 0)) 9743 (org-open-at-point))) 9744 ;; This is an internal link, widen the buffer 9745 ;; FIXME: use `org-switch-to-buffer-other-window'? 9746 (switch-to-buffer-other-window buffer) 9747 (widen) 9748 (goto-char marker) 9749 (when (search-forward l nil lkend) 9750 (goto-char (match-beginning 0)) 9751 (org-open-at-point))))) 9752 lk)) 9753 ((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)")) 9754 (save-excursion 9755 (beginning-of-line 1) 9756 (looking-at (concat ".*?\\(" org-link-bracket-re "\\)")))) 9757 (org-link-open-from-string (match-string 1))) 9758 (t (message "No link to open here"))))) 9759 9760 (defun org-agenda-copy-local-variable (var) 9761 "Get a variable from a referenced buffer and install it here." 9762 (let ((m (org-get-at-bol 'org-marker))) 9763 (when (and m (buffer-live-p (marker-buffer m))) 9764 (set (make-local-variable var) 9765 (with-current-buffer (marker-buffer m) 9766 (symbol-value var)))))) 9767 9768 (defun org-agenda-switch-to (&optional delete-other-windows) 9769 "Go to the Org mode file which contains the item at point. 9770 When optional argument DELETE-OTHER-WINDOWS is non-nil, the 9771 displayed Org file fills the frame." 9772 (interactive) 9773 (if (and org-return-follows-link 9774 (not (org-get-at-bol 'org-marker)) 9775 (org-in-regexp org-link-bracket-re)) 9776 (org-link-open-from-string (match-string 0)) 9777 (let* ((marker (or (org-get-at-bol 'org-marker) 9778 (org-agenda-error))) 9779 (buffer (marker-buffer marker)) 9780 (pos (marker-position marker))) 9781 (unless buffer (user-error "Trying to switch to non-existent buffer")) 9782 (pop-to-buffer-same-window buffer) 9783 (when delete-other-windows (delete-other-windows)) 9784 (widen) 9785 (goto-char pos) 9786 (when (derived-mode-p 'org-mode) 9787 (org-fold-show-context 'agenda) 9788 (run-hooks 'org-agenda-after-show-hook))))) 9789 9790 (defun org-agenda-goto-mouse (ev) 9791 "Go to the Org file which contains the item at the mouse click." 9792 (interactive "e") 9793 (mouse-set-point ev) 9794 (org-agenda-goto)) 9795 9796 (defun org-agenda-show (&optional full-entry) 9797 "Display the Org file which contains the item at point. 9798 With prefix argument FULL-ENTRY, make the entire entry visible 9799 if it was hidden in the outline." 9800 (interactive "P") 9801 (let ((win (selected-window))) 9802 (org-agenda-goto t) 9803 (when full-entry (org-fold-show-entry 'hide-drawers)) 9804 (select-window win))) 9805 9806 (defvar org-agenda-show-window nil) 9807 (defun org-agenda-show-and-scroll-up (&optional arg) 9808 "Display the Org file which contains the item at point. 9809 9810 When called repeatedly, scroll the window that is displaying the buffer. 9811 9812 With a `\\[universal-argument]' prefix argument, display the item, but \ 9813 fold drawers." 9814 (interactive "P") 9815 (let ((win (selected-window))) 9816 (if (and (window-live-p org-agenda-show-window) 9817 (eq this-command last-command)) 9818 (progn 9819 (select-window org-agenda-show-window) 9820 (ignore-errors (scroll-up))) 9821 (org-agenda-goto t) 9822 (org-fold-show-entry 'hide-drawers) 9823 (if arg (org-cycle-hide-drawers 'children) 9824 (org-with-wide-buffer 9825 (narrow-to-region (org-entry-beginning-position) 9826 (org-entry-end-position)) 9827 (org-fold-show-all '(drawers)))) 9828 (setq org-agenda-show-window (selected-window))) 9829 (select-window win))) 9830 9831 (defun org-agenda-show-scroll-down () 9832 "Scroll down the window showing the agenda." 9833 (interactive) 9834 (let ((win (selected-window))) 9835 (when (window-live-p org-agenda-show-window) 9836 (select-window org-agenda-show-window) 9837 (ignore-errors (scroll-down)) 9838 (select-window win)))) 9839 9840 (defun org-agenda-show-1 (&optional more) 9841 "Display the Org file which contains the item at point. 9842 The prefix arg selects the amount of information to display: 9843 9844 0 hide the subtree 9845 1 just show the entry according to defaults. 9846 2 show the children view 9847 3 show the subtree view 9848 4 show the entire subtree and any drawers 9849 With prefix argument FULL-ENTRY, make the entire entry visible 9850 if it was hidden in the outline." 9851 (interactive "p") 9852 (let ((win (selected-window))) 9853 (org-agenda-goto t) 9854 (org-back-to-heading) 9855 (set-window-start (selected-window) (line-beginning-position)) 9856 (cond 9857 ((= more 0) 9858 (org-fold-subtree t) 9859 (save-excursion 9860 (org-back-to-heading) 9861 (run-hook-with-args 'org-cycle-hook 'folded)) 9862 (message "Remote: FOLDED")) 9863 ((and (called-interactively-p 'any) (= more 1)) 9864 (message "Remote: show with default settings")) 9865 ((= more 2) 9866 (org-fold-show-entry 'hide-drawers) 9867 (org-fold-show-children) 9868 (save-excursion 9869 (org-back-to-heading) 9870 (run-hook-with-args 'org-cycle-hook 'children)) 9871 (message "Remote: CHILDREN")) 9872 ((= more 3) 9873 (org-fold-show-subtree) 9874 (save-excursion 9875 (org-back-to-heading) 9876 (run-hook-with-args 'org-cycle-hook 'subtree)) 9877 (message "Remote: SUBTREE")) 9878 ((> more 3) 9879 (org-fold-show-subtree) 9880 (message "Remote: SUBTREE AND ALL DRAWERS"))) 9881 (select-window win))) 9882 9883 (defvar org-agenda-cycle-counter nil) 9884 (defun org-agenda-cycle-show (&optional n) 9885 "Show the current entry in another window, with default settings. 9886 9887 Default settings are taken from `org-show-context-detail'. When 9888 use repeatedly in immediate succession, the remote entry will 9889 cycle through visibility 9890 9891 children -> subtree -> folded 9892 9893 When called with a numeric prefix arg, that arg will be passed through to 9894 `org-agenda-show-1'. For the interpretation of that argument, see the 9895 docstring of `org-agenda-show-1'." 9896 (interactive "P") 9897 (if (integerp n) 9898 (setq org-agenda-cycle-counter n) 9899 (if (not (eq last-command this-command)) 9900 (setq org-agenda-cycle-counter 1) 9901 (if (equal org-agenda-cycle-counter 0) 9902 (setq org-agenda-cycle-counter 2) 9903 (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) 9904 (when (> org-agenda-cycle-counter 3) 9905 (setq org-agenda-cycle-counter 0))))) 9906 (org-agenda-show-1 org-agenda-cycle-counter)) 9907 9908 (defun org-agenda-recenter (arg) 9909 "Display the Org file which contains the item at point and recenter." 9910 (interactive "P") 9911 (let ((win (selected-window))) 9912 (org-agenda-goto t) 9913 (recenter arg) 9914 (select-window win))) 9915 9916 (defun org-agenda-show-mouse (ev) 9917 "Display the Org file which contains the item at the mouse click." 9918 (interactive "e") 9919 (mouse-set-point ev) 9920 (org-agenda-show)) 9921 9922 (defun org-agenda-check-no-diary () 9923 "Check if the entry is a diary link and abort if yes." 9924 (when (org-get-at-bol 'org-agenda-diary-link) 9925 (org-agenda-error))) 9926 9927 (defun org-agenda-error () 9928 "Throw an error when a command is not allowed in the agenda." 9929 (user-error "Command not allowed in this line")) 9930 9931 (defun org-agenda-tree-to-indirect-buffer (arg) 9932 "Show the subtree corresponding to the current entry in an indirect buffer. 9933 This calls the command `org-tree-to-indirect-buffer' from the original buffer. 9934 9935 With a numerical prefix ARG, go up to this level and then take that tree. 9936 With a negative numeric ARG, go up by this number of levels. 9937 9938 With a `\\[universal-argument]' prefix, make a separate frame for this tree, \ 9939 i.e. don't use 9940 the dedicated frame." 9941 (interactive "P") 9942 (if current-prefix-arg 9943 (org-agenda-do-tree-to-indirect-buffer arg) 9944 (let ((agenda-buffer (buffer-name)) 9945 (agenda-window (selected-window)) 9946 (indirect-window 9947 (and org-last-indirect-buffer 9948 (get-buffer-window org-last-indirect-buffer)))) 9949 (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg)) 9950 (unless (or (eq org-indirect-buffer-display 'new-frame) 9951 (eq org-indirect-buffer-display 'dedicated-frame)) 9952 (unwind-protect 9953 (unless (and indirect-window (window-live-p indirect-window)) 9954 (setq indirect-window (split-window agenda-window))) 9955 (and indirect-window (select-window indirect-window)) 9956 (switch-to-buffer org-last-indirect-buffer :norecord) 9957 (fit-window-to-buffer indirect-window))) 9958 (select-window (get-buffer-window agenda-buffer)) 9959 (setq org-agenda-last-indirect-buffer org-last-indirect-buffer)))) 9960 9961 (defun org-agenda-do-tree-to-indirect-buffer (arg) 9962 "Same as `org-agenda-tree-to-indirect-buffer' without saving window." 9963 (org-agenda-check-no-diary) 9964 (let* ((marker (or (org-get-at-bol 'org-marker) 9965 (org-agenda-error))) 9966 (buffer (marker-buffer marker)) 9967 (pos (marker-position marker))) 9968 (with-current-buffer buffer 9969 (save-excursion 9970 (goto-char pos) 9971 (org-tree-to-indirect-buffer arg))))) 9972 9973 (defvar org-last-heading-marker (make-marker) 9974 "Marker pointing to the headline that last changed its TODO state 9975 by a remote command from the agenda.") 9976 9977 (defun org-agenda-todo-nextset () 9978 "Switch TODO entry to next sequence." 9979 (interactive) 9980 (org-agenda-todo 'nextset)) 9981 9982 (defun org-agenda-todo-previousset () 9983 "Switch TODO entry to previous sequence." 9984 (interactive) 9985 (org-agenda-todo 'previousset)) 9986 9987 (defvar org-agenda-headline-snapshot-before-repeat) 9988 9989 (defun org-agenda-todo (&optional arg) 9990 "Cycle TODO state of line at point, also in Org file. 9991 This changes the line at point, all other lines in the agenda referring to 9992 the same tree node, and the headline of the tree node in the Org file." 9993 (interactive "P") 9994 (org-agenda-check-no-diary) 9995 (org-agenda-maybe-loop 9996 #'org-agenda-todo arg nil nil 9997 (let* ((col (current-column)) 9998 (marker (or (org-get-at-bol 'org-marker) 9999 (org-agenda-error))) 10000 (buffer (marker-buffer marker)) 10001 (pos (marker-position marker)) 10002 (hdmarker (org-get-at-bol 'org-hd-marker)) 10003 (todayp (org-agenda-today-p (org-get-at-bol 'day))) 10004 (inhibit-read-only t) 10005 org-loop-over-headlines-in-active-region 10006 org-agenda-headline-snapshot-before-repeat newhead just-one) 10007 (org-with-remote-undo buffer 10008 (with-current-buffer buffer 10009 (widen) 10010 (goto-char pos) 10011 (org-fold-show-context 'agenda) 10012 (let ((current-prefix-arg arg)) 10013 (call-interactively 'org-todo) 10014 ;; Make sure that log is recorded in current undo. 10015 (when (and org-log-setup 10016 (not (eq org-log-note-how 'note))) 10017 (org-add-log-note))) 10018 (and (bolp) (forward-char 1)) 10019 (setq newhead (org-get-heading)) 10020 (when (and org-agenda-headline-snapshot-before-repeat 10021 (not (equal org-agenda-headline-snapshot-before-repeat 10022 newhead)) 10023 todayp) 10024 (setq newhead org-agenda-headline-snapshot-before-repeat 10025 just-one t)) 10026 (save-excursion 10027 (org-back-to-heading) 10028 (move-marker org-last-heading-marker (point)))) 10029 (beginning-of-line 1) 10030 (save-window-excursion 10031 (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) 10032 (when (bound-and-true-p org-clock-out-when-done) 10033 (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda)) 10034 newhead) 10035 (org-agenda-unmark-clocking-task)) 10036 (org-move-to-column col) 10037 (org-agenda-mark-clocking-task))))) 10038 10039 (defun org-agenda-add-note (&optional _arg) 10040 "Add a time-stamped note to the entry at point." 10041 (interactive) ;; "P" 10042 (org-agenda-check-no-diary) 10043 (let* ((marker (or (org-get-at-bol 'org-marker) 10044 (org-agenda-error))) 10045 (buffer (marker-buffer marker)) 10046 (pos (marker-position marker)) 10047 (_hdmarker (org-get-at-bol 'org-hd-marker)) 10048 (inhibit-read-only t)) 10049 (with-current-buffer buffer 10050 (widen) 10051 (goto-char pos) 10052 (org-fold-show-context 'agenda) 10053 (org-add-note)))) 10054 10055 (defun org-agenda-change-all-lines (newhead hdmarker 10056 &optional fixface just-this) 10057 "Change all lines in the agenda buffer which match HDMARKER. 10058 The new content of the line will be NEWHEAD (as modified by 10059 `org-agenda-format-item'). HDMARKER is checked with 10060 `equal' against all `org-hd-marker' text properties in the file. 10061 If FIXFACE is non-nil, the face of each item is modified according to 10062 the new TODO state. 10063 If JUST-THIS is non-nil, change just the current line, not all. 10064 If FORCE-TAGS is non-nil, the car of it returns the new tags." 10065 (let* ((inhibit-read-only t) 10066 (line (org-current-line)) 10067 (org-agenda-buffer (current-buffer)) 10068 (thetags (with-current-buffer (marker-buffer hdmarker) 10069 (org-get-tags hdmarker))) 10070 props m undone-face done-face finish new dotime level cat tags 10071 effort effort-minutes) ;; pl 10072 (save-excursion 10073 (goto-char (point-max)) 10074 (beginning-of-line 1) 10075 (while (not finish) 10076 (setq finish (bobp)) 10077 (when (and (setq m (org-get-at-bol 'org-hd-marker)) 10078 (or (not just-this) (= (org-current-line) line)) 10079 (equal m hdmarker)) 10080 (setq props (text-properties-at (point)) 10081 dotime (org-get-at-bol 'dotime) 10082 cat (org-agenda-get-category) 10083 level (org-get-at-bol 'level) 10084 tags thetags 10085 effort (org-get-at-bol 'effort) 10086 effort-minutes (org-get-at-bol 'effort-minutes) 10087 new 10088 (let ((org-prefix-format-compiled 10089 (or (get-text-property (min (1- (point-max)) (point)) 'format) 10090 org-prefix-format-compiled)) 10091 (extra (org-get-at-bol 'extra))) 10092 (with-current-buffer (marker-buffer hdmarker) 10093 (org-with-wide-buffer 10094 (org-agenda-format-item extra 10095 (org-add-props newhead nil 10096 'effort effort 10097 'effort-minutes effort-minutes) 10098 level cat tags dotime)))) 10099 ;; pl (text-property-any (line-beginning-position) 10100 ;; (line-end-position) 'org-heading t) 10101 undone-face (org-get-at-bol 'undone-face) 10102 done-face (org-get-at-bol 'done-face)) 10103 (beginning-of-line 1) 10104 (cond 10105 ((equal new "") (delete-region (point) (line-beginning-position 2))) 10106 ((looking-at ".*") 10107 ;; When replacing the whole line, preserve bulk mark 10108 ;; overlay, if any. 10109 (let ((mark (catch :overlay 10110 (dolist (o (overlays-in (point) (+ 2 (point)))) 10111 (when (eq (overlay-get o 'type) 10112 'org-marked-entry-overlay) 10113 (throw :overlay o)))))) 10114 (replace-match new t t) 10115 (beginning-of-line) 10116 (when mark (move-overlay mark (point) (+ 2 (point))))) 10117 (add-text-properties (line-beginning-position) 10118 (line-end-position) props) 10119 (when fixface 10120 (add-text-properties 10121 (line-beginning-position) (line-end-position) 10122 (list 'face 10123 (if org-last-todo-state-is-todo 10124 undone-face done-face)))) 10125 (org-agenda-highlight-todo 'line) 10126 (beginning-of-line 1)) 10127 (t (error "Line update did not work"))) 10128 (save-restriction 10129 (narrow-to-region (line-beginning-position) (line-end-position)) 10130 (org-agenda-finalize))) 10131 (beginning-of-line 0))))) 10132 10133 (defun org-agenda-align-tags (&optional line) 10134 "Align all tags in agenda items to `org-agenda-tags-column'. 10135 When optional argument LINE is non-nil, align tags only on the 10136 current line." 10137 (let ((inhibit-read-only t) 10138 (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column) 10139 (- (window-max-chars-per-line)) 10140 org-agenda-tags-column)) 10141 (end (and line (line-end-position))) 10142 l c) 10143 (org-fold-core-ignore-modifications 10144 (save-excursion 10145 (goto-char (if line (line-beginning-position) (point-min))) 10146 (while (re-search-forward org-tag-group-re end t) 10147 (add-text-properties 10148 (match-beginning 1) (match-end 1) 10149 (list 'face (delq nil (let ((prop (get-text-property 10150 (match-beginning 1) 'face))) 10151 (or (listp prop) (setq prop (list prop))) 10152 (if (memq 'org-tag prop) 10153 prop 10154 (cons 'org-tag prop)))))) 10155 (setq l (string-width (match-string 1)) 10156 c (if (< org-agenda-tags-column 0) 10157 (- (abs org-agenda-tags-column) l) 10158 org-agenda-tags-column)) 10159 (goto-char (match-beginning 1)) 10160 (delete-region (save-excursion (skip-chars-backward " \t") (point)) 10161 (point)) 10162 (insert (org-add-props 10163 (make-string (max 1 (- c (current-column))) ?\s) 10164 (plist-put (copy-sequence (text-properties-at (point))) 10165 'face nil)))) 10166 (goto-char (point-min)) 10167 (org-font-lock-add-tag-faces (point-max)))))) 10168 10169 (defun org-agenda-priority-up () 10170 "Increase the priority of line at point, also in Org file." 10171 (interactive) 10172 (org-agenda-priority 'up)) 10173 10174 (defun org-agenda-priority-down () 10175 "Decrease the priority of line at point, also in Org file." 10176 (interactive) 10177 (org-agenda-priority 'down)) 10178 10179 (defun org-agenda-priority (&optional force-direction) 10180 "Set the priority of line at point, also in Org file. 10181 This changes the line at point, all other lines in the agenda 10182 referring to the same tree node, and the headline of the tree 10183 node in the Org file. 10184 10185 Called with one universal prefix arg, show the priority instead 10186 of setting it. 10187 10188 When called programmatically, FORCE-DIRECTION can be `set', `up', 10189 `down', or a character." 10190 (interactive "P") 10191 (unless org-priority-enable-commands 10192 (user-error "Priority commands are disabled")) 10193 (org-agenda-check-no-diary) 10194 (let* ((col (current-column)) 10195 (hdmarker (org-get-at-bol 'org-hd-marker)) 10196 (buffer (marker-buffer hdmarker)) 10197 (pos (marker-position hdmarker)) 10198 (inhibit-read-only t) 10199 newhead) 10200 (org-with-remote-undo buffer 10201 (with-current-buffer buffer 10202 (widen) 10203 (goto-char pos) 10204 (org-fold-show-context 'agenda) 10205 (org-priority force-direction) 10206 (end-of-line 1) 10207 (setq newhead (org-get-heading))) 10208 (org-agenda-change-all-lines newhead hdmarker) 10209 (org-move-to-column col)))) 10210 10211 ;; FIXME: should fix the tags property of the agenda line. 10212 (defun org-agenda-set-tags (&optional tag onoff) 10213 "Set tags for the current headline." 10214 (interactive) 10215 (org-agenda-check-no-diary) 10216 (if (and (org-region-active-p) (called-interactively-p 'any)) 10217 (call-interactively 'org-change-tag-in-region) 10218 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 10219 (org-agenda-error))) 10220 (buffer (marker-buffer hdmarker)) 10221 (pos (marker-position hdmarker)) 10222 (inhibit-read-only t) 10223 newhead) 10224 (org-with-remote-undo buffer 10225 (with-current-buffer buffer 10226 (widen) 10227 (goto-char pos) 10228 (org-fold-show-context 'agenda) 10229 (if tag 10230 (org-toggle-tag tag onoff) 10231 (call-interactively #'org-set-tags-command)) 10232 (end-of-line 1) 10233 (setq newhead (org-get-heading))) 10234 (org-agenda-change-all-lines newhead hdmarker) 10235 (beginning-of-line 1))))) 10236 10237 (defun org-agenda-set-property () 10238 "Set a property for the current headline." 10239 (interactive) 10240 (org-agenda-check-no-diary) 10241 (org-agenda-maybe-loop 10242 #'org-agenda-set-property nil nil nil 10243 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 10244 (org-agenda-error))) 10245 (buffer (marker-buffer hdmarker)) 10246 (pos (marker-position hdmarker)) 10247 (inhibit-read-only t) 10248 ) ;; newhead 10249 (org-with-remote-undo buffer 10250 (with-current-buffer buffer 10251 (widen) 10252 (goto-char pos) 10253 (org-fold-show-context 'agenda) 10254 (call-interactively 'org-set-property)))))) 10255 10256 (defun org-agenda-set-effort () 10257 "Set the effort property for the current headline." 10258 (interactive) 10259 (org-agenda-check-no-diary) 10260 (org-agenda-maybe-loop 10261 #'org-agenda-set-effort nil nil nil 10262 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 10263 (org-agenda-error))) 10264 (buffer (marker-buffer hdmarker)) 10265 (pos (marker-position hdmarker)) 10266 (inhibit-read-only t) 10267 newhead) 10268 (org-with-remote-undo buffer 10269 (with-current-buffer buffer 10270 (widen) 10271 (goto-char pos) 10272 (org-fold-show-context 'agenda) 10273 (call-interactively 'org-set-effort) 10274 (end-of-line 1) 10275 (setq newhead (org-get-heading))) 10276 (org-agenda-change-all-lines newhead hdmarker))))) 10277 10278 (defun org-agenda-toggle-archive-tag () 10279 "Toggle the archive tag for the current entry." 10280 (interactive) 10281 (org-agenda-check-no-diary) 10282 (org-agenda-maybe-loop 10283 #'org-agenda-toggle-archive-tag nil nil nil 10284 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 10285 (org-agenda-error))) 10286 (buffer (marker-buffer hdmarker)) 10287 (pos (marker-position hdmarker)) 10288 (inhibit-read-only t) 10289 newhead) 10290 (org-with-remote-undo buffer 10291 (with-current-buffer buffer 10292 (widen) 10293 (goto-char pos) 10294 (org-fold-show-context 'agenda) 10295 (call-interactively 'org-toggle-archive-tag) 10296 (end-of-line 1) 10297 (setq newhead (org-get-heading))) 10298 (org-agenda-change-all-lines newhead hdmarker) 10299 (beginning-of-line 1))))) 10300 10301 (defun org-agenda-do-date-later (arg) 10302 (interactive "P") 10303 (cond 10304 ((or (equal arg '(16)) 10305 (memq last-command 10306 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) 10307 (setq this-command 'org-agenda-date-later-minutes) 10308 (org-agenda-date-later-minutes 1)) 10309 ((or (equal arg '(4)) 10310 (memq last-command 10311 '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) 10312 (setq this-command 'org-agenda-date-later-hours) 10313 (org-agenda-date-later-hours 1)) 10314 (t 10315 (org-agenda-date-later (prefix-numeric-value arg))))) 10316 10317 (defun org-agenda-do-date-earlier (arg) 10318 (interactive "P") 10319 (cond 10320 ((or (equal arg '(16)) 10321 (memq last-command 10322 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) 10323 (setq this-command 'org-agenda-date-earlier-minutes) 10324 (org-agenda-date-earlier-minutes 1)) 10325 ((or (equal arg '(4)) 10326 (memq last-command 10327 '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) 10328 (setq this-command 'org-agenda-date-earlier-hours) 10329 (org-agenda-date-earlier-hours 1)) 10330 (t 10331 (org-agenda-date-earlier (prefix-numeric-value arg))))) 10332 10333 (defun org-agenda-date-later (arg &optional what) 10334 "Change the date of this item to ARG day(s) later." 10335 (interactive "p") 10336 (org-agenda-check-type t 'agenda) 10337 (org-agenda-check-no-diary) 10338 (let* ((marker (or (org-get-at-bol 'org-marker) 10339 (org-agenda-error))) 10340 (buffer (marker-buffer marker)) 10341 (pos (marker-position marker)) 10342 cdate today) 10343 (org-with-remote-undo buffer 10344 (with-current-buffer buffer 10345 (widen) 10346 (goto-char pos) 10347 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) 10348 (when (and org-agenda-move-date-from-past-immediately-to-today 10349 (equal arg 1) 10350 (or (not what) (eq what 'day)) 10351 (not (save-match-data (org-at-date-range-p)))) 10352 (setq cdate (org-parse-time-string (match-string 0) 'nodefault) 10353 cdate (calendar-absolute-from-gregorian 10354 (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate))) 10355 today (org-today)) 10356 (when (> today cdate) 10357 ;; immediately shift to today 10358 (setq arg (- today cdate)))) 10359 (org-timestamp-change arg (or what 'day)) 10360 (when (and (org-at-date-range-p) 10361 (re-search-backward org-tr-regexp-both 10362 (line-beginning-position))) 10363 (let ((end org-last-changed-timestamp)) 10364 (org-timestamp-change arg (or what 'day)) 10365 (setq org-last-changed-timestamp 10366 (concat org-last-changed-timestamp "--" end))))) 10367 (org-agenda-show-new-time marker org-last-changed-timestamp)) 10368 (message "Time stamp changed to %s" org-last-changed-timestamp))) 10369 10370 (defun org-agenda-date-earlier (arg &optional what) 10371 "Change the date of this item to ARG day(s) earlier." 10372 (interactive "p") 10373 (org-agenda-date-later (- arg) what)) 10374 10375 (defun org-agenda-date-later-minutes (arg) 10376 "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." 10377 (interactive "p") 10378 (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) 10379 (org-agenda-date-later arg 'minute)) 10380 10381 (defun org-agenda-date-earlier-minutes (arg) 10382 "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." 10383 (interactive "p") 10384 (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) 10385 (org-agenda-date-earlier arg 'minute)) 10386 10387 (defun org-agenda-date-later-hours (arg) 10388 "Change the time of this item, in hour steps." 10389 (interactive "p") 10390 (org-agenda-date-later arg 'hour)) 10391 10392 (defun org-agenda-date-earlier-hours (arg) 10393 "Change the time of this item, in hour steps." 10394 (interactive "p") 10395 (org-agenda-date-earlier arg 'hour)) 10396 10397 (defun org-agenda-show-new-time (marker stamp &optional prefix) 10398 "Show new date stamp via text properties." 10399 ;; We use text properties to make this undoable 10400 (let ((inhibit-read-only t)) 10401 (setq stamp (concat prefix " => " stamp " ")) 10402 (save-excursion 10403 (goto-char (point-max)) 10404 (while (not (bobp)) 10405 (when (equal marker (org-get-at-bol 'org-marker)) 10406 (remove-text-properties (line-beginning-position) 10407 (line-end-position) 10408 '(display nil)) 10409 (org-move-to-column 10410 (- (window-max-chars-per-line) 10411 (length stamp)) 10412 t) 10413 (add-text-properties 10414 (1- (point)) (line-end-position) 10415 (list 'display (org-add-props stamp nil 10416 'face '(secondary-selection default)))) 10417 (beginning-of-line 1)) 10418 (beginning-of-line 0))))) 10419 10420 (defun org-agenda-date-prompt (arg) 10421 "Change the date of this item. Date is prompted for, with default today. 10422 The prefix ARG is passed to the `org-time-stamp' command and can therefore 10423 be used to request time specification in the time stamp." 10424 (interactive "P") 10425 (org-agenda-check-type t 'agenda) 10426 (org-agenda-check-no-diary) 10427 (org-agenda-maybe-loop 10428 #'org-agenda-date-prompt arg t nil 10429 (let* ((marker (or (org-get-at-bol 'org-marker) 10430 (org-agenda-error))) 10431 (buffer (marker-buffer marker)) 10432 (pos (marker-position marker))) 10433 (org-with-remote-undo buffer 10434 (with-current-buffer buffer 10435 (widen) 10436 (goto-char pos) 10437 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) 10438 (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) 10439 (org-agenda-show-new-time marker org-last-changed-timestamp)) 10440 (message "Time stamp changed to %s" org-last-changed-timestamp)))) 10441 10442 (defun org-agenda-schedule (arg &optional time) 10443 "Schedule the item at point. 10444 ARG is passed through to `org-schedule'." 10445 (interactive "P") 10446 (org-agenda-check-type t 'agenda 'todo 'tags 'search) 10447 (org-agenda-check-no-diary) 10448 (org-agenda-maybe-loop 10449 #'org-agenda-schedule arg t nil 10450 (let* ((marker (or (org-get-at-bol 'org-marker) 10451 (org-agenda-error))) 10452 ;; (type (marker-insertion-type marker)) 10453 (buffer (marker-buffer marker)) 10454 (pos (marker-position marker)) 10455 ts) 10456 (set-marker-insertion-type marker t) 10457 (org-with-remote-undo buffer 10458 (with-current-buffer buffer 10459 (widen) 10460 (goto-char pos) 10461 (setq ts (org-schedule arg time))) 10462 (org-agenda-show-new-time marker ts " S")) 10463 (message "%s" ts)))) 10464 10465 (defun org-agenda-deadline (arg &optional time) 10466 "Schedule the item at point. 10467 ARG is passed through to `org-deadline'." 10468 (interactive "P") 10469 (org-agenda-check-type t 'agenda 'todo 'tags 'search) 10470 (org-agenda-check-no-diary) 10471 (org-agenda-maybe-loop 10472 #'org-agenda-deadline arg t nil 10473 (let* ((marker (or (org-get-at-bol 'org-marker) 10474 (org-agenda-error))) 10475 (buffer (marker-buffer marker)) 10476 (pos (marker-position marker)) 10477 ts) 10478 (org-with-remote-undo buffer 10479 (with-current-buffer buffer 10480 (widen) 10481 (goto-char pos) 10482 (setq ts (org-deadline arg time))) 10483 (org-agenda-show-new-time marker ts " D")) 10484 (message "%s" ts)))) 10485 10486 (defun org-agenda-clock-in (&optional arg) 10487 "Start the clock on the currently selected item." 10488 (interactive "P") 10489 (org-agenda-check-no-diary) 10490 (if (equal arg '(4)) 10491 (org-clock-in arg) 10492 (let* ((marker (or (org-get-at-bol 'org-marker) 10493 (org-agenda-error))) 10494 (hdmarker (or (org-get-at-bol 'org-hd-marker) marker)) 10495 (pos (marker-position marker)) 10496 (col (current-column)) 10497 newhead) 10498 (org-with-remote-undo (marker-buffer marker) 10499 (with-current-buffer (marker-buffer marker) 10500 (widen) 10501 (goto-char pos) 10502 (org-fold-show-context 'agenda) 10503 (org-clock-in arg) 10504 (setq newhead (org-get-heading))) 10505 (org-agenda-change-all-lines newhead hdmarker)) 10506 (org-move-to-column col)))) 10507 10508 (defun org-agenda-clock-out () 10509 "Stop the currently running clock." 10510 (interactive) 10511 (unless (marker-buffer org-clock-marker) 10512 (user-error "No running clock")) 10513 (let ((marker (make-marker)) (col (current-column)) newhead) 10514 (org-with-remote-undo (marker-buffer org-clock-marker) 10515 (with-current-buffer (marker-buffer org-clock-marker) 10516 (org-with-wide-buffer 10517 (goto-char org-clock-marker) 10518 (org-back-to-heading t) 10519 (move-marker marker (point)) 10520 (org-clock-out) 10521 (setq newhead (org-get-heading))))) 10522 (org-agenda-change-all-lines newhead marker) 10523 (move-marker marker nil) 10524 (org-move-to-column col) 10525 (org-agenda-unmark-clocking-task))) 10526 10527 (defun org-agenda-clock-cancel (&optional _arg) 10528 "Cancel the currently running clock." 10529 (interactive) ;; "P" 10530 (unless (marker-buffer org-clock-marker) 10531 (user-error "No running clock")) 10532 (org-with-remote-undo (marker-buffer org-clock-marker) 10533 (org-clock-cancel))) 10534 10535 (defun org-agenda-clock-goto () 10536 "Jump to the currently clocked in task within the agenda. 10537 If the currently clocked in task is not listed in the agenda 10538 buffer, display it in another window." 10539 (interactive) 10540 (let (pos) 10541 (mapc (lambda (o) 10542 (when (eq (overlay-get o 'type) 'org-agenda-clocking) 10543 (setq pos (overlay-start o)))) 10544 (overlays-in (point-min) (point-max))) 10545 (cond (pos (goto-char pos)) 10546 ;; If the currently clocked entry is not in the agenda 10547 ;; buffer, we visit it in another window: 10548 ((bound-and-true-p org-clock-current-task) 10549 (org-switch-to-buffer-other-window (org-clock-goto))) 10550 (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) 10551 10552 (defun org-agenda-diary-entry-in-org-file () 10553 "Make a diary entry in the file `org-agenda-diary-file'." 10554 (let (d1 d2 char (text "") dp1 dp2) 10555 (if (equal (buffer-name) "*Calendar*") 10556 (setq d1 (calendar-cursor-to-date t) 10557 d2 (car calendar-mark-ring)) 10558 (setq dp1 (get-text-property (line-beginning-position) 'day)) 10559 (unless dp1 (user-error "No date defined in current line")) 10560 (setq d1 (calendar-gregorian-from-absolute dp1) 10561 d2 (and (ignore-errors (mark)) 10562 (save-excursion 10563 (goto-char (mark)) 10564 (setq dp2 (get-text-property (line-beginning-position) 'day))) 10565 (calendar-gregorian-from-absolute dp2)))) 10566 (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree") 10567 (setq char (read-char-exclusive)) 10568 (cond 10569 ((equal char ?d) 10570 (setq text (read-string "Day entry: ")) 10571 (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1) 10572 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) 10573 ((equal char ?a) 10574 (setq d1 (list (car d1) (nth 1 d1) 10575 (read-number (format "Reference year [%d]: " (nth 2 d1)) 10576 (nth 2 d1)))) 10577 (setq text (read-string "Anniversary (use %d to show years): ")) 10578 (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1) 10579 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) 10580 ((equal char ?b) 10581 (setq text (read-string "Block entry: ")) 10582 (unless (and d1 d2 (not (equal d1 d2))) 10583 (user-error "No block of days selected")) 10584 (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2) 10585 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) 10586 ((equal char ?j) 10587 (org-switch-to-buffer-other-window 10588 (find-file-noselect org-agenda-diary-file)) 10589 (require 'org-datetree) 10590 (org-datetree-find-date-create d1) 10591 (org-fold-reveal t)) 10592 (t (user-error "Invalid selection character `%c'" char))))) 10593 10594 (defcustom org-agenda-insert-diary-strategy 'date-tree 10595 "Where in `org-agenda-diary-file' should new entries be added? 10596 Valid values: 10597 10598 date-tree in the date tree, as first child of the date 10599 date-tree-last in the date tree, as last child of the date 10600 top-level as top-level entries at the end of the file." 10601 :group 'org-agenda 10602 :type '(choice 10603 (const :tag "first in a date tree" date-tree) 10604 (const :tag "last in a date tree" date-tree-last) 10605 (const :tag "as top level at end of file" top-level))) 10606 10607 (defcustom org-agenda-insert-diary-extract-time nil 10608 "Non-nil means extract any time specification from the diary entry." 10609 :group 'org-agenda 10610 :version "24.1" 10611 :type 'boolean) 10612 10613 (defcustom org-agenda-bulk-mark-char ">" 10614 "A single-character string to be used as the bulk mark." 10615 :group 'org-agenda 10616 :version "24.1" 10617 :type 'string) 10618 10619 (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) 10620 "Add a diary entry with TYPE to `org-agenda-diary-file'. 10621 If TEXT is not empty, it will become the headline of the new entry, and 10622 the resulting entry will not be shown. When TEXT is empty, switch to 10623 `org-agenda-diary-file' and let the user finish the entry there." 10624 (let ((cw (current-window-configuration))) 10625 (org-switch-to-buffer-other-window 10626 (find-file-noselect org-agenda-diary-file)) 10627 (widen) 10628 (goto-char (point-min)) 10629 (cl-case type 10630 (anniversary 10631 (or (re-search-forward "^\\*[ \t]+Anniversaries" nil t) 10632 (progn 10633 (or (org-at-heading-p) 10634 (progn 10635 (outline-next-heading) 10636 (insert "* Anniversaries\n\n") 10637 (beginning-of-line -1))))) 10638 (outline-next-heading) 10639 (org-back-over-empty-lines) 10640 (backward-char 1) 10641 (insert "\n") 10642 (insert (format "%%%%(org-anniversary %d %2d %2d) %s" 10643 (nth 2 d1) (car d1) (nth 1 d1) text))) 10644 (day 10645 (let ((org-prefix-has-time t) 10646 (org-agenda-time-leading-zero t) 10647 fmt time time2) 10648 (when org-agenda-insert-diary-extract-time 10649 ;; Use org-agenda-format-item to parse text for a time-range and 10650 ;; remove it. FIXME: This is a hack, we should refactor 10651 ;; that function to make time extraction available separately 10652 (setq fmt (org-agenda-format-item nil text nil nil nil t) 10653 time (get-text-property 0 'time fmt) 10654 time2 (if (> (length time) 0) 10655 ;; split-string removes trailing ...... if 10656 ;; no end time given. First space 10657 ;; separates time from date. 10658 (concat " " (car (split-string time "\\."))) 10659 nil) 10660 text (get-text-property 0 'txt fmt))) 10661 (if (eq org-agenda-insert-diary-strategy 'top-level) 10662 (org-agenda-insert-diary-as-top-level text) 10663 (require 'org-datetree) 10664 (org-datetree-find-date-create d1) 10665 (org-agenda-insert-diary-make-new-entry text)) 10666 (org-insert-time-stamp (org-time-from-absolute 10667 (calendar-absolute-from-gregorian d1)) 10668 nil nil nil nil time2)) 10669 (end-of-line 0)) 10670 ((block) ;; Wrap this in (strictly unnecessary) parens because 10671 ;; otherwise the indentation gets confused by the 10672 ;; special meaning of 'block 10673 (when (> (calendar-absolute-from-gregorian d1) 10674 (calendar-absolute-from-gregorian d2)) 10675 (setq d1 (prog1 d2 (setq d2 d1)))) 10676 (if (eq org-agenda-insert-diary-strategy 'top-level) 10677 (org-agenda-insert-diary-as-top-level text) 10678 (require 'org-datetree) 10679 (org-datetree-find-date-create d1) 10680 (org-agenda-insert-diary-make-new-entry text)) 10681 (org-insert-time-stamp (org-time-from-absolute 10682 (calendar-absolute-from-gregorian d1))) 10683 (insert "--") 10684 (org-insert-time-stamp (org-time-from-absolute 10685 (calendar-absolute-from-gregorian d2))) 10686 (end-of-line 0))) 10687 (if (string-match "\\S-" text) 10688 (progn 10689 (set-window-configuration cw) 10690 (message "%s entry added to %s" 10691 (capitalize (symbol-name type)) 10692 (abbreviate-file-name org-agenda-diary-file))) 10693 (org-fold-reveal t) 10694 (message "Please finish entry here")))) 10695 10696 (defun org-agenda-insert-diary-as-top-level (text) 10697 "Make new entry as a top-level entry at the end of the file. 10698 Add TEXT as headline, and position the cursor in the second line so that 10699 a timestamp can be added there." 10700 (widen) 10701 (goto-char (point-max)) 10702 (unless (bolp) (insert "\n")) 10703 (org-insert-heading nil t t) 10704 (insert text) 10705 (org-end-of-meta-data) 10706 (unless (bolp) (insert "\n")) 10707 (when org-adapt-indentation (indent-to-column 2))) 10708 10709 (defun org-agenda-insert-diary-make-new-entry (text) 10710 "Make a new entry with TEXT as a child of the current subtree. 10711 Position the point in the heading's first body line so that 10712 a timestamp can be added there." 10713 (cond 10714 ((eq org-agenda-insert-diary-strategy 'date-tree-last) 10715 (end-of-line) 10716 (org-insert-heading '(4) t) 10717 (org-do-demote)) 10718 (t 10719 (outline-next-heading) 10720 (org-back-over-empty-lines) 10721 (unless (looking-at "[ \t]*$") (save-excursion (insert "\n"))) 10722 (org-insert-heading nil t) 10723 (org-do-demote))) 10724 (let ((col (current-column))) 10725 (insert text) 10726 (org-end-of-meta-data) 10727 ;; Ensure point is left on a blank line, at proper indentation. 10728 (unless (bolp) (insert "\n")) 10729 (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n"))) 10730 (when org-adapt-indentation (indent-to-column col))) 10731 (org-fold-show-set-visibility 'lineage)) 10732 10733 (defun org-agenda-diary-entry () 10734 "Make a diary entry, like the `i' command from the calendar. 10735 All the standard commands work: block, weekly etc. 10736 When `org-agenda-diary-file' points to a file, 10737 `org-agenda-diary-entry-in-org-file' is called instead to create 10738 entries in that Org file." 10739 (interactive) 10740 (if (not (eq org-agenda-diary-file 'diary-file)) 10741 (org-agenda-diary-entry-in-org-file) 10742 (require 'diary-lib) 10743 (let* ((char (read-char-exclusive 10744 "Diary entry: [d]ay [w]eekly [m]onthly [y]early\ 10745 [a]nniversary [b]lock [c]yclic")) 10746 (cmd (cdr (assoc char 10747 '((?d . diary-insert-entry) 10748 (?w . diary-insert-weekly-entry) 10749 (?m . diary-insert-monthly-entry) 10750 (?y . diary-insert-yearly-entry) 10751 (?a . diary-insert-anniversary-entry) 10752 (?b . diary-insert-block-entry) 10753 (?c . diary-insert-cyclic-entry))))) 10754 (oldf (symbol-function 'calendar-cursor-to-date)) 10755 ;; (buf (get-file-buffer (substitute-in-file-name diary-file))) 10756 (point (point)) 10757 (mark (or (mark t) (point)))) 10758 (unless cmd 10759 (user-error "No command associated with <%c>" char)) 10760 (unless (and (get-text-property point 'day) 10761 (or (not (equal ?b char)) 10762 (get-text-property mark 'day))) 10763 (user-error "Don't know which date to use for diary entry")) 10764 ;; We implement this by hacking the `calendar-cursor-to-date' function 10765 ;; and the `calendar-mark-ring' variable. Saves a lot of code. 10766 (let ((calendar-mark-ring 10767 (list (calendar-gregorian-from-absolute 10768 (or (get-text-property mark 'day) 10769 (get-text-property point 'day)))))) 10770 (unwind-protect 10771 (progn 10772 (fset 'calendar-cursor-to-date 10773 (lambda (&optional _error _dummy) 10774 (calendar-gregorian-from-absolute 10775 (get-text-property point 'day)))) 10776 (call-interactively cmd)) 10777 (fset 'calendar-cursor-to-date oldf)))))) 10778 10779 (defun org-agenda-execute-calendar-command (cmd) 10780 "Execute a calendar command from the agenda with date from cursor." 10781 (org-agenda-check-type t 'agenda) 10782 (require 'diary-lib) 10783 (unless (get-text-property (min (1- (point-max)) (point)) 'day) 10784 (user-error "Don't know which date to use for the calendar command")) 10785 (let* ((oldf (symbol-function 'calendar-cursor-to-date)) 10786 (point (point)) 10787 (date (calendar-gregorian-from-absolute 10788 (get-text-property point 'day)))) 10789 ;; the following 2 vars are needed in the calendar 10790 (org-dlet 10791 ((displayed-month (car date)) 10792 (displayed-year (nth 2 date))) 10793 (unwind-protect 10794 (progn 10795 (fset 'calendar-cursor-to-date 10796 (lambda (&optional _error _dummy) 10797 (calendar-gregorian-from-absolute 10798 (get-text-property point 'day)))) 10799 (call-interactively cmd)) 10800 (fset 'calendar-cursor-to-date oldf))))) 10801 10802 (defun org-agenda-phases-of-moon () 10803 "Display the phases of the moon for the 3 months around the cursor date." 10804 (interactive) 10805 (org-agenda-execute-calendar-command 'calendar-lunar-phases)) 10806 10807 (defun org-agenda-holidays () 10808 "Display the holidays for the 3 months around the cursor date." 10809 (interactive) 10810 (org-agenda-execute-calendar-command 'calendar-list-holidays)) 10811 10812 (defvar calendar-longitude) ; defined in calendar.el 10813 (defvar calendar-latitude) ; defined in calendar.el 10814 (defvar calendar-location-name) ; defined in calendar.el 10815 10816 (defun org-agenda-sunrise-sunset (arg) 10817 "Display sunrise and sunset for the cursor date. 10818 Latitude and longitude can be specified with the variables 10819 `calendar-latitude' and `calendar-longitude'. When called with prefix 10820 argument, latitude and longitude will be prompted for." 10821 (interactive "P") 10822 (require 'solar) 10823 (let ((calendar-longitude (if arg nil calendar-longitude)) 10824 (calendar-latitude (if arg nil calendar-latitude)) 10825 (calendar-location-name 10826 (if arg "the given coordinates" calendar-location-name))) 10827 (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) 10828 10829 (defun org-agenda-goto-calendar () 10830 "Open the Emacs calendar with the date at the cursor." 10831 (interactive) 10832 (org-agenda-check-type t 'agenda) 10833 (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) 10834 (user-error "Don't know which date to open in calendar"))) 10835 (date (calendar-gregorian-from-absolute day)) 10836 (calendar-move-hook nil) 10837 (calendar-view-holidays-initially-flag nil) 10838 (calendar-view-diary-initially-flag nil)) 10839 (calendar) 10840 (calendar-goto-date date))) 10841 10842 ;;;###autoload 10843 (defun org-calendar-goto-agenda () 10844 "Compute the Org agenda for the calendar date displayed at the cursor. 10845 This is a command that has to be installed in `calendar-mode-map'." 10846 (interactive) 10847 ;; Temporarily disable sticky agenda since user clearly wants to 10848 ;; refresh view anyway. 10849 (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*") 10850 (org-agenda-sticky nil)) 10851 (org-agenda-list nil (calendar-absolute-from-gregorian 10852 (calendar-cursor-to-date)) 10853 nil))) 10854 10855 (defun org-agenda-convert-date () 10856 (interactive) 10857 (org-agenda-check-type t 'agenda) 10858 (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) 10859 date s) 10860 (unless day 10861 (user-error "Don't know which date to convert")) 10862 (setq date (calendar-gregorian-from-absolute day)) 10863 (setq s (concat 10864 "Gregorian: " (calendar-date-string date) "\n" 10865 "ISO: " (calendar-iso-date-string date) "\n" 10866 "Day of Yr: " (calendar-day-of-year-string date) "\n" 10867 "Julian: " (calendar-julian-date-string date) "\n" 10868 "Astron. JD: " (calendar-astro-date-string date) 10869 " (Julian date number at noon UTC)\n" 10870 "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" 10871 "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" 10872 "French: " (calendar-french-date-string date) "\n" 10873 "Bahá’í: " (calendar-bahai-date-string date) " (until sunset)\n" 10874 "Mayan: " (calendar-mayan-date-string date) "\n" 10875 "Coptic: " (calendar-coptic-date-string date) "\n" 10876 "Ethiopic: " (calendar-ethiopic-date-string date) "\n" 10877 "Persian: " (calendar-persian-date-string date) "\n" 10878 "Chinese: " (calendar-chinese-date-string date) "\n")) 10879 (with-output-to-temp-buffer "*Dates*" 10880 (princ s)) 10881 (org-fit-window-to-buffer (get-buffer-window "*Dates*")))) 10882 10883 ;;; Bulk commands 10884 10885 (defun org-agenda-bulk-marked-p () 10886 "Non-nil when current entry is marked for bulk action." 10887 (eq (get-char-property (line-beginning-position) 'type) 10888 'org-marked-entry-overlay)) 10889 10890 (defun org-agenda-bulk-mark (&optional arg) 10891 "Mark entries for future bulk action. 10892 10893 When ARG is nil or one and region is not active then mark the 10894 entry at point. 10895 10896 When ARG is nil or one and region is active then mark the entries 10897 in the region. 10898 10899 When ARG is greater than one mark ARG lines." 10900 (interactive "p") 10901 (when (and (or (not arg) (= arg 1)) (use-region-p)) 10902 (setq arg (count-lines (region-beginning) (region-end))) 10903 (goto-char (region-beginning)) 10904 (deactivate-mark)) 10905 (dotimes (_ (or arg 1)) 10906 (unless (org-get-at-bol 'org-agenda-diary-link) 10907 (let* ((m (org-get-at-bol 'org-hd-marker)) 10908 ov) 10909 (unless (org-agenda-bulk-marked-p) 10910 (unless m (user-error "Nothing to mark at point")) 10911 (push m org-agenda-bulk-marked-entries) 10912 (setq ov (make-overlay (line-beginning-position) 10913 (+ 2 (line-beginning-position)))) 10914 (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") 10915 (org-get-todo-face "TODO") 10916 'evaporate) 10917 (overlay-put ov 'type 'org-marked-entry-overlay)) 10918 (end-of-line 1) 10919 (or (ignore-errors 10920 (goto-char (next-single-property-change (point) 'org-hd-marker))) 10921 (beginning-of-line 2)) 10922 (while (and (get-char-property (point) 'invisible) (not (eobp))) 10923 (beginning-of-line 2))))) 10924 (message "%d entries marked for bulk action" 10925 (length org-agenda-bulk-marked-entries))) 10926 10927 (defun org-agenda-bulk-mark-all () 10928 "Mark all entries for future agenda bulk action." 10929 (interactive) 10930 (org-agenda-bulk-mark-regexp ".")) 10931 10932 (defun org-agenda-bulk-mark-regexp (regexp) 10933 "Mark entries matching REGEXP for future agenda bulk action." 10934 (interactive "sMark entries matching regexp: ") 10935 (let ((entries-marked 0) txt-at-point) 10936 (save-excursion 10937 (goto-char (point-min)) 10938 (goto-char (next-single-property-change (point) 'org-hd-marker)) 10939 (while (and (re-search-forward regexp nil t) 10940 (setq txt-at-point 10941 (get-text-property (match-beginning 0) 'txt))) 10942 (if (get-char-property (point) 'invisible) 10943 (beginning-of-line 2) 10944 (when (string-match-p regexp txt-at-point) 10945 (setq entries-marked (1+ entries-marked)) 10946 (call-interactively 'org-agenda-bulk-mark))))) 10947 (unless entries-marked 10948 (message "No entry matching this regexp.")))) 10949 10950 (defun org-agenda-bulk-unmark (&optional arg) 10951 "Unmark the entry at point for future bulk action." 10952 (interactive "P") 10953 (if arg 10954 (org-agenda-bulk-unmark-all) 10955 (cond ((org-agenda-bulk-marked-p) 10956 (org-agenda-bulk-remove-overlays 10957 (line-beginning-position) (+ 2 (line-beginning-position))) 10958 (setq org-agenda-bulk-marked-entries 10959 (delete (org-get-at-bol 'org-hd-marker) 10960 org-agenda-bulk-marked-entries)) 10961 (end-of-line 1) 10962 (or (ignore-errors 10963 (goto-char (next-single-property-change (point) 'txt))) 10964 (beginning-of-line 2)) 10965 (while (and (get-char-property (point) 'invisible) (not (eobp))) 10966 (beginning-of-line 2)) 10967 (message "%d entries left marked for bulk action" 10968 (length org-agenda-bulk-marked-entries))) 10969 (t (message "No entry to unmark here"))))) 10970 10971 (defun org-agenda-bulk-toggle-all () 10972 "Toggle all marks for bulk action." 10973 (interactive) 10974 (save-excursion 10975 (goto-char (point-min)) 10976 (while (ignore-errors 10977 (goto-char (next-single-property-change (point) 'org-hd-marker))) 10978 (org-agenda-bulk-toggle)))) 10979 10980 (defun org-agenda-bulk-toggle () 10981 "Toggle the mark at point for bulk action." 10982 (interactive) 10983 (if (org-agenda-bulk-marked-p) 10984 (org-agenda-bulk-unmark) 10985 (org-agenda-bulk-mark))) 10986 10987 (defun org-agenda-bulk-remove-overlays (&optional beg end) 10988 "Remove the mark overlays between BEG and END in the agenda buffer. 10989 BEG and END default to the buffer limits. 10990 10991 This only removes the overlays, it does not remove the markers 10992 from the list in `org-agenda-bulk-marked-entries'." 10993 (interactive) 10994 (mapc (lambda (ov) 10995 (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay) 10996 (delete-overlay ov))) 10997 (overlays-in (or beg (point-min)) (or end (point-max))))) 10998 10999 (defun org-agenda-bulk-unmark-all () 11000 "Remove all marks in the agenda buffer. 11001 This will remove the markers and the overlays." 11002 (interactive) 11003 (if (null org-agenda-bulk-marked-entries) 11004 (message "No entry to unmark") 11005 (setq org-agenda-bulk-marked-entries nil) 11006 (org-agenda-bulk-remove-overlays (point-min) (point-max)))) 11007 11008 (defcustom org-agenda-persistent-marks nil 11009 "Non-nil means marked items will stay marked after a bulk action. 11010 You can toggle this interactively by typing `p' when prompted for a 11011 bulk action." 11012 :group 'org-agenda 11013 :version "24.1" 11014 :type 'boolean) 11015 11016 (defcustom org-agenda-loop-over-headlines-in-active-region t 11017 "Shall some commands act upon headlines in the active region? 11018 11019 When set to t, some commands will be performed in all headlines 11020 within the active region. 11021 11022 When set to `start-level', some commands will be performed in all 11023 headlines within the active region, provided that these headlines 11024 are of the same level than the first one. 11025 11026 When set to a regular expression, those commands will be 11027 performed on the matching headlines within the active region. 11028 11029 The list of commands is: `org-agenda-schedule', 11030 `org-agenda-deadline', `org-agenda-date-prompt', 11031 `org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'. 11032 11033 See `org-loop-over-headlines-in-active-region' for the equivalent 11034 option for Org buffers." 11035 :type '(choice (const :tag "Don't loop" nil) 11036 (const :tag "All headlines in active region" t) 11037 (const :tag "In active region, headlines at the same level than the first one" start-level) 11038 (regexp :tag "Regular expression matcher")) 11039 :version "27.1" 11040 :package-version '(Org . "9.4") 11041 :group 'org-agenda) 11042 11043 (defun org-agenda-bulk-action (&optional arg) 11044 "Execute an remote-editing action on all marked entries. 11045 The prefix arg is passed through to the command if possible." 11046 (interactive "P") 11047 ;; When there is no mark, act on the agenda entry at point. 11048 (if (not org-agenda-bulk-marked-entries) 11049 (save-excursion (org-agenda-bulk-mark))) 11050 (dolist (m org-agenda-bulk-marked-entries) 11051 (unless (and (markerp m) 11052 (marker-buffer m) 11053 (buffer-live-p (marker-buffer m)) 11054 (marker-position m)) 11055 (user-error "Marker %s for bulk command is invalid" m))) 11056 11057 ;; Prompt for the bulk command. 11058 (org-unlogged-message 11059 (concat "Bulk (" (if org-agenda-persistent-marks "" "don't ") "[p]ersist marks): " 11060 "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " 11061 "[S]catter [f]unction " 11062 (and org-agenda-bulk-custom-functions 11063 (format " Custom: [%s]" 11064 (mapconcat (lambda (f) (char-to-string (car f))) 11065 org-agenda-bulk-custom-functions 11066 ""))))) 11067 (catch 'exit 11068 (let* ((org-log-refile (if org-log-refile 'time nil)) 11069 (entries (reverse org-agenda-bulk-marked-entries)) 11070 (org-overriding-default-time 11071 (and (get-text-property (point) 'org-agenda-date-header) 11072 (org-get-cursor-date))) 11073 redo-at-end 11074 cmd) 11075 (pcase (read-char-exclusive) 11076 (?p 11077 (let ((org-agenda-persistent-marks 11078 (not org-agenda-persistent-marks))) 11079 (org-agenda-bulk-action) 11080 (throw 'exit nil))) 11081 11082 (?$ 11083 (setq cmd #'org-agenda-archive)) 11084 11085 (?A 11086 (setq cmd #'org-agenda-archive-to-archive-sibling)) 11087 11088 ((or ?r ?w) 11089 (let ((refile-location 11090 (org-refile-get-location 11091 "Refile to" 11092 (marker-buffer (car entries)) 11093 org-refile-allow-creating-parent-nodes))) 11094 (when (nth 3 refile-location) 11095 (setcar (nthcdr 3 refile-location) 11096 (move-marker 11097 (make-marker) 11098 (nth 3 refile-location) 11099 (or (get-file-buffer (nth 1 refile-location)) 11100 (find-buffer-visiting (nth 1 refile-location)) 11101 (error "This should not happen"))))) 11102 11103 (setq cmd (lambda () (org-agenda-refile nil refile-location t))) 11104 (setq redo-at-end t))) 11105 11106 (?t 11107 (let ((state (completing-read 11108 "Todo state: " 11109 (with-current-buffer (marker-buffer (car entries)) 11110 (mapcar #'list org-todo-keywords-1))))) 11111 (setq cmd (lambda () 11112 (let ((org-inhibit-blocking t) 11113 (org-inhibit-logging 'note)) 11114 (org-agenda-todo state)))))) 11115 11116 ((and (or ?- ?+) action) 11117 (let ((tag (completing-read 11118 (format "Tag to %s: " (if (eq action ?+) "add" "remove")) 11119 (with-current-buffer (marker-buffer (car entries)) 11120 (delq nil 11121 (mapcar (lambda (x) (and (stringp (car x)) x)) 11122 org-current-tag-alist)))))) 11123 (setq cmd 11124 (lambda () 11125 (org-agenda-set-tags tag 11126 (if (eq action ?+) 'on 'off)))))) 11127 11128 ((and (or ?s ?d) c) 11129 (let* ((schedule? (eq c ?s)) 11130 (prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to")) 11131 (time 11132 (and (not arg) 11133 (let ((new (org-read-date 11134 nil nil nil prompt org-overriding-default-time))) 11135 ;; A "double plus" answer applies to every 11136 ;; scheduled time. Do not turn it into 11137 ;; a fixed date yet. 11138 (if (string-match-p "\\`[ \t]*\\+\\+" 11139 org-read-date-final-answer) 11140 org-read-date-final-answer 11141 new))))) 11142 ;; Make sure to not prompt for a note when bulk 11143 ;; rescheduling/resetting deadline as Org cannot cope with 11144 ;; simultaneous notes. Besides, it could be annoying 11145 ;; depending on the number of marked items. 11146 (setq cmd 11147 (if schedule? 11148 (lambda () 11149 (let ((org-log-reschedule 11150 (and org-log-reschedule 'time))) 11151 (org-agenda-schedule arg time))) 11152 (lambda () 11153 (let ((org-log-redeadline (and org-log-redeadline 'time))) 11154 (org-agenda-deadline arg time))))))) 11155 11156 (?S 11157 (unless (org-agenda-check-type nil 'agenda 'todo) 11158 (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)) 11159 (let ((days (read-number 11160 (format "Scatter tasks across how many %sdays: " 11161 (if arg "week" "")) 11162 7))) 11163 (setq cmd 11164 (lambda () 11165 (let ((distance (1+ (random days)))) 11166 (when arg 11167 (let ((dist distance) 11168 (day-of-week 11169 (calendar-day-of-week 11170 (calendar-gregorian-from-absolute (org-today))))) 11171 (dotimes (_ (1+ dist)) 11172 (while (member day-of-week org-agenda-weekend-days) 11173 (cl-incf distance) 11174 (cl-incf day-of-week) 11175 (when (= day-of-week 7) 11176 (setq day-of-week 0))) 11177 (cl-incf day-of-week) 11178 (when (= day-of-week 7) 11179 (setq day-of-week 0))))) 11180 ;; Silently fail when try to replan a sexp entry. 11181 (ignore-errors 11182 (let* ((date (calendar-gregorian-from-absolute 11183 (+ (org-today) distance))) 11184 (time (org-encode-time 11185 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 11186 (org-agenda-schedule nil time)))))))) 11187 11188 (?f 11189 (setq cmd 11190 (intern 11191 (completing-read "Function: " obarray #'fboundp t nil nil)))) 11192 11193 (action 11194 (setq cmd 11195 (pcase (assoc action org-agenda-bulk-custom-functions) 11196 (`(,_ ,fn) 11197 fn) 11198 (`(,_ ,fn ,arg-fn) 11199 (apply #'apply-partially fn (funcall arg-fn))) 11200 (_ 11201 (user-error "Invalid bulk action: %c" action)))) 11202 (setq redo-at-end t))) 11203 ;; Sort the markers, to make sure that parents are handled 11204 ;; before children. 11205 (setq entries (sort entries 11206 (lambda (a b) 11207 (cond 11208 ((eq (marker-buffer a) (marker-buffer b)) 11209 (< (marker-position a) (marker-position b))) 11210 (t 11211 (string< (buffer-name (marker-buffer a)) 11212 (buffer-name (marker-buffer b)))))))) 11213 11214 ;; Now loop over all markers and apply CMD. 11215 (let ((processed 0) 11216 (skipped 0)) 11217 (dolist (e entries) 11218 (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e))) 11219 (if (not pos) 11220 (progn (message "Skipping removed entry at %s" e) 11221 (cl-incf skipped)) 11222 (goto-char pos) 11223 (let (org-loop-over-headlines-in-active-region) (funcall cmd)) 11224 ;; `post-command-hook' is not run yet. We make sure any 11225 ;; pending log note is processed. 11226 (when org-log-setup (org-add-log-note)) 11227 (cl-incf processed)))) 11228 (when redo-at-end (org-agenda-redo)) 11229 (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all)) 11230 (message "Acted on %d entries%s%s" 11231 processed 11232 (if (= skipped 0) 11233 "" 11234 (format ", skipped %d (disappeared before their turn)" 11235 skipped)) 11236 (if (not org-agenda-persistent-marks) "" " (kept marked)")))))) 11237 11238 (defun org-agenda-capture (&optional with-time) 11239 "Call `org-capture' with the date at point. 11240 With a `C-1' prefix, use the HH:MM value at point (if any) or the 11241 current HH:MM time." 11242 (interactive "P") 11243 (if (not (eq major-mode 'org-agenda-mode)) 11244 (user-error "You cannot do this outside of agenda buffers") 11245 (let ((org-overriding-default-time 11246 (org-get-cursor-date (equal with-time 1)))) 11247 (call-interactively 'org-capture)))) 11248 11249 ;;; Dragging agenda lines forward/backward 11250 11251 (defun org-agenda-reapply-filters () 11252 "Re-apply all agenda filters." 11253 (mapcar 11254 (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t))) 11255 `((,org-agenda-tag-filter tag) 11256 (,org-agenda-category-filter category) 11257 (,org-agenda-regexp-filter regexp) 11258 (,org-agenda-effort-filter effort) 11259 (,(assoc-default 'tag org-agenda-filters-preset) tag) 11260 (,(assoc-default 'category org-agenda-filters-preset) category) 11261 (,(assoc-default 'effort org-agenda-filters-preset) effort) 11262 (,(assoc-default 'regexp org-agenda-filters-preset) regexp)))) 11263 11264 (defun org-agenda-drag-line-forward (arg &optional backward) 11265 "Drag an agenda line forward by ARG lines. 11266 When the optional argument `backward' is non-nil, move backward." 11267 (interactive "p") 11268 (let ((inhibit-read-only t) lst line) 11269 (if (or (not (get-text-property (point) 'txt)) 11270 (save-excursion 11271 (dotimes (_ arg) 11272 (move-beginning-of-line (if backward 0 2)) 11273 (push (not (get-text-property (point) 'txt)) lst)) 11274 (delq nil lst))) 11275 (message "Cannot move line forward") 11276 (let ((end (save-excursion (move-beginning-of-line 2) (point)))) 11277 (move-beginning-of-line 1) 11278 (setq line (buffer-substring (point) end)) 11279 (delete-region (point) end) 11280 (move-beginning-of-line (funcall (if backward '1- '1+) arg)) 11281 (insert line) 11282 (org-agenda-reapply-filters) 11283 (org-agenda-mark-clocking-task) 11284 (move-beginning-of-line 0))))) 11285 11286 (defun org-agenda-drag-line-backward (arg) 11287 "Drag an agenda line backward by ARG lines." 11288 (interactive "p") 11289 (org-agenda-drag-line-forward arg t)) 11290 11291 ;;; Flagging notes 11292 11293 (defun org-agenda-show-the-flagging-note () 11294 "Display the flagging note in the other window. 11295 When called a second time in direct sequence, offer to remove the FLAGGING 11296 tag and (if present) the flagging note." 11297 (interactive) 11298 (let ((hdmarker (org-get-at-bol 'org-hd-marker)) 11299 (win (selected-window)) 11300 note) ;; heading newhead 11301 (unless hdmarker 11302 (user-error "No linked entry at point")) 11303 (if (and (eq this-command last-command) 11304 (y-or-n-p "Unflag and remove any flagging note? ")) 11305 (progn 11306 (org-agenda-remove-flag hdmarker) 11307 (let ((win (get-buffer-window "*Flagging Note*"))) 11308 (and win (delete-window win))) 11309 (message "Entry unflagged")) 11310 (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE")) 11311 (unless note 11312 (user-error "No flagging note")) 11313 (org-kill-new note) 11314 (org-switch-to-buffer-other-window "*Flagging Note*") 11315 (erase-buffer) 11316 (insert note) 11317 (goto-char (point-min)) 11318 (while (re-search-forward "\\\\n" nil t) 11319 (replace-match "\n" t t)) 11320 (goto-char (point-min)) 11321 (select-window win) 11322 (message "%s" (substitute-command-keys "Flagging note pushed to \ 11323 kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \ 11324 tag and note"))))) 11325 11326 (defun org-agenda-remove-flag (marker) 11327 "Remove the FLAGGED tag and any flagging note in the entry." 11328 (let ((newhead 11329 (org-with-point-at marker 11330 (org-toggle-tag "FLAGGED" 'off) 11331 (org-entry-delete nil "THEFLAGGINGNOTE") 11332 (org-get-heading)))) 11333 (org-agenda-change-all-lines newhead marker) 11334 (message "Entry unflagged"))) 11335 11336 (defun org-agenda-get-any-marker (&optional pos) 11337 (or (get-text-property (or pos (line-beginning-position)) 'org-hd-marker) 11338 (get-text-property (or pos (line-beginning-position)) 'org-marker))) 11339 11340 ;;; Appointment reminders 11341 11342 (defvar appt-time-msg-list) ; defined in appt.el 11343 11344 ;;;###autoload 11345 (defun org-agenda-to-appt (&optional refresh filter &rest args) 11346 "Activate appointments found in `org-agenda-files'. 11347 11348 With a `\\[universal-argument]' prefix, refresh the list of \ 11349 appointments. 11350 11351 If FILTER is t, interactively prompt the user for a regular 11352 expression, and filter out entries that don't match it. 11353 11354 If FILTER is a string, use this string as a regular expression 11355 for filtering entries out. 11356 11357 If FILTER is a function, filter out entries against which 11358 calling the function returns nil. This function takes one 11359 argument: an entry from `org-agenda-get-day-entries'. 11360 11361 FILTER can also be an alist with the car of each cell being 11362 either `headline' or `category'. For example: 11363 11364 ((headline \"IMPORTANT\") 11365 (category \"Work\")) 11366 11367 will only add headlines containing IMPORTANT or headlines 11368 belonging to the \"Work\" category. 11369 11370 ARGS are symbols indicating what kind of entries to consider. 11371 By default `org-agenda-to-appt' will use :deadline*, :scheduled* 11372 \(i.e., deadlines and scheduled items with a hh:mm specification) 11373 and :timestamp entries. See the docstring of `org-diary' for 11374 details and examples. 11375 11376 If an entry has a APPT_WARNTIME property, its value will be used 11377 to override `appt-message-warning-time'." 11378 (interactive "P") 11379 (when refresh (setq appt-time-msg-list nil)) 11380 (when (eq filter t) 11381 (setq filter (read-from-minibuffer "Regexp filter: "))) 11382 (let* ((cnt 0) ; count added events 11383 (scope (or args '(:deadline* :scheduled* :timestamp))) 11384 (org-agenda-new-buffers nil) 11385 (org-deadline-warning-days 0) 11386 ;; Do not use `org-today' here because appt only takes 11387 ;; time and without date as argument, so it may pass wrong 11388 ;; information otherwise 11389 (today (org-date-to-gregorian 11390 (time-to-days nil))) 11391 (org-agenda-restrict nil) 11392 (files (org-agenda-files 'unrestricted)) entries file 11393 (org-agenda-buffer nil)) 11394 ;; Get all entries which may contain an appt 11395 (org-agenda-prepare-buffers files) 11396 (while (setq file (pop files)) 11397 (setq entries 11398 (delq nil 11399 (append entries 11400 (apply #'org-agenda-get-day-entries 11401 file today scope))))) 11402 ;; Map through entries and find if we should filter them out 11403 (mapc 11404 (lambda (x) 11405 (let* ((evt (org-trim 11406 (replace-regexp-in-string 11407 org-link-bracket-re "\\2" 11408 (or (get-text-property 1 'txt x) "")))) 11409 (cat (get-text-property (1- (length x)) 'org-category x)) 11410 (tod (get-text-property 1 'time-of-day x)) 11411 (ok (or (null filter) 11412 (and (stringp filter) (string-match filter evt)) 11413 (and (functionp filter) (funcall filter x)) 11414 (and (listp filter) 11415 (let ((cat-filter (cadr (assq 'category filter))) 11416 (evt-filter (cadr (assq 'headline filter)))) 11417 (or (and (stringp cat-filter) 11418 (string-match cat-filter cat)) 11419 (and (stringp evt-filter) 11420 (string-match evt-filter evt))))))) 11421 (wrn (get-text-property 1 'warntime x))) 11422 ;; FIXME: Shall we remove text-properties for the appt text? 11423 ;; (setq evt (set-text-properties 0 (length evt) nil evt)) 11424 (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt))) 11425 (setq tod (concat "00" (number-to-string tod))) 11426 (setq tod (when (string-match 11427 "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) 11428 (concat (match-string 1 tod) ":" 11429 (match-string 2 tod)))) 11430 (when (appt-add tod evt wrn) 11431 (setq cnt (1+ cnt)))))) 11432 entries) 11433 (org-release-buffers org-agenda-new-buffers) 11434 (if (eq cnt 0) 11435 (message "No event to add") 11436 (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) 11437 11438 (defun org-agenda-today-p (date) 11439 "Non-nil when DATE means today. 11440 DATE is either a list of the form (month day year) or a number of 11441 days as returned by `calendar-absolute-from-gregorian' or 11442 `org-today'. This function considers `org-extend-today-until' 11443 when defining today." 11444 (eq (org-today) 11445 (if (consp date) (calendar-absolute-from-gregorian date) date))) 11446 11447 (defun org-agenda-todo-yesterday (&optional arg) 11448 "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday." 11449 (interactive "P") 11450 (let* ((org-use-effective-time t) 11451 (hour (nth 2 (decode-time (org-current-time)))) 11452 (org-extend-today-until (1+ hour))) 11453 (org-agenda-todo arg))) 11454 11455 (defun org-agenda-ctrl-c-ctrl-c () 11456 "Set tags in agenda buffer." 11457 (interactive) 11458 (org-agenda-set-tags)) 11459 11460 (provide 'org-agenda) 11461 11462 ;;; org-agenda.el ends here