org-agenda.el (450943B)
1 ;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2004-2024 Free Software Foundation, Inc. 4 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, text 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 (require 'org-element) 58 59 (declare-function diary-add-to-list "diary-lib" 60 (date string specifier &optional marker globcolor literal)) 61 (declare-function calendar-iso-to-absolute "cal-iso" (date)) 62 (declare-function calendar-astro-date-string "cal-julian" (&optional date)) 63 (declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) 64 (declare-function calendar-chinese-date-string "cal-china" (&optional date)) 65 (declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) 66 (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) 67 (declare-function calendar-french-date-string "cal-french" (&optional date)) 68 (declare-function calendar-goto-date "cal-move" (date)) 69 (declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) 70 (declare-function calendar-islamic-date-string "cal-islam" (&optional date)) 71 (declare-function calendar-iso-date-string "cal-iso" (&optional date)) 72 (declare-function calendar-iso-from-absolute "cal-iso" (date)) 73 (declare-function calendar-julian-date-string "cal-julian" (&optional date)) 74 (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) 75 (declare-function calendar-persian-date-string "cal-persia" (&optional date)) 76 (declare-function calendar-check-holidays "holidays" (date)) 77 78 (declare-function org-columns-remove-overlays "org-colview" ()) 79 (declare-function org-datetree-find-date-create "org-datetree" 80 (date &optional keep-restriction)) 81 (declare-function org-columns-quit "org-colview" ()) 82 (declare-function diary-date-display-form "diary-lib" (&optional type)) 83 (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file)) 84 (declare-function org-habit-insert-consistency-graphs 85 "org-habit" (&optional line)) 86 (declare-function org-is-habit-p "org-habit" (&optional pom)) 87 (declare-function org-habit-parse-todo "org-habit" (&optional pom)) 88 (declare-function org-habit-get-urgency "org-habit" (habit &optional moment)) 89 (declare-function org-agenda-columns "org-colview" ()) 90 (declare-function org-add-archive-files "org-archive" (files)) 91 (declare-function org-capture "org-capture" (&optional goto keys)) 92 (declare-function org-clock-modify-effort-estimate "org-clock" (&optional value)) 93 94 (defvar calendar-mode-map) 95 (defvar org-clock-current-task) 96 (defvar org-current-tag-alist) 97 (defvar org-mobile-force-id-on-agenda-items) 98 (defvar org-habit-show-habits) 99 (defvar org-habit-show-habits-only-for-today) 100 (defvar org-habit-show-all-today) 101 (defvar org-habit-scheduled-past-days) 102 103 ;; Defined somewhere in this file, but used before definition. 104 (defvar org-agenda-buffer-name "*Org Agenda*") 105 (defvar org-agenda-title-append nil) 106 (defvar org-agenda-overriding-header) 107 ;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el 108 ;; (with-no-warnings (defvar date)) ;; unprefixed, from calendar.el 109 (defvar original-date) ; dynamically scoped, calendar.el does scope this 110 111 (defvar org-agenda-undo-list nil 112 "List of undoable operations in the agenda since last refresh.") 113 (defvar org-agenda-pending-undo-list nil 114 "In a series of undo commands, this is the list of remaining undo items.") 115 116 (defcustom org-agenda-confirm-kill 1 117 "When set, remote killing from the agenda buffer needs confirmation. 118 When t, a confirmation is always needed. When a number N, confirmation is 119 only needed when the text to be killed contains more than N non-white lines." 120 :group 'org-agenda 121 :type '(choice 122 (const :tag "Never" nil) 123 (const :tag "Always" t) 124 (integer :tag "When more than N lines"))) 125 126 (defcustom org-agenda-compact-blocks nil 127 "Non-nil means make the block agenda more compact. 128 This is done globally by leaving out lines like the agenda span 129 name and week number or the separator lines." 130 :group 'org-agenda 131 :type 'boolean) 132 133 (defcustom org-agenda-block-separator 134 (if (and (display-graphic-p) 135 (char-displayable-p ?─)) 136 ?─ 137 ?=) 138 "The separator between blocks in the agenda. 139 If this is a string, it will be used as the separator, with a newline added. 140 If it is a character, it will be repeated to fill the window width. 141 If nil the separator is disabled. In `org-agenda-custom-commands' this 142 addresses the separator between the current and the previous block." 143 :group 'org-agenda 144 :package-version '(Org . "9.6") 145 :type '(choice 146 (const :tag "Disabled" nil) 147 (character) 148 (string))) 149 150 (defgroup org-agenda-export nil 151 "Options concerning exporting agenda views in Org mode." 152 :tag "Org Agenda Export" 153 :group 'org-agenda) 154 155 (defcustom org-agenda-with-colors t 156 "Non-nil means use colors in agenda views." 157 :group 'org-agenda-export 158 :type 'boolean) 159 160 (defcustom org-agenda-exporter-settings nil 161 ;; FIXME: Do we really want to evaluate those settings and thus force 162 ;; the user to use `quote' all the time? 163 "Alist of variable/value pairs that should be active during agenda export. 164 This is a good place to set options for ps-print and for htmlize. 165 Note that the way this is implemented, the values will be evaluated 166 before assigned to the variables. So make sure to quote values you do 167 *not* want evaluated, for example 168 169 (setq org-agenda-exporter-settings 170 \\='((ps-print-color-p \\='black-white)))" 171 :group 'org-agenda-export 172 :type '(repeat 173 (list 174 (variable) 175 (sexp :tag "Value")))) 176 177 (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) 178 "Hook run in a temporary buffer before writing the agenda to an export file. 179 A useful function for this hook is `org-agenda-add-entry-text'." 180 :group 'org-agenda-export 181 :type 'hook 182 :options '(org-agenda-add-entry-text)) 183 184 (defcustom org-agenda-add-entry-text-maxlines 0 185 "Maximum number of entry text lines to be added to agenda. 186 This is only relevant when `org-agenda-add-entry-text' is part of 187 `org-agenda-before-write-hook', which is the default. 188 When this is 0, nothing will happen. When it is greater than 0, it 189 specifies the maximum number of lines that will be added for each entry 190 that is listed in the agenda view. 191 192 Note that this variable is not used during display, only when exporting 193 the agenda. For agenda display, see the variables `org-agenda-entry-text-mode' 194 and `org-agenda-entry-text-maxlines'." 195 :group 'org-agenda 196 :type 'integer) 197 198 (defcustom org-agenda-add-entry-text-descriptive-links t 199 "Non-nil means export org-links as descriptive links in agenda added text. 200 This variable applies to the text added to the agenda when 201 `org-agenda-add-entry-text-maxlines' is larger than 0. 202 When this variable is nil, the URL will (also) be shown." 203 :group 'org-agenda 204 :type 'boolean) 205 206 (defcustom org-agenda-export-html-style nil 207 "The style specification for exported HTML Agenda files. 208 If this variable contains a string, it will replace the default <style> 209 section as produced by `htmlize'. 210 Since there are different ways of setting style information, this variable 211 needs to contain the full HTML structure to provide a style, including the 212 surrounding HTML tags. The style specifications should include definitions 213 the fonts used by the agenda, here is an example: 214 215 <style type=\"text/css\"> 216 p { font-weight: normal; color: gray; } 217 .org-agenda-structure { 218 font-size: 110%; 219 color: #003399; 220 font-weight: 600; 221 } 222 .org-todo { 223 color: #cc6666; 224 font-weight: bold; 225 } 226 .org-agenda-done { 227 color: #339933; 228 } 229 .org-done { 230 color: #339933; 231 } 232 .title { text-align: center; } 233 .todo, .deadline { color: red; } 234 .done { color: green; } 235 </style> 236 237 or, if you want to keep the style in a file, 238 239 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> 240 241 As the value of this option simply gets inserted into the HTML <head> header, 242 you can \"misuse\" it to also add other text to the header." 243 :group 'org-agenda-export 244 :group 'org-export-html 245 :type '(choice 246 (const nil) 247 (string))) 248 249 (defcustom org-agenda-persistent-filter nil 250 "When set, keep filters from one agenda view to the next." 251 :group 'org-agenda 252 :type 'boolean) 253 254 (defgroup org-agenda-custom-commands nil 255 "Options concerning agenda views in Org mode." 256 :tag "Org Agenda Custom Commands" 257 :group 'org-agenda) 258 259 (defconst org-sorting-choice 260 '(choice 261 (const time-up) (const time-down) 262 (const timestamp-up) (const timestamp-down) 263 (const scheduled-up) (const scheduled-down) 264 (const deadline-up) (const deadline-down) 265 (const ts-up) (const ts-down) 266 (const tsia-up) (const tsia-down) 267 (const category-keep) (const category-up) (const category-down) 268 (const tag-down) (const tag-up) 269 (const priority-up) (const priority-down) 270 (const urgency-up) (const urgency-down) 271 (const todo-state-up) (const todo-state-down) 272 (const effort-up) (const effort-down) 273 (const habit-up) (const habit-down) 274 (const alpha-up) (const alpha-down) 275 (const user-defined-up) (const user-defined-down)) 276 "Sorting choices.") 277 278 ;; Keep custom values for `org-agenda-filter-preset' compatible with 279 ;; the new variable `org-agenda-tag-filter-preset'. 280 (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) 281 (defvaralias 'org-agenda-filter 'org-agenda-tag-filter) 282 283 (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) 284 "List of types searched for when creating the daily/weekly agenda. 285 This variable is a list of symbols that controls the types of 286 items that appear in the daily/weekly agenda. Allowed symbols in this 287 list are 288 289 :timestamp List items containing a date stamp or date range matching 290 the selected date. This includes sexp entries in angular 291 brackets. 292 293 :sexp List entries resulting from plain diary-like sexps. 294 295 :deadline List deadline due on that date. When the date is today, 296 also list any deadlines past due, or due within 297 `org-deadline-warning-days'. 298 299 :deadline* Same as above, but only include the deadline if it has an 300 hour specification as [h]h:mm. 301 302 :scheduled List all items which are scheduled for the given date. 303 The diary for *today* also contains items which were 304 scheduled earlier and are not yet marked DONE. 305 306 :scheduled* Same as above, but only include the scheduled item if it 307 has an hour specification as [h]h:mm. 308 309 By default, all four non-starred types are turned on. 310 311 When :scheduled* or :deadline* are included, :schedule or :deadline 312 will be ignored. 313 314 Never set this variable globally using `setq', because then it 315 will apply to all future agenda commands. Instead, bind it with 316 `let' to scope it dynamically into the agenda-constructing 317 command. A good way to set it is through options in 318 `org-agenda-custom-commands'. For a more flexible (though 319 somewhat less efficient) way of determining what is included in 320 the daily/weekly agenda, see `org-agenda-skip-function'.") 321 322 (defconst org-agenda-custom-commands-local-options 323 `(repeat :tag "Local settings for this command. Remember to quote values" 324 (choice :tag "Setting" 325 (list :tag "Heading for this block" 326 (const org-agenda-overriding-header) 327 (string :tag "Headline")) 328 (list :tag "Files to be searched" 329 (const org-agenda-files) 330 (list 331 (const :format "" quote) 332 (repeat (file)))) 333 (list :tag "Sorting strategy" 334 (const org-agenda-sorting-strategy) 335 (list 336 (const :format "" quote) 337 (repeat 338 ,org-sorting-choice))) 339 (list :tag "Prefix format" 340 (const org-agenda-prefix-format :value " %-12:c%?-12t% s") 341 (string)) 342 (list :tag "Number of days in agenda" 343 (const org-agenda-span) 344 (list 345 (const :format "" quote) 346 (choice (const :tag "Day" day) 347 (const :tag "Week" week) 348 (const :tag "Fortnight" fortnight) 349 (const :tag "Month" month) 350 (const :tag "Year" year) 351 (integer :tag "Custom")))) 352 (list :tag "Fixed starting date" 353 (const org-agenda-start-day) 354 (string :value "2007-11-01")) 355 (list :tag "Start on day of week" 356 (const org-agenda-start-on-weekday) 357 (choice :value 1 358 (const :tag "Today" nil) 359 (integer :tag "Weekday No."))) 360 (list :tag "Include data from diary" 361 (const org-agenda-include-diary) 362 (boolean)) 363 (list :tag "Deadline Warning days" 364 (const org-deadline-warning-days) 365 (integer :value 1)) 366 (list :tag "Category filter preset" 367 (const org-agenda-category-filter-preset) 368 (list 369 (const :format "" quote) 370 (repeat 371 (string :tag "+category or -category")))) 372 (list :tag "Tags filter preset" 373 (const org-agenda-tag-filter-preset) 374 (list 375 (const :format "" quote) 376 (repeat 377 (string :tag "+tag or -tag")))) 378 (list :tag "Effort filter preset" 379 (const org-agenda-effort-filter-preset) 380 (list 381 (const :format "" quote) 382 (repeat 383 (string :tag "+=10 or -=10 or +<10 or ->10")))) 384 (list :tag "Regexp filter preset" 385 (const org-agenda-regexp-filter-preset) 386 (list 387 (const :format "" quote) 388 (repeat 389 (string :tag "+regexp or -regexp")))) 390 (list :tag "Set daily/weekly entry types" 391 (const org-agenda-entry-types) 392 (list 393 (const :format "" quote) 394 (set :greedy t :value ,org-agenda-entry-types 395 (const :deadline) 396 (const :scheduled) 397 (const :deadline*) 398 (const :scheduled*) 399 (const :timestamp) 400 (const :sexp)))) 401 (list :tag "Columns format" 402 (const org-overriding-columns-format) 403 (string :tag "Format")) 404 (list :tag "Standard skipping condition" 405 :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) 406 (const org-agenda-skip-function) 407 (list 408 (const :format "" quote) 409 (list 410 (choice 411 :tag "Skipping range" 412 (const :tag "Skip entry" org-agenda-skip-entry-if) 413 (const :tag "Skip subtree" org-agenda-skip-subtree-if)) 414 (repeat :inline t :tag "Conditions for skipping" 415 (choice 416 :tag "Condition type" 417 (list :tag "Regexp matches" :inline t 418 (const :format "" regexp) 419 (regexp)) 420 (list :tag "Regexp does not match" :inline t 421 (const :format "" notregexp) 422 (regexp)) 423 (list :tag "TODO state is" :inline t 424 (const todo) 425 (choice 426 (const :tag "Any not-done state" todo) 427 (const :tag "Any done state" done) 428 (const :tag "Any state" any) 429 (list :tag "Keyword list" 430 (const :format "" quote) 431 (repeat (string :tag "Keyword"))))) 432 (list :tag "TODO state is not" :inline t 433 (const nottodo) 434 (choice 435 (const :tag "Any not-done state" todo) 436 (const :tag "Any done state" done) 437 (const :tag "Any state" any) 438 (list :tag "Keyword list" 439 (const :format "" quote) 440 (repeat (string :tag "Keyword"))))) 441 (const :tag "scheduled" scheduled) 442 (const :tag "not scheduled" notscheduled) 443 (const :tag "deadline" deadline) 444 (const :tag "no deadline" notdeadline) 445 (const :tag "timestamp" timestamp) 446 (const :tag "no timestamp" nottimestamp)))))) 447 (list :tag "Non-standard skipping condition" 448 :value (org-agenda-skip-function) 449 (const org-agenda-skip-function) 450 (sexp :tag "Function or form (quoted!)")) 451 (list :tag "Any variable" 452 (variable :tag "Variable") 453 (sexp :tag "Value (sexp)")))) 454 "Selection of examples for agenda command settings. 455 This will be spliced into the custom type of 456 `org-agenda-custom-commands'.") 457 458 459 (defcustom org-agenda-custom-commands 460 '(("n" "Agenda and all TODOs" ((agenda "") (alltodo "")))) 461 "Custom commands for the agenda. 462 \\<org-mode-map> 463 These commands will be offered on the splash screen displayed by the 464 agenda dispatcher `\\[org-agenda]'. Each entry is a list like this: 465 466 (key desc type match settings files) 467 468 key The key (one or more characters as a string) to be associated 469 with the command. 470 desc A description of the command. When omitted or nil, a default 471 description is built using MATCH. 472 type The command type, any of the following symbols: 473 agenda The daily/weekly agenda. 474 agenda* Appointments for current week/day. 475 todo Entries with a specific TODO keyword, in all agenda files. 476 search Entries containing search words entry or headline. 477 tags Tags/Property/TODO match in all agenda files. 478 tags-todo Tags/P/T match in all agenda files, TODO entries only. 479 todo-tree Sparse tree of specific TODO keyword in *current* file. 480 tags-tree Sparse tree with all tags matches in *current* file. 481 occur-tree Occur sparse tree for *current* file. 482 alltodo The global TODO list. 483 stuck Stuck projects. 484 ... A user-defined function. 485 match What to search for: 486 - a single keyword for TODO keyword searches 487 - a tags/property/todo match expression for searches 488 - a word search expression for text searches. 489 - a regular expression for occur searches 490 For all other commands, this should be the empty string. 491 settings A list of option settings, similar to that in a let form, so like 492 this: ((opt1 val1) (opt2 val2) ...). The values will be 493 evaluated at the moment of execution, so quote them when needed. 494 files A list of files to write the produced agenda buffer to with 495 the command `org-store-agenda-views'. 496 If a file name ends in \".html\", an HTML version of the buffer 497 is written out. If it ends in \".ps\", a PostScript version is 498 produced. Otherwise, only the plain text is written to the file. 499 500 You can also define a set of commands, to create a composite agenda buffer. 501 In this case, an entry looks like this: 502 503 (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files) 504 505 where 506 507 desc A description string to be displayed in the dispatcher menu. 508 cmd An agenda command, similar to the above. However, tree commands 509 are not allowed. Valid commands for a set are: 510 (agenda \"\" settings) 511 (agenda* \"\" settings) 512 (alltodo \"\" settings) 513 (stuck \"\" settings) 514 (todo \"match\" settings files) 515 (search \"match\" settings files) 516 (tags \"match\" settings files) 517 (tags-todo \"match\" settings files) 518 519 Each command can carry a list of options, and another set of options can be 520 given for the whole set of commands. Individual command options take 521 precedence over the general options. 522 523 When using several characters as key to a command, the first characters 524 are prefix commands. For the dispatcher to display useful information, you 525 should provide a description for the prefix, like 526 527 (setq org-agenda-custom-commands 528 \\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" 529 (\"hl\" tags \"+HOME+Lisa\") 530 (\"hp\" tags \"+HOME+Peter\") 531 (\"hk\" tags \"+HOME+Kim\"))) 532 533 See also Info node `(org) Custom Agenda Views'." 534 :group 'org-agenda-custom-commands 535 :type `(repeat 536 (choice :value ("x" "Describe command here" tags "" nil) 537 (list :tag "Single command" 538 (string :tag "Access Key(s) ") 539 (option (string :tag "Description")) 540 (choice 541 (const :tag "Agenda" agenda) 542 (const :tag "TODO list" alltodo) 543 (const :tag "Search words" search) 544 (const :tag "Stuck projects" stuck) 545 (const :tag "Tags/Property match (all agenda files)" tags) 546 (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) 547 (const :tag "TODO keyword search (all agenda files)" todo) 548 (const :tag "Tags sparse tree (current buffer)" tags-tree) 549 (const :tag "TODO keyword tree (current buffer)" todo-tree) 550 (const :tag "Occur tree (current buffer)" occur-tree) 551 (sexp :tag "Other, user-defined function")) 552 (string :tag "Match (only for some commands)") 553 ,org-agenda-custom-commands-local-options 554 (option (repeat :tag "Export" (file :tag "Export to")))) 555 (list :tag "Command series, all agenda files" 556 (string :tag "Access Key(s)") 557 (string :tag "Description ") 558 (repeat :tag "Component" 559 (choice 560 (list :tag "Agenda" 561 (const :format "" agenda) 562 (const :tag "" :format "" "") 563 ,org-agenda-custom-commands-local-options) 564 (list :tag "TODO list (all keywords)" 565 (const :format "" alltodo) 566 (const :tag "" :format "" "") 567 ,org-agenda-custom-commands-local-options) 568 (list :tag "Search words" 569 (const :format "" search) 570 (string :tag "Match") 571 ,org-agenda-custom-commands-local-options) 572 (list :tag "Stuck projects" 573 (const :format "" stuck) 574 (const :tag "" :format "" "") 575 ,org-agenda-custom-commands-local-options) 576 (list :tag "Tags/Property match (all agenda files)" 577 (const :format "" tags) 578 (string :tag "Match") 579 ,org-agenda-custom-commands-local-options) 580 (list :tag "Tags/Property match of TODO entries (all agenda files)" 581 (const :format "" tags-todo) 582 (string :tag "Match") 583 ,org-agenda-custom-commands-local-options) 584 (list :tag "TODO keyword search" 585 (const :format "" todo) 586 (string :tag "Match") 587 ,org-agenda-custom-commands-local-options) 588 (list :tag "Other, user-defined function" 589 (symbol :tag "function") 590 (string :tag "Match") 591 ,org-agenda-custom-commands-local-options))) 592 593 (repeat :tag "Settings for entire command set" 594 (list (variable :tag "Any variable") 595 (sexp :tag "Value"))) 596 (option (repeat :tag "Export" (file :tag "Export to")))) 597 (cons :tag "Prefix key documentation" 598 (string :tag "Access Key(s)") 599 (string :tag "Description "))))) 600 601 (defcustom org-agenda-query-register ?o 602 "The register holding the current query string. 603 The purpose of this is that if you construct a query string interactively, 604 you can then use it to define a custom command." 605 :group 'org-agenda-custom-commands 606 :type 'character) 607 608 (defcustom org-stuck-projects 609 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") 610 "How to identify stuck projects. 611 This is a list of four items: 612 613 1. A tags/todo/property matcher string that is used to identify a project. 614 See Info node `(org) Matching tags and properties' for a 615 description of tag and property searches. The entire tree 616 below a headline matched by this is considered one project. 617 618 2. A list of TODO keywords identifying non-stuck projects. 619 If the project subtree contains any headline with one of these todo 620 keywords, the project is considered to be not stuck. If you specify 621 \"*\" as a keyword, any TODO keyword will mark the project unstuck. 622 623 3. A list of tags identifying non-stuck projects. 624 If the project subtree contains any headline with one of these tags, 625 the project is considered to be not stuck. If you specify \"*\" as 626 a tag, any tag will mark the project unstuck. Note that this is about 627 the explicit presence of a tag somewhere in the subtree, inherited 628 tags do not count here. If inherited tags make a project not stuck, 629 use \"-TAG\" in the tags part of the matcher under (1.) above. 630 631 4. An arbitrary regular expression matching non-stuck projects. 632 633 If the project turns out to be not stuck, search continues also in the 634 subtree to see if any of the subtasks have project status. 635 636 See also the variable `org-tags-match-list-sublevels' which applies 637 to projects matched by this search as well. 638 639 After defining this variable, you may use `org-agenda-list-stuck-projects' 640 \(bound to `\\[org-agenda] #') to produce the list." 641 :group 'org-agenda-custom-commands 642 :type '(list 643 (string :tag "Tags/TODO match to identify a project") 644 (repeat :tag "Projects are *not* stuck if they have an entry with \ 645 TODO keyword any of" (string)) 646 (repeat :tag "Projects are *not* stuck if they have an entry with \ 647 TAG being any of" (string)) 648 (regexp :tag "Projects are *not* stuck if this regexp matches inside \ 649 the subtree"))) 650 651 (defgroup org-agenda-skip nil 652 "Options concerning skipping parts of agenda files." 653 :tag "Org Agenda Skip" 654 :group 'org-agenda) 655 656 (defcustom org-agenda-skip-function-global nil 657 "Function to be called at each match during agenda construction. 658 If this function returns nil, the current match should not be skipped. 659 If the function decided to skip an agenda match, is must return the 660 buffer position from which the search should be continued. 661 This may also be a Lisp form, which will be evaluated. 662 663 This variable will be applied to every agenda match, including 664 tags/property searches and TODO lists. So try to make the test function 665 do its checking as efficiently as possible. To implement a skipping 666 condition just for specific agenda commands, use the variable 667 `org-agenda-skip-function' which can be set in the options section 668 of custom agenda commands." 669 :group 'org-agenda-skip 670 :type 'sexp) 671 672 (defgroup org-agenda-daily/weekly nil 673 "Options concerning the daily/weekly agenda." 674 :tag "Org Agenda Daily/Weekly" 675 :group 'org-agenda) 676 (defgroup org-agenda-todo-list nil 677 "Options concerning the global todo list agenda view." 678 :tag "Org Agenda Todo List" 679 :group 'org-agenda) 680 (defgroup org-agenda-match-view nil 681 "Options concerning the general tags/property/todo match agenda view." 682 :tag "Org Agenda Match View" 683 :group 'org-agenda) 684 (defgroup org-agenda-search-view nil 685 "Options concerning the search agenda view." 686 :tag "Org Agenda Search View" 687 :group 'org-agenda) 688 689 (defvar org-agenda-archives-mode nil 690 "Non-nil means the agenda will include archived items. 691 If this is the symbol `trees', trees in the selected agenda scope 692 that are marked with the ARCHIVE tag will be included anyway. When this is 693 t, also all archive files associated with the current selection of agenda 694 files will be included.") 695 696 (defcustom org-agenda-restriction-lock-highlight-subtree t 697 "Non-nil means highlight the whole subtree when restriction is active. 698 Otherwise only highlight the headline. Highlighting the whole subtree is 699 useful to ensure no edits happen beyond the restricted region." 700 :group 'org-agenda 701 :type 'boolean) 702 703 (defcustom org-agenda-skip-comment-trees t 704 "Non-nil means skip trees that start with the COMMENT keyword. 705 When nil, these trees are also scanned by agenda commands." 706 :group 'org-agenda-skip 707 :type 'boolean) 708 709 (defcustom org-agenda-todo-list-sublevels t 710 "Non-nil means check also the sublevels of a TODO entry for TODO entries. 711 When nil, the sublevels of a TODO entry are not checked, resulting in 712 potentially much shorter TODO lists." 713 :group 'org-agenda-skip 714 :group 'org-agenda-todo-list 715 :type 'boolean) 716 717 (defcustom org-agenda-todo-ignore-with-date nil 718 "Non-nil means don't show entries with a date in the global todo list. 719 You can use this if you prefer to mark mere appointments with a TODO keyword, 720 but don't want them to show up in the TODO list. 721 When this is set, it also covers deadlines and scheduled items, the settings 722 of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' 723 will be ignored. 724 See also the variable `org-agenda-tags-todo-honor-ignore-options'." 725 :group 'org-agenda-skip 726 :group 'org-agenda-todo-list 727 :type 'boolean) 728 729 (defcustom org-agenda-todo-ignore-timestamp nil 730 "Non-nil means don't show entries with a timestamp. 731 This applies when creating the global todo list. 732 Valid values are: 733 734 past Don't show entries for today or in the past. 735 736 future Don't show entries with a timestamp in the future. 737 The idea behind this is that if it has a future 738 timestamp, you don't want to think about it until the 739 date. 740 741 all Don't show any entries with a timestamp in the global todo list. 742 The idea behind this is that by setting a timestamp, you 743 have already \"taken care\" of this item. 744 745 This variable can also have an integer as a value. If positive (N), 746 todos with a timestamp N or more days in the future will be ignored. If 747 negative (-N), todos with a timestamp N or more days in the past will be 748 ignored. If 0, todos with a timestamp either today or in the future will 749 be ignored. For example, a value of -1 will exclude todos with a 750 timestamp in the past (yesterday or earlier), while a value of 7 will 751 exclude todos with a timestamp a week or more in the future. 752 753 See also `org-agenda-todo-ignore-with-date'. 754 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want 755 to make his option also apply to the tags-todo list." 756 :group 'org-agenda-skip 757 :group 'org-agenda-todo-list 758 :version "24.1" 759 :type '(choice 760 (const :tag "Ignore future timestamp todos" future) 761 (const :tag "Ignore past or present timestamp todos" past) 762 (const :tag "Ignore all timestamp todos" all) 763 (const :tag "Show timestamp todos" nil) 764 (integer :tag "Ignore if N or more days in past(-) or future(+)."))) 765 766 (defcustom org-agenda-todo-ignore-scheduled nil 767 "Non-nil means, ignore some scheduled TODO items when making TODO list. 768 This applies when creating the global todo list. 769 Valid values are: 770 771 past Don't show entries scheduled today or in the past. 772 773 future Don't show entries scheduled in the future. 774 The idea behind this is that by scheduling it, you don't want to 775 think about it until the scheduled date. 776 777 all Don't show any scheduled entries in the global todo list. 778 The idea behind this is that by scheduling it, you have already 779 \"taken care\" of this item. 780 781 t Same as `all', for backward compatibility. 782 783 This variable can also have an integer as a value. See 784 `org-agenda-todo-ignore-timestamp' for more details. 785 786 See also `org-agenda-todo-ignore-with-date'. 787 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want 788 to make his option also apply to the tags-todo list." 789 :group 'org-agenda-skip 790 :group 'org-agenda-todo-list 791 :type '(choice 792 (const :tag "Ignore future-scheduled todos" future) 793 (const :tag "Ignore past- or present-scheduled todos" past) 794 (const :tag "Ignore all scheduled todos" all) 795 (const :tag "Ignore all scheduled todos (compatibility)" t) 796 (const :tag "Show scheduled todos" nil) 797 (integer :tag "Ignore if N or more days in past(-) or future(+)."))) 798 799 (defcustom org-agenda-todo-ignore-deadlines nil 800 "Non-nil means ignore some deadline TODO items when making TODO list. 801 802 There are different motivations for using different values, please think 803 carefully when configuring this variable. 804 805 This applies when creating the global TODO list. 806 807 Valid values are: 808 809 near Don't show near deadline entries. A deadline is near when it is 810 closer than `org-deadline-warning-days' days. The idea behind this 811 is that such items will appear in the agenda anyway. 812 813 far Don't show TODO entries where a deadline has been defined, but 814 is not going to happen anytime soon. This is useful if you want to use 815 the TODO list to figure out what to do now. 816 817 past Don't show entries with a deadline timestamp for today or in the past. 818 819 future Don't show entries with a deadline timestamp in the future, not even 820 when they become `near' ones. Use it with caution. 821 822 all Ignore all TODO entries that do have a deadline. 823 824 t Same as `near', for backward compatibility. 825 826 This variable can also have an integer as a value. See 827 `org-agenda-todo-ignore-timestamp' for more details. 828 829 See also `org-agenda-todo-ignore-with-date'. 830 See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want 831 to make his option also apply to the tags-todo list." 832 :group 'org-agenda-skip 833 :group 'org-agenda-todo-list 834 :type '(choice 835 (const :tag "Ignore near deadlines" near) 836 (const :tag "Ignore near deadlines (compatibility)" t) 837 (const :tag "Ignore far deadlines" far) 838 (const :tag "Ignore all TODOs with a deadlines" all) 839 (const :tag "Show all TODOs, even if they have a deadline" nil) 840 (integer :tag "Ignore if N or more days in past(-) or future(+)."))) 841 842 (defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil 843 "Time unit to use when possibly ignoring an agenda item. 844 845 See the docstring of various `org-agenda-todo-ignore-*' options. 846 The default is to compare time stamps using days. An item is thus 847 considered to be in the future if it is at least one day after today. 848 Non-nil means to compare time stamps using seconds. An item is then 849 considered future if it has a time value later than current time." 850 :group 'org-agenda-skip 851 :group 'org-agenda-todo-list 852 :version "24.4" 853 :package-version '(Org . "8.0") 854 :type '(choice 855 (const :tag "Compare time with days" nil) 856 (const :tag "Compare time with seconds" t))) 857 858 (defcustom org-agenda-tags-todo-honor-ignore-options nil 859 "Non-nil means honor todo-list ignores options also in tags-todo search. 860 The variables 861 `org-agenda-todo-ignore-with-date', 862 `org-agenda-todo-ignore-timestamp', 863 `org-agenda-todo-ignore-scheduled', 864 `org-agenda-todo-ignore-deadlines' 865 make the global TODO list skip entries that have time stamps of certain 866 kinds. If this option is set, the same options will also apply for the 867 tags-todo search, which is the general tags/property matcher 868 restricted to unfinished TODO entries only." 869 :group 'org-agenda-skip 870 :group 'org-agenda-todo-list 871 :group 'org-agenda-match-view 872 :type 'boolean) 873 874 (defcustom org-agenda-skip-scheduled-if-done nil 875 "Non-nil means don't show scheduled items in agenda when they are done. 876 This is relevant for the daily/weekly agenda, not for the TODO list. It 877 applies only to the actual date of the scheduling. Warnings about an item 878 with a past scheduling dates are always turned off when the item is DONE." 879 :group 'org-agenda-skip 880 :group 'org-agenda-daily/weekly 881 :type 'boolean) 882 883 (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil 884 "Non-nil means skip scheduling line if same entry shows because of deadline. 885 886 In the agenda of today, an entry can show up multiple times 887 because it is both scheduled and has a nearby deadline, and maybe 888 a plain time stamp as well. 889 890 When this variable is nil, the entry will be shown several times. 891 892 When set to t, then only the deadline is shown and the fact that 893 the entry is scheduled today or was scheduled previously is not 894 shown. 895 896 When set to the symbol `not-today', skip scheduled previously, 897 but not scheduled today." 898 :group 'org-agenda-skip 899 :group 'org-agenda-daily/weekly 900 :type '(choice 901 (const :tag "Never" nil) 902 (const :tag "Always" t) 903 (const :tag "Not when scheduled today" not-today)) 904 :package-version '(Org . "9.7")) 905 906 (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil 907 "Non-nil means skip timestamp line if same entry shows because of deadline. 908 In the agenda of today, an entry can show up multiple times 909 because it has both a plain timestamp and has a nearby deadline. 910 When this variable is t, then only the deadline is shown and the 911 fact that the entry has a timestamp for or including today is not 912 shown. When this variable is nil, the entry will be shown 913 several times." 914 :group 'org-agenda-skip 915 :group 'org-agenda-daily/weekly 916 :version "24.1" 917 :type '(choice 918 (const :tag "Never" nil) 919 (const :tag "Always" t))) 920 921 (defcustom org-agenda-skip-deadline-if-done nil 922 "Non-nil means don't show deadlines when the corresponding item is done. 923 When nil, the deadline is still shown and should give you a happy feeling. 924 This is relevant for the daily/weekly agenda. It applies only to the 925 actual date of the deadline. Warnings about approaching and past-due 926 deadlines are always turned off when the item is DONE." 927 :group 'org-agenda-skip 928 :group 'org-agenda-daily/weekly 929 :type 'boolean) 930 931 (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil 932 "Non-nil means skip deadline prewarning when entry is also scheduled. 933 This will apply on all days where a prewarning for the deadline would 934 be shown, but not at the day when the entry is actually due. On that day, 935 the deadline will be shown anyway. 936 This variable may be set to nil, t, the symbol `pre-scheduled', 937 or a number which will then give the number of days before the actual 938 deadline when the prewarnings should resume. The symbol `pre-scheduled' 939 eliminates the deadline prewarning only prior to the scheduled date. 940 This can be used in a workflow where the first showing of the deadline will 941 trigger you to schedule it, and then you don't want to be reminded of it 942 because you will take care of it on the day when scheduled." 943 :group 'org-agenda-skip 944 :group 'org-agenda-daily/weekly 945 :version "24.1" 946 :type '(choice 947 (const :tag "Always show prewarning" nil) 948 (const :tag "Remove prewarning prior to scheduled date" pre-scheduled) 949 (const :tag "Remove prewarning if entry is scheduled" t) 950 (integer :tag "Restart prewarning N days before deadline"))) 951 952 (defcustom org-agenda-skip-scheduled-delay-if-deadline nil 953 "Non-nil means skip scheduled delay when entry also has a deadline. 954 This variable may be set to nil, t, the symbol `post-deadline', 955 or a number which will then give the number of days after the actual 956 scheduled date when the delay should expire. The symbol `post-deadline' 957 eliminates the schedule delay when the date is posterior to the deadline." 958 :group 'org-agenda-skip 959 :group 'org-agenda-daily/weekly 960 :version "24.4" 961 :package-version '(Org . "8.0") 962 :type '(choice 963 (const :tag "Always honor delay" nil) 964 (const :tag "Ignore delay if posterior to the deadline" post-deadline) 965 (const :tag "Ignore delay if entry has a deadline" t) 966 (integer :tag "Honor delay up until N days after the scheduled date"))) 967 968 (defcustom org-agenda-skip-additional-timestamps-same-entry nil 969 "When nil, multiple same-day timestamps in entry make multiple agenda lines. 970 When non-nil, after the search for timestamps has matched once in an 971 entry, the rest of the entry will not be searched." 972 :group 'org-agenda-skip 973 :type 'boolean) 974 975 (defcustom org-agenda-skip-timestamp-if-done nil 976 "Non-nil means don't select item by timestamp or -range if it is DONE." 977 :group 'org-agenda-skip 978 :group 'org-agenda-daily/weekly 979 :type 'boolean) 980 981 (defcustom org-agenda-dim-blocked-tasks t 982 "Non-nil means dim blocked tasks in the agenda display. 983 This causes some overhead during agenda construction, but if you 984 have turned on `org-enforce-todo-dependencies', 985 `org-enforce-todo-checkbox-dependencies', or any other blocking 986 mechanism, this will create useful feedback in the agenda. 987 988 Instead of t, this variable can also have the value `invisible'. 989 Then blocked tasks will be invisible and only become visible when 990 they become unblocked. An exemption to this behavior is when a task is 991 blocked because of unchecked checkboxes below it. Since checkboxes do 992 not show up in the agenda views, making this task invisible you remove any 993 trace from agenda views that there is something to do. Therefore, a task 994 that is blocked because of checkboxes will never be made invisible, it 995 will only be dimmed." 996 :group 'org-agenda-daily/weekly 997 :group 'org-agenda-todo-list 998 :version "24.3" 999 :type '(choice 1000 (const :tag "Do not dim" nil) 1001 (const :tag "Dim to a gray face" t) 1002 (const :tag "Make invisible" invisible))) 1003 1004 (defgroup org-agenda-startup nil 1005 "Options concerning initial settings in the Agenda in Org Mode." 1006 :tag "Org Agenda Startup" 1007 :group 'org-agenda) 1008 1009 (defcustom org-agenda-menu-show-matcher t 1010 "Non-nil means show the match string in the agenda dispatcher menu. 1011 When nil, the matcher string is not shown, but is put into the help-echo 1012 property so than moving the mouse over the command shows it. 1013 Setting it to nil is good if matcher strings are very long and/or if 1014 you want to use two-columns display (see `org-agenda-menu-two-columns')." 1015 :group 'org-agenda 1016 :version "24.1" 1017 :type 'boolean) 1018 1019 (defcustom org-agenda-menu-two-columns nil 1020 "Non-nil means, use two columns to show custom commands in the dispatcher. 1021 If you use this, you probably want to set `org-agenda-menu-show-matcher' 1022 to nil." 1023 :group 'org-agenda 1024 :version "24.1" 1025 :type 'boolean) 1026 1027 (defcustom org-agenda-finalize-hook nil 1028 "Hook run just before displaying an agenda buffer. 1029 The buffer is still writable when the hook is called. 1030 1031 You can modify some of the buffer substrings but you should be 1032 extra careful not to modify the text properties of the agenda 1033 headlines as the agenda display heavily relies on them." 1034 :group 'org-agenda-startup 1035 :type 'hook) 1036 1037 (defcustom org-agenda-filter-hook nil 1038 "Hook run just after filtering with `org-agenda-filter'." 1039 :group 'org-agenda-startup 1040 :package-version '(Org . "9.4") 1041 :type 'hook) 1042 1043 (defcustom org-agenda-mouse-1-follows-link nil 1044 "Non-nil means \\`mouse-1' on a link will follow the link in the agenda. 1045 A longer mouse click will still set point. Needs to be set 1046 before org.el is loaded." 1047 :group 'org-agenda-startup 1048 :type 'boolean) 1049 1050 (defcustom org-agenda-start-with-follow-mode nil 1051 "The initial value of follow mode in a newly created agenda window." 1052 :group 'org-agenda-startup 1053 :type 'boolean) 1054 1055 (defcustom org-agenda-follow-indirect nil 1056 "Non-nil means `org-agenda-follow-mode' displays only the 1057 current item's tree, in an indirect buffer." 1058 :group 'org-agenda 1059 :version "24.1" 1060 :type 'boolean) 1061 1062 (defcustom org-agenda-show-outline-path t 1063 "Non-nil means show outline path in echo area after line motion. 1064 1065 If set to `title', show outline path with prepended document 1066 title. Fallback to file name is no title is present." 1067 :group 'org-agenda-startup 1068 :type '(choice 1069 (const :tag "Don't show outline path in agenda view." nil) 1070 (const :tag "Show outline path with prepended file name." t) 1071 (const :tag "Show outline path with prepended document title." title)) 1072 :package-version '(Org . "9.6")) 1073 1074 (defcustom org-agenda-start-with-entry-text-mode nil 1075 "The initial value of entry-text-mode in a newly created agenda window." 1076 :group 'org-agenda-startup 1077 :type 'boolean) 1078 1079 (defcustom org-agenda-entry-text-maxlines 5 1080 "Number of text lines to be added when `E' is pressed in the agenda. 1081 1082 Note that this variable only used during agenda display. To add entry text 1083 when exporting the agenda, configure the variable 1084 `org-agenda-add-entry-text-maxlines'." 1085 :group 'org-agenda 1086 :type 'integer) 1087 1088 (defcustom org-agenda-entry-text-exclude-regexps nil 1089 "List of regular expressions to clean up entry text. 1090 The complete matches of all regular expressions in this list will be 1091 removed from entry text before it is shown in the agenda." 1092 :group 'org-agenda 1093 :type '(repeat (regexp))) 1094 1095 (defcustom org-agenda-entry-text-leaders " > " 1096 "Text prepended to the entry text in agenda buffers." 1097 :version "24.4" 1098 :package-version '(Org . "8.0") 1099 :group 'org-agenda 1100 :type 'string) 1101 1102 (defcustom org-agenda-start-with-archives-mode nil 1103 "Initial value of archive mode in a newly created agenda window. 1104 See `org-agenda-archives-mode' for acceptable values and their 1105 meaning." 1106 :group 'org-agenda-startup 1107 :package-version '(Org . "9.7") 1108 :type 'symbol) 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 1189 This variable only applies when agenda spans either 7 or 14 days." 1190 :group 'org-agenda-daily/weekly 1191 :type '(choice (const :tag "Today" nil) 1192 (integer :tag "Weekday No."))) 1193 1194 (defcustom org-agenda-show-all-dates t 1195 "Non-nil means `org-agenda' shows every day in the selected range. 1196 When nil, only the days which actually have entries are shown." 1197 :group 'org-agenda-daily/weekly 1198 :type 'boolean) 1199 1200 (defcustom org-agenda-format-date 'org-agenda-format-date-aligned 1201 "Format string for displaying dates in the agenda. 1202 Used by the daily/weekly agenda. This should be a format string 1203 understood by `format-time-string', or a function returning the 1204 formatted date as a string. The function must take a single 1205 argument, a calendar-style date list like (month day year)." 1206 :group 'org-agenda-daily/weekly 1207 :type '(choice 1208 (string :tag "Format string") 1209 (function :tag "Function"))) 1210 1211 (defun org-agenda-end-of-line () 1212 "Go to the end of visible line." 1213 (interactive) 1214 (goto-char (line-end-position))) 1215 1216 (defun org-agenda-format-date-aligned (date) 1217 "Format a DATE string for display in the daily/weekly agenda. 1218 This function makes sure that dates are aligned for easy reading." 1219 (require 'cal-iso) 1220 (let* ((dayname (calendar-day-name date)) 1221 (day (cadr date)) 1222 (day-of-week (calendar-day-of-week date)) 1223 (month (car date)) 1224 (monthname (calendar-month-name month)) 1225 (year (nth 2 date)) 1226 (iso-week (org-days-to-iso-week 1227 (calendar-absolute-from-gregorian date))) 1228 ;; (weekyear (cond ((and (= month 1) (>= iso-week 52)) 1229 ;; (1- year)) 1230 ;; ((and (= month 12) (<= iso-week 1)) 1231 ;; (1+ year)) 1232 ;; (t year))) 1233 (weekstring (if (= day-of-week 1) 1234 (format " W%02d" iso-week) 1235 ""))) 1236 (format "%-10s %2d %s %4d%s" 1237 dayname day monthname year weekstring))) 1238 1239 (defcustom org-agenda-time-leading-zero nil 1240 "Non-nil means use leading zero for military times in agenda. 1241 For example, 9:30am would become 09:30 rather than 9:30." 1242 :group 'org-agenda-daily/weekly 1243 :version "24.1" 1244 :type 'boolean) 1245 1246 (defcustom org-agenda-timegrid-use-ampm nil 1247 "When set, show AM/PM style timestamps on the timegrid." 1248 :group 'org-agenda 1249 :version "24.1" 1250 :type 'boolean) 1251 1252 (defcustom org-agenda-clock-report-header nil 1253 "Header inserted before the table in Org agenda clock report mode. 1254 1255 See Info node `(org) Agenda Commands' for more details." 1256 :group 'org-agenda 1257 :type '(choice 1258 (string :tag "Header") 1259 (const :tag "No header" nil)) 1260 :safe #'stringp 1261 :package-version '(Org . "9.6")) 1262 1263 (defun org-agenda-time-of-day-to-ampm (time) 1264 "Convert TIME of a string like \"13:45\" to an AM/PM style time string." 1265 (let* ((hour-number (string-to-number (substring time 0 -3))) 1266 (minute (substring time -2)) 1267 (ampm "am")) 1268 (cond 1269 ((equal hour-number 12) 1270 (setq ampm "pm")) 1271 ((> hour-number 12) 1272 (setq ampm "pm") 1273 (setq hour-number (- hour-number 12)))) 1274 (concat 1275 (if org-agenda-time-leading-zero 1276 (format "%02d" hour-number) 1277 (format "%02s" (number-to-string hour-number))) 1278 ":" minute ampm))) 1279 1280 (defun org-agenda-time-of-day-to-ampm-maybe (time) 1281 "Conditionally convert TIME to AM/PM format. 1282 This is based on `org-agenda-timegrid-use-ampm'." 1283 (if org-agenda-timegrid-use-ampm 1284 (org-agenda-time-of-day-to-ampm time) 1285 time)) 1286 1287 (defcustom org-agenda-weekend-days '(6 0) 1288 "Which days are weekend? 1289 These days get the special face `org-agenda-date-weekend' in the agenda." 1290 :group 'org-agenda-daily/weekly 1291 :type '(set :greedy t 1292 (const :tag "Monday" 1) 1293 (const :tag "Tuesday" 2) 1294 (const :tag "Wednesday" 3) 1295 (const :tag "Thursday" 4) 1296 (const :tag "Friday" 5) 1297 (const :tag "Saturday" 6) 1298 (const :tag "Sunday" 0))) 1299 1300 (defcustom org-agenda-move-date-from-past-immediately-to-today t 1301 "Non-nil means jump to today when moving a past date forward in time. 1302 When using S-right in the agenda to move a date forward, and the date 1303 stamp currently points to the past, the first key press will move it 1304 to today. When nil, just move one day forward even if the date stays 1305 in the past." 1306 :group 'org-agenda-daily/weekly 1307 :version "24.1" 1308 :type 'boolean) 1309 1310 (defcustom org-agenda-diary-file 'diary-file 1311 "File to which to add new entries with the `i' key in agenda and calendar. 1312 When this is the symbol `diary-file', the functionality in the Emacs 1313 calendar will be used to add entries to the `diary-file'. But when this 1314 points to a file, `org-agenda-diary-entry' will be used instead." 1315 :group 'org-agenda 1316 :type '(choice 1317 (const :tag "The standard Emacs diary file" diary-file) 1318 (file :tag "Special Org file diary entries"))) 1319 1320 (defcustom org-agenda-include-diary nil 1321 "If non-nil, include in the agenda entries from the Emacs Calendar's diary. 1322 Custom commands can set this variable in the options section." 1323 :group 'org-agenda-daily/weekly 1324 :type 'boolean) 1325 1326 (defcustom org-agenda-include-deadlines t 1327 "If non-nil, include entries within their deadline warning period. 1328 Custom commands can set this variable in the options section." 1329 :group 'org-agenda-daily/weekly 1330 :version "24.1" 1331 :type 'boolean) 1332 1333 (defcustom org-agenda-show-future-repeats t 1334 "Non-nil shows repeated entries in the future part of the agenda. 1335 When set to the symbol `next' only the first future repeat is shown." 1336 :group 'org-agenda-daily/weekly 1337 :type '(choice 1338 (const :tag "Show all repeated entries" t) 1339 (const :tag "Show next repeated entry" next) 1340 (const :tag "Do not show repeated entries" nil)) 1341 :package-version '(Org . "9.1") 1342 :safe #'symbolp) 1343 1344 (defcustom org-agenda-skip-scheduled-repeats-after-deadline nil 1345 "Non-nil hides scheduled repeated entries past deadline." 1346 :group 'org-agenda-daily/weekly 1347 :type 'boolean 1348 :package-version '(Org . "9.7") 1349 :safe t) 1350 1351 (defcustom org-agenda-prefer-last-repeat nil 1352 "Non-nil sets date for repeated entries to their last repeat. 1353 1354 When nil, display SCHEDULED and DEADLINE dates at their base 1355 date, and in today's agenda, as a reminder. Display plain 1356 timestamps, on the other hand, at every repeat date in the past 1357 in addition to the base date. 1358 1359 When non-nil, show a repeated entry at its latest repeat date, 1360 possibly being today even if it wasn't marked as done. This 1361 setting is useful if you do not always mark repeated entries as 1362 done and, yet, consider that reaching repeat date starts the task 1363 anew. 1364 1365 When set to a list of strings, prefer last repeats only for 1366 entries with these TODO keywords." 1367 :group 'org-agenda-daily/weekly 1368 :type '(choice 1369 (const :tag "Prefer last repeat" t) 1370 (const :tag "Prefer base date" nil) 1371 (repeat :tag "Prefer last repeat for entries with these TODO keywords" 1372 (string :tag "TODO keyword"))) 1373 :version "26.1" 1374 :package-version '(Org . "9.1") 1375 :safe (lambda (x) (or (booleanp x) (consp x)))) 1376 1377 (defcustom org-scheduled-past-days 10000 1378 "Number of days to continue listing scheduled items not marked DONE. 1379 When an item is scheduled on a date, it shows up in the agenda on 1380 this day and will be listed until it is marked done or for the 1381 number of days given here." 1382 :group 'org-agenda-daily/weekly 1383 :type 'integer 1384 :safe 'integerp) 1385 1386 (defcustom org-deadline-past-days 10000 1387 "Number of days to warn about missed deadlines. 1388 When an item has deadline on a date, it shows up in the agenda on 1389 this day and will appear as a reminder until it is marked DONE or 1390 for the number of days given here." 1391 :group 'org-agenda-daily/weekly 1392 :type 'integer 1393 :version "26.1" 1394 :package-version '(Org . "9.1") 1395 :safe 'integerp) 1396 1397 (defcustom org-agenda-log-mode-items '(closed clock) 1398 "List of items that should be shown in agenda log mode. 1399 \\<org-agenda-mode-map>\ 1400 This list may contain the following symbols: 1401 1402 closed Show entries that have been closed on that day. 1403 clock Show entries that have received clocked time on that day. 1404 state Show all logged state changes. 1405 Note that instead of changing this variable, you can also press \ 1406 `\\[universal-argument] \\[org-agenda-log-mode]' in 1407 the agenda to display all available LOG items temporarily." 1408 :group 'org-agenda-daily/weekly 1409 :type '(set :greedy t (const closed) (const clock) (const state))) 1410 1411 (defcustom org-agenda-clock-consistency-checks 1412 '(:max-duration "10:00" :min-duration 0 :max-gap "0:05" 1413 :gap-ok-around ("4:00") 1414 :default-face ((:background "DarkRed") (:foreground "white")) 1415 :overlap-face nil :gap-face nil :no-end-time-face nil 1416 :long-face nil :short-face nil) 1417 "This is a property list, with the following keys: 1418 1419 :max-duration Mark clocking chunks that are longer than this time. 1420 This is a time string like \"HH:MM\", or the number 1421 of minutes as an integer. 1422 1423 :min-duration Mark clocking chunks that are shorter that this. 1424 This is a time string like \"HH:MM\", or the number 1425 of minutes as an integer. 1426 1427 :max-gap Mark gaps between clocking chunks that are longer than 1428 this duration. A number of minutes, or a string 1429 like \"HH:MM\". 1430 1431 :gap-ok-around List of times during the day which are usually not working 1432 times. When a gap is detected, but the gap contains any 1433 of these times, the gap is *not* reported. For example, 1434 if this is (\"4:00\" \"13:00\") then gaps that contain 1435 4:00 in the morning (i.e. the night) and 13:00 1436 (i.e. a typical lunch time) do not cause a warning. 1437 You should have at least one time during the night in this 1438 list, or otherwise the first task each morning will trigger 1439 a warning because it follows a long gap. 1440 1441 Furthermore, the following properties can be used to define faces for 1442 issue display. 1443 1444 :default-face the default face, if the specific face is undefined 1445 :overlap-face face for overlapping clocks 1446 :gap-face face for gaps between clocks 1447 :no-end-time-face face for incomplete clocks 1448 :long-face face for clock intervals that are too long 1449 :short-face face for clock intervals that are too short" 1450 :group 'org-agenda-daily/weekly 1451 :group 'org-clock 1452 :version "24.1" 1453 :type 'plist) 1454 1455 (defcustom org-agenda-log-mode-add-notes t 1456 "Non-nil means add first line of notes to log entries in agenda views. 1457 If a log item like a state change or a clock entry is associated with 1458 notes, the first line of these notes will be added to the entry in the 1459 agenda display." 1460 :group 'org-agenda-daily/weekly 1461 :type 'boolean) 1462 1463 (defcustom org-agenda-start-with-log-mode nil 1464 "The initial value of log-mode in a newly created agenda window. 1465 See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further 1466 explanations on the possible values." 1467 :group 'org-agenda-startup 1468 :group 'org-agenda-daily/weekly 1469 :type '(choice (const :tag "Don't show log items" nil) 1470 (const :tag "Show only log items" only) 1471 (const :tag "Show all possible log items" clockcheck) 1472 (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'" 1473 (choice (const :tag "Show closed log items" closed) 1474 (const :tag "Show clocked log items" clock) 1475 (const :tag "Show all logged state changes" state))))) 1476 1477 (defcustom org-agenda-start-with-clockreport-mode nil 1478 "The initial value of clockreport-mode in a newly created agenda window." 1479 :group 'org-agenda-startup 1480 :group 'org-agenda-daily/weekly 1481 :type 'boolean) 1482 1483 (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2) 1484 "Property list with parameters for the clocktable in clockreport mode. 1485 This is the display mode that shows a clock table in the daily/weekly 1486 agenda, the properties for this dynamic block can be set here. 1487 The usual clocktable parameters are allowed here, but you cannot set 1488 the properties :name, :tstart, :tend, :block, and :scope - these will 1489 be overwritten to make sure the content accurately reflects the 1490 current display in the agenda." 1491 :group 'org-agenda-daily/weekly 1492 :type 'plist) 1493 1494 (defvaralias 'org-agenda-search-view-search-words-only 1495 'org-agenda-search-view-always-boolean) 1496 1497 (defcustom org-agenda-search-view-always-boolean nil 1498 "Non-nil means the search string is interpreted as individual parts. 1499 1500 The search string for search view can either be interpreted as a phrase, 1501 or as a list of snippets that define a boolean search for a number of 1502 strings. 1503 1504 When this is non-nil, the string will be split on whitespace, and each 1505 snippet will be searched individually, and all must match in order to 1506 select an entry. A snippet is then a single string of non-white 1507 characters, or a string in double quotes, or a regexp in {} braces. 1508 If a snippet is preceded by \"-\", the snippet must *not* match. 1509 \"+\" is syntactic sugar for positive selection. Each snippet may 1510 be found as a full word or a partial word, but see the variable 1511 `org-agenda-search-view-force-full-words'. 1512 1513 When this is nil, search will look for the entire search phrase as one, 1514 with each space character matching any amount of whitespace, including 1515 line breaks. 1516 1517 Even when this is nil, you can still switch to Boolean search dynamically 1518 by preceding the first snippet with \"+\" or \"-\". If the first snippet 1519 is a regexp marked with braces like \"{abc}\", this will also switch to 1520 boolean search." 1521 :group 'org-agenda-search-view 1522 :version "24.1" 1523 :type 'boolean) 1524 1525 (defcustom org-agenda-search-view-force-full-words nil 1526 "Non-nil means, search words must be matches as complete words. 1527 When nil, they may also match part of a word." 1528 :group 'org-agenda-search-view 1529 :version "24.1" 1530 :type 'boolean) 1531 1532 (defcustom org-agenda-search-view-max-outline-level 0 1533 "Maximum outline level to display in search view. 1534 E.g. when this is set to 1, the search view will only 1535 show headlines of level 1. When set to 0, the default 1536 value, don't limit agenda view by outline level." 1537 :group 'org-agenda-search-view 1538 :version "26.1" 1539 :package-version '(Org . "8.3") 1540 :type 'integer) 1541 1542 (defgroup org-agenda-time-grid nil 1543 "Options concerning the time grid in the Org Agenda." 1544 :tag "Org Agenda Time Grid" 1545 :group 'org-agenda) 1546 1547 (defcustom org-agenda-search-headline-for-time t 1548 "Non-nil means search headline for a time-of-day. 1549 If the headline contains a time-of-day in one format or another, it will 1550 be used to sort the entry into the time sequence of items for a day. 1551 Timestamps in the headline will be ignored." 1552 :group 'org-agenda-time-grid 1553 :type 'boolean) 1554 1555 (defcustom org-agenda-use-time-grid t 1556 "Non-nil means show a time grid in the agenda schedule. 1557 A time grid is a set of lines for specific times (like every two hours between 1558 8:00 and 20:00). The items scheduled for a day at specific times are 1559 sorted in between these lines. 1560 For details about when the grid will be shown, and what it will look like, see 1561 the variable `org-agenda-time-grid'." 1562 :group 'org-agenda-time-grid 1563 :type 'boolean) 1564 1565 (defcustom org-agenda-time-grid 1566 (let ((graphical (and (display-graphic-p) 1567 (char-displayable-p ?┄)))) 1568 `((daily today require-timed) 1569 (800 1000 1200 1400 1600 1800 2000) 1570 ,(if graphical " ┄┄┄┄┄ " "......") 1571 ,(if graphical "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄" "----------------"))) 1572 "The settings for time grid for agenda display. 1573 This is a list of four items. The first item is again a list. It contains 1574 symbols specifying conditions when the grid should be displayed: 1575 1576 daily if the agenda shows a single day 1577 weekly if the agenda shows an entire week 1578 today show grid on current date, independent of daily/weekly display 1579 require-timed show grid only if at least one item has a time specification 1580 remove-match skip grid times already present in an entry 1581 1582 The second item is a list of integers, indicating the times that 1583 should have a grid line. 1584 1585 The third item is a string which will be placed right after the 1586 times that have a grid line. 1587 1588 The fourth item is a string placed after the grid times. This 1589 will align with agenda items." 1590 :group 'org-agenda-time-grid 1591 :package-version '(Org . "9.6") 1592 :type 1593 '(list 1594 (set :greedy t :tag "Grid Display Options" 1595 (const :tag "Show grid in single day agenda display" daily) 1596 (const :tag "Show grid in weekly agenda display" weekly) 1597 (const :tag "Always show grid for today" today) 1598 (const :tag "Show grid only if any timed entries are present" 1599 require-timed) 1600 (const :tag "Skip grid times already present in an entry" 1601 remove-match)) 1602 (repeat :tag "Grid Times" (integer :tag "Time")) 1603 (string :tag "Grid String (after agenda times)") 1604 (string :tag "Grid String (aligns with agenda items)"))) 1605 1606 (defcustom org-agenda-show-current-time-in-grid t 1607 "Non-nil means show the current time in the time grid." 1608 :group 'org-agenda-time-grid 1609 :version "24.1" 1610 :type 'boolean) 1611 1612 (defcustom org-agenda-current-time-string 1613 (if (and (display-graphic-p) 1614 (char-displayable-p ?←) 1615 (char-displayable-p ?─)) 1616 "← now ───────────────────────────────────────────────" 1617 "now - - - - - - - - - - - - - - - - - - - - - - - - -") 1618 "The string for the current time marker in the agenda." 1619 :group 'org-agenda-time-grid 1620 :package-version '(Org . "9.6") 1621 :type 'string) 1622 1623 (defgroup org-agenda-sorting nil 1624 "Options concerning sorting in the Org Agenda." 1625 :tag "Org Agenda Sorting" 1626 :group 'org-agenda) 1627 1628 (defcustom org-agenda-sorting-strategy 1629 '((agenda habit-down time-up urgency-down category-keep) 1630 (todo urgency-down category-keep) 1631 (tags urgency-down category-keep) 1632 (search category-keep)) 1633 "Sorting structure for the agenda items of a single day. 1634 This is a list of symbols which will be used in sequence to determine 1635 if an entry should be listed before another entry. The following 1636 symbols are recognized: 1637 1638 time-up Put entries with time-of-day indications first, early first. 1639 time-down Put entries with time-of-day indications first, late first. 1640 timestamp-up Sort by any timestamp, early first. 1641 timestamp-down Sort by any timestamp, late first. 1642 scheduled-up Sort by scheduled timestamp, early first. 1643 scheduled-down Sort by scheduled timestamp, late first. 1644 deadline-up Sort by deadline timestamp, early first. 1645 deadline-down Sort by deadline timestamp, late first. 1646 ts-up Sort by active timestamp, early first. 1647 ts-down Sort by active timestamp, late first. 1648 tsia-up Sort by inactive timestamp, early first. 1649 tsia-down Sort by inactive timestamp, late first. 1650 category-keep Keep the default order of categories, corresponding to the 1651 sequence in `org-agenda-files'. 1652 category-up Sort alphabetically by category, A-Z. 1653 category-down Sort alphabetically by category, Z-A. 1654 tag-up Sort alphabetically by last tag, A-Z. 1655 tag-down Sort alphabetically by last tag, Z-A. 1656 priority-up Sort numerically by priority, high priority last. 1657 priority-down Sort numerically by priority, high priority first. 1658 urgency-up Sort numerically by urgency, high urgency last. 1659 Urgency is calculated based on item's priority, 1660 and proximity to scheduled time and deadline. See 1661 info node `(org)Sorting of agenda items' for 1662 details. 1663 urgency-down Sort numerically by urgency, high urgency first. 1664 todo-state-up Sort by todo state, tasks that are done last. 1665 todo-state-down Sort by todo state, tasks that are done first. 1666 effort-up Sort numerically by estimated effort, high effort last. 1667 effort-down Sort numerically by estimated effort, high effort first. 1668 user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. 1669 user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. 1670 habit-up Put entries that are habits first. 1671 habit-down Put entries that are habits last. 1672 alpha-up Sort headlines alphabetically. 1673 alpha-down Sort headlines alphabetically, reversed. 1674 1675 The different possibilities will be tried in sequence, and testing stops 1676 if one comparison returns a \"not-equal\". For example, 1677 (setq org-agenda-sorting-strategy 1678 \\='(time-up category-keep priority-down)) 1679 means: Pull out all entries having a specified time of day and sort them, 1680 in order to make a time schedule for the current day the first thing in the 1681 agenda listing for the day. Of the entries without a time indication, keep 1682 the grouped in categories, don't sort the categories, but keep them in 1683 the sequence given in `org-agenda-files'. Within each category sort by 1684 priority. 1685 1686 Leaving out `category-keep' would mean that items will be sorted across 1687 categories by priority. 1688 1689 Instead of a single list, this can also be a set of list for specific 1690 contents, with a context symbol in the car of the list, any of 1691 `agenda', `todo', `tags', `search' for the corresponding agenda views. 1692 1693 Custom commands can bind this variable in the options section." 1694 :group 'org-agenda-sorting 1695 :type `(choice 1696 (repeat :tag "General" ,org-sorting-choice) 1697 (list :tag "Individually" 1698 (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) 1699 (repeat ,org-sorting-choice)) 1700 (cons (const :tag "Strategy for TODO lists" todo) 1701 (repeat ,org-sorting-choice)) 1702 (cons (const :tag "Strategy for Tags matches" tags) 1703 (repeat ,org-sorting-choice)) 1704 (cons (const :tag "Strategy for search matches" search) 1705 (repeat ,org-sorting-choice)))) 1706 :package-version '(Org . "9.7")) 1707 1708 (defcustom org-agenda-cmp-user-defined nil 1709 "A function to define the comparison `user-defined'. 1710 This function must receive two arguments, agenda entry a and b. 1711 If a>b, return +1. If a<b, return -1. If they are equal as seen by 1712 the user comparison, return nil. 1713 When this is defined, you can make `user-defined-up' and `user-defined-down' 1714 part of an agenda sorting strategy." 1715 :group 'org-agenda-sorting 1716 :type 'symbol) 1717 1718 (defcustom org-agenda-sort-notime-is-late t 1719 "Non-nil means items without time are considered late. 1720 This is only relevant for sorting. When t, items which have no explicit 1721 time like 15:30 will be considered as 99:01, i.e. later than any items which 1722 do have a time. When nil, the default time is before 0:00. You can use this 1723 option to decide if the schedule for today should come before or after timeless 1724 agenda entries." 1725 :group 'org-agenda-sorting 1726 :type 'boolean) 1727 1728 (defcustom org-agenda-sort-noeffort-is-high t 1729 "Non-nil means items without effort estimate are sorted as high effort. 1730 This also applies when filtering an agenda view with respect to the 1731 < or > effort operator. Then, tasks with no effort defined will be treated 1732 as tasks with high effort. 1733 When nil, such items are sorted as 0 minutes effort." 1734 :group 'org-agenda-sorting 1735 :type 'boolean) 1736 1737 (defgroup org-agenda-line-format nil 1738 "Options concerning the entry prefix in the Org agenda display." 1739 :tag "Org Agenda Line Format" 1740 :group 'org-agenda) 1741 1742 (defcustom org-agenda-prefix-format 1743 '((agenda . " %i %-12:c%?-12t% s") 1744 (todo . " %i %-12:c") 1745 (tags . " %i %-12:c") 1746 (search . " %i %-12:c")) 1747 "Format specifications for the prefix of items in the agenda views. 1748 1749 An alist with one entry per agenda type. The keys of the 1750 sublists are `agenda', `todo', `search' and `tags'. The values 1751 are format strings. 1752 1753 This format works similar to a printf format, with the following meaning: 1754 1755 %c the category of the item, \"Diary\" for entries from the diary, 1756 or as given by the CATEGORY keyword or derived from the file name 1757 %e the effort required by the item 1758 %l the level of the item (insert X space(s) if item is of level X) 1759 %i the icon category of the item, see `org-agenda-category-icon-alist' 1760 %T the last tag of the item (ignore inherited tags, which come first) 1761 %t the HH:MM time-of-day specification if one applies to the entry 1762 %s Scheduling/Deadline information, a short string 1763 %b show breadcrumbs, i.e., the names of the higher levels 1764 %(expression) Eval EXPRESSION and replace the control string 1765 by the result 1766 1767 All specifiers work basically like the standard `%s' of printf, but may 1768 contain two additional characters: a question mark just after the `%' 1769 and a whitespace/punctuation character just before the final letter. 1770 1771 If the first character after `%' is a question mark, the entire field 1772 will only be included if the corresponding value applies to the current 1773 entry. This is useful for fields which should have fixed width when 1774 present, but zero width when absent. For example, \"%?-12t\" will 1775 result in a 12 character time field if a time of the day is specified, 1776 but will completely disappear in entries which do not contain a time. 1777 1778 If there is punctuation or whitespace character just before the 1779 final format letter, this character will be appended to the field 1780 value if the value is not empty. For example, the format 1781 \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If 1782 the category is empty, no additional colon is inserted. 1783 1784 The default value for the agenda sublist is \" %-12:c%?-12t% s\", 1785 which means: 1786 1787 - Indent the line with two space characters 1788 - Give the category a 12 chars wide field, padded with whitespace on 1789 the right (because of `-'). Append a colon if there is a category 1790 (because of `:'). 1791 - If there is a time-of-day, put it into a 12 chars wide field. If no 1792 time, don't put in an empty field, just skip it (because of '?'). 1793 - Finally, put the scheduling information. 1794 1795 See also the variables `org-agenda-remove-times-when-in-prefix' and 1796 `org-agenda-remove-tags'. 1797 1798 Custom commands can set this variable in the options section." 1799 :type '(choice 1800 (string :tag "General format") 1801 (list :greedy t :tag "View dependent" 1802 (cons (const agenda) (string :tag "Format")) 1803 (cons (const todo) (string :tag "Format")) 1804 (cons (const tags) (string :tag "Format")) 1805 (cons (const search) (string :tag "Format")))) 1806 :group 'org-agenda-line-format 1807 :version "26.1" 1808 :package-version '(Org . "9.1")) 1809 1810 (defcustom org-agenda-breadcrumbs-separator "->" 1811 "The separator of breadcrumbs in agenda lines." 1812 :group 'org-agenda-line-format 1813 :package-version '(Org . "9.3") 1814 :type 'string 1815 :safe #'stringp) 1816 1817 (defvar org-prefix-format-compiled nil 1818 "The compiled prefix format and associated variables. 1819 This is a list where first element is a list of variable bindings, and second 1820 element is the compiled format expression. See the variable 1821 `org-agenda-prefix-format'.") 1822 1823 (defcustom org-agenda-todo-keyword-format "%-1s" 1824 "Format for the TODO keyword in agenda lines. 1825 Set this to something like \"%-12s\" if you want all TODO keywords 1826 to occupy a fixed space in the agenda display." 1827 :group 'org-agenda-line-format 1828 :type 'string) 1829 1830 (defcustom org-agenda-diary-sexp-prefix nil 1831 "A regexp that matches part of a diary sexp entry 1832 which should be treated as scheduling/deadline information in 1833 `org-agenda'. 1834 1835 For example, you can use this to extract the `diary-remind-message' from 1836 `diary-remind' entries." 1837 :group 'org-agenda-line-format 1838 :type '(choice (const :tag "None" nil) (regexp :tag "Regexp"))) 1839 1840 (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") 1841 "Text preceding timerange entries in the agenda view. 1842 This is a list with two strings. The first applies when the range 1843 is entirely on one day. The second applies if the range spans several days. 1844 The strings may have two \"%d\" format specifiers which will be filled 1845 with the sequence number of the days, and the total number of days in the 1846 range, respectively." 1847 :group 'org-agenda-line-format 1848 :type '(list 1849 (string :tag "Deadline today ") 1850 (choice :tag "Deadline relative" 1851 (string :tag "Format string") 1852 (function)))) 1853 1854 (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") 1855 "Text preceding scheduled items in the agenda view. 1856 This is a list with two strings. The first applies when the item is 1857 scheduled on the current day. The second applies when it has been scheduled 1858 previously, it may contain a %d indicating that this is the nth time that 1859 this item is scheduled, due to automatic rescheduling of unfinished items 1860 for the following day. So this number is one larger than the number of days 1861 that passed since this item was scheduled first." 1862 :group 'org-agenda-line-format 1863 :version "24.4" 1864 :package-version '(Org . "8.0") 1865 :type '(list 1866 (string :tag "Scheduled today ") 1867 (string :tag "Scheduled previously"))) 1868 1869 (defcustom org-agenda-inactive-leader "[" 1870 "Text preceding item pulled into the agenda by inactive time stamps. 1871 These entries are added to the agenda when pressing \"[\"." 1872 :group 'org-agenda-line-format 1873 :version "24.1" 1874 :type 'string) 1875 1876 (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ") 1877 "Text preceding deadline items in the agenda view. 1878 This is a list with three strings. The first applies when the item has its 1879 deadline on the current day. The second applies when the deadline is in the 1880 future, the third one when it is in the past. The strings may contain %d 1881 to capture the number of days." 1882 :group 'org-agenda-line-format 1883 :version "24.4" 1884 :package-version '(Org . "8.0") 1885 :type '(list 1886 (string :tag "Deadline today ") 1887 (string :tag "Deadline in the future ") 1888 (string :tag "Deadline in the past "))) 1889 1890 (defcustom org-agenda-remove-times-when-in-prefix t 1891 "Non-nil means remove duplicate time specifications in agenda items. 1892 When the format `org-agenda-prefix-format' contains a `%t' specifier, a 1893 time-of-day specification in a headline or diary entry is extracted and 1894 placed into the prefix. If this option is non-nil, the original specification 1895 \(a timestamp or -range, or just a plain time(range) specification like 1896 11:30-4pm) will be removed for agenda display. This makes the agenda less 1897 cluttered. 1898 The option can be t or nil. It may also be the symbol `beg', indicating 1899 that the time should only be removed when it is located at the beginning of 1900 the headline/diary entry." 1901 :group 'org-agenda-line-format 1902 :type '(choice 1903 (const :tag "Always" t) 1904 (const :tag "Never" nil) 1905 (const :tag "When at beginning of entry" beg))) 1906 1907 (defcustom org-agenda-remove-timeranges-from-blocks nil 1908 "Non-nil means remove time ranges specifications in agenda 1909 items that span on several days." 1910 :group 'org-agenda-line-format 1911 :version "24.1" 1912 :type 'boolean) 1913 1914 (defcustom org-agenda-default-appointment-duration nil 1915 "Default duration for appointments that only have a starting time. 1916 When nil, no duration is specified in such cases. 1917 When non-nil, this must be the number of minutes, e.g. 60 for one hour." 1918 :group 'org-agenda-line-format 1919 :type '(choice 1920 (integer :tag "Minutes") 1921 (const :tag "No default duration"))) 1922 1923 (defcustom org-agenda-show-inherited-tags t 1924 "Non-nil means show inherited tags in each agenda line. 1925 1926 When this option is set to `always', it takes precedence over 1927 `org-agenda-use-tag-inheritance' and inherited tags are shown 1928 in every agenda. 1929 1930 When this option is set to t (the default), inherited tags are 1931 shown when they are available, i.e. when the value of 1932 `org-agenda-use-tag-inheritance' enables tag inheritance for the 1933 given agenda type. 1934 1935 This can be set to a list of agenda types in which the agenda 1936 must display the inherited tags. Available types are `todo', 1937 `agenda' and `search'. 1938 1939 When set to nil, never show inherited tags in agenda lines." 1940 :group 'org-agenda-line-format 1941 :group 'org-agenda 1942 :version "24.3" 1943 :type '(choice 1944 (const :tag "Show inherited tags when available" t) 1945 (const :tag "Always show inherited tags" always) 1946 (repeat :tag "Show inherited tags only in selected agenda types" 1947 (symbol :tag "Agenda type")))) 1948 1949 (defcustom org-agenda-use-tag-inheritance '(todo search agenda) 1950 "List of agenda view types where to use tag inheritance. 1951 1952 In tags/tags-todo/tags-tree agenda views, tag inheritance is 1953 controlled by `org-use-tag-inheritance'. In other agenda types, 1954 `org-use-tag-inheritance' is not used for the selection of the 1955 agenda entries. Still, you may want the agenda to be aware of 1956 the inherited tags anyway, e.g. for later tag filtering. 1957 1958 Allowed value are `todo', `search' and `agenda'. 1959 1960 This variable has no effect if `org-agenda-show-inherited-tags' 1961 is set to `always'. In that case, the agenda is aware of those 1962 tags. 1963 1964 The default value sets tags in every agenda type. Setting this 1965 option to nil will speed up non-tags agenda view a lot." 1966 :group 'org-agenda 1967 :version "26.1" 1968 :package-version '(Org . "9.1") 1969 :type '(choice 1970 (const :tag "Use tag inheritance in all agenda types" t) 1971 (repeat :tag "Use tag inheritance in selected agenda types" 1972 (symbol :tag "Agenda type")))) 1973 1974 (defcustom org-agenda-hide-tags-regexp nil 1975 "Regular expression used to filter away specific tags in agenda views. 1976 This means that these tags will be present, but not be shown in the agenda 1977 line. Secondary filtering will still work on the hidden tags. 1978 Nil means don't hide any tags." 1979 :group 'org-agenda-line-format 1980 :type '(choice 1981 (const :tag "Hide none" nil) 1982 (regexp :tag "Regexp "))) 1983 1984 (defvaralias 'org-agenda-remove-tags-when-in-prefix 1985 'org-agenda-remove-tags) 1986 1987 (defcustom org-agenda-remove-tags nil 1988 "Non-nil means remove the tags from the headline copy in the agenda. 1989 When this is the symbol `prefix', only remove tags when 1990 `org-agenda-prefix-format' contains a `%T' specifier." 1991 :group 'org-agenda-line-format 1992 :type '(choice 1993 (const :tag "Always" t) 1994 (const :tag "Never" nil) 1995 (const :tag "When prefix format contains %T" prefix))) 1996 1997 (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) 1998 1999 (defcustom org-agenda-tags-column 'auto 2000 "Shift tags in agenda items to this column. 2001 If set to `auto', tags will be automatically aligned to the right 2002 edge of the window. 2003 2004 If set to a positive number, tags will be left-aligned to that 2005 column. If set to a negative number, tags will be right-aligned 2006 to that column. For example, -80 works well for a normal 80 2007 character screen." 2008 :group 'org-agenda-line-format 2009 :type '(choice 2010 (const :tag "Automatically align to right edge of window" auto) 2011 (integer :tag "Specific column" -80)) 2012 :package-version '(Org . "9.1") 2013 :version "26.1") 2014 2015 (defcustom org-agenda-fontify-priorities 'cookies 2016 "Non-nil means highlight low and high priorities in agenda. 2017 When t, the highest priority entries are bold, lowest priority italic. 2018 However, settings in `org-priority-faces' will overrule these faces. 2019 When this variable is the symbol `cookies', only fontify the 2020 cookies, not the entire task. 2021 This may also be an association list of priority faces, whose 2022 keys are the character values of `org-priority-highest', 2023 `org-priority-default', and `org-priority-lowest' (the default values 2024 are ?A, ?B, and ?C, respectively). The face may be a named face, a 2025 color as a string, or a list like `(:background \"Red\")'. 2026 If it is a color, the variable `org-faces-easy-properties' 2027 determines if it is a foreground or a background color." 2028 :group 'org-agenda-line-format 2029 :type '(choice 2030 (const :tag "Never" nil) 2031 (const :tag "Defaults" t) 2032 (const :tag "Cookies only" cookies) 2033 (repeat :tag "Specify" 2034 (list (character :tag "Priority" :value ?A) 2035 (choice :tag "Face " 2036 (string :tag "Color") 2037 (sexp :tag "Face")))))) 2038 2039 (defcustom org-agenda-day-face-function nil 2040 "Function called to determine what face should be used to display a day. 2041 The only argument passed to that function is the day. It should 2042 returns a face, or nil if does not want to specify a face and let 2043 the normal rules apply." 2044 :group 'org-agenda-line-format 2045 :version "24.1" 2046 :type '(choice (const nil) (function))) 2047 2048 (defcustom org-agenda-category-icon-alist nil 2049 "Alist of category icon to be displayed in agenda views. 2050 2051 The icons are displayed in place of the %i placeholders in 2052 `org-agenda-prefix-format', which see. 2053 2054 Each entry should have the following format: 2055 2056 (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS) 2057 2058 Where CATEGORY-REGEXP is a regexp matching the categories where 2059 the icon should be displayed. 2060 FILE-OR-DATA either a file path or a string containing image data. 2061 2062 The other fields can be omitted safely if not needed: 2063 TYPE indicates the image type. 2064 DATA-P is a boolean indicating whether the FILE-OR-DATA string is 2065 image data. 2066 PROPS are additional image attributes to assign to the image, 2067 like, e.g. `:ascent center'. 2068 2069 (\"Org\" \"/path/to/icon.png\" nil nil :ascent center) 2070 2071 If you want to set the display properties yourself, just put a 2072 list as second element: 2073 2074 (CATEGORY-REGEXP (MY PROPERTY LIST)) 2075 2076 For example, to display a 16px horizontal space for Emacs 2077 category, you can use: 2078 2079 (\"Emacs\" \\='(space . (:width (16))))" 2080 :group 'org-agenda-line-format 2081 :version "24.1" 2082 :type '(alist :key-type (regexp :tag "Regexp matching category") 2083 :value-type (choice (list :tag "Icon" 2084 (string :tag "File or data") 2085 (symbol :tag "Type") 2086 (boolean :tag "Data?") 2087 (repeat :tag "Extra image properties" :inline t sexp)) 2088 (list :tag "Display properties" sexp)))) 2089 2090 (defgroup org-agenda-column-view nil 2091 "Options concerning column view in the agenda." 2092 :tag "Org Agenda Column View" 2093 :group 'org-agenda) 2094 2095 (defcustom org-agenda-view-columns-initially nil 2096 "When non-nil, switch to columns view right after creating the agenda." 2097 :group 'org-agenda-column-view 2098 :type 'boolean 2099 :version "26.1" 2100 :package-version '(Org . "9.0") 2101 :safe #'booleanp) 2102 2103 (defcustom org-agenda-columns-show-summaries t 2104 "Non-nil means show summaries for columns displayed in the agenda view." 2105 :group 'org-agenda-column-view 2106 :type 'boolean) 2107 2108 (defcustom org-agenda-columns-compute-summary-properties t 2109 "Non-nil means recompute all summary properties before column view. 2110 When column view in the agenda is listing properties that have a summary 2111 operator, it can go to all relevant buffers and recompute the summaries 2112 there. This can mean overhead for the agenda column view, but is necessary 2113 to have thing up to date. 2114 As a special case, a CLOCKSUM property also makes sure that the clock 2115 computations are current." 2116 :group 'org-agenda-column-view 2117 :type 'boolean) 2118 2119 (defcustom org-agenda-columns-add-appointments-to-effort-sum nil 2120 "Non-nil means the duration of an appointment will add to day effort. 2121 The property to which appointment durations will be added is the one given 2122 in the option `org-effort-property'. If an appointment does not have 2123 an end time, `org-agenda-default-appointment-duration' will be used. If that 2124 is not set, an appointment without end time will not contribute to the time 2125 estimate." 2126 :group 'org-agenda-column-view 2127 :type 'boolean) 2128 2129 (defcustom org-agenda-auto-exclude-function nil 2130 "A function called with a tag to decide if it is filtered on \ 2131 \\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] RET'. 2132 The sole argument to the function, which is called once for each 2133 possible tag, is a string giving the name of the tag. The 2134 function should return either nil if the tag should be included 2135 as normal, \"-<TAG>\" to exclude the tag, or \"+<TAG>\" to exclude 2136 lines not carrying this tag. 2137 Note that for the purpose of tag filtering, only the lower-case version of 2138 all tags will be considered, so that this function will only ever see 2139 the lower-case version of all tags." 2140 :group 'org-agenda 2141 :type '(choice (const nil) (function))) 2142 2143 (defcustom org-agenda-bulk-custom-functions nil 2144 "Alist of characters and custom functions for bulk actions. 2145 For example, this makes those two functions available: 2146 2147 (setq org-agenda-bulk-custom-functions 2148 \\='((?R set-category) 2149 (?C bulk-cut))) 2150 2151 With selected entries in an agenda buffer, `B R' will call 2152 the custom function `set-category' on the selected entries. 2153 Note that functions in this alist don't need to be quoted. 2154 2155 You can also specify a function which collects arguments to be 2156 used for each call to your bulk custom function. The argument 2157 collecting function will be run once and should return a list of 2158 arguments to pass to the bulk function. For example: 2159 2160 (setq org-agenda-bulk-custom-functions 2161 \\='((?R set-category get-category))) 2162 2163 Now, `B R' will call the custom `get-category' which would prompt 2164 the user once for a category. That category is then passed as an 2165 argument to `set-category' for each entry it's called against." 2166 :type 2167 '(alist :key-type character 2168 :value-type 2169 (group (function :tag "Bulk Custom Function") 2170 (choice (function :tag "Bulk Custom Argument Function") 2171 (const :tag "No Bulk Custom Argument Function" nil)))) 2172 :package-version '(Org . "9.5") 2173 :group 'org-agenda) 2174 2175 (defmacro org-agenda-with-point-at-orig-entry (string &rest body) 2176 "Execute BODY with point at location given by `org-hd-marker' property. 2177 If STRING is non-nil, the text property will be fetched from position 0 2178 in that string. If STRING is nil, it will be fetched from the beginning 2179 of the current line." 2180 (declare (debug t) (indent 1)) 2181 (org-with-gensyms (marker) 2182 `(let ((,marker (get-text-property (if ,string 0 (line-beginning-position)) 2183 'org-hd-marker ,string))) 2184 (with-current-buffer (marker-buffer ,marker) 2185 (save-excursion 2186 (goto-char ,marker) 2187 ,@body))))) 2188 2189 (defun org-add-agenda-custom-command (entry) 2190 "Replace or add a command in `org-agenda-custom-commands'. 2191 This is mostly for hacking and trying a new command - once the command 2192 works you probably want to add it to `org-agenda-custom-commands' for good." 2193 (let ((ass (assoc (car entry) org-agenda-custom-commands))) 2194 (if ass 2195 (setcdr ass (cdr entry)) 2196 (push entry org-agenda-custom-commands)))) 2197 2198 (defmacro org-agenda--insert-overriding-header (default) 2199 "Insert header into agenda view. 2200 The inserted header depends on `org-agenda-overriding-header'. 2201 If the empty string, don't insert a header. If any other string, 2202 insert it as a header. If nil, insert DEFAULT, which should 2203 evaluate to a string. If a function, call it and insert the 2204 string that it returns." 2205 (declare (debug (form)) (indent defun)) 2206 `(cond 2207 ((not org-agenda-overriding-header) (insert ,default)) 2208 ((equal org-agenda-overriding-header "") nil) 2209 ((stringp org-agenda-overriding-header) 2210 (insert (propertize org-agenda-overriding-header 2211 'face 'org-agenda-structure) 2212 "\n")) 2213 ((functionp org-agenda-overriding-header) 2214 (insert (funcall org-agenda-overriding-header))) 2215 (t (user-error "Invalid value for `org-agenda-overriding-header': %S" 2216 org-agenda-overriding-header)))) 2217 2218 ;;; Define the org-agenda-mode 2219 2220 (defvaralias 'org-agenda-keymap 'org-agenda-mode-map) 2221 (defvar org-agenda-mode-map (make-sparse-keymap) 2222 "Keymap for `org-agenda-mode'.") 2223 2224 (org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line) 2225 2226 (defvar org-agenda-menu) ; defined later in this file. 2227 (defvar org-agenda-restrict nil 2228 "Non-nil means agenda restriction is active. 2229 This is an internal flag indicating either temporary or extended 2230 agenda restriction. Specifically, it is set to t if the agenda 2231 is restricted to an entire file, and is set to the corresponding 2232 buffer if the agenda is restricted to a part of a file, e.g. a 2233 region or a subtree. In the latter case, 2234 `org-agenda-restrict-begin' and `org-agenda-restrict-end' are set 2235 to the beginning and the end of the part. 2236 2237 See also `org-agenda-set-restriction-lock'.") 2238 (defvar org-agenda-follow-mode nil) 2239 (defvar org-agenda-entry-text-mode nil) 2240 (defvar org-agenda-clockreport-mode nil) 2241 (defvar org-agenda-show-log nil 2242 "When non-nil, show the log in the agenda. 2243 Do not set this directly; instead use 2244 `org-agenda-start-with-log-mode', which see.") 2245 (defvar org-agenda-redo-command nil) 2246 (defvar org-agenda-query-string nil) 2247 (defvar org-agenda-mode-hook nil 2248 "Hook run after `org-agenda-mode' is turned on. 2249 The buffer is still writable when this hook is called.") 2250 (defvar org-agenda-type nil) 2251 (defvar org-agenda-force-single-file nil) 2252 (defvar org-agenda-bulk-marked-entries nil 2253 "List of markers that refer to marked entries in the agenda.") 2254 (defvar org-agenda-current-date nil 2255 "Active date when building the agenda.") 2256 2257 ;;; Multiple agenda buffers support 2258 2259 (defcustom org-agenda-sticky nil 2260 "Non-nil means agenda q key will bury agenda buffers. 2261 Agenda commands will then show existing buffer instead of generating new ones. 2262 When nil, `q' will kill the single agenda buffer." 2263 :group 'org-agenda 2264 :version "24.3" 2265 :type 'boolean) 2266 2267 2268 ;;;###autoload 2269 (defun org-toggle-sticky-agenda (&optional arg) 2270 "Toggle `org-agenda-sticky'." 2271 (interactive "P") 2272 (let ((new-value (if arg 2273 (> (prefix-numeric-value arg) 0) 2274 (not org-agenda-sticky)))) 2275 (if (equal new-value org-agenda-sticky) 2276 (and (called-interactively-p 'interactive) 2277 (message "Sticky agenda was already %s" 2278 (if org-agenda-sticky "enabled" "disabled"))) 2279 (setq org-agenda-sticky new-value) 2280 (org-agenda-kill-all-agenda-buffers) 2281 (and (called-interactively-p 'interactive) 2282 (message "Sticky agenda %s" 2283 (if org-agenda-sticky "enabled" "disabled")))))) 2284 2285 (defvar org-agenda-buffer nil 2286 "Agenda buffer currently being generated.") 2287 2288 (defvar org-agenda-last-prefix-arg nil) 2289 (defvar org-agenda-this-buffer-name nil) 2290 (defvar org-agenda-doing-sticky-redo nil) 2291 (defvar org-agenda-this-buffer-is-sticky nil) 2292 (defvar org-agenda-last-indirect-buffer nil 2293 "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.") 2294 2295 (defconst org-agenda-local-vars 2296 '(org-agenda-this-buffer-name 2297 org-agenda-undo-list 2298 org-agenda-pending-undo-list 2299 org-agenda-follow-mode 2300 org-agenda-entry-text-mode 2301 org-agenda-clockreport-mode 2302 org-agenda-show-log 2303 org-agenda-redo-command 2304 org-agenda-query-string 2305 org-agenda-type 2306 org-agenda-bulk-marked-entries 2307 org-agenda-undo-has-started-in 2308 org-agenda-info 2309 org-agenda-pre-window-conf 2310 org-agenda-columns-active 2311 org-agenda-tag-filter 2312 org-agenda-category-filter 2313 org-agenda-top-headline-filter 2314 org-agenda-regexp-filter 2315 org-agenda-effort-filter 2316 org-agenda-filters-preset 2317 org-agenda-markers 2318 org-agenda-last-search-view-search-was-boolean 2319 org-agenda-last-indirect-buffer 2320 org-agenda-filtered-by-category 2321 org-agenda-filter-form 2322 org-agenda-cycle-counter 2323 org-agenda-last-prefix-arg) 2324 "Variables that must be local in agenda buffers to allow multiple buffers.") 2325 2326 (defun org-agenda-mode () 2327 "Mode for time-sorted view on action items in Org files. 2328 2329 The following commands are available: 2330 2331 \\{org-agenda-mode-map}" 2332 (interactive) 2333 (ignore-errors (require 'face-remap)) 2334 (let ((agenda-local-vars-to-keep 2335 '(text-scale-mode-amount 2336 text-scale-mode 2337 text-scale-mode-lighter 2338 face-remapping-alist)) 2339 (save (buffer-local-variables))) 2340 (kill-all-local-variables) 2341 (cl-flet ((reset-saved (var-set) 2342 "Reset variables in VAR-SET to possibly stored value in SAVE." 2343 (dolist (elem save) 2344 (pcase elem 2345 (`(,var . ,val) ;ignore unbound variables 2346 (when (and val (memq var var-set)) 2347 (set var val))))))) 2348 (cond (org-agenda-doing-sticky-redo 2349 ;; Refreshing sticky agenda-buffer 2350 ;; 2351 ;; Preserve the value of `org-agenda-local-vars' variables. 2352 (mapc #'make-local-variable org-agenda-local-vars) 2353 (reset-saved org-agenda-local-vars) 2354 (setq-local org-agenda-this-buffer-is-sticky t)) 2355 (org-agenda-sticky 2356 ;; Creating a sticky Agenda buffer for the first time 2357 (mapc #'make-local-variable org-agenda-local-vars) 2358 (setq-local org-agenda-this-buffer-is-sticky t)) 2359 (t 2360 ;; Creating a non-sticky agenda buffer 2361 (setq-local org-agenda-this-buffer-is-sticky nil))) 2362 (mapc #'make-local-variable agenda-local-vars-to-keep) 2363 (reset-saved agenda-local-vars-to-keep))) 2364 (setq org-agenda-undo-list nil 2365 org-agenda-pending-undo-list nil 2366 org-agenda-bulk-marked-entries nil) 2367 (setq major-mode 'org-agenda-mode) 2368 ;; Keep global-font-lock-mode from turning on font-lock-mode 2369 (setq-local font-lock-global-modes (list 'not major-mode)) 2370 (setq mode-name "Org-Agenda") 2371 (setq indent-tabs-mode nil) 2372 (use-local-map org-agenda-mode-map) 2373 (when org-startup-truncated (setq truncate-lines t)) 2374 (setq-local line-move-visual nil) 2375 (add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local) 2376 (add-hook 'pre-command-hook #'org-unhighlight nil 'local) 2377 ;; Make sure properties are removed when copying text 2378 (if (boundp 'filter-buffer-substring-functions) 2379 (add-hook 'filter-buffer-substring-functions 2380 (lambda (fun start end delete) 2381 (substring-no-properties (funcall fun start end delete))) 2382 nil t) 2383 ;; Emacs >= 24.4. 2384 (add-function :filter-return (local 'filter-buffer-substring-function) 2385 #'substring-no-properties)) 2386 (unless org-agenda-keep-modes 2387 (setq org-agenda-follow-mode org-agenda-start-with-follow-mode 2388 org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode 2389 org-agenda-show-log org-agenda-start-with-log-mode 2390 org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode 2391 org-agenda-archives-mode org-agenda-start-with-archives-mode)) 2392 (add-to-invisibility-spec '(org-filtered)) 2393 (add-to-invisibility-spec '(org-link)) 2394 (easy-menu-change 2395 '("Agenda") "Agenda Files" 2396 (append 2397 (list 2398 (vector 2399 (if (get 'org-agenda-files 'org-restrict) 2400 "Restricted to single file" 2401 "Edit File List") 2402 '(org-edit-agenda-file-list) 2403 (not (get 'org-agenda-files 'org-restrict))) 2404 "--") 2405 (mapcar #'org-file-menu-entry (org-agenda-files)))) 2406 (org-agenda-set-mode-name) 2407 (run-mode-hooks 'org-agenda-mode-hook)) 2408 2409 (substitute-key-definition #'undo #'org-agenda-undo 2410 org-agenda-mode-map global-map) 2411 (org-defkey org-agenda-mode-map "\C-i" #'org-agenda-goto) 2412 (org-defkey org-agenda-mode-map [(tab)] #'org-agenda-goto) 2413 (org-defkey org-agenda-mode-map "\C-m" #'org-agenda-switch-to) 2414 (org-defkey org-agenda-mode-map "\C-k" #'org-agenda-kill) 2415 (org-defkey org-agenda-mode-map "\C-c\C-w" #'org-agenda-refile) 2416 (org-defkey org-agenda-mode-map [(meta down)] #'org-agenda-drag-line-forward) 2417 (org-defkey org-agenda-mode-map [(meta up)] #'org-agenda-drag-line-backward) 2418 (org-defkey org-agenda-mode-map "m" #'org-agenda-bulk-mark) 2419 (org-defkey org-agenda-mode-map "\M-m" #'org-agenda-bulk-toggle) 2420 (org-defkey org-agenda-mode-map "*" #'org-agenda-bulk-mark-all) 2421 (org-defkey org-agenda-mode-map "\M-*" #'org-agenda-bulk-toggle-all) 2422 (org-defkey org-agenda-mode-map "#" #'org-agenda-dim-blocked-tasks) 2423 (org-defkey org-agenda-mode-map "%" #'org-agenda-bulk-mark-regexp) 2424 (org-defkey org-agenda-mode-map "u" #'org-agenda-bulk-unmark) 2425 (org-defkey org-agenda-mode-map "U" #'org-agenda-bulk-unmark-all) 2426 (org-defkey org-agenda-mode-map "B" #'org-agenda-bulk-action) 2427 (org-defkey org-agenda-mode-map "k" #'org-agenda-capture) 2428 (org-defkey org-agenda-mode-map "A" #'org-agenda-append-agenda) 2429 (org-defkey org-agenda-mode-map "\C-c\C-x!" #'org-reload) 2430 (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" #'org-agenda-archive-default) 2431 (org-defkey org-agenda-mode-map "\C-c\C-xa" #'org-agenda-toggle-archive-tag) 2432 (org-defkey org-agenda-mode-map "\C-c\C-xA" #'org-agenda-archive-to-archive-sibling) 2433 (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" #'org-agenda-archive) 2434 (org-defkey org-agenda-mode-map "\C-c$" #'org-agenda-archive) 2435 (org-defkey org-agenda-mode-map "$" #'org-agenda-archive) 2436 (org-defkey org-agenda-mode-map "\C-c\C-o" #'org-agenda-open-link) 2437 (org-defkey org-agenda-mode-map " " #'org-agenda-show-and-scroll-up) 2438 (org-defkey org-agenda-mode-map [backspace] #'org-agenda-show-scroll-down) 2439 (org-defkey org-agenda-mode-map "\d" #'org-agenda-show-scroll-down) 2440 (org-defkey org-agenda-mode-map [(control shift right)] #'org-agenda-todo-nextset) 2441 (org-defkey org-agenda-mode-map [(control shift left)] #'org-agenda-todo-previousset) 2442 (org-defkey org-agenda-mode-map "\C-c\C-xb" #'org-agenda-tree-to-indirect-buffer) 2443 (org-defkey org-agenda-mode-map "o" #'delete-other-windows) 2444 (org-defkey org-agenda-mode-map "L" #'org-agenda-recenter) 2445 (org-defkey org-agenda-mode-map "\C-c\C-t" #'org-agenda-todo) 2446 (org-defkey org-agenda-mode-map "t" #'org-agenda-todo) 2447 (org-defkey org-agenda-mode-map "a" #'org-agenda-archive-default-with-confirmation) 2448 (org-defkey org-agenda-mode-map ":" #'org-agenda-set-tags) 2449 (org-defkey org-agenda-mode-map "\C-c\C-q" #'org-agenda-set-tags) 2450 (org-defkey org-agenda-mode-map "." #'org-agenda-goto-today) 2451 (org-defkey org-agenda-mode-map "j" #'org-agenda-goto-date) 2452 (org-defkey org-agenda-mode-map "d" #'org-agenda-day-view) 2453 (org-defkey org-agenda-mode-map "w" #'org-agenda-week-view) 2454 (org-defkey org-agenda-mode-map "y" #'org-agenda-year-view) 2455 (org-defkey org-agenda-mode-map "\C-c\C-z" #'org-agenda-add-note) 2456 (org-defkey org-agenda-mode-map "z" #'org-agenda-add-note) 2457 (org-defkey org-agenda-mode-map [(shift right)] #'org-agenda-do-date-later) 2458 (org-defkey org-agenda-mode-map [(shift left)] #'org-agenda-do-date-earlier) 2459 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] #'org-agenda-do-date-later) 2460 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] #'org-agenda-do-date-earlier) 2461 (org-defkey org-agenda-mode-map ">" #'org-agenda-date-prompt) 2462 (org-defkey org-agenda-mode-map "\C-c\C-s" #'org-agenda-schedule) 2463 (org-defkey org-agenda-mode-map "\C-c\C-d" #'org-agenda-deadline) 2464 (let ((l '(1 2 3 4 5 6 7 8 9 0))) 2465 (while l (org-defkey org-agenda-mode-map 2466 (number-to-string (pop l)) #'digit-argument))) 2467 (org-defkey org-agenda-mode-map "F" #'org-agenda-follow-mode) 2468 (org-defkey org-agenda-mode-map "R" #'org-agenda-clockreport-mode) 2469 (org-defkey org-agenda-mode-map "E" #'org-agenda-entry-text-mode) 2470 (org-defkey org-agenda-mode-map "l" #'org-agenda-log-mode) 2471 (org-defkey org-agenda-mode-map "v" #'org-agenda-view-mode-dispatch) 2472 (org-defkey org-agenda-mode-map "D" #'org-agenda-toggle-diary) 2473 (org-defkey org-agenda-mode-map "!" #'org-agenda-toggle-deadlines) 2474 (org-defkey org-agenda-mode-map "G" #'org-agenda-toggle-time-grid) 2475 (org-defkey org-agenda-mode-map "r" #'org-agenda-redo) 2476 (org-defkey org-agenda-mode-map "g" #'org-agenda-redo-all) 2477 (org-defkey org-agenda-mode-map "e" #'org-agenda-set-effort) 2478 (org-defkey org-agenda-mode-map "\C-c\C-xe" #'org-agenda-set-effort) 2479 (org-defkey org-agenda-mode-map "\C-c\C-x\C-e" 2480 #'org-clock-modify-effort-estimate) 2481 (org-defkey org-agenda-mode-map "\C-c\C-xp" #'org-agenda-set-property) 2482 (org-defkey org-agenda-mode-map "q" #'org-agenda-quit) 2483 (org-defkey org-agenda-mode-map "Q" #'org-agenda-Quit) 2484 (org-defkey org-agenda-mode-map "x" #'org-agenda-exit) 2485 (org-defkey org-agenda-mode-map "\C-x\C-w" #'org-agenda-write) 2486 (org-defkey org-agenda-mode-map "\C-x\C-s" #'org-save-all-org-buffers) 2487 (org-defkey org-agenda-mode-map "s" #'org-save-all-org-buffers) 2488 (org-defkey org-agenda-mode-map "T" #'org-agenda-show-tags) 2489 (org-defkey org-agenda-mode-map "n" #'org-agenda-next-line) 2490 (org-defkey org-agenda-mode-map "p" #'org-agenda-previous-line) 2491 (org-defkey org-agenda-mode-map "N" #'org-agenda-next-item) 2492 (org-defkey org-agenda-mode-map "P" #'org-agenda-previous-item) 2493 (substitute-key-definition #'next-line #'org-agenda-next-line 2494 org-agenda-mode-map global-map) 2495 (substitute-key-definition #'previous-line #'org-agenda-previous-line 2496 org-agenda-mode-map global-map) 2497 (org-defkey org-agenda-mode-map "\C-c\C-a" #'org-attach) 2498 (org-defkey org-agenda-mode-map "\C-c\C-n" #'org-agenda-next-date-line) 2499 (org-defkey org-agenda-mode-map "\C-c\C-p" #'org-agenda-previous-date-line) 2500 (org-defkey org-agenda-mode-map "\C-c," #'org-agenda-priority) 2501 (org-defkey org-agenda-mode-map "," #'org-agenda-priority) 2502 (org-defkey org-agenda-mode-map "i" #'org-agenda-diary-entry) 2503 (org-defkey org-agenda-mode-map "c" #'org-agenda-goto-calendar) 2504 (org-defkey org-agenda-mode-map "C" #'org-agenda-convert-date) 2505 (org-defkey org-agenda-mode-map "M" #'org-agenda-phases-of-moon) 2506 (org-defkey org-agenda-mode-map "S" #'org-agenda-sunrise-sunset) 2507 (org-defkey org-agenda-mode-map "h" #'org-agenda-holidays) 2508 (org-defkey org-agenda-mode-map "H" #'org-agenda-holidays) 2509 (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" #'org-agenda-clock-in) 2510 (org-defkey org-agenda-mode-map "I" #'org-agenda-clock-in) 2511 (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" #'org-agenda-clock-out) 2512 (org-defkey org-agenda-mode-map "O" #'org-agenda-clock-out) 2513 (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" #'org-agenda-clock-cancel) 2514 (org-defkey org-agenda-mode-map "X" #'org-agenda-clock-cancel) 2515 (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" #'org-clock-goto) 2516 (org-defkey org-agenda-mode-map "J" #'org-agenda-clock-goto) 2517 (org-defkey org-agenda-mode-map "+" #'org-agenda-priority-up) 2518 (org-defkey org-agenda-mode-map "-" #'org-agenda-priority-down) 2519 (org-defkey org-agenda-mode-map [(shift up)] #'org-agenda-priority-up) 2520 (org-defkey org-agenda-mode-map [(shift down)] #'org-agenda-priority-down) 2521 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] #'org-agenda-priority-up) 2522 (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] #'org-agenda-priority-down) 2523 (org-defkey org-agenda-mode-map "f" #'org-agenda-later) 2524 (org-defkey org-agenda-mode-map "b" #'org-agenda-earlier) 2525 (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" #'org-agenda-columns) 2526 (org-defkey org-agenda-mode-map "\C-c\C-x>" #'org-agenda-remove-restriction-lock) 2527 (org-defkey org-agenda-mode-map "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda) 2528 (org-defkey org-agenda-mode-map "[" #'org-agenda-manipulate-query-add) 2529 (org-defkey org-agenda-mode-map "]" #'org-agenda-manipulate-query-subtract) 2530 (org-defkey org-agenda-mode-map "{" #'org-agenda-manipulate-query-add-re) 2531 (org-defkey org-agenda-mode-map "}" #'org-agenda-manipulate-query-subtract-re) 2532 (org-defkey org-agenda-mode-map "\\" #'org-agenda-filter-by-tag) 2533 (org-defkey org-agenda-mode-map "_" #'org-agenda-filter-by-effort) 2534 (org-defkey org-agenda-mode-map "=" #'org-agenda-filter-by-regexp) 2535 (org-defkey org-agenda-mode-map "/" #'org-agenda-filter) 2536 (org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all) 2537 (org-defkey org-agenda-mode-map "~" #'org-agenda-limit-interactively) 2538 (org-defkey org-agenda-mode-map "<" #'org-agenda-filter-by-category) 2539 (org-defkey org-agenda-mode-map "^" #'org-agenda-filter-by-top-headline) 2540 (org-defkey org-agenda-mode-map ";" #'org-timer-set-timer) 2541 (org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop) 2542 (org-defkey org-agenda-mode-map "?" #'org-agenda-show-the-flagging-note) 2543 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" #'org-mobile-pull) 2544 (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" #'org-mobile-push) 2545 (org-defkey org-agenda-mode-map "\C-c\C-xI" #'org-info-find-node) 2546 (org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse) 2547 (org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse) 2548 (org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block) 2549 (org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block) 2550 (org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c) 2551 2552 (when org-agenda-mouse-1-follows-link 2553 (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) 2554 2555 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu." 2556 '("Agenda" 2557 ("Agenda Files") 2558 "--" 2559 ("Agenda Dates" 2560 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)] 2561 ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] 2562 ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] 2563 ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)]) 2564 "--" 2565 ("View" 2566 ["Day View" org-agenda-day-view 2567 :active (org-agenda-check-type nil 'agenda) 2568 :style radio :selected (eq org-agenda-current-span 'day) 2569 :keys "v d (or just d)"] 2570 ["Week View" org-agenda-week-view 2571 :active (org-agenda-check-type nil 'agenda) 2572 :style radio :selected (eq org-agenda-current-span 'week) 2573 :keys "v w"] 2574 ["Fortnight View" org-agenda-fortnight-view 2575 :active (org-agenda-check-type nil 'agenda) 2576 :style radio :selected (eq org-agenda-current-span 'fortnight) 2577 :keys "v t"] 2578 ["Month View" org-agenda-month-view 2579 :active (org-agenda-check-type nil 'agenda) 2580 :style radio :selected (eq org-agenda-current-span 'month) 2581 :keys "v m"] 2582 ["Year View" org-agenda-year-view 2583 :active (org-agenda-check-type nil 'agenda) 2584 :style radio :selected (eq org-agenda-current-span 'year) 2585 :keys "v y"] 2586 "--" 2587 ["Include Diary" org-agenda-toggle-diary 2588 :style toggle :selected org-agenda-include-diary 2589 :active (org-agenda-check-type nil 'agenda)] 2590 ["Include Deadlines" org-agenda-toggle-deadlines 2591 :style toggle :selected org-agenda-include-deadlines 2592 :active (org-agenda-check-type nil 'agenda)] 2593 ["Use Time Grid" org-agenda-toggle-time-grid 2594 :style toggle :selected org-agenda-use-time-grid 2595 :active (org-agenda-check-type nil 'agenda)] 2596 "--" 2597 ["Show clock report" org-agenda-clockreport-mode 2598 :style toggle :selected org-agenda-clockreport-mode 2599 :active (org-agenda-check-type nil 'agenda)] 2600 ["Show some entry text" org-agenda-entry-text-mode 2601 :style toggle :selected org-agenda-entry-text-mode 2602 :active t] 2603 "--" 2604 ["Show Logbook entries" org-agenda-log-mode 2605 :style toggle :selected org-agenda-show-log 2606 :active (org-agenda-check-type nil 'agenda) 2607 :keys "v l (or just l)"] 2608 ["Include archived trees" org-agenda-archives-mode 2609 :style toggle :selected org-agenda-archives-mode :active t 2610 :keys "v a"] 2611 ["Include archive files" (org-agenda-archives-mode t) 2612 :style toggle :selected (eq org-agenda-archives-mode t) :active t 2613 :keys "v A"] 2614 "--" 2615 ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) 2616 ("Filter current view" 2617 ["with generic interface" org-agenda-filter t] 2618 "--" 2619 ["by category at cursor" org-agenda-filter-by-category t] 2620 ["by tag" org-agenda-filter-by-tag t] 2621 ["by effort" org-agenda-filter-by-effort t] 2622 ["by regexp" org-agenda-filter-by-regexp t] 2623 ["by top-level headline" org-agenda-filter-by-top-headline t] 2624 "--" 2625 ["Remove all filtering" org-agenda-filter-remove-all t] 2626 "--" 2627 ["limit" org-agenda-limit-interactively t]) 2628 ["Rebuild buffer" org-agenda-redo t] 2629 ["Write view to file" org-agenda-write t] 2630 ["Save all Org buffers" org-save-all-org-buffers t] 2631 "--" 2632 ["Show original entry" org-agenda-show t] 2633 ["Go To (other window)" org-agenda-goto t] 2634 ["Go To (this window)" org-agenda-switch-to t] 2635 ["Capture with cursor date" org-agenda-capture t] 2636 ["Follow Mode" org-agenda-follow-mode 2637 :style toggle :selected org-agenda-follow-mode :active t] 2638 ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] 2639 "--" 2640 ("TODO" 2641 ["Cycle TODO" org-agenda-todo t] 2642 ["Next TODO set" org-agenda-todo-nextset t] 2643 ["Previous TODO set" org-agenda-todo-previousset t] 2644 ["Add note" org-agenda-add-note t]) 2645 ("Archive/Refile/Delete" 2646 ["Archive default" org-agenda-archive-default t] 2647 ["Archive default" org-agenda-archive-default-with-confirmation t] 2648 ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] 2649 ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] 2650 ["Archive subtree" org-agenda-archive t] 2651 "--" 2652 ["Refile" org-agenda-refile t] 2653 "--" 2654 ["Delete subtree" org-agenda-kill t]) 2655 ("Bulk action" 2656 ["Mark entry" org-agenda-bulk-mark t] 2657 ["Mark all" org-agenda-bulk-mark-all t] 2658 ["Unmark entry" org-agenda-bulk-unmark t] 2659 ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"] 2660 ["Toggle mark" org-agenda-bulk-toggle t] 2661 ["Toggle all" org-agenda-bulk-toggle-all t] 2662 ["Mark regexp" org-agenda-bulk-mark-regexp t]) 2663 ["Act on all marked" org-agenda-bulk-action t] 2664 "--" 2665 ("Tags and Properties" 2666 ["Show all Tags" org-agenda-show-tags t] 2667 ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] 2668 ["Change tag in region" org-agenda-set-tags (org-region-active-p)] 2669 "--" 2670 ["Column View" org-columns t]) 2671 ("Deadline/Schedule" 2672 ["Schedule" org-agenda-schedule t] 2673 ["Set Deadline" org-agenda-deadline t] 2674 "--" 2675 ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)] 2676 ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)] 2677 ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"] 2678 ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"] 2679 ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"] 2680 ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"] 2681 ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)]) 2682 ("Clock and Effort" 2683 ["Clock in" org-agenda-clock-in t] 2684 ["Clock out" org-agenda-clock-out t] 2685 ["Clock cancel" org-agenda-clock-cancel t] 2686 ["Goto running clock" org-clock-goto t] 2687 "--" 2688 ["Set Effort" org-agenda-set-effort t] 2689 ["Change clocked effort" org-clock-modify-effort-estimate 2690 (org-clock-is-active)]) 2691 ("Priority" 2692 ["Set Priority" org-agenda-priority t] 2693 ["Increase Priority" org-agenda-priority-up t] 2694 ["Decrease Priority" org-agenda-priority-down t] 2695 ["Show Priority" org-priority-show t]) 2696 ("Calendar/Diary" 2697 ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)] 2698 ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)] 2699 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)] 2700 ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)] 2701 ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)] 2702 ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)] 2703 "--" 2704 ["Create iCalendar File" org-icalendar-combine-agenda-files t]) 2705 "--" 2706 ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] 2707 "--" 2708 ("MobileOrg" 2709 ["Push Files and Views" org-mobile-push t] 2710 ["Get Captured and Flagged" org-mobile-pull t] 2711 ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"] 2712 ["Show note / unflag" org-agenda-show-the-flagging-note t] 2713 "--" 2714 ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) 2715 "--" 2716 ["Quit" org-agenda-quit t] 2717 ["Exit and Release Buffers" org-agenda-exit t] 2718 )) 2719 2720 ;;; Agenda undo 2721 2722 (defvar org-agenda-allow-remote-undo t 2723 "Non-nil means allow remote undo from the agenda buffer.") 2724 (defvar org-agenda-undo-has-started-in nil 2725 "Buffers that have already seen `undo-start' in the current undo sequence.") 2726 2727 (defun org-agenda-undo () 2728 "Undo a remote editing step in the agenda. 2729 This undoes changes both in the agenda buffer and in the remote buffer 2730 that have been changed along." 2731 (interactive) 2732 (or org-agenda-allow-remote-undo 2733 (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo")) 2734 (when (not (eq this-command last-command)) 2735 (setq org-agenda-undo-has-started-in nil 2736 org-agenda-pending-undo-list org-agenda-undo-list)) 2737 (when (not org-agenda-pending-undo-list) 2738 (user-error "No further undo information")) 2739 (let* ((entry (pop org-agenda-pending-undo-list)) 2740 buf line cmd rembuf) 2741 (setq cmd (pop entry) line (pop entry)) 2742 (setq rembuf (nth 2 entry)) 2743 (org-with-remote-undo rembuf 2744 (while (bufferp (setq buf (pop entry))) 2745 (when (pop entry) 2746 (with-current-buffer buf 2747 (let (;; (last-undo-buffer buf) 2748 (inhibit-read-only t)) 2749 (unless (memq buf org-agenda-undo-has-started-in) 2750 (push buf org-agenda-undo-has-started-in) 2751 (make-local-variable 'pending-undo-list) 2752 (undo-start)) 2753 (while (and pending-undo-list 2754 (listp pending-undo-list) 2755 (not (car pending-undo-list))) 2756 (pop pending-undo-list)) 2757 (undo-more 1)))))) 2758 (org-goto-line line) 2759 (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) 2760 2761 (defun org-verify-change-for-undo (l1 l2) 2762 "Verify that a real change occurred between the undo lists L1 and L2." 2763 (while (and l1 (listp l1) (null (car l1))) (pop l1)) 2764 (while (and l2 (listp l2) (null (car l2))) (pop l2)) 2765 (not (eq l1 l2))) 2766 2767 ;;; Agenda dispatch 2768 2769 (defvar org-agenda-restrict-begin (make-marker) 2770 "Internal variable used to mark the restriction beginning. 2771 It is only relevant when `org-agenda-restrict' is a buffer.") 2772 (defvar org-agenda-restrict-end (make-marker) 2773 "Internal variable used to mark the restriction end. 2774 It is only relevant when `org-agenda-restrict' is a buffer.") 2775 (defvar org-agenda-overriding-restriction nil 2776 "Non-nil means extended agenda restriction is active. 2777 This is an internal flag set by `org-agenda-set-restriction-lock'.") 2778 2779 (defcustom org-agenda-custom-commands-contexts nil 2780 "Alist of custom agenda keys and contextual rules. 2781 2782 For example, if you have a custom agenda command \"p\" and you 2783 want this command to be accessible only from plain text files, 2784 use this: 2785 2786 (setq org-agenda-custom-commands-contexts 2787 \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\"))))) 2788 2789 Here are the available contexts definitions: 2790 2791 in-file: command displayed only in matching files 2792 in-mode: command displayed only in matching modes 2793 not-in-file: command not displayed in matching files 2794 not-in-mode: command not displayed in matching modes 2795 in-buffer: command displayed only in matching buffers 2796 not-in-buffer: command not displayed in matching buffers 2797 [function]: a custom function taking no argument 2798 2799 If you define several checks, the agenda command will be 2800 accessible if there is at least one valid check. 2801 2802 You can also bind a key to another agenda custom command 2803 depending on contextual rules. 2804 2805 (setq org-agenda-custom-commands-contexts 2806 \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\"))))) 2807 2808 Here it means: in .txt files, use \"p\" as the key for the 2809 agenda command otherwise associated with \"q\". (The command 2810 originally associated with \"q\" is not displayed to avoid 2811 duplicates.)" 2812 :version "24.3" 2813 :group 'org-agenda-custom-commands 2814 :type '(repeat (list :tag "Rule" 2815 (string :tag " Agenda key") 2816 (string :tag "Replace by command") 2817 (repeat :tag "Available when" 2818 (choice 2819 (cons :tag "Condition" 2820 (choice 2821 (const :tag "In file" in-file) 2822 (const :tag "Not in file" not-in-file) 2823 (const :tag "In buffer" in-buffer) 2824 (const :tag "Not in buffer" not-in-buffer) 2825 (const :tag "In mode" in-mode) 2826 (const :tag "Not in mode" not-in-mode)) 2827 (regexp)) 2828 (function :tag "Custom function")))))) 2829 2830 (defcustom org-agenda-max-entries nil 2831 "Maximum number of entries to display in an agenda. 2832 This can be nil (no limit) or an integer or an alist of agenda 2833 types with an associated number of entries to display in this 2834 type." 2835 :version "24.4" 2836 :package-version '(Org . "8.0") 2837 :group 'org-agenda-custom-commands 2838 :type '(choice (symbol :tag "No limit" nil) 2839 (integer :tag "Max number of entries") 2840 (repeat 2841 (cons (choice :tag "Agenda type" 2842 (const agenda) 2843 (const todo) 2844 (const tags) 2845 (const search)) 2846 (integer :tag "Max number of entries"))))) 2847 2848 (defcustom org-agenda-max-todos nil 2849 "Maximum number of TODOs to display in an agenda. 2850 This can be nil (no limit) or an integer or an alist of agenda 2851 types with an associated number of entries to display in this 2852 type." 2853 :version "24.4" 2854 :package-version '(Org . "8.0") 2855 :group 'org-agenda-custom-commands 2856 :type '(choice (symbol :tag "No limit" nil) 2857 (integer :tag "Max number of TODOs") 2858 (repeat 2859 (cons (choice :tag "Agenda type" 2860 (const agenda) 2861 (const todo) 2862 (const tags) 2863 (const search)) 2864 (integer :tag "Max number of TODOs"))))) 2865 2866 (defcustom org-agenda-max-tags nil 2867 "Maximum number of tagged entries to display in an agenda. 2868 This can be nil (no limit) or an integer or an alist of agenda 2869 types with an associated number of entries to display in this 2870 type." 2871 :version "24.4" 2872 :package-version '(Org . "8.0") 2873 :group 'org-agenda-custom-commands 2874 :type '(choice (symbol :tag "No limit" nil) 2875 (integer :tag "Max number of tagged entries") 2876 (repeat 2877 (cons (choice :tag "Agenda type" 2878 (const agenda) 2879 (const todo) 2880 (const tags) 2881 (const search)) 2882 (integer :tag "Max number of tagged entries"))))) 2883 2884 (defcustom org-agenda-max-effort nil 2885 "Maximum cumulated effort duration for the agenda. 2886 This can be nil (no limit) or a number of minutes (as an integer) 2887 or an alist of agenda types with an associated number of minutes 2888 to limit entries to in this type." 2889 :version "24.4" 2890 :package-version '(Org . "8.0") 2891 :group 'org-agenda-custom-commands 2892 :type '(choice (symbol :tag "No limit" nil) 2893 (integer :tag "Max number of minutes") 2894 (repeat 2895 (cons (choice :tag "Agenda type" 2896 (const agenda) 2897 (const todo) 2898 (const tags) 2899 (const search)) 2900 (integer :tag "Max number of minutes"))))) 2901 2902 (defvar org-agenda-keep-restricted-file-list nil) 2903 (defvar org-keys nil) 2904 (defvar org-match nil) 2905 ;;;###autoload 2906 (defun org-agenda (&optional arg keys restriction) 2907 "Dispatch agenda commands to collect entries to the agenda buffer. 2908 Prompts for a command to execute. Any prefix arg will be passed 2909 on to the selected command. The default selections are: 2910 2911 a Call `org-agenda-list' to display the agenda for current day or week. 2912 t Call `org-todo-list' to display the global todo list. 2913 T Call `org-todo-list' to display the global todo list, select only 2914 entries with a specific TODO keyword (the user gets a prompt). 2915 m Call `org-tags-view' to display headlines with tags matching 2916 a condition (the user is prompted for the condition). 2917 M Like `m', but select only TODO entries, no ordinary headlines. 2918 e Export views to associated files. 2919 s Search entries for keywords. 2920 S Search entries for keywords, only with TODO keywords. 2921 / Multi occur across all agenda files and also files listed 2922 in `org-agenda-text-search-extra-files'. 2923 < Restrict agenda commands to buffer, subtree, or region. 2924 Press several times to get the desired effect. 2925 > Remove a previous restriction. 2926 # List \"stuck\" projects. 2927 ! Configure what \"stuck\" means. 2928 C Configure custom agenda commands. 2929 2930 More commands can be added by configuring the variable 2931 `org-agenda-custom-commands'. In particular, specific tags and TODO keyword 2932 searches can be pre-defined in this way. 2933 2934 If the current buffer is in Org mode and visiting a file, you can also 2935 first press `<' once to indicate that the agenda should be temporarily 2936 \(until the next use of `\\[org-agenda]') restricted to the current file. 2937 Pressing `<' twice means to restrict to the current subtree or region 2938 \(if active)." 2939 (interactive "P") 2940 (catch 'exit 2941 (let* ((org-keys keys) 2942 (prefix-descriptions nil) 2943 (org-agenda-buffer-name org-agenda-buffer-name) 2944 (org-agenda-window-setup (if (equal (buffer-name) 2945 org-agenda-buffer-name) 2946 'current-window 2947 org-agenda-window-setup)) 2948 (org-agenda-custom-commands-orig org-agenda-custom-commands) 2949 (org-agenda-custom-commands 2950 ;; normalize different versions 2951 (delq nil 2952 (mapcar 2953 (lambda (x) 2954 (cond ((stringp (cdr x)) 2955 (push x prefix-descriptions) 2956 nil) 2957 ((stringp (nth 1 x)) x) 2958 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) 2959 (t (cons (car x) (cons "" (cdr x)))))) 2960 org-agenda-custom-commands))) 2961 (org-agenda-custom-commands 2962 (org-contextualize-keys 2963 org-agenda-custom-commands org-agenda-custom-commands-contexts)) 2964 ;; (buf (current-buffer)) 2965 (bfn (buffer-file-name (buffer-base-buffer))) 2966 entry type org-match lprops ans) ;; key 2967 ;; Turn off restriction unless there is an overriding one, 2968 (unless org-agenda-overriding-restriction 2969 (unless org-agenda-keep-restricted-file-list 2970 ;; There is a request to keep the file list in place 2971 (put 'org-agenda-files 'org-restrict nil)) 2972 (setq org-agenda-restrict nil) 2973 (move-marker org-agenda-restrict-begin nil) 2974 (move-marker org-agenda-restrict-end nil)) 2975 (unless org-keys 2976 (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) 2977 org-keys (car ans) 2978 restriction (cdr ans))) 2979 ;; If we have sticky agenda buffers, set a name for the buffer, 2980 ;; depending on the invoking keys. The user may still set this 2981 ;; as a command option, which will overwrite what we do here. 2982 (when org-agenda-sticky 2983 (setq org-agenda-buffer-name 2984 (format "*Org Agenda(%s)*" org-keys))) 2985 ;; Establish the restriction, if any 2986 (when (and (not org-agenda-overriding-restriction) restriction) 2987 (put 'org-agenda-files 'org-restrict (list bfn)) 2988 (cond 2989 ((eq restriction 'region) 2990 (setq org-agenda-restrict (current-buffer)) 2991 (move-marker org-agenda-restrict-begin (region-beginning)) 2992 (move-marker org-agenda-restrict-end (region-end))) 2993 ((eq restriction 'subtree) 2994 (save-excursion 2995 (setq org-agenda-restrict (current-buffer)) 2996 (org-back-to-heading t) 2997 (move-marker org-agenda-restrict-begin (point)) 2998 (move-marker org-agenda-restrict-end 2999 (progn (org-end-of-subtree t))))) 3000 ((eq restriction 'buffer) 3001 (if (not (buffer-narrowed-p)) 3002 (setq org-agenda-restrict t) 3003 (setq org-agenda-restrict (current-buffer)) 3004 (move-marker org-agenda-restrict-begin (point-min)) 3005 (move-marker org-agenda-restrict-end (point-max)))))) 3006 3007 ;; For example the todo list should not need it (but does...) 3008 (cond 3009 ((setq entry (assoc org-keys org-agenda-custom-commands)) 3010 (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) 3011 (progn 3012 ;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars) 3013 ;; to some of the local variables? There's no doc about 3014 ;; that for `org-agenda-custom-commands'. 3015 (setq type (nth 2 entry) org-match (eval (nth 3 entry) t) 3016 lprops (nth 4 entry)) 3017 (when org-agenda-sticky 3018 (setq org-agenda-buffer-name 3019 (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match)) 3020 (format "*Org Agenda(%s)*" org-keys)))) 3021 (cl-progv 3022 (mapcar #'car lprops) 3023 (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) 3024 (pcase type 3025 (`agenda 3026 (org-agenda-list arg)) 3027 (`agenda* 3028 (org-agenda-list arg nil nil t)) 3029 (`alltodo 3030 (org-todo-list arg)) 3031 (`search 3032 (org-search-view arg org-match nil)) 3033 (`stuck 3034 (org-agenda-list-stuck-projects arg)) 3035 (`tags 3036 (org-tags-view arg org-match)) 3037 (`tags-todo 3038 (org-tags-view '(4) org-match)) 3039 (`todo 3040 (org-todo-list org-match)) 3041 (`tags-tree 3042 (org-check-for-org-mode) 3043 (org-match-sparse-tree arg org-match)) 3044 (`todo-tree 3045 (org-check-for-org-mode) 3046 (org-occur (concat "^" org-outline-regexp "[ \t]*" 3047 (regexp-quote org-match) "\\(?:[\t ]\\|$\\)"))) 3048 (`occur-tree 3049 (org-check-for-org-mode) 3050 (org-occur org-match)) 3051 ((pred functionp) 3052 (funcall type org-match)) 3053 ;; FIXME: Will signal an error since it's not `functionp'! 3054 ((pred fboundp) (funcall type org-match)) 3055 (_ (user-error "Invalid custom agenda command type %s" type)))) 3056 (let ((inhibit-read-only t)) 3057 (add-text-properties (point-min) (point-max) 3058 `(org-lprops ,lprops)))) 3059 (org-agenda-run-series (nth 1 entry) (cddr entry)))) 3060 ((equal org-keys "C") 3061 (setq org-agenda-custom-commands org-agenda-custom-commands-orig) 3062 (customize-variable 'org-agenda-custom-commands)) 3063 ((equal org-keys "a") (call-interactively 'org-agenda-list)) 3064 ((equal org-keys "s") (call-interactively 'org-search-view)) 3065 ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4)))) 3066 ((equal org-keys "t") (call-interactively 'org-todo-list)) 3067 ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) 3068 ((equal org-keys "m") (call-interactively 'org-tags-view)) 3069 ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) 3070 ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) 3071 ((equal org-keys "?") (org-tags-view nil "+FLAGGED") 3072 (add-hook 3073 'post-command-hook 3074 (lambda () 3075 (unless (current-message) 3076 (let* ((m (org-agenda-get-any-marker)) 3077 (note (and m (org-entry-get m "THEFLAGGINGNOTE")))) 3078 (when note 3079 (message "FLAGGING-NOTE ([?] for more info): %s" 3080 (org-add-props 3081 (replace-regexp-in-string 3082 "\\\\n" "//" 3083 (copy-sequence note)) 3084 nil 'face 'org-warning)))))) 3085 t t)) 3086 ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) 3087 ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) 3088 ((equal org-keys "!") (customize-variable 'org-stuck-projects)) 3089 (t (user-error "Invalid agenda key")))))) 3090 3091 (defvar org-agenda-multi) 3092 3093 (defun org-agenda-append-agenda () 3094 "Append another agenda view to the current one. 3095 This function allows interactive building of block agendas. 3096 Agenda views are separated by `org-agenda-block-separator'." 3097 (interactive) 3098 (unless (derived-mode-p 'org-agenda-mode) 3099 (user-error "Can only append from within agenda buffer")) 3100 (let ((org-agenda-multi t)) 3101 (org-agenda) 3102 (widen) 3103 (org-agenda-finalize) 3104 (setq buffer-read-only t) 3105 (org-agenda-fit-window-to-buffer))) 3106 3107 (defun org-agenda-normalize-custom-commands (cmds) 3108 "Normalize custom commands CMDS." 3109 (delq nil 3110 (mapcar 3111 (lambda (x) 3112 (cond ((stringp (cdr x)) nil) 3113 ((stringp (nth 1 x)) x) 3114 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) 3115 (t (cons (car x) (cons "" (cdr x)))))) 3116 cmds))) 3117 3118 (defun org-agenda-get-restriction-and-command (prefix-descriptions) 3119 "The user interface for selecting an agenda command." 3120 (catch 'exit 3121 (let* ((bfn (buffer-file-name (buffer-base-buffer))) 3122 (restrict-ok (and bfn (derived-mode-p 'org-mode))) 3123 (region-p (org-region-active-p)) 3124 (custom org-agenda-custom-commands) 3125 (selstring "") 3126 restriction second-time 3127 c entry key type match prefixes rmheader header-end custom1 desc 3128 line lines left right n n1) 3129 (save-window-excursion 3130 (pop-to-buffer " *Agenda Commands*" '(org-display-buffer-split)) 3131 (erase-buffer) 3132 (insert (eval-when-compile 3133 (let ((header 3134 (copy-sequence 3135 "Press key for an agenda command: 3136 -------------------------------- < Buffer, subtree/region restriction 3137 a Agenda for current week or day > Remove restriction 3138 / Multi-occur e Export agenda views 3139 t List of all TODO entries T Entries with special TODO kwd 3140 m Match a TAGS/PROP/TODO query M Like m, but only TODO entries 3141 s Search for keywords S Like s, but only TODO entries 3142 ? Find :FLAGGED: entries C Configure custom agenda commands 3143 * Toggle sticky agenda views # List stuck projects (!=configure) 3144 ")) 3145 (start 0)) 3146 (while (string-match 3147 "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" 3148 header start) 3149 (setq start (match-end 0)) 3150 (add-text-properties (match-beginning 2) (match-end 2) 3151 '(face bold) header)) 3152 header))) 3153 (setq header-end (point-marker)) 3154 (unwind-protect 3155 (while t 3156 (setq custom1 custom) 3157 (when (eq rmheader t) 3158 (org-goto-line 1) 3159 (re-search-forward ":" nil t) 3160 (delete-region (match-end 0) (line-end-position)) 3161 (forward-char 1) 3162 (looking-at "-+") 3163 (delete-region (match-end 0) (line-end-position)) 3164 (move-marker header-end (match-end 0))) 3165 (goto-char header-end) 3166 (delete-region (point) (point-max)) 3167 3168 ;; Produce all the lines that describe custom commands and prefixes 3169 (setq lines nil) 3170 (while (setq entry (pop custom1)) 3171 (setq key (car entry) desc (nth 1 entry) 3172 type (nth 2 entry) 3173 match (nth 3 entry)) 3174 (if (> (length key) 1) 3175 (cl-pushnew (string-to-char key) prefixes :test #'equal) 3176 (setq line 3177 (format 3178 "%-4s%-14s" 3179 (org-add-props (copy-sequence key) 3180 '(face bold)) 3181 (cond 3182 ((string-match "\\S-" desc) desc) 3183 ((eq type 'agenda) "Agenda for current week or day") 3184 ((eq type 'agenda*) "Appointments for current week or day") 3185 ((eq type 'alltodo) "List of all TODO entries") 3186 ((eq type 'search) "Word search") 3187 ((eq type 'stuck) "List of stuck projects") 3188 ((eq type 'todo) "TODO keyword") 3189 ((eq type 'tags) "Tags query") 3190 ((eq type 'tags-todo) "Tags (TODO)") 3191 ((eq type 'tags-tree) "Tags tree") 3192 ((eq type 'todo-tree) "TODO kwd tree") 3193 ((eq type 'occur-tree) "Occur tree") 3194 ((functionp type) (if (symbolp type) 3195 (symbol-name type) 3196 "Lambda expression")) 3197 (t "???")))) 3198 (cond 3199 ((not (org-string-nw-p match)) nil) 3200 (org-agenda-menu-show-matcher 3201 (setq line 3202 (concat line ": " 3203 (cond 3204 ((stringp match) 3205 (propertize match 'face 'org-warning)) 3206 ((listp type) 3207 (format "set of %d commands" (length type))))))) 3208 (t 3209 (org-add-props line nil 'help-echo (concat "Matcher: " match)))) 3210 (push line lines))) 3211 (setq lines (nreverse lines)) 3212 (when prefixes 3213 (mapc (lambda (x) 3214 (push 3215 (format "%s %s" 3216 (org-add-props (char-to-string x) 3217 nil 'face 'bold) 3218 (or (cdr (assoc (concat selstring 3219 (char-to-string x)) 3220 prefix-descriptions)) 3221 "Prefix key")) 3222 lines)) 3223 prefixes)) 3224 3225 ;; Check if we should display in two columns 3226 (if org-agenda-menu-two-columns 3227 (progn 3228 (setq n (length lines) 3229 n1 (+ (/ n 2) (mod n 2)) 3230 right (nthcdr n1 lines) 3231 left (copy-sequence lines)) 3232 (setcdr (nthcdr (1- n1) left) nil)) 3233 (setq left lines right nil)) 3234 (while left 3235 (insert "\n" (pop left)) 3236 (when right 3237 (if (< (current-column) 40) 3238 (move-to-column 40 t) 3239 (insert " ")) 3240 (insert (pop right)))) 3241 3242 ;; Make the window the right size 3243 (goto-char (point-min)) 3244 (if second-time 3245 (when (not (pos-visible-in-window-p (point-max))) 3246 (org-fit-window-to-buffer)) 3247 (setq second-time t) 3248 (org-fit-window-to-buffer)) 3249 3250 ;; Hint to navigation if window too small for all information 3251 (setq header-line-format 3252 (when (not (pos-visible-in-window-p (point-max))) 3253 "Use C-v, M-v, C-n or C-p to navigate.")) 3254 3255 ;; Ask for selection 3256 (cl-loop 3257 do (progn 3258 (message "Press key for agenda command%s:" 3259 (if (or restrict-ok org-agenda-overriding-restriction) 3260 (if org-agenda-overriding-restriction 3261 " (restriction lock active)" 3262 (if restriction 3263 (format " (restricted to %s)" restriction) 3264 " (unrestricted)")) 3265 "")) 3266 (setq c (read-char-exclusive))) 3267 until (not (memq c '(14 16 22 134217846))) 3268 do (org-scroll c)) 3269 3270 (message "") 3271 (cond 3272 ((assoc (char-to-string c) custom) 3273 (setq selstring (concat selstring (char-to-string c))) 3274 (throw 'exit (cons selstring restriction))) 3275 ((memq c prefixes) 3276 (setq selstring (concat selstring (char-to-string c)) 3277 prefixes nil 3278 rmheader (or rmheader t) 3279 custom (delq nil (mapcar 3280 (lambda (x) 3281 (if (or (= (length (car x)) 1) 3282 (/= (string-to-char (car x)) c)) 3283 nil 3284 (cons (substring (car x) 1) (cdr x)))) 3285 custom)))) 3286 ((eq c ?*) 3287 (call-interactively 'org-toggle-sticky-agenda) 3288 (sit-for 2)) 3289 ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) 3290 (message "Restriction is only possible in Org buffers") 3291 (ding) (sit-for 1)) 3292 ((eq c ?1) 3293 (org-agenda-remove-restriction-lock 'noupdate) 3294 (setq restriction 'buffer)) 3295 ((eq c ?0) 3296 (org-agenda-remove-restriction-lock 'noupdate) 3297 (setq restriction (if region-p 'region 'subtree))) 3298 ((eq c ?<) 3299 (org-agenda-remove-restriction-lock 'noupdate) 3300 (setq restriction 3301 (cond 3302 ((eq restriction 'buffer) 3303 (if region-p 'region 'subtree)) 3304 ((memq restriction '(subtree region)) 3305 nil) 3306 (t 'buffer)))) 3307 ((eq c ?>) 3308 (org-agenda-remove-restriction-lock 'noupdate) 3309 (setq restriction nil)) 3310 ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) 3311 (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) 3312 ((and (> (length selstring) 0) (eq c ?\d)) 3313 (delete-window) 3314 (org-agenda-get-restriction-and-command prefix-descriptions)) 3315 3316 ((equal c ?q) (user-error "Abort")) 3317 (t (user-error "Invalid key %c" c)))) 3318 ;; Close *Agenda Commands* window. 3319 (quit-window 'kill)))))) 3320 3321 (defun org-agenda-fit-window-to-buffer () 3322 "Fit the window to the buffer size." 3323 (and (memq org-agenda-window-setup '(reorganize-frame)) 3324 (fboundp 'fit-window-to-buffer) 3325 (if (and (= (cdr org-agenda-window-frame-fractions) 1.0) 3326 (= (car org-agenda-window-frame-fractions) 1.0)) 3327 (display-buffer (current-buffer) '(org-display-buffer-full-frame)) 3328 (org-fit-window-to-buffer 3329 nil 3330 (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) 3331 (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))) 3332 3333 (defvar org-cmd nil) 3334 (defvar org-agenda-overriding-cmd nil) 3335 (defvar org-agenda-overriding-arguments nil) 3336 (defvar org-agenda-overriding-cmd-arguments nil) 3337 3338 (defun org-agenda-run-series (name series) 3339 "Run agenda NAME as a SERIES of agenda commands." 3340 (let* ((gprops (nth 1 series)) 3341 (gvars (mapcar #'car gprops)) 3342 (gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops))) 3343 (cl-progv gvars gvals (org-agenda-prepare name)) 3344 ;; We need to reset agenda markers here, because when constructing a 3345 ;; block agenda, the individual blocks do not do that. 3346 (org-agenda-reset-markers) 3347 (with-no-warnings 3348 (defvar match)) ;Used via the `eval' below. 3349 (let* ((org-agenda-multi t) 3350 ;; FIXME: Redo should contain lists of (FUNS . ARGS) rather 3351 ;; than expressions, so you don't need to `quote' the args 3352 ;; and you just need to `apply' instead of `eval' when using it. 3353 (redo (list 'org-agenda-run-series name (list 'quote series))) 3354 (cmds (car series)) 3355 match 3356 org-cmd type lprops) 3357 (while (setq org-cmd (pop cmds)) 3358 (setq type (car org-cmd)) 3359 (setq match (eval (nth 1 org-cmd) t)) 3360 (setq lprops (nth 2 org-cmd)) 3361 (let ((org-agenda-overriding-arguments 3362 (if (eq org-agenda-overriding-cmd org-cmd) 3363 (or org-agenda-overriding-arguments 3364 org-agenda-overriding-cmd-arguments))) 3365 (lvars (mapcar #'car lprops)) 3366 (lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops))) 3367 (cl-progv (append gvars lvars) (append gvals lvals) 3368 (pcase type 3369 (`agenda 3370 (call-interactively 'org-agenda-list)) 3371 (`agenda* 3372 (funcall 'org-agenda-list nil nil nil t)) 3373 (`alltodo 3374 (call-interactively 'org-todo-list)) 3375 (`search 3376 (org-search-view current-prefix-arg match nil)) 3377 (`stuck 3378 (call-interactively 'org-agenda-list-stuck-projects)) 3379 (`tags 3380 (org-tags-view current-prefix-arg match)) 3381 (`tags-todo 3382 (org-tags-view '(4) match)) 3383 (`todo 3384 (org-todo-list match)) 3385 ((pred fboundp) 3386 (funcall type match)) 3387 (_ (error "Invalid type in command series")))))) 3388 (widen) 3389 (let ((inhibit-read-only t)) 3390 (add-text-properties (point-min) (point-max) 3391 `(org-series t org-series-redo-cmd ,redo))) 3392 (setq org-agenda-redo-command redo) 3393 (goto-char (point-min))) 3394 (org-agenda-fit-window-to-buffer) 3395 (cl-progv gvars gvals (org-agenda-finalize)))) 3396 3397 (defun org-agenda--split-plist (plist) 3398 ;; We could/should arguably use `map-keys' and `map-values'. 3399 (let (keys vals) 3400 (while plist 3401 (push (pop plist) keys) 3402 (push (pop plist) vals)) 3403 (cons (nreverse keys) (nreverse vals)))) 3404 3405 ;;;###autoload 3406 (defmacro org-batch-agenda (cmd-key &rest parameters) 3407 "Run an agenda command in batch mode and send the result to STDOUT. 3408 If CMD-KEY is a string of length 1, it is used as a key in 3409 `org-agenda-custom-commands' and triggers this command. If it is a 3410 longer string it is used as a tags/todo match string. 3411 Parameters are alternating variable names and values that will be bound 3412 before running the agenda command." 3413 (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) 3414 `(org--batch-agenda ,cmd-key ',vars (list ,@exps)))) 3415 3416 (defun org--batch-agenda (cmd-key vars vals) 3417 ;; `org-batch-agenda' is a macro because every other "parameter" is 3418 ;; a variable name rather than an expression to evaluate. Yuck! 3419 (cl-progv vars vals 3420 (let (org-agenda-sticky) 3421 (if (> (length cmd-key) 1) 3422 (org-tags-view nil cmd-key) 3423 (org-agenda nil cmd-key)))) 3424 (set-buffer org-agenda-buffer-name) 3425 (princ (buffer-string))) 3426 3427 (defvar org-agenda-info nil) 3428 3429 ;;;###autoload 3430 (defmacro org-batch-agenda-csv (cmd-key &rest parameters) 3431 "Run an agenda command in batch mode and send the result to STDOUT. 3432 If CMD-KEY is a string of length 1, it is used as a key in 3433 `org-agenda-custom-commands' and triggers this command. If it is a 3434 longer string it is used as a tags/todo match string. 3435 Parameters are alternating variable names and values that will be bound 3436 before running the agenda command. 3437 3438 The output gives a line for each selected agenda item. Each 3439 item is a list of comma-separated values, like this: 3440 3441 category,head,type,todo,tags,date,time,extra,priority-l,priority-n 3442 3443 category The category of the item 3444 head The headline, without TODO kwd, TAGS and PRIORITY 3445 type The type of the agenda entry, can be 3446 todo selected in TODO match 3447 tagsmatch selected in tags match 3448 diary imported from diary 3449 deadline a deadline on given date 3450 scheduled scheduled on given date 3451 timestamp entry has timestamp on given date 3452 closed entry was closed on given date 3453 upcoming-deadline warning about deadline 3454 past-scheduled forwarded scheduled item 3455 block entry has date block including g. date 3456 todo The todo keyword, if any 3457 tags All tags including inherited ones, separated by colons 3458 date The relevant date, like 2007-2-14 3459 time The time, like 15:00-16:50 3460 extra String with extra planning info 3461 priority-l The priority letter if any was given 3462 priority-n The computed numerical priority 3463 agenda-day The day in the agenda where this is listed" 3464 (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) 3465 `(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps)))) 3466 3467 (defun org--batch-agenda-csv (cmd-key vars vals) 3468 ;; `org-batch-agenda-csv' is a macro because every other "parameter" is 3469 ;; a variable name rather than an expression to evaluate. Yuck! 3470 (let ((org-agenda-remove-tags t)) 3471 (cl-progv vars vals 3472 ;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)? 3473 (if (> (length cmd-key) 2) 3474 (org-tags-view nil cmd-key) 3475 (org-agenda nil cmd-key)))) 3476 (set-buffer org-agenda-buffer-name) 3477 (let ((lines (org-split-string (buffer-string) "\n"))) 3478 (dolist (line lines) 3479 (when (get-text-property 0 'org-category line) 3480 (setq org-agenda-info 3481 (org-fix-agenda-info (text-properties-at 0 line))) 3482 (princ 3483 (mapconcat #'org-agenda-export-csv-mapper 3484 '(org-category txt type todo tags date time extra 3485 priority-letter priority agenda-day) 3486 ",")) 3487 (princ "\n"))))) 3488 3489 (defun org-fix-agenda-info (props) 3490 "Make sure all properties on an agenda item have a canonical form. 3491 This ensures the export commands can easily use it." 3492 (let (tmp re) 3493 (when (setq tmp (plist-get props 'tags)) 3494 (setq props (plist-put props 'tags (mapconcat #'identity tmp ":")))) 3495 (when (setq tmp (plist-get props 'date)) 3496 (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) 3497 (let ((calendar-date-display-form 3498 '((format "%s-%.2d-%.2d" year 3499 (string-to-number month) 3500 (string-to-number day))))) 3501 (setq tmp (calendar-date-string tmp))) 3502 (setq props (plist-put props 'date tmp))) 3503 (when (setq tmp (plist-get props 'day)) 3504 (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) 3505 (let ((calendar-date-display-form 3506 '((format "%s-%.2d-%.2d" year 3507 (string-to-number month) 3508 (string-to-number day))))) 3509 (setq tmp (calendar-date-string tmp))) 3510 (setq props (plist-put props 'day tmp)) 3511 (setq props (plist-put props 'agenda-day tmp))) 3512 (when (setq tmp (plist-get props 'txt)) 3513 (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) 3514 (plist-put props 'priority-letter (match-string 1 tmp)) 3515 (setq tmp (replace-match "" t t tmp))) 3516 (when (and (setq re (plist-get props 'org-todo-regexp)) 3517 (setq re (concat "\\`\\.*" re " ?")) 3518 (let ((case-fold-search nil)) (string-match re tmp))) 3519 (plist-put props 'todo (match-string 1 tmp)) 3520 (setq tmp (replace-match "" t t tmp))) 3521 (plist-put props 'txt tmp))) 3522 props) 3523 3524 (defun org-agenda-export-csv-mapper (prop) 3525 (let ((res (plist-get org-agenda-info prop))) 3526 (setq res 3527 (cond 3528 ((not res) "") 3529 ((stringp res) res) 3530 (t (prin1-to-string res)))) 3531 (org-trim (replace-regexp-in-string "," ";" res nil t)))) 3532 3533 ;;;###autoload 3534 (defun org-store-agenda-views (&rest _parameters) 3535 "Store agenda views." 3536 (interactive) 3537 (org--batch-store-agenda-views nil nil)) 3538 3539 ;;;###autoload 3540 (defmacro org-batch-store-agenda-views (&rest parameters) 3541 "Run all custom agenda commands that have a file argument." 3542 (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters))) 3543 `(org--batch-store-agenda-views ',vars (list ,@exps)))) 3544 3545 (defun org--batch-store-agenda-views (vars vals) 3546 (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) 3547 (pop-up-frames nil) 3548 (dir default-directory) 3549 cmd thiscmdkey thiscmdcmd match files opts cmd-or-set 3550 seriesp bufname) 3551 (save-window-excursion 3552 (while cmds 3553 (setq cmd (pop cmds) 3554 thiscmdkey (car cmd) 3555 thiscmdcmd (cdr cmd) 3556 match (nth 2 thiscmdcmd) 3557 bufname (if org-agenda-sticky 3558 (or (and (stringp match) 3559 (format "*Org Agenda(%s:%s)*" thiscmdkey match)) 3560 (format "*Org Agenda(%s)*" thiscmdkey)) 3561 org-agenda-buffer-name) 3562 ;; series: (0:key 1:desc 2:(cmd1 cmd2 ...) 3:general-settings 4:files) 3563 ;; non-series: (0:key 1:desc 2:type 3:match 4:settings 5:files) 3564 cmd-or-set (nth 2 cmd) 3565 seriesp (not (or (symbolp cmd-or-set) (functionp cmd-or-set))) 3566 opts (nth (if seriesp 3 4) cmd) 3567 files (nth (if seriesp 4 5) cmd)) 3568 (if (stringp files) (setq files (list files))) 3569 (when files 3570 (let* ((opts (append org-agenda-exporter-settings opts)) 3571 (vars (append (mapcar #'car opts) vars)) 3572 (vals (append (mapcar (lambda (binding) (eval (cadr binding) t)) 3573 opts) 3574 vals))) 3575 (cl-progv vars vals 3576 (org-agenda nil thiscmdkey)) 3577 (set-buffer bufname) 3578 (while files 3579 (cl-progv vars vals 3580 (org-agenda-write (expand-file-name (pop files) dir) 3581 nil t bufname)))) 3582 (and (get-buffer bufname) 3583 (kill-buffer bufname))))))) 3584 3585 (defvar org-agenda-current-span nil 3586 "The current span used in the agenda view.") ; local variable in the agenda buffer 3587 (defun org-agenda-mark-header-line (pos) 3588 "Mark the line at POS as an agenda structure header." 3589 (save-excursion 3590 (goto-char pos) 3591 (put-text-property (line-beginning-position) (line-end-position) 3592 'org-agenda-structural-header t) 3593 (when org-agenda-title-append 3594 (put-text-property (line-beginning-position) (line-end-position) 3595 'org-agenda-title-append org-agenda-title-append)))) 3596 3597 (defvar org-mobile-creating-agendas) ; defined in org-mobile.el 3598 (defvar org-agenda-write-buffer-name "Agenda View") 3599 (defun org-agenda-write (file &optional open nosettings agenda-bufname) 3600 "Write the current buffer (an agenda view) as a file. 3601 3602 Depending on the extension of the file name, plain text (.txt), 3603 HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced. 3604 If the extension is .ics, translate visible agenda into iCalendar 3605 format. If the extension is .org, collect all subtrees 3606 corresponding to the agenda entries and add them in an .org file. 3607 3608 With prefix argument OPEN, open the new file immediately. If 3609 NOSETTINGS is given, do not scope the settings of 3610 `org-agenda-exporter-settings' into the export commands. This is 3611 used when the settings have already been scoped and we do not 3612 wish to overrule other, higher priority settings. If 3613 AGENDA-BUFFER-NAME is provided, use this as the buffer name for 3614 the agenda to write." 3615 (interactive "FWrite agenda to file: \nP") 3616 (if (or (not (file-writable-p file)) 3617 (and (file-exists-p file) 3618 (if (called-interactively-p 'any) 3619 (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) 3620 (user-error "Cannot write agenda to file %s" file)) 3621 (cl-progv 3622 (if nosettings nil (mapcar #'car org-agenda-exporter-settings)) 3623 (if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t)) 3624 org-agenda-exporter-settings)) 3625 (save-excursion 3626 (save-window-excursion 3627 (let ((bs (copy-sequence (buffer-string))) 3628 (extension (file-name-extension file)) 3629 (default-directory (file-name-directory file)) 3630 ) ;; beg content 3631 (with-temp-buffer 3632 (rename-buffer org-agenda-write-buffer-name t) 3633 (set-buffer-modified-p nil) 3634 (insert bs) 3635 (org-agenda-remove-marked-text 'invisible 'org-filtered) 3636 (run-hooks 'org-agenda-before-write-hook) 3637 (cond 3638 ((bound-and-true-p org-mobile-creating-agendas) 3639 (org-mobile-write-agenda-for-mobile file)) 3640 ((string= "org" extension) 3641 (let (content p m message-log-max) 3642 (goto-char (point-min)) 3643 (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) 3644 (goto-char p) 3645 (setq m (get-text-property (point) 'org-hd-marker)) 3646 (when m 3647 (cl-pushnew (with-current-buffer (marker-buffer m) 3648 (goto-char m) 3649 (org-copy-subtree 1 nil t t) 3650 org-subtree-clip) 3651 content 3652 :test #'equal))) 3653 (find-file file) 3654 (erase-buffer) 3655 (dolist (s content) (org-paste-subtree 1 s)) 3656 (write-file file) 3657 (kill-buffer (current-buffer)) 3658 (message "Org file written to %s" file))) 3659 ((member extension '("html" "htm")) 3660 (org-require-package 'htmlize) 3661 (declare-function htmlize-buffer "htmlize" (&optional buffer)) 3662 (set-buffer (htmlize-buffer (current-buffer))) 3663 (when org-agenda-export-html-style 3664 ;; replace <style> section with org-agenda-export-html-style 3665 (goto-char (point-min)) 3666 (kill-region (- (search-forward "<style") 6) 3667 (search-forward "</style>")) 3668 (insert org-agenda-export-html-style)) 3669 (write-file file) 3670 (kill-buffer (current-buffer)) 3671 (message "HTML written to %s" file)) 3672 ((string= "ps" extension) 3673 (require 'ps-print) 3674 (ps-print-buffer-with-faces file) 3675 (message "Postscript written to %s" file)) 3676 ((string= "pdf" extension) 3677 (require 'ps-print) 3678 (ps-print-buffer-with-faces 3679 (concat (file-name-sans-extension file) ".ps")) 3680 (call-process "ps2pdf" nil nil nil 3681 (expand-file-name 3682 (concat (file-name-sans-extension file) ".ps")) 3683 (expand-file-name file)) 3684 (delete-file (concat (file-name-sans-extension file) ".ps")) 3685 (message "PDF written to %s" file)) 3686 ((string= "ics" extension) 3687 (require 'ox-icalendar) 3688 (declare-function org-icalendar-export-current-agenda 3689 "ox-icalendar" (file)) 3690 (org-icalendar-export-current-agenda (expand-file-name file))) 3691 (t 3692 (write-region nil nil file) 3693 (message "Plain text written to %s" file))))))) 3694 (set-buffer (or agenda-bufname 3695 ;; FIXME: I'm pretty sure called-interactively-p 3696 ;; doesn't do what we want here! 3697 (and (called-interactively-p 'any) (buffer-name)) 3698 org-agenda-buffer-name))) 3699 (when open (org-open-file file))) 3700 3701 (defun org-agenda-remove-marked-text (property &optional value) 3702 "Delete all text marked with VALUE of PROPERTY. 3703 VALUE defaults to t." 3704 (let (beg) 3705 (setq value (or value t)) 3706 (while (setq beg (text-property-any (point-min) (point-max) 3707 property value)) 3708 (delete-region 3709 beg (or (next-single-property-change beg property) 3710 (point-max)))))) 3711 3712 (defun org-agenda-add-entry-text () 3713 "Add entry text to agenda lines. 3714 This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the 3715 entry text following headings shown in the agenda. 3716 Drawers will be excluded, also the line with scheduling/deadline info." 3717 (when (and (> org-agenda-add-entry-text-maxlines 0) 3718 (not (bound-and-true-p org-mobile-creating-agendas))) 3719 (let (m txt) 3720 (goto-char (point-min)) 3721 (while (not (eobp)) 3722 (if (not (setq m (org-get-at-bol 'org-hd-marker))) 3723 (forward-line 1) 3724 (setq txt (org-agenda-get-some-entry-text 3725 m org-agenda-add-entry-text-maxlines " > ")) 3726 (end-of-line 1) 3727 (if (string-match "\\S-" txt) 3728 (insert "\n" txt) 3729 (or (eobp) (forward-char 1)))))))) 3730 3731 (defun org-agenda-get-some-entry-text (marker n-lines &optional indent 3732 &rest keep) 3733 "Extract entry text from MARKER, at most N-LINES lines. 3734 This will ignore drawers etc, just get the text. 3735 If INDENT is given, prefix every line with this string. If KEEP is 3736 given, it is a list of symbols, defining stuff that should not be 3737 removed from the entry content. Currently only `planning' is allowed here." 3738 (let (txt drawer-re kwd-time-re ind) 3739 (save-excursion 3740 (with-current-buffer (marker-buffer marker) 3741 (if (not (derived-mode-p 'org-mode)) 3742 (setq txt "") 3743 (org-with-wide-buffer 3744 (goto-char marker) 3745 (end-of-line 1) 3746 (setq txt (buffer-substring 3747 (min (1+ (point)) (point-max)) 3748 (progn (outline-next-heading) (point))) 3749 drawer-re org-drawer-regexp 3750 kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp 3751 ".*\n?")) 3752 (with-temp-buffer 3753 (insert txt) 3754 (when org-agenda-add-entry-text-descriptive-links 3755 (goto-char (point-min)) 3756 (while (org-activate-links (point-max)) 3757 (goto-char (match-end 0)))) 3758 (goto-char (point-min)) 3759 (while (re-search-forward org-link-bracket-re (point-max) t) 3760 (set-text-properties (match-beginning 0) (match-end 0) 3761 nil)) 3762 (goto-char (point-min)) 3763 (while (re-search-forward drawer-re nil t) 3764 (delete-region 3765 (match-beginning 0) 3766 (progn (re-search-forward 3767 "^[ \t]*:END:.*\n?" nil 'move) 3768 (point)))) 3769 (unless (member 'planning keep) 3770 (goto-char (point-min)) 3771 (while (re-search-forward kwd-time-re nil t) 3772 (replace-match ""))) 3773 (goto-char (point-min)) 3774 (when org-agenda-entry-text-exclude-regexps 3775 (let ((re-list org-agenda-entry-text-exclude-regexps) re) 3776 (while (setq re (pop re-list)) 3777 (goto-char (point-min)) 3778 (while (re-search-forward re nil t) 3779 (replace-match ""))))) 3780 (goto-char (point-max)) 3781 (skip-chars-backward " \t\n") 3782 (when (looking-at "[ \t\n]+\\'") (replace-match "")) 3783 3784 ;; find and remove min common indentation 3785 (goto-char (point-min)) 3786 (untabify (point-min) (point-max)) 3787 (setq ind (org-current-text-indentation)) 3788 (while (not (eobp)) 3789 (unless (looking-at "[ \t]*$") 3790 (setq ind (min ind (org-current-text-indentation)))) 3791 (forward-line 1)) 3792 (goto-char (point-min)) 3793 (while (not (eobp)) 3794 (unless (looking-at "[ \t]*$") 3795 (move-to-column ind) 3796 (delete-region (line-beginning-position) (point))) 3797 (forward-line 1)) 3798 3799 (run-hooks 'org-agenda-entry-text-cleanup-hook) 3800 3801 (goto-char (point-min)) 3802 (when indent 3803 (while (and (not (eobp)) (re-search-forward "^" nil t)) 3804 (replace-match indent t t))) 3805 (goto-char (point-min)) 3806 (while (looking-at "[ \t]*\n") (replace-match "")) 3807 (goto-char (point-max)) 3808 (when (> (org-current-line) 3809 n-lines) 3810 (org-goto-line (1+ n-lines)) 3811 (backward-char 1)) 3812 (setq txt (buffer-substring (point-min) (point)))))))) 3813 txt)) 3814 3815 (defun org-check-for-org-mode () 3816 "Make sure current buffer is in Org mode. Error if not." 3817 (or (derived-mode-p 'org-mode) 3818 (error "Cannot execute Org agenda command on buffer in %s" 3819 major-mode))) 3820 3821 ;;; Agenda prepare and finalize 3822 3823 (defvar org-agenda-multi nil) ; dynamically scoped 3824 (defvar org-agenda-pre-window-conf nil) 3825 (defvar org-agenda-columns-active nil) 3826 (defvar org-agenda-name nil) 3827 (defvar org-agenda-tag-filter nil) 3828 (defvar org-agenda-category-filter nil) 3829 (defvar org-agenda-regexp-filter nil) 3830 (defvar org-agenda-effort-filter nil) 3831 (defvar org-agenda-top-headline-filter nil) 3832 3833 (defvar org-agenda-represented-categories nil 3834 "Cache for the list of all categories in the agenda.") 3835 (defvar org-agenda-represented-tags nil 3836 "Cache for the list of all categories in the agenda.") 3837 (defvar org-agenda-tag-filter-preset nil 3838 "A preset of the tags filter used for secondary agenda filtering. 3839 This must be a list of strings, each string must be a single tag preceded 3840 by \"+\" or \"-\". 3841 This variable should not be set directly, but agenda custom commands can 3842 bind it in the options section. The preset filter is a global property of 3843 the entire agenda view. In a block agenda, it will not work reliably to 3844 define a filter for one of the individual blocks. You need to set it in 3845 the global options and expect it to be applied to the entire view.") 3846 3847 (defvar org-agenda-filters-preset nil 3848 "Alist of filter types and associated preset of filters. 3849 This variable is local in `org-agenda' buffers. See `org-agenda-local-vars'.") 3850 3851 (defconst org-agenda-filter-variables 3852 '((category . org-agenda-category-filter) 3853 (tag . org-agenda-tag-filter) 3854 (effort . org-agenda-effort-filter) 3855 (regexp . org-agenda-regexp-filter)) 3856 "Alist of filter types and associated variables.") 3857 (defun org-agenda-filter-any () 3858 "Is any filter active?" 3859 (cl-some (lambda (x) 3860 (or (symbol-value (cdr x)) 3861 (assoc-default (car x) org-agenda-filters-preset))) 3862 org-agenda-filter-variables)) 3863 3864 (defvar org-agenda-category-filter-preset nil 3865 "A preset of the category filter used for secondary agenda filtering. 3866 This must be a list of strings, each string must be a single category 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 (defvar org-agenda-regexp-filter-preset nil 3875 "A preset of the regexp filter used for secondary agenda filtering. 3876 This must be a list of strings, each string must be a single regexp 3877 preceded by \"+\" or \"-\". 3878 This variable should not be set directly, but agenda custom commands can 3879 bind it in the options section. The preset filter is a global property of 3880 the entire agenda view. In a block agenda, it will not work reliably to 3881 define a filter for one of the individual blocks. You need to set it in 3882 the global options and expect it to be applied to the entire view.") 3883 3884 (defvar org-agenda-effort-filter-preset nil 3885 "A preset of the effort condition used for secondary agenda filtering. 3886 This must be a list of strings, each string must be a single regexp 3887 preceded by \"+\" or \"-\". 3888 This variable should not be set directly, but agenda custom commands can 3889 bind it in the options section. The preset filter is a global property of 3890 the entire agenda view. In a block agenda, it will not work reliably to 3891 define a filter for one of the individual blocks. You need to set it in 3892 the global options and expect it to be applied to the entire view.") 3893 3894 (defun org-agenda-use-sticky-p () 3895 "Return non-nil if an agenda buffer named 3896 `org-agenda-buffer-name' exists and should be shown instead of 3897 generating a new one." 3898 (and 3899 ;; turned off by user 3900 org-agenda-sticky 3901 ;; For multi-agenda buffer already exists 3902 (not org-agenda-multi) 3903 ;; buffer found 3904 (get-buffer org-agenda-buffer-name) 3905 ;; C-u parameter is same as last call 3906 (with-current-buffer org-agenda-buffer-name 3907 (and 3908 (equal current-prefix-arg 3909 org-agenda-last-prefix-arg) 3910 ;; In case user turned stickiness on, while having existing 3911 ;; Agenda buffer active, don't reuse that buffer, because it 3912 ;; does not have org variables local 3913 org-agenda-this-buffer-is-sticky)))) 3914 3915 (defvar org-agenda-buffer-tmp-name nil) 3916 3917 (defun org-agenda--get-buffer-name (sticky-name) 3918 (or org-agenda-buffer-tmp-name 3919 (and org-agenda-doing-sticky-redo org-agenda-buffer-name) 3920 sticky-name 3921 "*Org Agenda*")) 3922 3923 (defun org-agenda-prepare-window (abuf filter-alist) 3924 "Setup agenda buffer in the window. 3925 ABUF is the buffer for the agenda window. 3926 FILTER-ALIST is an alist of filters we need to apply when 3927 `org-agenda-persistent-filter' is non-nil." 3928 (let* ((awin (get-buffer-window abuf)) wconf) 3929 (cond 3930 ((equal (current-buffer) abuf) nil) 3931 (awin (select-window awin)) 3932 ((not (setq wconf (current-window-configuration)))) 3933 ((eq org-agenda-window-setup 'current-window) 3934 (pop-to-buffer-same-window abuf)) 3935 ((eq org-agenda-window-setup 'other-window) 3936 (switch-to-buffer-other-window abuf)) 3937 ((eq org-agenda-window-setup 'other-frame) 3938 (switch-to-buffer-other-frame abuf)) 3939 ((eq org-agenda-window-setup 'other-tab) 3940 (if (fboundp 'switch-to-buffer-other-tab) 3941 (switch-to-buffer-other-tab abuf) 3942 (user-error "Your version of Emacs does not have tab bar support"))) 3943 ((eq org-agenda-window-setup 'only-window) 3944 (pop-to-buffer abuf '(org-display-buffer-full-frame))) 3945 ((eq org-agenda-window-setup 'reorganize-frame) 3946 (pop-to-buffer abuf '(org-display-buffer-split)))) 3947 (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist))) 3948 (setq org-agenda-category-filter (cdr (assq 'cat filter-alist))) 3949 (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist))) 3950 (setq org-agenda-regexp-filter (cdr (assq 're filter-alist))) 3951 ;; Additional test in case agenda is invoked from within agenda 3952 ;; buffer via elisp link. 3953 (unless (equal (current-buffer) abuf) 3954 (pop-to-buffer-same-window abuf)) 3955 (setq org-agenda-pre-window-conf 3956 (or wconf org-agenda-pre-window-conf)))) 3957 3958 (defun org-agenda-prepare (&optional name) 3959 (let ((filter-alist (when org-agenda-persistent-filter 3960 (with-current-buffer 3961 (get-buffer-create org-agenda-buffer-name) 3962 `((tag . ,org-agenda-tag-filter) 3963 (re . ,org-agenda-regexp-filter) 3964 (effort . ,org-agenda-effort-filter) 3965 (cat . ,org-agenda-category-filter)))))) 3966 (if (org-agenda-use-sticky-p) 3967 (progn 3968 ;; Popup existing buffer 3969 (org-agenda-prepare-window (get-buffer org-agenda-buffer-name) 3970 filter-alist) 3971 (message "Sticky Agenda buffer, use `r' to refresh") 3972 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 3973 (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) 3974 (if org-agenda-multi 3975 (progn 3976 (setq buffer-read-only nil) 3977 (goto-char (point-max)) 3978 (unless (or (bobp) org-agenda-compact-blocks 3979 (not org-agenda-block-separator)) 3980 (insert "\n" 3981 (if (stringp org-agenda-block-separator) 3982 org-agenda-block-separator 3983 (make-string (window-max-chars-per-line) org-agenda-block-separator)) 3984 "\n")) 3985 (narrow-to-region (point) (point-max))) 3986 (setq org-todo-keywords-for-agenda nil) 3987 (setq org-done-keywords-for-agenda nil) 3988 ;; Setting any org variables that are in org-agenda-local-vars 3989 ;; list need to be done after the prepare call 3990 (org-agenda-prepare-window 3991 (get-buffer-create org-agenda-buffer-name) filter-alist) 3992 (setq buffer-read-only nil) 3993 (org-agenda-reset-markers) 3994 (let ((inhibit-read-only t)) (erase-buffer)) 3995 (org-agenda-mode) 3996 (setq org-agenda-buffer (current-buffer)) 3997 (setq org-agenda-contributing-files nil) 3998 (setq org-agenda-columns-active nil) 3999 (setq org-agenda-filters-preset 4000 `((tag . ,org-agenda-tag-filter-preset) 4001 (category . ,org-agenda-category-filter-preset) 4002 (regexp . ,org-agenda-regexp-filter-preset) 4003 (effort . ,org-agenda-effort-filter-preset))) 4004 (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) 4005 (setq org-todo-keywords-for-agenda 4006 (org-uniquify org-todo-keywords-for-agenda)) 4007 (setq org-done-keywords-for-agenda 4008 (org-uniquify org-done-keywords-for-agenda)) 4009 (setq org-agenda-last-prefix-arg current-prefix-arg) 4010 (setq org-agenda-this-buffer-name org-agenda-buffer-name) 4011 (and name (not org-agenda-name) 4012 (setq-local org-agenda-name name))) 4013 (setq buffer-read-only nil)))) 4014 4015 (defvar org-overriding-columns-format) 4016 (defvar org-local-columns-format) 4017 (defun org-agenda-finalize () 4018 "Finishing touch for the agenda buffer. 4019 This function is called just before displaying the agenda. If 4020 you want to add your own functions to the finalization of the 4021 agenda display, configure `org-agenda-finalize-hook'." 4022 (unless org-agenda-multi 4023 (let ((inhibit-read-only t)) 4024 (save-excursion 4025 (goto-char (point-min)) 4026 (save-excursion 4027 (while (org-activate-links (point-max)) 4028 (goto-char (match-end 0)))) 4029 (unless (eq org-agenda-remove-tags t) 4030 (org-agenda-align-tags)) 4031 (unless org-agenda-with-colors 4032 (remove-text-properties (point-min) (point-max) '(face nil))) 4033 (when (bound-and-true-p org-overriding-columns-format) 4034 (setq-local org-local-columns-format 4035 org-overriding-columns-format)) 4036 (when org-agenda-view-columns-initially 4037 (org-agenda-columns)) 4038 (when org-agenda-fontify-priorities 4039 (org-agenda-fontify-priorities)) 4040 (when (and org-agenda-dim-blocked-tasks org-blocker-hook) 4041 (org-agenda-dim-blocked-tasks)) 4042 (org-agenda-mark-clocking-task) 4043 (when org-agenda-entry-text-mode 4044 (org-agenda-entry-text-hide) 4045 (org-agenda-entry-text-show)) 4046 (when (and (featurep 'org-habit) 4047 (save-excursion (next-single-property-change (point-min) 'org-habit-p))) 4048 (org-habit-insert-consistency-graphs)) 4049 (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) 4050 (unless (or (eq org-agenda-show-inherited-tags 'always) 4051 (and (listp org-agenda-show-inherited-tags) 4052 (memq org-agenda-type org-agenda-show-inherited-tags)) 4053 (and (eq org-agenda-show-inherited-tags t) 4054 (or (eq org-agenda-use-tag-inheritance t) 4055 (and (listp org-agenda-use-tag-inheritance) 4056 (not (memq org-agenda-type 4057 org-agenda-use-tag-inheritance)))))) 4058 (let (mrk) 4059 (save-excursion 4060 (goto-char (point-min)) 4061 (while (equal (forward-line) 0) 4062 (when (setq mrk (get-text-property (point) 'org-hd-marker)) 4063 (put-text-property (line-beginning-position) (line-end-position) 4064 'tags 4065 (org-with-point-at mrk 4066 (org-get-tags)))))))) 4067 (setq org-agenda-represented-tags nil 4068 org-agenda-represented-categories nil) 4069 (when org-agenda-top-headline-filter 4070 (org-agenda-filter-top-headline-apply 4071 org-agenda-top-headline-filter)) 4072 (when org-agenda-tag-filter 4073 (org-agenda-filter-apply org-agenda-tag-filter 'tag t)) 4074 (when (assoc-default 'tag org-agenda-filters-preset) 4075 (org-agenda-filter-apply 4076 (assoc-default 'tag org-agenda-filters-preset) 'tag t)) 4077 (when org-agenda-category-filter 4078 (org-agenda-filter-apply org-agenda-category-filter 'category)) 4079 (when (assoc-default 'category org-agenda-filters-preset) 4080 (org-agenda-filter-apply 4081 (assoc-default 'category org-agenda-filters-preset) 'category)) 4082 (when org-agenda-regexp-filter 4083 (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) 4084 (when (assoc-default 'regexp org-agenda-filters-preset) 4085 (org-agenda-filter-apply 4086 (assoc-default 'regexp org-agenda-filters-preset) 'regexp)) 4087 (when org-agenda-effort-filter 4088 (org-agenda-filter-apply org-agenda-effort-filter 'effort)) 4089 (when (assoc-default 'effort org-agenda-filters-preset) 4090 (org-agenda-filter-apply 4091 (assoc-default 'effort org-agenda-filters-preset) 'effort)) 4092 (add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local)) 4093 (run-hooks 'org-agenda-finalize-hook)))) 4094 4095 (defun org-agenda-mark-clocking-task () 4096 "Mark the current clock entry in the agenda if it is present." 4097 ;; We need to widen when `org-agenda-finalize' is called from 4098 ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in'). 4099 (when (bound-and-true-p org-clock-current-task) 4100 (save-restriction 4101 (widen) 4102 (org-agenda-unmark-clocking-task) 4103 (when (marker-buffer org-clock-hd-marker) 4104 (save-excursion 4105 (goto-char (point-min)) 4106 (let (s ov) 4107 (while (setq s (next-single-property-change (point) 'org-hd-marker)) 4108 (goto-char s) 4109 (when (equal (org-get-at-bol 'org-hd-marker) 4110 org-clock-hd-marker) 4111 (setq ov (make-overlay (line-beginning-position) 4112 (1+ (line-end-position)))) 4113 (overlay-put ov 'type 'org-agenda-clocking) 4114 (overlay-put ov 'face 'org-agenda-clocking) 4115 (overlay-put ov 'help-echo 4116 "The clock is running in this item"))))))))) 4117 4118 (defun org-agenda-unmark-clocking-task () 4119 "Unmark the current clocking task." 4120 (mapc (lambda (o) 4121 (when (eq (overlay-get o 'type) 'org-agenda-clocking) 4122 (delete-overlay o))) 4123 (overlays-in (point-min) (point-max)))) 4124 4125 (defun org-agenda-fontify-priorities () 4126 "Make highest priority lines bold, and lowest italic." 4127 (interactive) 4128 (mapc (lambda (o) (when (eq (overlay-get o 'org-type) 'org-priority) 4129 (delete-overlay o))) 4130 (overlays-in (point-min) (point-max))) 4131 (save-excursion 4132 (let (b e p ov h l) 4133 (goto-char (point-min)) 4134 (while (re-search-forward org-priority-regexp nil t) 4135 (setq h (or (get-char-property (point) 'org-priority-highest) 4136 org-priority-highest) 4137 l (or (get-char-property (point) 'org-priority-lowest) 4138 org-priority-lowest) 4139 p (string-to-char (match-string 2)) 4140 b (match-beginning 1) 4141 e (if (eq org-agenda-fontify-priorities 'cookies) 4142 (1+ (match-end 2)) 4143 (line-end-position)) 4144 ov (make-overlay b e)) 4145 (overlay-put 4146 ov 'face 4147 (let ((special-face 4148 (cond ((org-face-from-face-or-color 4149 'priority 'org-priority 4150 (cdr (assoc p org-priority-faces)))) 4151 ((and (listp org-agenda-fontify-priorities) 4152 (org-face-from-face-or-color 4153 'priority 'org-priority 4154 (cdr (assoc p org-agenda-fontify-priorities))))) 4155 ((equal p l) 'italic) 4156 ((equal p h) 'bold)))) 4157 (if special-face (list special-face 'org-priority) 'org-priority))) 4158 (overlay-put ov 'org-type 'org-priority))))) 4159 4160 (defvar org-depend-tag-blocked) 4161 4162 (defun org-agenda-dim-blocked-tasks (&optional _invisible) 4163 "Dim currently blocked TODOs in the agenda display. 4164 When INVISIBLE is non-nil, hide currently blocked TODO instead of 4165 dimming them." ;FIXME: The arg isn't used, actually! 4166 (interactive "P") 4167 (when (called-interactively-p 'interactive) 4168 (message "Dim or hide blocked tasks...")) 4169 (dolist (o (overlays-in (point-min) (point-max))) 4170 (when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face) 4171 (delete-overlay o))) 4172 (save-excursion 4173 (let ((inhibit-read-only t)) 4174 (goto-char (point-min)) 4175 (while (let ((pos (text-property-not-all 4176 (point) (point-max) 'org-todo-blocked nil))) 4177 (when pos (goto-char pos))) 4178 (let* ((invisible 4179 (eq (org-get-at-bol 'org-todo-blocked) 'invisible)) 4180 (todo-blocked 4181 (eq (org-get-at-bol 'org-filter-type) 'todo-blocked)) 4182 (ov (make-overlay (if invisible 4183 (line-end-position 0) 4184 (line-beginning-position)) 4185 (line-end-position)))) 4186 (when todo-blocked 4187 (overlay-put ov 'face 'org-agenda-dimmed-todo-face) 4188 ;; Override other overlays. 4189 (overlay-put ov 'priority 50)) 4190 (when invisible 4191 (org-agenda-filter-hide-line 'todo-blocked))) 4192 (if (= (point-max) (line-end-position)) 4193 (goto-char (point-max)) 4194 (move-beginning-of-line 2))))) 4195 (when (called-interactively-p 'interactive) 4196 (message "Dim or hide blocked tasks...done"))) 4197 4198 (defun org-agenda--mark-blocked-entry (entry) 4199 "If ENTRY is blocked, mark it for fontification or invisibility. 4200 4201 If the header at `org-hd-marker' is blocked according to 4202 `org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is 4203 `invisible' and the header is not blocked by checkboxes, set the 4204 text property `org-todo-blocked' to `invisible', otherwise set it 4205 to t." 4206 (when (get-text-property 0 'todo-state entry) 4207 (let ((entry-marker (get-text-property 0 'org-hd-marker entry)) 4208 (org-blocked-by-checkboxes nil) 4209 ;; Necessary so that `org-entry-blocked-p' does not change 4210 ;; the buffer. 4211 (org-depend-tag-blocked nil)) 4212 (when entry-marker 4213 (let ((blocked 4214 (with-current-buffer (marker-buffer entry-marker) 4215 (save-excursion 4216 (goto-char entry-marker) 4217 (org-entry-blocked-p))))) 4218 (when blocked 4219 (let ((really-invisible 4220 (and (not org-blocked-by-checkboxes) 4221 (eq org-agenda-dim-blocked-tasks 'invisible)))) 4222 (put-text-property 4223 0 (length entry) 'org-todo-blocked 4224 (if really-invisible 'invisible t) 4225 entry) 4226 (put-text-property 4227 0 (length entry) 'org-filter-type 'todo-blocked entry))))))) 4228 entry) 4229 4230 (defvar org-agenda-skip-function nil 4231 "Function to be called at each match during agenda construction. 4232 If this function returns nil, the current match should not be skipped. 4233 Otherwise, the function must return a position from where the search 4234 should be continued. 4235 4236 This may also be a Lisp form that will be evaluated. Useful 4237 forms include `org-agenda-skip-entry-if' and 4238 `org-agenda-skip-subtree-if'. See the Info node `(org) Special 4239 Agenda Views' for more details and examples. 4240 4241 Never set this variable using `setq' or similar, because then it 4242 will apply to all future agenda commands. If you want a global 4243 skipping condition, use the option `org-agenda-skip-function-global' 4244 instead. 4245 4246 The correct way to use `org-agenda-skip-function' is to bind it with `let' 4247 to scope it dynamically into the agenda-constructing command. 4248 A good way to set it is through options in `org-agenda-custom-commands'.") 4249 4250 (defun org-agenda-skip (&optional element) 4251 "Throw to `:skip' in places that should be skipped. 4252 Also moves point to the end of the skipped region, so that search can 4253 continue from there. 4254 4255 Optional argument ELEMENT contains element at point." 4256 (save-match-data 4257 (when (or 4258 (if element 4259 (org-element-type-p element 'comment) 4260 (save-excursion 4261 (goto-char (line-beginning-position)) 4262 (looking-at comment-start-skip))) 4263 (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) 4264 (or (and (save-match-data (org-in-archived-heading-p nil element)) 4265 (org-end-of-subtree t element)) 4266 (and (member org-archive-tag org-file-tags) 4267 (goto-char (point-max))))) 4268 (and org-agenda-skip-comment-trees 4269 (org-in-commented-heading-p nil element) 4270 (org-end-of-subtree t element)) 4271 (let ((to (or (org-agenda-skip-eval org-agenda-skip-function-global) 4272 (org-agenda-skip-eval org-agenda-skip-function)))) 4273 (and to (goto-char to))) 4274 (org-in-src-block-p t element)) 4275 (throw :skip t)))) 4276 4277 (defun org-agenda-skip-eval (form) 4278 "If FORM is a function or a list, call (or eval) it and return the result. 4279 `save-excursion' and `save-match-data' are wrapped around the call, so point 4280 and match data are returned to the previous state no matter what these 4281 functions do." 4282 (let (fp) 4283 (and form 4284 (or (setq fp (functionp form)) 4285 (consp form)) 4286 (save-excursion 4287 (save-match-data 4288 (if fp 4289 (funcall form) 4290 (eval form t))))))) 4291 4292 (defvar org-agenda-markers nil 4293 "List of all currently active markers created by `org-agenda'.") 4294 (defvar org-agenda-last-marker-time (float-time) 4295 "Creation time of the last agenda marker.") 4296 4297 (defun org-agenda-new-marker (&optional pos) 4298 "Return a new agenda marker. 4299 Marker is at point, or at POS if non-nil. Org mode keeps a list 4300 of these markers and resets them when they are no longer in use." 4301 (let ((m (copy-marker (or pos (point)) t))) 4302 (setq org-agenda-last-marker-time (float-time)) 4303 (if (and org-agenda-buffer (buffer-live-p org-agenda-buffer)) 4304 (with-current-buffer org-agenda-buffer 4305 (push m org-agenda-markers)) 4306 (push m org-agenda-markers)) 4307 m)) 4308 4309 (defun org-agenda-reset-markers () 4310 "Reset markers created by `org-agenda'." 4311 (while org-agenda-markers 4312 (move-marker (pop org-agenda-markers) nil))) 4313 4314 (defun org-agenda-save-markers-for-cut-and-paste (beg end) 4315 "Save relative positions of markers in region. 4316 This check for agenda markers in all agenda buffers currently active." 4317 (dolist (buf (buffer-list)) 4318 (with-current-buffer buf 4319 (when (eq major-mode 'org-agenda-mode) 4320 (mapc (lambda (m) (org-check-and-save-marker m beg end)) 4321 org-agenda-markers))))) 4322 4323 ;;; Entry text mode 4324 4325 (defun org-agenda-entry-text-show-here () 4326 "Add some text from the entry as context to the current line." 4327 (let (m txt o) 4328 (setq m (org-get-at-bol 'org-hd-marker)) 4329 (unless (marker-buffer m) 4330 (error "No marker points to an entry here")) 4331 (setq txt (concat "\n" (org-no-properties 4332 (org-agenda-get-some-entry-text 4333 m org-agenda-entry-text-maxlines 4334 org-agenda-entry-text-leaders)))) 4335 (when (string-match "\\S-" txt) 4336 (setq o (make-overlay (line-beginning-position) (line-end-position))) 4337 (overlay-put o 'evaporate t) 4338 (overlay-put o 'org-overlay-type 'agenda-entry-content) 4339 (overlay-put o 'after-string txt)))) 4340 4341 (defun org-agenda-entry-text-show () 4342 "Add entry context for all agenda lines." 4343 (interactive) 4344 (save-excursion 4345 (goto-char (point-max)) 4346 (forward-line 0) 4347 (while (not (bobp)) 4348 (when (org-get-at-bol 'org-hd-marker) 4349 (org-agenda-entry-text-show-here)) 4350 (forward-line -1)))) 4351 4352 (defun org-agenda-entry-text-hide () 4353 "Remove any shown entry context." 4354 (mapc (lambda (o) 4355 (when (eq (overlay-get o 'org-overlay-type) 4356 'agenda-entry-content) 4357 (delete-overlay o))) 4358 (overlays-in (point-min) (point-max)))) 4359 4360 (defun org-agenda-get-day-face (date) 4361 "Return the face DATE should be displayed with." 4362 (cond ((and (functionp org-agenda-day-face-function) 4363 (funcall org-agenda-day-face-function date))) 4364 ((and (org-agenda-today-p date) 4365 (memq (calendar-day-of-week date) org-agenda-weekend-days)) 4366 'org-agenda-date-weekend-today) 4367 ((org-agenda-today-p date) 'org-agenda-date-today) 4368 ((memq (calendar-day-of-week date) org-agenda-weekend-days) 4369 'org-agenda-date-weekend) 4370 (t 'org-agenda-date))) 4371 4372 (defvar org-agenda-show-log-scoped) 4373 4374 ;;; Agenda Daily/Weekly 4375 4376 (defvar org-agenda-start-day nil ; dynamically scoped parameter 4377 "Start day for the agenda view. 4378 Custom commands can set this variable in the options section. 4379 This is usually a string like \"2007-11-01\", \"+2d\" or any other 4380 input allowed when reading a date through the Org calendar. 4381 See the docstring of `org-read-date' for details. 4382 4383 This variable has no effect when `org-agenda-start-on-weekday' is set 4384 and agenda spans 7 or 14 days.") 4385 (defvar org-starting-day nil) ; local variable in the agenda buffer 4386 (defvar org-arg-loc nil) ; local variable 4387 4388 ;;;###autoload 4389 (defun org-agenda-list (&optional arg start-day span with-hour) 4390 "Produce a daily/weekly view from all files in variable `org-agenda-files'. 4391 The view will be for the current day or week, but from the overview buffer 4392 you will be able to go to other days/weeks. 4393 4394 With a numeric prefix argument in an interactive call, the agenda will 4395 span ARG days. Lisp programs should instead specify SPAN to change 4396 the number of days. SPAN defaults to `org-agenda-span'. 4397 4398 START-DAY defaults to TODAY, or to the most recent match for the weekday 4399 given in `org-agenda-start-on-weekday'. 4400 4401 When WITH-HOUR is non-nil, only include scheduled and deadline 4402 items if they have an hour specification like [h]h:mm." 4403 (interactive "P") 4404 (when org-agenda-overriding-arguments 4405 (setq arg (car org-agenda-overriding-arguments) 4406 start-day (nth 1 org-agenda-overriding-arguments) 4407 span (nth 2 org-agenda-overriding-arguments))) 4408 (when (and (integerp arg) (> arg 0)) 4409 (setq span arg arg nil)) 4410 (when (numberp span) 4411 (unless (< 0 span) 4412 (user-error "Agenda creation impossible for this span(=%d days)" span))) 4413 (catch 'exit 4414 (setq org-agenda-buffer-name 4415 (org-agenda--get-buffer-name 4416 (and org-agenda-sticky 4417 (cond ((and org-keys (stringp org-match)) 4418 (format "*Org Agenda(%s:%s)*" org-keys org-match)) 4419 (org-keys 4420 (format "*Org Agenda(%s)*" org-keys)) 4421 (t "*Org Agenda(a)*"))))) 4422 (org-agenda-prepare "Day/Week") 4423 (setq start-day (or start-day org-agenda-start-day)) 4424 (when (stringp start-day) 4425 ;; Convert to an absolute day number 4426 (setq start-day (time-to-days (org-read-date nil t start-day)))) 4427 (org-compile-prefix-format 'agenda) 4428 (org-set-sorting-strategy 'agenda) 4429 (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span))) 4430 (today (org-today)) 4431 (sd (or start-day today)) 4432 (ndays (org-agenda-span-to-ndays span sd)) 4433 (org-agenda-start-on-weekday 4434 (and (or (eq ndays 7) (eq ndays 14)) 4435 org-agenda-start-on-weekday)) 4436 (thefiles (org-agenda-files nil 'ifmode)) 4437 (files thefiles) 4438 (start (if (or (null org-agenda-start-on-weekday) 4439 (< ndays 7)) 4440 sd 4441 (let* ((nt (calendar-day-of-week 4442 (calendar-gregorian-from-absolute sd))) 4443 (n1 org-agenda-start-on-weekday) 4444 (d (- nt n1))) 4445 (- sd (+ (if (< d 0) 7 0) d))))) 4446 (day-numbers (list start)) 4447 (day-cnt 0) 4448 ;; FIXME: This may cause confusion when users are trying to 4449 ;; debug agenda. The debugger will not trigger without 4450 ;; redisplay. 4451 (inhibit-redisplay (not debug-on-error)) 4452 (org-agenda-show-log-scoped org-agenda-show-log) 4453 s rtn rtnall file date d start-pos end-pos todayp ;; e 4454 clocktable-start clocktable-end) ;; filter 4455 (setq org-agenda-redo-command 4456 (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour)) 4457 (dotimes (_ (1- ndays)) 4458 (push (1+ (car day-numbers)) day-numbers)) 4459 (setq day-numbers (nreverse day-numbers)) 4460 (setq clocktable-start (car day-numbers) 4461 clocktable-end (1+ (or (org-last day-numbers) 0))) 4462 (setq-local org-starting-day (car day-numbers)) 4463 (setq-local org-arg-loc arg) 4464 (setq-local org-agenda-current-span (org-agenda-ndays-to-span span)) 4465 (unless org-agenda-compact-blocks 4466 (let* ((d1 (car day-numbers)) 4467 (d2 (org-last day-numbers)) 4468 (w1 (org-days-to-iso-week d1)) 4469 (w2 (org-days-to-iso-week d2))) 4470 (setq s (point)) 4471 (org-agenda--insert-overriding-header 4472 (concat (org-agenda-span-name span) 4473 "-agenda" 4474 (cond ((<= 350 (- d2 d1)) "") 4475 ((= w1 w2) (format " (W%02d)" w1)) 4476 (t (format " (W%02d-W%02d)" w1 w2))) 4477 ":\n"))) 4478 ;; Add properties if we actually inserted a header. 4479 (when (> (point) s) 4480 (add-text-properties s (1- (point)) 4481 (list 'face 'org-agenda-structure 4482 'org-date-line t)) 4483 (org-agenda-mark-header-line s))) 4484 (while (setq d (pop day-numbers)) 4485 (setq date (calendar-gregorian-from-absolute d) 4486 s (point)) 4487 (if (or (setq todayp (= d today)) 4488 (and (not start-pos) (= d sd))) 4489 (setq start-pos (point)) 4490 (when (and start-pos (not end-pos)) 4491 (setq end-pos (point)))) 4492 (setq files thefiles 4493 rtnall nil) 4494 (while (setq file (pop files)) 4495 (catch 'nextfile 4496 (org-check-agenda-file file) 4497 (let ((org-agenda-entry-types org-agenda-entry-types)) 4498 ;; Starred types override non-starred equivalents 4499 (when (member :deadline* org-agenda-entry-types) 4500 (setq org-agenda-entry-types 4501 (delq :deadline org-agenda-entry-types))) 4502 (when (member :scheduled* org-agenda-entry-types) 4503 (setq org-agenda-entry-types 4504 (delq :scheduled org-agenda-entry-types))) 4505 ;; Honor with-hour 4506 (when with-hour 4507 (when (member :deadline org-agenda-entry-types) 4508 (setq org-agenda-entry-types 4509 (delq :deadline org-agenda-entry-types)) 4510 (push :deadline* org-agenda-entry-types)) 4511 (when (member :scheduled org-agenda-entry-types) 4512 (setq org-agenda-entry-types 4513 (delq :scheduled org-agenda-entry-types)) 4514 (push :scheduled* org-agenda-entry-types))) 4515 (unless org-agenda-include-deadlines 4516 (setq org-agenda-entry-types 4517 (delq :deadline* (delq :deadline org-agenda-entry-types)))) 4518 (cond 4519 ((memq org-agenda-show-log-scoped '(only clockcheck)) 4520 (setq rtn (org-agenda-get-day-entries 4521 file date :closed))) 4522 (org-agenda-show-log-scoped 4523 (setq rtn (apply #'org-agenda-get-day-entries 4524 file date 4525 (append '(:closed) org-agenda-entry-types)))) 4526 (t 4527 (setq rtn (apply #'org-agenda-get-day-entries 4528 file date 4529 org-agenda-entry-types))))) 4530 (setq rtnall (append rtnall rtn)))) ;; all entries 4531 (when org-agenda-include-diary 4532 (let ((org-agenda-search-headline-for-time t)) 4533 (require 'diary-lib) 4534 (setq rtn (org-get-entries-from-diary date)) 4535 (setq rtnall (append rtnall rtn)))) 4536 (when (or rtnall org-agenda-show-all-dates) 4537 (setq day-cnt (1+ day-cnt)) 4538 (insert 4539 (if (stringp org-agenda-format-date) 4540 (format-time-string org-agenda-format-date 4541 (org-time-from-absolute date)) 4542 (funcall org-agenda-format-date date)) 4543 "\n") 4544 (put-text-property s (1- (point)) 'face 4545 (org-agenda-get-day-face date)) 4546 (put-text-property s (1- (point)) 'org-date-line t) 4547 (put-text-property s (1- (point)) 'org-agenda-date-header t) 4548 (put-text-property s (1- (point)) 'org-day-cnt day-cnt) 4549 (when todayp 4550 (put-text-property s (1- (point)) 'org-today t)) 4551 (setq rtnall 4552 (org-agenda-add-time-grid-maybe rtnall ndays todayp)) 4553 (when rtnall (insert ;; all entries 4554 (org-agenda-finalize-entries rtnall 'agenda) 4555 "\n")) 4556 (put-text-property s (1- (point)) 'day d) 4557 (put-text-property s (1- (point)) 'org-day-cnt day-cnt))) 4558 (when (and org-agenda-clockreport-mode clocktable-start) 4559 (let ((org-agenda-files (org-agenda-files nil 'ifmode)) 4560 ;; the above line is to ensure the restricted range! 4561 (p (copy-sequence org-agenda-clockreport-parameter-plist)) 4562 tbl) 4563 (setq p (org-plist-delete p :block)) 4564 (setq p (plist-put p :tstart clocktable-start)) 4565 (setq p (plist-put p :tend clocktable-end)) 4566 (setq p (plist-put p :scope 'agenda)) 4567 (setq tbl (apply #'org-clock-get-clocktable p)) 4568 (when org-agenda-clock-report-header 4569 (insert (propertize org-agenda-clock-report-header 'face 'org-agenda-structure)) 4570 (unless (string-suffix-p "\n" org-agenda-clock-report-header) 4571 (insert "\n"))) 4572 (insert tbl))) 4573 (goto-char (point-min)) 4574 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 4575 (unless (or (not (get-buffer-window org-agenda-buffer-name)) 4576 (and (pos-visible-in-window-p (point-min)) 4577 (pos-visible-in-window-p (point-max)))) 4578 (goto-char (1- (point-max))) 4579 (recenter -1) 4580 (when (not (pos-visible-in-window-p (or start-pos 1))) 4581 (goto-char (or start-pos 1)) 4582 (recenter 1))) 4583 (goto-char (or start-pos 1)) 4584 (add-text-properties (point-min) (point-max) 4585 `(org-agenda-type agenda 4586 org-last-args (,arg ,start-day ,span) 4587 org-redo-cmd ,org-agenda-redo-command 4588 org-series-cmd ,org-cmd)) 4589 (when (eq org-agenda-show-log-scoped 'clockcheck) 4590 (org-agenda-show-clocking-issues)) 4591 (org-agenda-finalize) 4592 (setq buffer-read-only t) 4593 (message "")))) 4594 4595 (defun org-agenda-ndays-to-span (n) 4596 "Return a span symbol for a span of N days, or N if none matches." 4597 (cond ((symbolp n) n) 4598 ((= n 1) 'day) 4599 ((= n 7) 'week) 4600 ((= n 14) 'fortnight) 4601 (t n))) 4602 4603 (defun org-agenda-span-to-ndays (span &optional start-day) 4604 "Return ndays from SPAN, possibly starting at START-DAY. 4605 START-DAY is an absolute time value." 4606 (cond ((numberp span) span) 4607 ((eq span 'day) 1) 4608 ((eq span 'week) 7) 4609 ((eq span 'fortnight) 14) 4610 ((eq span 'month) 4611 (let ((date (calendar-gregorian-from-absolute start-day))) 4612 (calendar-last-day-of-month (car date) (cl-caddr date)))) 4613 ((eq span 'year) 4614 (let ((date (calendar-gregorian-from-absolute start-day))) 4615 (if (calendar-leap-year-p (cl-caddr date)) 366 365))))) 4616 4617 (defun org-agenda-span-name (span) 4618 "Return a SPAN name." 4619 (if (null span) 4620 "" 4621 (if (symbolp span) 4622 (capitalize (symbol-name span)) 4623 (format "%d days" span)))) 4624 4625 ;;; Agenda word search 4626 4627 (defvar org-agenda-search-history nil) 4628 4629 (defvar org-search-syntax-table nil 4630 "Special syntax table for Org search. 4631 In this table, we have single quotes not as word constituents, to 4632 that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") 4633 4634 (defvar org-mode-syntax-table) ; From org.el 4635 (defun org-search-syntax-table () 4636 (unless org-search-syntax-table 4637 (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) 4638 (modify-syntax-entry ?' "." org-search-syntax-table) 4639 (modify-syntax-entry ?` "." org-search-syntax-table)) 4640 org-search-syntax-table) 4641 4642 (defvar org-agenda-last-search-view-search-was-boolean nil) 4643 4644 ;;;###autoload 4645 (defun org-search-view (&optional todo-only string edit-at) 4646 "Show all entries that contain a phrase or words or regular expressions. 4647 4648 With optional prefix argument TODO-ONLY, only consider entries that are 4649 TODO entries. The argument STRING can be used to pass a default search 4650 string into this function. If EDIT-AT is non-nil, it means that the 4651 user should get a chance to edit this string, with cursor at position 4652 EDIT-AT. 4653 4654 The search string can be viewed either as a phrase that should be found as 4655 is, or it can be broken into a number of snippets, each of which must match 4656 in a Boolean way to select an entry. The default depends on the variable 4657 `org-agenda-search-view-always-boolean'. 4658 Even if this is turned off (the default) you can always switch to 4659 Boolean search dynamically by preceding the first word with \"+\" or \"-\". 4660 4661 The default is a direct search of the whole phrase, where each space in 4662 the search string can expand to an arbitrary amount of whitespace, 4663 including newlines. 4664 4665 If using a Boolean search, the search string is split on whitespace and 4666 each snippet is searched separately, with logical AND to select an entry. 4667 Words prefixed with a minus must *not* occur in the entry. Words without 4668 a prefix or prefixed with a plus must occur in the entry. Matching is 4669 case-insensitive. Words are enclosed by word delimiters (i.e. they must 4670 match whole words, not parts of a word) if 4671 `org-agenda-search-view-force-full-words' is set (default is nil). 4672 4673 Boolean search snippets enclosed by curly braces are interpreted as 4674 regular expressions that must or (when preceded with \"-\") must not 4675 match in the entry. Snippets enclosed into double quotes will be taken 4676 as a whole, to include whitespace. 4677 4678 - If the search string starts with an asterisk, search only in headlines. 4679 - If (possibly after the leading star) the search string starts with an 4680 exclamation mark, this also means to look at TODO entries only, an effect 4681 that can also be achieved with a prefix argument. 4682 - If (possibly after star and exclamation mark) the search string starts 4683 with a colon, this will mean that the (non-regexp) snippets of the 4684 Boolean search must match as full words. 4685 4686 This command searches the agenda files, and in addition the files 4687 listed in `org-agenda-text-search-extra-files' unless a restriction lock 4688 is active." 4689 (interactive "P") 4690 (when org-agenda-overriding-arguments 4691 (setq todo-only (car org-agenda-overriding-arguments) 4692 string (nth 1 org-agenda-overriding-arguments) 4693 edit-at (nth 2 org-agenda-overriding-arguments))) 4694 (let* ((props (list 'face nil 4695 'done-face 'org-agenda-done 4696 'org-not-done-regexp org-not-done-regexp 4697 'org-todo-regexp org-todo-regexp 4698 'org-complex-heading-regexp org-complex-heading-regexp 4699 'mouse-face 'highlight 4700 'help-echo "mouse-2 or RET jump to location")) 4701 (full-words org-agenda-search-view-force-full-words) 4702 (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) 4703 regexp rtn rtnall files file pos inherited-tags 4704 marker category level tags c neg re boolean 4705 ee txt beg end last-search-end words regexps+ regexps- hdl-only buffer beg1 str) 4706 (unless (and (not edit-at) 4707 (stringp string) 4708 (string-match "\\S-" string)) 4709 (setq string (read-string 4710 (if org-agenda-search-view-always-boolean 4711 "[+-]Word/{Regexp} ...: " 4712 "Phrase or [+-]Word/{Regexp} ...: ") 4713 (cond 4714 ((integerp edit-at) (cons string edit-at)) 4715 (edit-at string)) 4716 'org-agenda-search-history))) 4717 (catch 'exit 4718 (setq org-agenda-buffer-name 4719 (org-agenda--get-buffer-name 4720 (and org-agenda-sticky 4721 (if (stringp string) 4722 (format "*Org Agenda(%s:%s)*" 4723 (or org-keys (or (and todo-only "S") "s")) 4724 string) 4725 (format "*Org Agenda(%s)*" 4726 (or (and todo-only "S") "s")))))) 4727 (org-agenda-prepare "SEARCH") 4728 (org-compile-prefix-format 'search) 4729 (org-set-sorting-strategy 'search) 4730 (setq org-agenda-redo-command 4731 (list 'org-search-view (if todo-only t nil) 4732 (list 'if 'current-prefix-arg nil string))) 4733 (setq org-agenda-query-string string) 4734 (if (equal (string-to-char string) ?*) 4735 (setq hdl-only t 4736 words (substring string 1)) 4737 (setq words string)) 4738 (when (equal (string-to-char words) ?!) 4739 (setq todo-only t 4740 words (substring words 1))) 4741 (when (equal (string-to-char words) ?:) 4742 (setq full-words t 4743 words (substring words 1))) 4744 (when (or org-agenda-search-view-always-boolean 4745 (member (string-to-char words) '(?- ?+ ?\{))) 4746 (setq boolean t)) 4747 (setq words (split-string words)) 4748 (let (www w) 4749 (while (setq w (pop words)) 4750 (while (and (string-match "\\\\\\'" w) words) 4751 (setq w (concat (substring w 0 -1) " " (pop words)))) 4752 (push w www)) 4753 (setq words (nreverse www) www nil) 4754 (while (setq w (pop words)) 4755 (when (and (string-match "\\`[-+]?{" w) 4756 (not (string-match "}\\'" w))) 4757 (while (and words (not (string-match "}\\'" (car words)))) 4758 (setq w (concat w " " (pop words)))) 4759 (setq w (concat w " " (pop words)))) 4760 (push w www)) 4761 (setq words (nreverse www))) 4762 (setq org-agenda-last-search-view-search-was-boolean boolean) 4763 (when boolean 4764 (let (wds w) 4765 (while (setq w (pop words)) 4766 (when (or (equal (substring w 0 1) "\"") 4767 (and (> (length w) 1) 4768 (member (substring w 0 1) '("+" "-")) 4769 (equal (substring w 1 2) "\""))) 4770 (while (and words (not (equal (substring w -1) "\""))) 4771 (setq w (concat w " " (pop words))))) 4772 (and (string-match "\\`\\([-+]?\\)\"" w) 4773 (setq w (replace-match "\\1" nil nil w))) 4774 (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) 4775 (push w wds)) 4776 (setq words (nreverse wds)))) 4777 (if boolean 4778 (mapc (lambda (w) 4779 (setq c (string-to-char w)) 4780 (if (equal c ?-) 4781 (setq neg t w (substring w 1)) 4782 (if (equal c ?+) 4783 (setq neg nil w (substring w 1)) 4784 (setq neg nil))) 4785 (if (string-match "\\`{.*}\\'" w) 4786 (setq re (substring w 1 -1)) 4787 (if full-words 4788 (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) 4789 (setq re (regexp-quote (downcase w))))) 4790 (if neg (push re regexps-) (push re regexps+))) 4791 words) 4792 (push (mapconcat #'regexp-quote words "\\s-+") 4793 regexps+)) 4794 (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) 4795 (if (not regexps+) 4796 (setq regexp org-outline-regexp-bol) 4797 (setq regexp (pop regexps+)) 4798 (when hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" 4799 regexp)))) 4800 (setq files (org-agenda-files nil 'ifmode)) 4801 ;; Add `org-agenda-text-search-extra-files' unless there is some 4802 ;; restriction. 4803 (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) 4804 (pop org-agenda-text-search-extra-files) 4805 (unless (get 'org-agenda-files 'org-restrict) 4806 (setq files (org-add-archive-files files)))) 4807 ;; Uniquify files. However, let `org-check-agenda-file' handle 4808 ;; non-existent ones. 4809 (setq files (cl-remove-duplicates 4810 (append files org-agenda-text-search-extra-files) 4811 :test (lambda (a b) 4812 (and (file-exists-p a) 4813 (file-exists-p b) 4814 (file-equal-p a b)))) 4815 rtnall nil) 4816 (while (setq file (pop files)) 4817 (setq ee nil) 4818 (catch 'nextfile 4819 (org-check-agenda-file file) 4820 (setq buffer (if (file-exists-p file) 4821 (org-get-agenda-file-buffer file) 4822 (error "No such file %s" file))) 4823 (unless buffer 4824 ;; If file does not exist, make sure an error message is sent 4825 (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" 4826 file)))) 4827 (with-current-buffer buffer 4828 (with-syntax-table (org-search-syntax-table) 4829 (unless (derived-mode-p 'org-mode) 4830 (error "Agenda file %s is not in Org mode" file)) 4831 (let ((case-fold-search t)) 4832 (save-excursion 4833 (save-restriction 4834 (if (eq buffer org-agenda-restrict) 4835 (narrow-to-region org-agenda-restrict-begin 4836 org-agenda-restrict-end) 4837 (widen)) 4838 (goto-char (point-min)) 4839 (unless (or (org-at-heading-p) 4840 (outline-next-heading)) 4841 (throw 'nextfile t)) 4842 (goto-char (max (point-min) (1- (point)))) 4843 (while (re-search-forward regexp nil t) 4844 (setq last-search-end (point)) 4845 (org-back-to-heading t) 4846 (while (and (not (zerop org-agenda-search-view-max-outline-level)) 4847 (> (org-reduced-level (org-outline-level)) 4848 org-agenda-search-view-max-outline-level) 4849 (forward-line -1) 4850 (org-back-to-heading t))) 4851 (skip-chars-forward "* ") 4852 (setq beg (line-beginning-position) 4853 beg1 (point) 4854 end (progn 4855 (outline-next-heading) 4856 (while (and (not (zerop org-agenda-search-view-max-outline-level)) 4857 (> (org-reduced-level (org-outline-level)) 4858 org-agenda-search-view-max-outline-level) 4859 (forward-line 1) 4860 (outline-next-heading))) 4861 (point))) 4862 4863 (catch :skip 4864 (goto-char beg) 4865 (org-agenda-skip) 4866 (setq str (buffer-substring-no-properties 4867 (line-beginning-position) 4868 (if hdl-only (line-end-position) end))) 4869 (mapc (lambda (wr) (when (string-match wr str) 4870 (goto-char (1- end)) 4871 (throw :skip t))) 4872 regexps-) 4873 (mapc (lambda (wr) (unless (string-match wr str) 4874 (goto-char (1- end)) 4875 (throw :skip t))) 4876 (if todo-only 4877 (cons (concat "^\\*+[ \t]+" 4878 org-not-done-regexp) 4879 regexps+) 4880 regexps+)) 4881 (goto-char beg) 4882 (setq marker (org-agenda-new-marker (point)) 4883 category (org-get-category) 4884 level (make-string (org-reduced-level (org-outline-level)) ? ) 4885 inherited-tags 4886 (or (eq org-agenda-show-inherited-tags 'always) 4887 (and (listp org-agenda-show-inherited-tags) 4888 (memq 'todo org-agenda-show-inherited-tags)) 4889 (and (eq org-agenda-show-inherited-tags t) 4890 (or (eq org-agenda-use-tag-inheritance t) 4891 (memq 'todo org-agenda-use-tag-inheritance)))) 4892 tags (org-get-tags nil (not inherited-tags)) 4893 txt (org-agenda-format-item 4894 "" 4895 (buffer-substring-no-properties 4896 beg1 (line-end-position)) 4897 level category tags t)) 4898 (org-add-props txt props 4899 'org-marker marker 'org-hd-marker marker 4900 'org-todo-regexp org-todo-regexp 4901 'level level 4902 'org-complex-heading-regexp org-complex-heading-regexp 4903 'urgency 1000 4904 'priority 1000 4905 'type "search") 4906 (push txt ee) 4907 (goto-char (max (1- end) last-search-end)))))))))) 4908 (setq rtn (nreverse ee)) 4909 (setq rtnall (append rtnall rtn))) 4910 (org-agenda--insert-overriding-header 4911 (with-temp-buffer 4912 (insert "Search words: ") 4913 (add-text-properties (point-min) (1- (point)) 4914 (list 'face 'org-agenda-structure)) 4915 (setq pos (point)) 4916 (insert string "\n") 4917 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter)) 4918 (setq pos (point)) 4919 (unless org-agenda-multi 4920 (insert (substitute-command-keys "\\<org-agenda-mode-map>\ 4921 Press `\\[org-agenda-manipulate-query-add]', \ 4922 `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \ 4923 `\\[org-agenda-manipulate-query-add-re]', \ 4924 `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \ 4925 `\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n")) 4926 (add-text-properties pos (1- (point)) 4927 (list 'face 'org-agenda-structure-secondary))) 4928 (buffer-string))) 4929 (org-agenda-mark-header-line (point-min)) 4930 (when rtnall 4931 (insert (org-agenda-finalize-entries rtnall 'search) "\n")) 4932 (goto-char (point-min)) 4933 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 4934 (add-text-properties (point-min) (point-max) 4935 `(org-agenda-type search 4936 org-last-args (,todo-only ,string ,edit-at) 4937 org-redo-cmd ,org-agenda-redo-command 4938 org-series-cmd ,org-cmd)) 4939 (org-agenda-finalize) 4940 (setq buffer-read-only t)))) 4941 4942 ;;; Agenda TODO list 4943 4944 (defun org-agenda-propertize-selected-todo-keywords (keywords) 4945 "Use `org-todo-keyword-faces' for the selected todo KEYWORDS." 4946 (concat 4947 (if (or (equal keywords "ALL") (not keywords)) 4948 (propertize "ALL" 'face 'org-agenda-structure-filter) 4949 (mapconcat 4950 (lambda (kw) 4951 (propertize kw 'face (list (org-get-todo-face kw) 'org-agenda-structure))) 4952 (org-split-string keywords "|") 4953 "|")) 4954 "\n")) 4955 4956 (defvar org-select-this-todo-keyword nil 4957 "Keyword selector for todo agenda. 4958 Should either be a keyword, \"*\", or \"|\"-separated list of todo 4959 keywords.") 4960 (defvar org-last-arg nil) 4961 4962 (defvar crm-separator) 4963 4964 ;;;###autoload 4965 (defun org-todo-list (&optional arg) 4966 "Show all (not done) TODO entries from all agenda files in a single list. 4967 The prefix arg can be used to select a specific TODO keyword and limit 4968 the list to these. When using `\\[universal-argument]', you will be prompted 4969 for a keyword. A numeric prefix directly selects the Nth keyword in 4970 `org-todo-keywords-1'." 4971 (interactive "P") 4972 (when org-agenda-overriding-arguments 4973 (setq arg org-agenda-overriding-arguments)) 4974 (when (and (stringp arg) (not (string-match "\\S-" arg))) 4975 (setq arg nil)) 4976 (let* ((today (calendar-gregorian-from-absolute (org-today))) 4977 (completion-ignore-case t) 4978 todo-keywords org-select-this-todo-keyword todo-entries all-todo-entries files file pos) 4979 (catch 'exit 4980 (setq org-agenda-buffer-name 4981 (org-agenda--get-buffer-name 4982 (when org-agenda-sticky 4983 (if (stringp org-select-this-todo-keyword) 4984 (format "*Org Agenda(%s:%s)*" (or org-keys "t") 4985 org-select-this-todo-keyword) 4986 (format "*Org Agenda(%s)*" (or org-keys "t")))))) 4987 (org-agenda-prepare "TODO") 4988 (setq todo-keywords org-todo-keywords-for-agenda 4989 org-select-this-todo-keyword (cond ((stringp arg) arg) 4990 ((and (integerp arg) (> arg 0)) 4991 (nth (1- arg) todo-keywords)))) 4992 (when (equal arg '(4)) 4993 (setq org-select-this-todo-keyword 4994 (mapconcat #'identity 4995 (let ((crm-separator "|")) 4996 (completing-read-multiple 4997 "Keyword (or KWD1|KWD2|...): " 4998 (mapcar #'list todo-keywords) nil nil)) 4999 "|"))) 5000 (when (equal arg 0) 5001 (setq org-select-this-todo-keyword nil)) 5002 (org-compile-prefix-format 'todo) 5003 (org-set-sorting-strategy 'todo) 5004 (setq org-agenda-redo-command 5005 `(org-todo-list (or (and (numberp current-prefix-arg) current-prefix-arg) 5006 ,org-select-this-todo-keyword 5007 current-prefix-arg 5008 ,arg))) 5009 (setq files (org-agenda-files nil 'ifmode) 5010 all-todo-entries nil) 5011 (while (setq file (pop files)) 5012 (catch 'nextfile 5013 (org-check-agenda-file file) 5014 (setq todo-entries (org-agenda-get-day-entries file today :todo)) 5015 (setq all-todo-entries (append all-todo-entries todo-entries)))) 5016 (org-agenda--insert-overriding-header 5017 (with-temp-buffer 5018 (insert "Global list of TODO items of type: ") 5019 (add-text-properties (point-min) (1- (point)) 5020 (list 'face 'org-agenda-structure 5021 'short-heading 5022 (concat "ToDo: " 5023 (or org-select-this-todo-keyword "ALL")))) 5024 (org-agenda-mark-header-line (point-min)) 5025 (insert (org-agenda-propertize-selected-todo-keywords 5026 org-select-this-todo-keyword)) 5027 (setq pos (point)) 5028 (unless org-agenda-multi 5029 (insert (substitute-command-keys "Press \ 5030 \\<org-agenda-mode-map>`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \ 5031 to search again: (0)[ALL]")) 5032 (let ((n 0)) 5033 (dolist (k todo-keywords) 5034 (let ((s (format "(%d)%s" (cl-incf n) k))) 5035 (when (> (+ (current-column) (string-width s) 1) (window-max-chars-per-line)) 5036 (insert "\n ")) 5037 (insert " " s)))) 5038 (insert "\n")) 5039 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary)) 5040 (buffer-string))) 5041 (org-agenda-mark-header-line (point-min)) 5042 (when all-todo-entries 5043 (insert (org-agenda-finalize-entries all-todo-entries 'todo) "\n")) 5044 (goto-char (point-min)) 5045 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 5046 (add-text-properties (point-min) (point-max) 5047 `(org-agenda-type todo 5048 org-last-args ,arg 5049 org-redo-cmd ,org-agenda-redo-command 5050 org-series-cmd ,org-cmd)) 5051 (org-agenda-finalize) 5052 (setq buffer-read-only t)))) 5053 5054 ;;; Agenda tags match 5055 5056 ;;;###autoload 5057 (defun org-tags-view (&optional todo-only match) 5058 "Show all headlines for all `org-agenda-files' matching a TAGS criterion. 5059 The prefix arg TODO-ONLY limits the search to TODO entries." 5060 (interactive "P") 5061 (when org-agenda-overriding-arguments 5062 (setq todo-only (car org-agenda-overriding-arguments) 5063 match (nth 1 org-agenda-overriding-arguments))) 5064 (let* ((org-tags-match-list-sublevels 5065 org-tags-match-list-sublevels) 5066 (completion-ignore-case t) 5067 (org--matcher-tags-todo-only todo-only) 5068 rtn rtnall files file pos matcher 5069 buffer) 5070 (when (and (stringp match) (not (string-match "\\S-" match))) 5071 (setq match nil)) 5072 (catch 'exit 5073 (setq org-agenda-buffer-name 5074 (org-agenda--get-buffer-name 5075 (and org-agenda-sticky 5076 (if (stringp match) 5077 (format "*Org Agenda(%s:%s)*" 5078 (or org-keys (or (and todo-only "M") "m")) 5079 match) 5080 (format "*Org Agenda(%s)*" 5081 (or (and todo-only "M") "m")))))) 5082 (setq matcher (org-make-tags-matcher match)) 5083 ;; Prepare agendas (and `org-tag-alist-for-agenda') before 5084 ;; expanding tags within `org-make-tags-matcher' 5085 (org-agenda-prepare (concat "TAGS " match)) 5086 (setq match (car matcher) 5087 matcher (cdr matcher)) 5088 (org-compile-prefix-format 'tags) 5089 (org-set-sorting-strategy 'tags) 5090 (setq org-agenda-query-string match) 5091 (setq org-agenda-redo-command 5092 (list 'org-tags-view 5093 `(quote ,org--matcher-tags-todo-only) 5094 `(if current-prefix-arg nil ,org-agenda-query-string))) 5095 (setq files (org-agenda-files nil 'ifmode) 5096 rtnall nil) 5097 (while (setq file (pop files)) 5098 (catch 'nextfile 5099 (org-check-agenda-file file) 5100 (setq buffer (if (file-exists-p file) 5101 (org-get-agenda-file-buffer file) 5102 (error "No such file %s" file))) 5103 (if (not buffer) 5104 ;; If file does not exist, error message to agenda 5105 (setq rtn (list 5106 (format "ORG-AGENDA-ERROR: No such org-file %s" file)) 5107 rtnall (append rtnall rtn)) 5108 (with-current-buffer buffer 5109 (unless (derived-mode-p 'org-mode) 5110 (error "Agenda file %s is not in Org mode" file)) 5111 (save-excursion 5112 (save-restriction 5113 (if (eq buffer org-agenda-restrict) 5114 (narrow-to-region org-agenda-restrict-begin 5115 org-agenda-restrict-end) 5116 (widen)) 5117 (setq rtn (org-scan-tags 'agenda 5118 matcher 5119 org--matcher-tags-todo-only)) 5120 (setq rtnall (append rtnall rtn)))))))) 5121 (org-agenda--insert-overriding-header 5122 (with-temp-buffer 5123 (insert "Headlines with TAGS match: ") 5124 (add-text-properties (point-min) (1- (point)) 5125 (list 'face 'org-agenda-structure 5126 'short-heading 5127 (concat "Match: " match))) 5128 (setq pos (point)) 5129 (insert match "\n") 5130 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-filter)) 5131 (setq pos (point)) 5132 (unless org-agenda-multi 5133 (insert (substitute-command-keys 5134 "Press \ 5135 \\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \ 5136 to search again\n"))) 5137 (add-text-properties pos (1- (point)) 5138 (list 'face 'org-agenda-structure-secondary)) 5139 (buffer-string))) 5140 (org-agenda-mark-header-line (point-min)) 5141 (when rtnall 5142 (insert (org-agenda-finalize-entries rtnall 'tags) "\n")) 5143 (goto-char (point-min)) 5144 (or org-agenda-multi (org-agenda-fit-window-to-buffer)) 5145 (add-text-properties 5146 (point-min) (point-max) 5147 `(org-agenda-type tags 5148 org-last-args (,org--matcher-tags-todo-only ,match) 5149 org-redo-cmd ,org-agenda-redo-command 5150 org-series-cmd ,org-cmd)) 5151 (org-agenda-finalize) 5152 (setq buffer-read-only t)))) 5153 5154 ;;; Agenda Finding stuck projects 5155 5156 (defvar org-agenda-skip-regexp nil 5157 "Regular expression used in skipping subtrees for the agenda. 5158 This is basically a temporary global variable that can be set and then 5159 used by user-defined selections using `org-agenda-skip-function'.") 5160 5161 (defvar org-agenda-overriding-header nil 5162 "When set during agenda, todo and tags searches it replaces the header. 5163 If an empty string, no header will be inserted. If any other 5164 string, it will be inserted as a header. If a function, insert 5165 the string returned by the function as a header. If nil, a 5166 header will be generated automatically according to the command. 5167 This variable should not be set directly, but custom commands can 5168 bind it in the options section.") 5169 5170 (defun org-agenda-skip-entry-if (&rest conditions) 5171 "Skip entry if any of CONDITIONS is true. 5172 See `org-agenda-skip-if' for details about CONDITIONS. 5173 5174 This function can be put into `org-agenda-skip-function' for the 5175 duration of a command." 5176 (org-agenda-skip-if nil conditions)) 5177 5178 (defun org-agenda-skip-subtree-if (&rest conditions) 5179 "Skip subtree if any of CONDITIONS is true. 5180 See `org-agenda-skip-if' for details about CONDITIONS. 5181 5182 This function can be put into `org-agenda-skip-function' for the 5183 duration of a command." 5184 (org-agenda-skip-if t conditions)) 5185 5186 (defun org-agenda-skip-if (subtree conditions) 5187 "Check current entity for CONDITIONS. 5188 If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only 5189 the entry (i.e. the text before the next heading) is checked. 5190 5191 CONDITIONS is a list of symbols, boolean OR is used to combine the results 5192 from different tests. Valid conditions are: 5193 5194 scheduled Check if there is a scheduled cookie 5195 notscheduled Check if there is no scheduled cookie 5196 deadline Check if there is a deadline 5197 notdeadline Check if there is no deadline 5198 timestamp Check if there is a timestamp (also deadline or scheduled) 5199 nottimestamp Check if there is no timestamp (also deadline or scheduled) 5200 regexp Check if regexp matches 5201 notregexp Check if regexp does not match. 5202 todo Check if TODO keyword matches 5203 nottodo Check if TODO keyword does not match 5204 5205 The regexp is taken from the conditions list, and must come right 5206 after the `regexp' or `notregexp' element. 5207 5208 `todo' and `nottodo' accept as an argument a list of todo 5209 keywords, which may include \"*\" to match any todo keyword. 5210 5211 (org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\")) 5212 5213 would skip all entries with \"TODO\" or \"WAITING\" keywords. 5214 5215 Instead of a list, a keyword class may be given. For example: 5216 5217 (org-agenda-skip-entry-if \\='nottodo \\='done) 5218 5219 would skip entries that haven't been marked with any of \"DONE\" 5220 keywords. Possible classes are: `todo', `done', `any'. 5221 5222 If any of these conditions is met, this function returns the end point of 5223 the entity, causing the search to continue from there. This is a function 5224 that can be put into `org-agenda-skip-function' for the duration of a command." 5225 (org-back-to-heading t) 5226 (let* (;; (beg (point)) 5227 (end (if subtree (save-excursion (org-end-of-subtree t) (point)) 5228 (org-entry-end-position))) 5229 (planning-end (if subtree end (line-end-position 2))) 5230 m) 5231 (and 5232 (or (and (memq 'scheduled conditions) 5233 (re-search-forward org-scheduled-time-regexp planning-end t)) 5234 (and (memq 'notscheduled conditions) 5235 (not 5236 (save-excursion 5237 (re-search-forward org-scheduled-time-regexp planning-end t)))) 5238 (and (memq 'deadline conditions) 5239 (re-search-forward org-deadline-time-regexp planning-end t)) 5240 (and (memq 'notdeadline conditions) 5241 (not 5242 (save-excursion 5243 (re-search-forward org-deadline-time-regexp planning-end t)))) 5244 (and (memq 'timestamp conditions) 5245 (re-search-forward org-ts-regexp end t)) 5246 (and (memq 'nottimestamp conditions) 5247 (not (save-excursion (re-search-forward org-ts-regexp end t)))) 5248 (and (setq m (memq 'regexp conditions)) 5249 (stringp (nth 1 m)) 5250 (re-search-forward (nth 1 m) end t)) 5251 (and (setq m (memq 'notregexp conditions)) 5252 (stringp (nth 1 m)) 5253 (not (save-excursion (re-search-forward (nth 1 m) end t)))) 5254 (and (or 5255 (setq m (memq 'nottodo conditions)) 5256 (setq m (memq 'todo-unblocked conditions)) 5257 (setq m (memq 'nottodo-unblocked conditions)) 5258 (setq m (memq 'todo conditions))) 5259 (org-agenda-skip-if-todo m end))) 5260 end))) 5261 5262 (defun org-agenda-skip-if-todo (args end) 5263 "Helper function for `org-agenda-skip-if', do not use it directly. 5264 ARGS is a list with first element either `todo', `nottodo', 5265 `todo-unblocked' or `nottodo-unblocked'. The remainder is either 5266 a list of TODO keywords, or a state symbol `todo' or `done' or 5267 `any'." 5268 (let ((todo-re 5269 (concat "^\\*+[ \t]+" 5270 (regexp-opt 5271 (pcase args 5272 (`(,_ todo) 5273 (org-delete-all org-done-keywords 5274 (copy-sequence org-todo-keywords-1))) 5275 (`(,_ done) org-done-keywords) 5276 (`(,_ any) org-todo-keywords-1) 5277 (`(,_ ,(pred atom)) 5278 (error "Invalid TODO class or type: %S" args)) 5279 (`(,_ ,(pred (member "*"))) org-todo-keywords-1) 5280 (`(,_ ,todo-list) todo-list)) 5281 'words)))) 5282 (pcase args 5283 (`(todo . ,_) 5284 (let (case-fold-search) (re-search-forward todo-re end t))) 5285 (`(nottodo . ,_) 5286 (not (let (case-fold-search) (re-search-forward todo-re end t)))) 5287 (`(todo-unblocked . ,_) 5288 (catch :unblocked 5289 (while (let (case-fold-search) (re-search-forward todo-re end t)) 5290 (when (org-entry-blocked-p) (throw :unblocked t))) 5291 nil)) 5292 (`(nottodo-unblocked . ,_) 5293 (catch :unblocked 5294 (while (let (case-fold-search) (re-search-forward todo-re end t)) 5295 (when (org-entry-blocked-p) (throw :unblocked nil))) 5296 t)) 5297 (`(,type . ,_) (error "Unknown TODO skip type: %S" type))))) 5298 5299 ;;;###autoload 5300 (defun org-agenda-list-stuck-projects (&rest _ignore) 5301 "Create agenda view for projects that are stuck. 5302 Stuck projects are project that have no next actions. For the definitions 5303 of what a project is and how to check if it stuck, customize the variable 5304 `org-stuck-projects'." 5305 (interactive) 5306 (let* ((org-agenda-overriding-header 5307 (or org-agenda-overriding-header "List of stuck projects: ")) 5308 (matcher (nth 0 org-stuck-projects)) 5309 (todo (nth 1 org-stuck-projects)) 5310 (tags (nth 2 org-stuck-projects)) 5311 (gen-re (org-string-nw-p (nth 3 org-stuck-projects))) 5312 (todo-wds 5313 (if (not (member "*" todo)) todo 5314 (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) 5315 (org-delete-all org-done-keywords-for-agenda 5316 (copy-sequence org-todo-keywords-for-agenda)))) 5317 (todo-re (and todo 5318 (format "^\\*+[ \t]+\\(%s\\)\\(?:[ \t]\\|$\\)" 5319 (mapconcat #'regexp-quote todo-wds "\\|")))) 5320 (tags-re (cond ((null tags) nil) 5321 ((member "*" tags) org-tag-line-re) 5322 (tags 5323 (let ((other-tags (format "\\(?:%s:\\)*" org-tag-re))) 5324 (concat org-outline-regexp-bol 5325 ".*?[ \t]:" 5326 other-tags 5327 (regexp-opt tags t) 5328 ":" other-tags "[ \t]*$"))) 5329 (t nil))) 5330 (re-list (delq nil (list todo-re tags-re gen-re))) 5331 (skip-re 5332 (if (null re-list) 5333 (error "Missing information to identify unstuck projects") 5334 (mapconcat #'identity re-list "\\|"))) 5335 (org-agenda-skip-function 5336 ;; Skip entry if `org-agenda-skip-regexp' matches anywhere 5337 ;; in the subtree. 5338 (lambda () 5339 (and (save-excursion 5340 (let ((case-fold-search nil)) 5341 (re-search-forward 5342 skip-re (save-excursion (org-end-of-subtree t)) t))) 5343 (progn (outline-next-heading) (point)))))) 5344 (org-tags-view nil matcher) 5345 (setq org-agenda-buffer-name (buffer-name)) 5346 (with-current-buffer org-agenda-buffer-name 5347 (setq org-agenda-redo-command 5348 `(org-agenda-list-stuck-projects ,current-prefix-arg)) 5349 (let ((inhibit-read-only t)) 5350 (add-text-properties 5351 (point-min) (point-max) 5352 `(org-redo-cmd ,org-agenda-redo-command)))))) 5353 5354 ;;; Diary integration 5355 5356 (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. 5357 (defvar diary-list-entries-hook) 5358 (defvar diary-time-regexp) 5359 (defvar diary-modify-entry-list-string-function) 5360 (defvar diary-file-name-prefix) 5361 (defvar diary-display-function) 5362 5363 (defun org-get-entries-from-diary (date) 5364 "Get the (Emacs Calendar) diary entries for DATE." 5365 (require 'diary-lib) 5366 (declare-function diary-fancy-display "diary-lib" ()) 5367 (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") 5368 (diary-display-function #'diary-fancy-display) 5369 (pop-up-frames nil) 5370 (diary-list-entries-hook 5371 (cons 'org-diary-default-entry diary-list-entries-hook)) 5372 (diary-file-name-prefix nil) ; turn this feature off 5373 (diary-modify-entry-list-string-function 5374 #'org-modify-diary-entry-string) 5375 (diary-time-regexp (concat "^" diary-time-regexp)) 5376 entries 5377 (org-disable-agenda-to-diary t)) 5378 (save-excursion 5379 (save-window-excursion 5380 (diary-list-entries date 1))) 5381 (if (not (get-buffer diary-fancy-buffer)) 5382 (setq entries nil) 5383 (with-current-buffer diary-fancy-buffer 5384 (setq buffer-read-only nil) 5385 (if (zerop (buffer-size)) 5386 ;; No entries 5387 (setq entries nil) 5388 ;; Omit the date and other unnecessary stuff 5389 (org-agenda-cleanup-fancy-diary) 5390 ;; Add prefix to each line and extend the text properties 5391 (if (zerop (buffer-size)) 5392 (setq entries nil) 5393 (setq entries (buffer-substring (point-min) (- (point-max) 1))) 5394 (setq entries 5395 (with-temp-buffer 5396 (insert entries) (goto-char (point-min)) 5397 (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t) 5398 (unless (save-match-data (string-match diary-time-regexp (match-string 1))) 5399 (replace-match (concat "; " (match-string 1))))) 5400 (buffer-string))))) 5401 (set-buffer-modified-p nil) 5402 (kill-buffer diary-fancy-buffer))) 5403 (when entries 5404 (setq entries (org-split-string entries "\n")) 5405 (setq entries 5406 (mapcar 5407 (lambda (x) 5408 (setq x (org-agenda-format-item "" x nil "Diary" nil 'time)) 5409 ;; Extend the text properties to the beginning of the line 5410 (org-add-props x (text-properties-at (1- (length x)) x) 5411 'type "diary" 'date date 'face 'org-agenda-diary)) 5412 entries))))) 5413 5414 (defvar org-agenda-cleanup-fancy-diary-hook nil 5415 "Hook run when the fancy diary buffer is cleaned up.") 5416 5417 (defun org-agenda-cleanup-fancy-diary () 5418 "Remove unwanted stuff in buffer created by `diary-fancy-display'. 5419 This gets rid of the date, the underline under the date, and the 5420 dummy entry installed by Org mode to ensure non-empty diary for 5421 each date. It also removes lines that contain only whitespace." 5422 (goto-char (point-min)) 5423 (if (looking-at ".*?:[ \t]*") 5424 (progn 5425 (replace-match "") 5426 (re-search-forward "\n=+$" nil t) 5427 (replace-match "") 5428 (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) 5429 (re-search-forward "\n=+$" nil t) 5430 (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) 5431 (goto-char (point-min)) 5432 (while (re-search-forward "^ +\n" nil t) 5433 (replace-match "")) 5434 (goto-char (point-min)) 5435 (when (re-search-forward "^Org mode dummy\n?" nil t) 5436 (replace-match "")) 5437 (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) 5438 5439 (defun org-modify-diary-entry-string (string) 5440 "Add text properties to string, allowing Org to act on it." 5441 (org-add-props string nil 5442 'mouse-face 'highlight 5443 'help-echo (if buffer-file-name 5444 (format "mouse-2 or RET jump to diary file %s" 5445 (abbreviate-file-name buffer-file-name)) 5446 "") 5447 'org-agenda-diary-link t 5448 'org-marker (org-agenda-new-marker (line-beginning-position)))) 5449 5450 (defun org-diary-default-entry () 5451 "Add a dummy entry to the diary. 5452 Needed to avoid empty dates which mess up holiday display." 5453 ;; Catch the error if dealing with the new add-to-diary-alist 5454 (when org-disable-agenda-to-diary 5455 (diary-add-to-list original-date "Org mode dummy" ""))) 5456 5457 (defvar org-diary-last-run-time nil) 5458 5459 ;;;###autoload 5460 (defun org-diary (&rest args) 5461 "Return diary information from org files. 5462 This function can be used in a \"sexp\" diary entry in the Emacs calendar. 5463 It accesses org files and extracts information from those files to be 5464 listed in the diary. The function accepts arguments specifying what 5465 items should be listed. For a list of arguments allowed here, see the 5466 variable `org-agenda-entry-types'. 5467 5468 The call in the diary file should look like this: 5469 5470 &%%(org-diary) ~/path/to/some/orgfile.org 5471 5472 Use a separate line for each org file to check. Or, if you omit the file name, 5473 all files listed in `org-agenda-files' will be checked automatically: 5474 5475 &%%(org-diary) 5476 5477 If you don't give any arguments (as in the example above), the default value 5478 of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). 5479 So the example above may also be written as 5480 5481 &%%(org-diary :deadline :timestamp :sexp :scheduled) 5482 5483 The function expects the lisp variables `entry' and `date' to be provided 5484 by the caller, because this is how the calendar works. Don't use this 5485 function from a program - use `org-agenda-get-day-entries' instead." 5486 (with-no-warnings (defvar date) (defvar entry)) 5487 (when (> (- (float-time) 5488 org-agenda-last-marker-time) 5489 5) 5490 ;; I am not sure if this works with sticky agendas, because the marker 5491 ;; list is then no longer a global variable. 5492 (org-agenda-reset-markers)) 5493 (org-compile-prefix-format 'agenda) 5494 (org-set-sorting-strategy 'agenda) 5495 (setq args (or args org-agenda-entry-types)) 5496 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) 5497 (list entry) 5498 (org-agenda-files t))) 5499 (time (float-time)) 5500 file rtn results) 5501 (when (or (not org-diary-last-run-time) 5502 (> (- time 5503 org-diary-last-run-time) 5504 3)) 5505 (org-agenda-prepare-buffers files)) 5506 (setq org-diary-last-run-time time) 5507 ;; If this is called during org-agenda, don't return any entries to 5508 ;; the calendar. Org Agenda will list these entries itself. 5509 (when org-disable-agenda-to-diary (setq files nil)) 5510 (while (setq file (pop files)) 5511 (setq rtn (apply #'org-agenda-get-day-entries file date args)) 5512 (setq results (append results rtn))) 5513 (when results 5514 (setq results 5515 (mapcar (lambda (i) (replace-regexp-in-string 5516 org-link-bracket-re "\\2" i)) 5517 results)) 5518 (concat (org-agenda-finalize-entries results) "\n")))) 5519 5520 ;;; Agenda entry finders 5521 5522 (defun org-agenda--timestamp-to-absolute (&rest args) 5523 "Call `org-time-string-to-absolute' with ARGS. 5524 However, throw `:skip' whenever an error is raised." 5525 (condition-case e 5526 (apply #'org-time-string-to-absolute args) 5527 (org-diary-sexp-no-match (throw :skip nil)) 5528 (error 5529 (message "%s; Skipping entry" (error-message-string e)) 5530 (throw :skip nil)))) 5531 5532 (defun org-agenda-get-day-entries (file date &rest args) 5533 "Does the work for `org-diary' and `org-agenda'. 5534 FILE is the path to a file to be checked for entries. DATE is date like 5535 the one returned by `calendar-current-date'. ARGS are symbols indicating 5536 which kind of entries should be extracted. For details about these, see 5537 the documentation of `org-diary'." 5538 (let* ((org-startup-folded nil) 5539 (org-startup-align-all-tables nil) 5540 (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file) 5541 (error "No such file %s" file)))) 5542 (if (not buffer) 5543 ;; If file does not exist, signal it in diary nonetheless. 5544 (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) 5545 (with-current-buffer buffer 5546 (unless (derived-mode-p 'org-mode) 5547 (error "Agenda file %s is not in Org mode" file)) 5548 (setq org-agenda-buffer (or org-agenda-buffer buffer)) 5549 (setf org-agenda-current-date date) 5550 (save-excursion 5551 (save-restriction 5552 (if (eq buffer org-agenda-restrict) 5553 (narrow-to-region org-agenda-restrict-begin 5554 org-agenda-restrict-end) 5555 (widen)) 5556 ;; Rationalize ARGS. Also make sure `:deadline' comes 5557 ;; first in order to populate DEADLINES before passing it. 5558 ;; 5559 ;; We use `delq' since `org-uniquify' duplicates ARGS, 5560 ;; guarding us from modifying `org-agenda-entry-types'. 5561 (setf args (org-uniquify (or args org-agenda-entry-types))) 5562 (when (and (memq :scheduled args) (memq :scheduled* args)) 5563 (setf args (delq :scheduled* args))) 5564 (cond 5565 ((memq :deadline args) 5566 (setf args (cons :deadline 5567 (delq :deadline (delq :deadline* args))))) 5568 ((memq :deadline* args) 5569 (setf args (cons :deadline* (delq :deadline* args))))) 5570 ;; Collect list of headlines. Return them flattened. 5571 (let ((case-fold-search nil) results deadlines) 5572 (org-dlet 5573 ((date date)) 5574 (dolist (arg args (apply #'nconc (nreverse results))) 5575 (pcase arg 5576 ((and :todo (guard (org-agenda-today-p date))) 5577 (push (org-agenda-get-todos) results)) 5578 (:timestamp 5579 (push (org-agenda-get-blocks) results) 5580 (push (org-agenda-get-timestamps deadlines) results)) 5581 (:sexp 5582 (push (org-agenda-get-sexps) results)) 5583 (:scheduled 5584 (push (org-agenda-get-scheduled deadlines) results)) 5585 (:scheduled* 5586 (push (org-agenda-get-scheduled deadlines t) results)) 5587 (:closed 5588 (push (org-agenda-get-progress) results)) 5589 (:deadline 5590 (setf deadlines (org-agenda-get-deadlines)) 5591 (push deadlines results)) 5592 (:deadline* 5593 (setf deadlines (org-agenda-get-deadlines t)) 5594 (push deadlines results)))))))))))) 5595 5596 (defsubst org-em (x y list) 5597 "Is X or Y a member of LIST?" 5598 (or (memq x list) (memq y list))) 5599 5600 (defvar org-heading-keyword-regexp-format) ; defined in org.el 5601 (defvar org-agenda-sorting-strategy-selected nil) 5602 5603 (defun org-agenda-entry-get-agenda-timestamp (epom) 5604 "Retrieve timestamp information for sorting agenda views. 5605 Given an element, point, or marker EPOM, returns a cons cell of the 5606 timestamp and the timestamp type relevant for the sorting strategy in 5607 `org-agenda-sorting-strategy-selected'." 5608 (let (ts ts-date-type) 5609 (save-match-data 5610 (cond ((org-em 'scheduled-up 'scheduled-down 5611 org-agenda-sorting-strategy-selected) 5612 (setq ts (org-entry-get epom "SCHEDULED") 5613 ts-date-type " scheduled")) 5614 ((org-em 'deadline-up 'deadline-down 5615 org-agenda-sorting-strategy-selected) 5616 (setq ts (org-entry-get epom "DEADLINE") 5617 ts-date-type " deadline")) 5618 ((org-em 'ts-up 'ts-down 5619 org-agenda-sorting-strategy-selected) 5620 (setq ts (org-entry-get epom "TIMESTAMP") 5621 ts-date-type " timestamp")) 5622 ((org-em 'tsia-up 'tsia-down 5623 org-agenda-sorting-strategy-selected) 5624 (setq ts (org-entry-get epom "TIMESTAMP_IA") 5625 ts-date-type " timestamp_ia")) 5626 ((org-em 'timestamp-up 'timestamp-down 5627 org-agenda-sorting-strategy-selected) 5628 (setq ts (or (org-entry-get epom "SCHEDULED") 5629 (org-entry-get epom "DEADLINE") 5630 (org-entry-get epom "TIMESTAMP") 5631 (org-entry-get epom "TIMESTAMP_IA")) 5632 ts-date-type "")) 5633 (t (setq ts-date-type ""))) 5634 (cons (when ts (ignore-errors (org-time-string-to-absolute ts))) 5635 ts-date-type)))) 5636 5637 (defun org-agenda-get-todos () 5638 "Return the TODO information for agenda display." 5639 (let* ((props (list 'face nil 5640 'done-face 'org-agenda-done 5641 'org-not-done-regexp org-not-done-regexp 5642 'org-todo-regexp org-todo-regexp 5643 'org-complex-heading-regexp org-complex-heading-regexp 5644 'mouse-face 'highlight 5645 'help-echo 5646 (format "mouse-2 or RET jump to org file %s" 5647 (abbreviate-file-name buffer-file-name)))) 5648 (case-fold-search nil) 5649 (regexp (format org-heading-keyword-regexp-format 5650 (cond 5651 ((and org-select-this-todo-keyword 5652 (equal org-select-this-todo-keyword "*")) 5653 org-todo-regexp) 5654 (org-select-this-todo-keyword 5655 (concat "\\(" 5656 (mapconcat #'regexp-quote 5657 (org-split-string 5658 org-select-this-todo-keyword 5659 "|") 5660 "\\|") 5661 "\\)")) 5662 (t org-not-done-regexp)))) 5663 marker priority urgency category level tags todo-state 5664 ts-date ts-date-type ts-date-pair 5665 ee txt beg end inherited-tags todo-state-end-pos 5666 effort effort-minutes) 5667 (goto-char (point-min)) 5668 (while (re-search-forward regexp nil t) 5669 (catch :skip 5670 (save-match-data 5671 (forward-line 0) 5672 (org-agenda-skip) 5673 (setq beg (point) end (save-excursion (outline-next-heading) (point))) 5674 (unless (and (setq todo-state (org-get-todo-state)) 5675 (setq todo-state-end-pos (match-end 2))) 5676 (goto-char end) 5677 (throw :skip nil)) 5678 (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end) 5679 (goto-char (1+ beg)) 5680 (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) 5681 (throw :skip nil))) 5682 (goto-char (match-beginning 2)) 5683 (setq marker (org-agenda-new-marker (match-beginning 0)) 5684 category (save-match-data (org-get-category)) 5685 effort (save-match-data (or (get-text-property (point) 'effort) 5686 (org-entry-get (point) org-effort-property))) 5687 effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))) 5688 ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) 5689 ts-date (car ts-date-pair) 5690 ts-date-type (cdr ts-date-pair) 5691 txt (org-trim (buffer-substring (match-beginning 2) (match-end 0))) 5692 inherited-tags 5693 (or (eq org-agenda-show-inherited-tags 'always) 5694 (and (listp org-agenda-show-inherited-tags) 5695 (memq 'todo org-agenda-show-inherited-tags)) 5696 (and (eq org-agenda-show-inherited-tags t) 5697 (or (eq org-agenda-use-tag-inheritance t) 5698 (memq 'todo org-agenda-use-tag-inheritance)))) 5699 tags (org-get-tags nil (not inherited-tags)) 5700 level (make-string (org-reduced-level (org-outline-level)) ? ) 5701 txt (org-agenda-format-item 5702 "" 5703 (org-add-props txt nil 5704 'effort effort 5705 'effort-minutes effort-minutes) 5706 level category tags t) 5707 urgency (1+ (org-get-priority txt)) 5708 priority (org-get-priority txt)) 5709 (org-add-props txt props 5710 'org-marker marker 'org-hd-marker marker 5711 'priority priority 5712 'urgency urgency 5713 'effort effort 'effort-minutes effort-minutes 5714 'level level 5715 'ts-date ts-date 5716 'type (concat "todo" ts-date-type) 'todo-state todo-state) 5717 (push txt ee) 5718 (if org-agenda-todo-list-sublevels 5719 (goto-char todo-state-end-pos) 5720 (org-end-of-subtree 'invisible)))) 5721 (nreverse ee))) 5722 5723 (defun org-agenda-todo-custom-ignore-p (time n) 5724 "Check whether timestamp is farther away than n number of days. 5725 This function is invoked if `org-agenda-todo-ignore-deadlines', 5726 `org-agenda-todo-ignore-scheduled' or 5727 `org-agenda-todo-ignore-timestamp' is set to an integer." 5728 (let ((days (org-timestamp-to-now 5729 time org-agenda-todo-ignore-time-comparison-use-seconds))) 5730 (if (>= n 0) 5731 (>= days n) 5732 (<= days n)))) 5733 5734 ;;;###autoload 5735 (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item 5736 (&optional end) 5737 "Do we have a reason to ignore this TODO entry because it has a time stamp?" 5738 (when (or org-agenda-todo-ignore-with-date 5739 org-agenda-todo-ignore-scheduled 5740 org-agenda-todo-ignore-deadlines 5741 org-agenda-todo-ignore-timestamp) 5742 (setq end (or end (save-excursion (outline-next-heading) (point)))) 5743 (save-excursion 5744 (or (and org-agenda-todo-ignore-with-date 5745 (re-search-forward org-ts-regexp end t)) 5746 (and org-agenda-todo-ignore-scheduled 5747 (re-search-forward org-scheduled-time-regexp end t) 5748 (cond 5749 ((eq org-agenda-todo-ignore-scheduled 'future) 5750 (> (org-timestamp-to-now 5751 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5752 0)) 5753 ((eq org-agenda-todo-ignore-scheduled 'past) 5754 (<= (org-timestamp-to-now 5755 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5756 0)) 5757 ((numberp org-agenda-todo-ignore-scheduled) 5758 (org-agenda-todo-custom-ignore-p 5759 (match-string 1) org-agenda-todo-ignore-scheduled)) 5760 (t))) 5761 (and org-agenda-todo-ignore-deadlines 5762 (re-search-forward org-deadline-time-regexp end t) 5763 (cond 5764 ((eq org-agenda-todo-ignore-deadlines 'all) t) 5765 ((eq org-agenda-todo-ignore-deadlines 'far) 5766 (not (org-deadline-close-p (match-string 1)))) 5767 ((eq org-agenda-todo-ignore-deadlines 'future) 5768 (> (org-timestamp-to-now 5769 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5770 0)) 5771 ((eq org-agenda-todo-ignore-deadlines 'past) 5772 (<= (org-timestamp-to-now 5773 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5774 0)) 5775 ((numberp org-agenda-todo-ignore-deadlines) 5776 (org-agenda-todo-custom-ignore-p 5777 (match-string 1) org-agenda-todo-ignore-deadlines)) 5778 (t (org-deadline-close-p (match-string 1))))) 5779 (and org-agenda-todo-ignore-timestamp 5780 (let ((buffer (current-buffer)) 5781 (regexp 5782 (concat 5783 org-scheduled-time-regexp "\\|" org-deadline-time-regexp)) 5784 (start (point))) 5785 ;; Copy current buffer into a temporary one 5786 (with-temp-buffer 5787 (insert-buffer-substring buffer start end) 5788 (goto-char (point-min)) 5789 ;; Delete SCHEDULED and DEADLINE items 5790 (while (re-search-forward regexp end t) 5791 (delete-region (match-beginning 0) (match-end 0))) 5792 (goto-char (point-min)) 5793 ;; No search for timestamp left 5794 (when (re-search-forward org-ts-regexp nil t) 5795 (cond 5796 ((eq org-agenda-todo-ignore-timestamp 'future) 5797 (> (org-timestamp-to-now 5798 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5799 0)) 5800 ((eq org-agenda-todo-ignore-timestamp 'past) 5801 (<= (org-timestamp-to-now 5802 (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 5803 0)) 5804 ((numberp org-agenda-todo-ignore-timestamp) 5805 (org-agenda-todo-custom-ignore-p 5806 (match-string 1) org-agenda-todo-ignore-timestamp)) 5807 (t)))))))))) 5808 5809 (defun org-agenda-get-timestamps (&optional deadlines) 5810 "Return the date stamp information for agenda display. 5811 Optional argument DEADLINES is a list of deadline items to be 5812 displayed in agenda view." 5813 (with-no-warnings (defvar date)) 5814 (let* ((props (list 'face 'org-agenda-calendar-event 5815 'org-not-done-regexp org-not-done-regexp 5816 'org-todo-regexp org-todo-regexp 5817 'org-complex-heading-regexp org-complex-heading-regexp 5818 'mouse-face 'highlight 5819 'help-echo 5820 (format "mouse-2 or RET jump to Org file %s" 5821 (abbreviate-file-name buffer-file-name)))) 5822 (current (calendar-absolute-from-gregorian date)) 5823 (today (org-today)) 5824 (deadline-position-alist 5825 (mapcar (lambda (d) 5826 (let ((m (get-text-property 0 'org-hd-marker d))) 5827 (and m (marker-position m)))) 5828 deadlines)) 5829 ;; Match timestamps set to current date, timestamps with 5830 ;; a repeater, and S-exp timestamps. 5831 (regexp 5832 (concat 5833 (if org-agenda-include-inactive-timestamps "[[<]" "<") 5834 (regexp-quote 5835 (format-time-string 5836 "%Y-%m-%d" ; We do not use `org-time-stamp-format' to not demand day name in timestamps. 5837 (org-encode-time ; DATE bound by calendar 5838 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 5839 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" 5840 "\\|\\(<%%\\(([^>\n]+)\\)\\([^\n>]*\\)>\\)")) 5841 timestamp-items) 5842 (goto-char (point-min)) 5843 (while (re-search-forward regexp nil t) 5844 ;; Skip date ranges, scheduled and deadlines, which are handled 5845 ;; specially. Also skip timestamps before first headline as 5846 ;; there would be no entry to add to the agenda. Eventually, 5847 ;; ignore clock entries. 5848 (catch :skip 5849 (save-match-data 5850 (when (or (org-at-date-range-p t) 5851 (org-at-planning-p) 5852 (org-before-first-heading-p) 5853 (and org-agenda-include-inactive-timestamps 5854 (org-at-clock-log-p)) 5855 (not (org-at-timestamp-p 'agenda))) 5856 (throw :skip nil)) 5857 (org-agenda-skip (org-element-at-point))) 5858 (let* ((pos (match-beginning 0)) 5859 (repeat (match-string 1)) 5860 (sexp-entry (match-string 3)) 5861 (timestamp (if (or repeat sexp-entry) (match-string 0) 5862 (save-excursion 5863 (goto-char pos) 5864 (looking-at org-ts-regexp-both) 5865 (match-string 0)))) 5866 (todo-state (org-get-todo-state)) 5867 (warntime (org-entry-get (point) "APPT_WARNTIME" 'selective)) 5868 (done? (member todo-state org-done-keywords))) 5869 ;; Possibly skip done tasks. 5870 (when (and done? org-agenda-skip-timestamp-if-done) 5871 (throw :skip t)) 5872 ;; S-exp entry doesn't match current day: skip it. 5873 (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date))) 5874 (throw :skip nil)) 5875 (when repeat 5876 (let* ((past 5877 ;; A repeating time stamp is shown at its base 5878 ;; date and every repeated date up to TODAY. If 5879 ;; `org-agenda-prefer-last-repeat' is non-nil, 5880 ;; however, only the last repeat before today 5881 ;; (inclusive) is shown. 5882 (org-agenda--timestamp-to-absolute 5883 repeat 5884 (if (or (> current today) 5885 (eq org-agenda-prefer-last-repeat t) 5886 (member todo-state org-agenda-prefer-last-repeat)) 5887 today 5888 current) 5889 'past (current-buffer) pos)) 5890 (future 5891 ;; Display every repeated date past TODAY 5892 ;; (exclusive) unless 5893 ;; `org-agenda-show-future-repeats' is nil. If 5894 ;; this variable is set to `next', only display 5895 ;; the first repeated date after TODAY 5896 ;; (exclusive). 5897 (cond 5898 ((<= current today) past) 5899 ((not org-agenda-show-future-repeats) past) 5900 (t 5901 (let ((base (if (eq org-agenda-show-future-repeats 'next) 5902 (1+ today) 5903 current))) 5904 (org-agenda--timestamp-to-absolute 5905 repeat base 'future (current-buffer) pos)))))) 5906 (when (and (/= current past) (/= current future)) 5907 (throw :skip nil)))) 5908 (save-excursion 5909 (re-search-backward org-outline-regexp-bol nil t) 5910 ;; Possibly skip timestamp when a deadline is set. 5911 (when (and org-agenda-skip-timestamp-if-deadline-is-shown 5912 (assq (point) deadline-position-alist)) 5913 (throw :skip nil)) 5914 (let* ((category (org-get-category pos)) 5915 (effort (org-entry-get pos org-effort-property)) 5916 (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 5917 (inherited-tags 5918 (or (eq org-agenda-show-inherited-tags 'always) 5919 (and (consp org-agenda-show-inherited-tags) 5920 (memq 'agenda org-agenda-show-inherited-tags)) 5921 (and (eq org-agenda-show-inherited-tags t) 5922 (or (eq org-agenda-use-tag-inheritance t) 5923 (memq 'agenda 5924 org-agenda-use-tag-inheritance))))) 5925 (tags (org-get-tags nil (not inherited-tags))) 5926 (level (make-string (org-reduced-level (org-outline-level)) 5927 ?\s)) 5928 (head (and (looking-at "\\*+[ \t]+\\(.*\\)") 5929 (match-string 1))) 5930 (inactive? (= (char-after pos) ?\[)) 5931 (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p))) 5932 (item 5933 (org-agenda-format-item 5934 (and inactive? org-agenda-inactive-leader) 5935 (org-add-props head nil 5936 'effort effort 5937 'effort-minutes effort-minutes) 5938 level category tags timestamp org-ts-regexp habit?))) 5939 (org-add-props item props 5940 'urgency (if habit? 5941 (org-habit-get-urgency (org-habit-parse-todo)) 5942 (org-get-priority item)) 5943 'priority (org-get-priority item) 5944 'org-marker (org-agenda-new-marker pos) 5945 'org-hd-marker (org-agenda-new-marker) 5946 'date date 5947 'level level 5948 'effort effort 'effort-minutes effort-minutes 5949 'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat) 5950 current) 5951 'todo-state todo-state 5952 'warntime warntime 5953 'type "timestamp") 5954 (push item timestamp-items)))) 5955 (when org-agenda-skip-additional-timestamps-same-entry 5956 (outline-next-heading)))) 5957 (nreverse timestamp-items))) 5958 5959 (defun org-agenda-get-sexps () 5960 "Return the sexp information for agenda display." 5961 (require 'diary-lib) 5962 (with-no-warnings (defvar date) (defvar entry)) 5963 (let* ((props (list 'face 'org-agenda-calendar-sexp 5964 'mouse-face 'highlight 5965 'help-echo 5966 (format "mouse-2 or RET jump to org file %s" 5967 (abbreviate-file-name buffer-file-name)))) 5968 (regexp "^&?%%(") 5969 ;; FIXME: Is this `entry' binding intended to be dynamic, 5970 ;; so as to "hide" any current binding for it? 5971 marker category extra level ee txt tags entry 5972 result beg b sexp sexp-entry todo-state warntime inherited-tags 5973 effort effort-minutes) 5974 (goto-char (point-min)) 5975 (while (re-search-forward regexp nil t) 5976 (catch :skip 5977 ;; We do not run `org-agenda-skip' right away because every single sexp 5978 ;; in the buffer is matched here, unlike day-specific search 5979 ;; in ordinary timestamps. Most of the sexps will not match 5980 ;; the agenda day and it is quicker to run `org-agenda-skip' only for 5981 ;; matching sexps later on. 5982 (setq beg (match-beginning 0)) 5983 (goto-char (1- (match-end 0))) 5984 (setq b (point)) 5985 (forward-sexp 1) 5986 (setq sexp (buffer-substring b (point))) 5987 (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)") 5988 (buffer-substring 5989 (match-beginning 1) 5990 (save-excursion 5991 (goto-char (match-end 1)) 5992 (skip-chars-backward "[:blank:]") 5993 (point))) 5994 "")) 5995 (setq result (org-diary-sexp-entry sexp sexp-entry date)) 5996 (when result 5997 ;; Only check if entry should be skipped on matching sexps. 5998 (org-agenda-skip (org-element-at-point)) 5999 (setq marker (org-agenda-new-marker beg) 6000 level (make-string (org-reduced-level (org-outline-level)) ? ) 6001 category (org-get-category beg) 6002 effort (save-match-data (or (get-text-property (point) 'effort) 6003 (org-entry-get (point) org-effort-property))) 6004 inherited-tags 6005 (or (eq org-agenda-show-inherited-tags 'always) 6006 (and (listp org-agenda-show-inherited-tags) 6007 (memq 'agenda org-agenda-show-inherited-tags)) 6008 (and (eq org-agenda-show-inherited-tags t) 6009 (or (eq org-agenda-use-tag-inheritance t) 6010 (memq 'agenda org-agenda-use-tag-inheritance)))) 6011 tags (org-get-tags nil (not inherited-tags)) 6012 todo-state (org-get-todo-state) 6013 warntime (org-entry-get (point) "APPT_WARNTIME" 'selective) 6014 extra nil) 6015 (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6016 6017 (dolist (r (if (stringp result) 6018 (list result) 6019 result)) ;; we expect a list here 6020 (when (and org-agenda-diary-sexp-prefix 6021 (string-match org-agenda-diary-sexp-prefix r)) 6022 (setq extra (match-string 0 r) 6023 r (replace-match "" nil nil r))) 6024 (if (string-match "\\S-" r) 6025 (setq txt r) 6026 (setq txt "SEXP entry returned empty string")) 6027 (setq txt (org-agenda-format-item extra 6028 (org-add-props txt nil 6029 'effort effort 6030 'effort-minutes effort-minutes) 6031 level category tags 'time)) 6032 (org-add-props txt props 'org-marker marker 6033 'date date 'todo-state todo-state 6034 'effort effort 'effort-minutes effort-minutes 6035 'level level 'type "sexp" 'warntime warntime) 6036 (push txt ee))))) 6037 (nreverse ee))) 6038 6039 ;; Calendar sanity: define some functions that are independent of 6040 ;; `calendar-date-style'. 6041 (defun org-anniversary (year month day &optional mark) 6042 "Like `diary-anniversary', but with fixed (ISO) order of arguments." 6043 (with-no-warnings 6044 (let ((calendar-date-style 'iso)) 6045 (diary-anniversary year month day mark)))) 6046 (defun org-cyclic (N year month day &optional mark) 6047 "Like `diary-cyclic', but with fixed (ISO) order of arguments." 6048 (with-no-warnings 6049 (let ((calendar-date-style 'iso)) 6050 (diary-cyclic N year month day mark)))) 6051 (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark) 6052 "Like `diary-block', but with fixed (ISO) order of arguments." 6053 (with-no-warnings 6054 (let ((calendar-date-style 'iso)) 6055 (diary-block Y1 M1 D1 Y2 M2 D2 mark)))) 6056 (defun org-date (year month day &optional mark) 6057 "Like `diary-date', but with fixed (ISO) order of arguments." 6058 (with-no-warnings 6059 (let ((calendar-date-style 'iso)) 6060 (diary-date year month day mark)))) 6061 6062 ;; Define the `org-class' function 6063 (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks) 6064 "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. 6065 DAYNAME is a number between 0 (Sunday) and 6 (Saturday). 6066 SKIP-WEEKS is any number of ISO weeks in the block period for which the 6067 item should be skipped. If any of the SKIP-WEEKS arguments is the symbol 6068 `holidays', then any date that is known by the Emacs calendar to be a 6069 holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings, 6070 then those holidays will be skipped." 6071 (with-no-warnings (defvar date) (defvar entry)) 6072 (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1))) 6073 (date2 (calendar-absolute-from-gregorian (list m2 d2 y2))) 6074 (d (calendar-absolute-from-gregorian date)) 6075 (h (when skip-weeks (calendar-check-holidays date)))) 6076 (and 6077 (<= date1 d) 6078 (<= d date2) 6079 (= (calendar-day-of-week date) dayname) 6080 (or (not skip-weeks) 6081 (progn 6082 (require 'cal-iso) 6083 (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) 6084 (not (or (and h (memq 'holidays skip-weeks)) 6085 (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) 6086 entry))) 6087 6088 (defalias 'org-get-closed #'org-agenda-get-progress) 6089 (defun org-agenda-get-progress () 6090 "Return the logged TODO entries for agenda display." 6091 (with-no-warnings (defvar date)) 6092 (let* ((props (list 'mouse-face 'highlight 6093 'org-not-done-regexp org-not-done-regexp 6094 'org-todo-regexp org-todo-regexp 6095 'org-complex-heading-regexp org-complex-heading-regexp 6096 'help-echo 6097 (format "mouse-2 or RET jump to org file %s" 6098 (abbreviate-file-name buffer-file-name)))) 6099 (items (if (consp org-agenda-show-log-scoped) 6100 org-agenda-show-log-scoped 6101 (if (eq org-agenda-show-log-scoped 'clockcheck) 6102 '(clock) 6103 org-agenda-log-mode-items))) 6104 (parts 6105 (delq nil 6106 (list 6107 (when (memq 'closed items) (concat "\\<" org-closed-string)) 6108 (when (memq 'clock items) (concat "\\<" org-clock-string)) 6109 (when (memq 'state items) 6110 (format "- +State \"%s\".*?" org-todo-regexp))))) 6111 (parts-re (if parts (mapconcat #'identity parts "\\|") 6112 (error "`org-agenda-log-mode-items' is empty"))) 6113 (regexp (concat 6114 "\\(" parts-re "\\)" 6115 " *\\[" 6116 (regexp-quote 6117 (format-time-string 6118 "%Y-%m-%d" ; We do not use `org-time-stamp-format' to not demand day name in timestamps. 6119 (org-encode-time ; DATE bound by calendar 6120 0 0 0 (nth 1 date) (car date) (nth 2 date)))))) 6121 (org-agenda-search-headline-for-time nil) 6122 marker hdmarker priority category level tags closedp type 6123 statep clockp state ee txt extra timestr rest clocked inherited-tags 6124 effort effort-minutes) 6125 (goto-char (point-min)) 6126 (while (re-search-forward regexp nil t) 6127 (catch :skip 6128 (org-agenda-skip) 6129 (setq marker (org-agenda-new-marker (match-beginning 0)) 6130 closedp (equal (match-string 1) org-closed-string) 6131 statep (equal (string-to-char (match-string 1)) ?-) 6132 clockp (not (or closedp statep)) 6133 state (and statep (match-string 2)) 6134 category (save-match-data (org-get-category (match-beginning 0))) 6135 timestr (buffer-substring (match-beginning 0) (line-end-position)) 6136 effort (save-match-data (or (get-text-property (point) 'effort) 6137 (org-entry-get (point) org-effort-property)))) 6138 (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6139 (when (string-match org-ts-regexp-inactive timestr) 6140 ;; substring should only run to end of time stamp 6141 (setq rest (substring timestr (match-end 0)) 6142 timestr (substring timestr 0 (match-end 0))) 6143 (if (and (not closedp) (not statep) 6144 (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" 6145 rest)) 6146 (progn (setq timestr (concat (substring timestr 0 -1) 6147 "-" (match-string 1 rest) "]")) 6148 (setq clocked (match-string 2 rest))) 6149 (setq clocked "-"))) 6150 (save-excursion 6151 (setq extra 6152 (cond 6153 ((not org-agenda-log-mode-add-notes) nil) 6154 (statep 6155 (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") 6156 (match-string 1))) 6157 (clockp 6158 (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") 6159 (match-string 1))))) 6160 (if (not (re-search-backward org-outline-regexp-bol nil t)) 6161 (throw :skip nil) 6162 (goto-char (match-beginning 0)) 6163 (setq hdmarker (org-agenda-new-marker) 6164 inherited-tags 6165 (or (eq org-agenda-show-inherited-tags 'always) 6166 (and (listp org-agenda-show-inherited-tags) 6167 (memq 'todo org-agenda-show-inherited-tags)) 6168 (and (eq org-agenda-show-inherited-tags t) 6169 (or (eq org-agenda-use-tag-inheritance t) 6170 (memq 'todo org-agenda-use-tag-inheritance)))) 6171 tags (org-get-tags nil (not inherited-tags)) 6172 level (make-string (org-reduced-level (org-outline-level)) ? )) 6173 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 6174 (setq txt (match-string 1)) 6175 (when extra 6176 (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt) 6177 (setq txt (concat (substring txt 0 (match-beginning 1)) 6178 " - " extra " " (match-string 2 txt))) 6179 (setq txt (concat txt " - " extra)))) 6180 (setq txt (org-agenda-format-item 6181 (cond 6182 (closedp "Closed: ") 6183 (statep (concat "State: (" state ")")) 6184 (t (concat "Clocked: (" clocked ")"))) 6185 (org-add-props txt nil 6186 'effort effort 6187 'effort-minutes effort-minutes) 6188 level category tags timestr))) 6189 (setq type (cond (closedp "closed") 6190 (statep "state") 6191 (t "clock"))) 6192 (setq priority 100000) 6193 (org-add-props txt props 6194 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 6195 'urgency priority 'priority priority 'level level 6196 'effort effort 'effort-minutes effort-minutes 6197 'type type 'date date 6198 'undone-face 'org-warning 'done-face 'org-agenda-done) 6199 (push txt ee)) 6200 (goto-char (line-end-position)))) 6201 (nreverse ee))) 6202 6203 (defun org-agenda-show-clocking-issues () 6204 "Add overlays, showing issues with clocking. 6205 See also the user option `org-agenda-clock-consistency-checks'." 6206 (interactive) 6207 (let* ((pl org-agenda-clock-consistency-checks) 6208 (re (concat "^[ \t]*" 6209 org-clock-string 6210 "[ \t]+" 6211 "\\(\\[.*?\\]\\)" ; group 1 is first stamp 6212 "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second 6213 (tlstart 0.) 6214 (tlend 0.) 6215 (maxtime (org-duration-to-minutes 6216 (or (plist-get pl :max-duration) "24:00"))) 6217 (mintime (org-duration-to-minutes 6218 (or (plist-get pl :min-duration) 0))) 6219 (maxgap (org-duration-to-minutes 6220 ;; default 30:00 means never complain 6221 (or (plist-get pl :max-gap) "30:00"))) 6222 (gapok (mapcar #'org-duration-to-minutes 6223 (plist-get pl :gap-ok-around))) 6224 (def-face (or (plist-get pl :default-face) 6225 '((:background "DarkRed") (:foreground "white")))) 6226 issue face m te ts dt ov) 6227 (goto-char (point-min)) 6228 (while (re-search-forward " Clocked: +(\\(?:-\\|\\([0-9]+:[0-9]+\\)\\))" nil t) 6229 (setq issue nil face def-face) 6230 (catch 'next 6231 (setq m (org-get-at-bol 'org-marker) 6232 te nil ts nil) 6233 (unless (and m (markerp m)) 6234 (setq issue "No valid clock line") (throw 'next t)) 6235 (org-with-point-at m 6236 (save-excursion 6237 (goto-char (line-beginning-position)) 6238 (unless (looking-at re) 6239 (error "No valid Clock line") 6240 (throw 'next t)) 6241 (unless (match-end 3) 6242 (setq issue 6243 (format 6244 "No end time: (%s)" 6245 (org-duration-from-minutes 6246 (floor 6247 (- (float-time (org-current-time)) 6248 (float-time (org-time-string-to-time (match-string 1)))) 6249 60))) 6250 face (or (plist-get pl :no-end-time-face) face)) 6251 (throw 'next t)) 6252 (setq ts (match-string 1) 6253 te (match-string 3) 6254 ts (float-time (org-time-string-to-time ts)) 6255 te (float-time (org-time-string-to-time te)) 6256 dt (- te ts)))) 6257 (cond 6258 ((> dt (* 60 maxtime)) 6259 ;; a very long clocking chunk 6260 (setq issue (format "Clocking interval is very long: %s" 6261 (org-duration-from-minutes (floor dt 60))) 6262 face (or (plist-get pl :long-face) face))) 6263 ((< dt (* 60 mintime)) 6264 ;; a very short clocking chunk 6265 (setq issue (format "Clocking interval is very short: %s" 6266 (org-duration-from-minutes (floor dt 60))) 6267 face (or (plist-get pl :short-face) face))) 6268 ((and (> tlend 0) (< ts tlend)) 6269 ;; Two clock entries are overlapping 6270 (setq issue (format "Clocking overlap: %d minutes" 6271 (/ (- tlend ts) 60)) 6272 face (or (plist-get pl :overlap-face) face))) 6273 ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap)))) 6274 ;; There is a gap, lets see if we need to report it 6275 (unless (org-agenda-check-clock-gap tlend ts gapok) 6276 (setq issue (format "Clocking gap: %d minutes" 6277 (/ (- ts tlend) 60)) 6278 face (or (plist-get pl :gap-face) face)))) 6279 (t nil))) 6280 (setq tlend (or te tlend) tlstart (or ts tlstart)) 6281 (when issue 6282 ;; OK, there was some issue, add an overlay to show the issue 6283 (setq ov (make-overlay (line-beginning-position) (line-end-position))) 6284 (overlay-put ov 'before-string 6285 (concat 6286 (org-add-props 6287 (format "%-43s" (concat " " issue)) 6288 nil 6289 'face face) 6290 "\n")) 6291 (overlay-put ov 'evaporate t))))) 6292 6293 (defun org-agenda-check-clock-gap (t1 t2 ok-list) 6294 "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values." 6295 (catch 'exit 6296 (unless ok-list 6297 ;; there are no OK times for gaps... 6298 (throw 'exit nil)) 6299 (when (> (- (/ t2 36000) (/ t1 36000)) 24) 6300 ;; This is more than 24 hours, so it is OK. 6301 ;; because we have at least one OK time, that must be in the 6302 ;; 24 hour interval. 6303 (throw 'exit t)) 6304 ;; We have a shorter gap. 6305 ;; Now we have to get the minute of the day when these times are 6306 (let* ((t1dec (decode-time t1)) 6307 (t2dec (decode-time t2)) 6308 ;; compute the minute on the day 6309 (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec)))) 6310 (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec))))) 6311 (when (< min2 min1) 6312 ;; if min2 is smaller than min1, this means it is on the next day. 6313 ;; Wrap it to after midnight. 6314 (setq min2 (+ min2 1440))) 6315 ;; Now check if any of the OK times is in the gap 6316 (mapc (lambda (x) 6317 ;; Wrap the time to after midnight if necessary 6318 (when (< x min1) (setq x (+ x 1440))) 6319 ;; Check if in interval 6320 (and (<= min1 x) (>= min2 x) (throw 'exit t))) 6321 ok-list) 6322 ;; Nope, this gap is not OK 6323 nil))) 6324 6325 (defun org-agenda-get-deadlines (&optional with-hour) 6326 "Return the deadline information for agenda display. 6327 When WITH-HOUR is non-nil, only return deadlines with an hour 6328 specification like [h]h:mm." 6329 (with-no-warnings (defvar date)) 6330 (let* ((props (list 'mouse-face 'highlight 6331 'org-not-done-regexp org-not-done-regexp 6332 'org-todo-regexp org-todo-regexp 6333 'org-complex-heading-regexp org-complex-heading-regexp 6334 'help-echo 6335 (format "mouse-2 or RET jump to org file %s" 6336 (abbreviate-file-name buffer-file-name)))) 6337 (regexp (if with-hour 6338 org-deadline-time-hour-regexp 6339 org-deadline-time-regexp)) 6340 (today (org-today)) 6341 (today? (org-agenda-today-p date)) ; DATE bound by calendar. 6342 (current (calendar-absolute-from-gregorian date)) 6343 deadline-items) 6344 (org-element-cache-map 6345 (lambda (el) 6346 (when (and (org-element-property :deadline el) 6347 ;; Only consider active timestamp values. 6348 (memq (org-element-property 6349 :type 6350 (org-element-property :deadline el)) 6351 '(diary active active-range)) 6352 (or (not with-hour) 6353 (org-element-property 6354 :hour-start 6355 (org-element-property :deadline el)) 6356 (org-element-property 6357 :hour-end 6358 (org-element-property :deadline el)))) 6359 (goto-char (org-element-contents-begin el)) 6360 (catch :skip 6361 (org-agenda-skip el) 6362 (let* ((s (substring (org-element-property 6363 :raw-value 6364 (org-element-property :deadline el)) 6365 1 -1)) 6366 (pos (save-excursion 6367 (goto-char (org-element-contents-begin el)) 6368 ;; We intentionally leave NOERROR 6369 ;; argument in `re-search-forward' nil. If 6370 ;; the search fails here, something went 6371 ;; wrong and we are looking at 6372 ;; non-matching headline. 6373 (re-search-forward regexp (line-end-position)) 6374 (1- (match-beginning 1)))) 6375 (todo-state (org-element-property :todo-keyword el)) 6376 (done? (eq 'done (org-element-property :todo-type el))) 6377 (sexp? (eq 'diary 6378 (org-element-property 6379 :type (org-element-property :deadline el)))) 6380 ;; DEADLINE is the deadline date for the entry. It is 6381 ;; either the base date or the last repeat, according 6382 ;; to `org-agenda-prefer-last-repeat'. 6383 (deadline 6384 (cond 6385 (sexp? (org-agenda--timestamp-to-absolute s current)) 6386 ((or (eq org-agenda-prefer-last-repeat t) 6387 (member todo-state org-agenda-prefer-last-repeat)) 6388 (org-agenda--timestamp-to-absolute 6389 s today 'past (current-buffer) pos)) 6390 (t (org-agenda--timestamp-to-absolute s)))) 6391 ;; REPEAT is the future repeat closest from CURRENT, 6392 ;; according to `org-agenda-show-future-repeats'. If 6393 ;; the latter is nil, or if the time stamp has no 6394 ;; repeat part, default to DEADLINE. 6395 (repeat 6396 (cond 6397 (sexp? deadline) 6398 ((<= current today) deadline) 6399 ((not org-agenda-show-future-repeats) deadline) 6400 (t 6401 (let ((base (if (eq org-agenda-show-future-repeats 'next) 6402 (1+ today) 6403 current))) 6404 (org-agenda--timestamp-to-absolute 6405 s base 'future (current-buffer) pos))))) 6406 (diff (- deadline current)) 6407 (max-warning-days 6408 (let ((scheduled 6409 (and org-agenda-skip-deadline-prewarning-if-scheduled 6410 (org-element-property 6411 :raw-value 6412 (org-element-property :scheduled el))))) 6413 (cond 6414 ((not scheduled) most-positive-fixnum) 6415 ;; The current item has a scheduled date, so 6416 ;; evaluate its prewarning lead time. 6417 ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) 6418 ;; Use global prewarning-restart lead time. 6419 org-agenda-skip-deadline-prewarning-if-scheduled) 6420 ((eq org-agenda-skip-deadline-prewarning-if-scheduled 6421 'pre-scheduled) 6422 ;; Set pre-warning to no earlier than SCHEDULED. 6423 (min (- deadline 6424 (org-agenda--timestamp-to-absolute scheduled)) 6425 org-deadline-warning-days)) 6426 ;; Set pre-warning to deadline. 6427 (t 0)))) 6428 (warning-days (min max-warning-days (org-get-wdays s)))) 6429 (cond 6430 ;; Only display deadlines at their base date, at future 6431 ;; repeat occurrences or in today agenda. 6432 ((= current deadline) nil) 6433 ((= current repeat) nil) 6434 ((not today?) (throw :skip nil)) 6435 ;; Upcoming deadline: display within warning period WARNING-DAYS. 6436 ((> deadline current) (when (> diff warning-days) (throw :skip nil))) 6437 ;; Overdue deadline: warn about it for 6438 ;; `org-deadline-past-days' duration. 6439 (t (when (< org-deadline-past-days (- diff)) (throw :skip nil)))) 6440 ;; Possibly skip done tasks. 6441 (when (and done? 6442 (or org-agenda-skip-deadline-if-done 6443 (/= deadline current))) 6444 (throw :skip nil)) 6445 (save-excursion 6446 (goto-char (org-element-begin el)) 6447 (let* ((category (org-get-category)) 6448 (effort (save-match-data (or (get-text-property (point) 'effort) 6449 (org-element-property (intern (concat ":" (upcase org-effort-property))) el)))) 6450 (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6451 (level (make-string (org-element-property :level el) 6452 ?\s)) 6453 (head (save-excursion 6454 (goto-char (org-element-begin el)) 6455 (re-search-forward org-outline-regexp-bol) 6456 (buffer-substring-no-properties (point) (line-end-position)))) 6457 (inherited-tags 6458 (or (eq org-agenda-show-inherited-tags 'always) 6459 (and (listp org-agenda-show-inherited-tags) 6460 (memq 'agenda org-agenda-show-inherited-tags)) 6461 (and (eq org-agenda-show-inherited-tags t) 6462 (or (eq org-agenda-use-tag-inheritance t) 6463 (memq 'agenda 6464 org-agenda-use-tag-inheritance))))) 6465 (tags (org-get-tags el (not inherited-tags))) 6466 (time 6467 (cond 6468 ;; No time of day designation if it is only 6469 ;; a reminder. 6470 ((and (/= current deadline) (/= current repeat)) nil) 6471 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 6472 (concat (substring s (match-beginning 1)) " ")) 6473 (t 'time))) 6474 (item 6475 (org-agenda-format-item 6476 ;; Insert appropriate suffixes before deadlines. 6477 ;; Those only apply to today agenda. 6478 (pcase-let ((`(,now ,future ,past) 6479 org-agenda-deadline-leaders)) 6480 (cond 6481 ((and today? (< deadline today)) (format past (- diff))) 6482 ((and today? (> deadline today)) (format future diff)) 6483 (t now))) 6484 (org-add-props head nil 6485 'effort effort 6486 'effort-minutes effort-minutes) 6487 level category tags time)) 6488 (face (org-agenda-deadline-face 6489 (- 1 (/ (float diff) (max warning-days 1))))) 6490 (upcoming? (and today? (> deadline today))) 6491 (warntime (org-entry-get (point) "APPT_WARNTIME" 'selective))) 6492 (org-add-props item props 6493 'org-marker (org-agenda-new-marker pos) 6494 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 6495 'warntime warntime 6496 'level level 6497 'effort effort 'effort-minutes effort-minutes 6498 'ts-date deadline 6499 'urgency 6500 ;; Adjust urgency to today reminders about deadlines. 6501 ;; Overdue deadlines get the highest urgency 6502 ;; increase, then imminent deadlines and eventually 6503 ;; more distant deadlines. 6504 (let ((adjust (if today? (- diff) 0))) 6505 (+ adjust (org-get-priority item))) 6506 'priority (org-get-priority item) 6507 'todo-state todo-state 6508 'type (if upcoming? "upcoming-deadline" "deadline") 6509 'date (if upcoming? date deadline) 6510 'face (if done? 'org-agenda-done face) 6511 'undone-face face 6512 'done-face 'org-agenda-done) 6513 (push item deadline-items))))))) 6514 :next-re regexp 6515 :fail-re regexp 6516 :narrow t) 6517 (nreverse deadline-items))) 6518 6519 (defun org-agenda-deadline-face (fraction) 6520 "Return the face to displaying a deadline item. 6521 FRACTION is what fraction of the head-warning time has passed." 6522 (assoc-default fraction org-agenda-deadline-faces #'<=)) 6523 6524 (defun org-agenda-get-scheduled (&optional deadlines with-hour) 6525 "Return the scheduled information for agenda display. 6526 Optional argument DEADLINES is a list of deadline items to be 6527 displayed in agenda view. When WITH-HOUR is non-nil, only return 6528 scheduled items with an hour specification like [h]h:mm." 6529 (with-no-warnings (defvar date)) 6530 (let* ((props (list 'org-not-done-regexp org-not-done-regexp 6531 'org-todo-regexp org-todo-regexp 6532 'org-complex-heading-regexp org-complex-heading-regexp 6533 'done-face 'org-agenda-done 6534 'mouse-face 'highlight 6535 'help-echo 6536 (format "mouse-2 or RET jump to Org file %s" 6537 (abbreviate-file-name buffer-file-name)))) 6538 (regexp (if with-hour 6539 org-scheduled-time-hour-regexp 6540 org-scheduled-time-regexp)) 6541 (today (org-today)) 6542 (todayp (org-agenda-today-p date)) ; DATE bound by calendar. 6543 (current (calendar-absolute-from-gregorian date)) 6544 (deadline-pos 6545 (mapcar (lambda (d) 6546 (let ((m (get-text-property 0 'org-hd-marker d))) 6547 (and m (marker-position m)))) 6548 deadlines)) 6549 scheduled-items) 6550 (org-element-cache-map 6551 (lambda (el) 6552 (when (and (org-element-property :scheduled el) 6553 ;; Only consider active timestamp values. 6554 (memq (org-element-property 6555 :type 6556 (org-element-property :scheduled el)) 6557 '(diary active active-range)) 6558 (or (not with-hour) 6559 (org-element-property 6560 :hour-start 6561 (org-element-property :scheduled el)) 6562 (org-element-property 6563 :hour-end 6564 (org-element-property :scheduled el)))) 6565 (goto-char (org-element-contents-begin el)) 6566 (catch :skip 6567 (org-agenda-skip el) 6568 (let* ((s (substring (org-element-property 6569 :raw-value 6570 (org-element-property :scheduled el)) 6571 1 -1)) 6572 (pos (save-excursion 6573 (goto-char (org-element-contents-begin el)) 6574 ;; We intentionally leave NOERROR 6575 ;; argument in `re-search-forward' nil. If 6576 ;; the search fails here, something went 6577 ;; wrong and we are looking at 6578 ;; non-matching headline. 6579 (re-search-forward regexp (line-end-position)) 6580 (1- (match-beginning 1)))) 6581 (todo-state (org-element-property :todo-keyword el)) 6582 (donep (eq 'done (org-element-property :todo-type el))) 6583 (sexp? (eq 'diary 6584 (org-element-property 6585 :type (org-element-property :scheduled el)))) 6586 ;; SCHEDULE is the scheduled date for the entry. It is 6587 ;; either the bare date or the last repeat, according 6588 ;; to `org-agenda-prefer-last-repeat'. 6589 (schedule 6590 (cond 6591 (sexp? (org-agenda--timestamp-to-absolute s current)) 6592 ((or (eq org-agenda-prefer-last-repeat t) 6593 (member todo-state org-agenda-prefer-last-repeat)) 6594 (org-agenda--timestamp-to-absolute 6595 s today 'past (current-buffer) pos)) 6596 (t (org-agenda--timestamp-to-absolute s)))) 6597 ;; REPEAT is the future repeat closest from CURRENT, 6598 ;; according to `org-agenda-show-future-repeats'. If 6599 ;; the latter is nil, or if the time stamp has no 6600 ;; repeat part, default to SCHEDULE. 6601 (repeat 6602 (cond 6603 (sexp? schedule) 6604 ((<= current today) schedule) 6605 ((not org-agenda-show-future-repeats) schedule) 6606 (t 6607 (let ((base (if (eq org-agenda-show-future-repeats 'next) 6608 (1+ today) 6609 current))) 6610 (org-agenda--timestamp-to-absolute 6611 s base 'future (current-buffer) pos))))) 6612 (diff (- current schedule)) 6613 (warntime (org-entry-get (point) "APPT_WARNTIME" 'selective)) 6614 (pastschedp (< schedule today)) 6615 (futureschedp (> schedule today)) 6616 (habitp (and (fboundp 'org-is-habit-p) 6617 (string= "habit" (org-element-property :STYLE el)))) 6618 (max-delay-days 6619 (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline 6620 (org-element-property 6621 :raw-value 6622 (org-element-property :deadline el))))) 6623 (cond 6624 ((not deadline) most-positive-fixnum) 6625 ;; The current item has a deadline date, so 6626 ;; evaluate its delay time. 6627 ((integerp org-agenda-skip-scheduled-delay-if-deadline) 6628 ;; Use global delay time. 6629 (- org-agenda-skip-scheduled-delay-if-deadline)) 6630 ((eq org-agenda-skip-scheduled-delay-if-deadline 6631 'post-deadline) 6632 ;; Set delay to no later than DEADLINE. 6633 (min (- schedule 6634 (org-agenda--timestamp-to-absolute deadline)) 6635 org-scheduled-delay-days)) 6636 (t 0)))) 6637 (delay-days 6638 (cond 6639 ;; Nullify delay when a repeater triggered already 6640 ;; and the delay is of the form --Xd. 6641 ((and (string-match-p "--[0-9]+[hdwmy]" s) 6642 (> schedule (org-agenda--timestamp-to-absolute s))) 6643 0) 6644 (t (min max-delay-days (org-get-wdays s t)))))) 6645 ;; Display scheduled items at base date (SCHEDULE), today if 6646 ;; scheduled before the current date, and at any repeat past 6647 ;; today. However, skip delayed items and items that have 6648 ;; been displayed for more than `org-scheduled-past-days'. 6649 (unless (and todayp 6650 habitp 6651 (bound-and-true-p org-habit-show-all-today)) 6652 (when (or (and (> delay-days 0) (< diff delay-days)) 6653 (> diff (or (and habitp org-habit-scheduled-past-days) 6654 org-scheduled-past-days)) 6655 (> schedule current) 6656 (and (/= current schedule) 6657 (/= current today) 6658 (/= current repeat))) 6659 (throw :skip nil))) 6660 ;; Possibly skip done tasks. 6661 (when (and donep 6662 (or org-agenda-skip-scheduled-if-done 6663 (/= schedule current))) 6664 (throw :skip nil)) 6665 ;; Skip entry if it already appears as a deadline, per 6666 ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This 6667 ;; doesn't apply to habits. 6668 (when (or org-agenda-skip-scheduled-repeats-after-deadline 6669 ;; FIXME: Backwards-compatibility. 6670 (eq org-agenda-skip-scheduled-if-deadline-is-shown 6671 'repeated-after-deadline)) 6672 (let ((deadline 6673 (time-to-days 6674 (when (org-element-property :deadline el) 6675 (org-time-string-to-time 6676 (org-element-interpret-data 6677 (org-element-property :deadline el))))))) 6678 (when (and (or (<= (org-agenda--timestamp-to-absolute s) deadline) 6679 (not (= schedule current))) 6680 (> current deadline)) 6681 (throw :skip nil)))) 6682 (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown 6683 ((guard 6684 (or (not (memq (line-beginning-position 0) deadline-pos)) 6685 habitp)) 6686 nil) 6687 (`not-today pastschedp) 6688 (`t t) 6689 (_ nil)) 6690 (throw :skip nil)) 6691 ;; Skip habits if `org-habit-show-habits' is nil, or if we 6692 ;; only show them for today. Also skip done habits. 6693 (when (and habitp 6694 (or donep 6695 (not (bound-and-true-p org-habit-show-habits)) 6696 (and (not todayp) 6697 (bound-and-true-p 6698 org-habit-show-habits-only-for-today)))) 6699 (throw :skip nil)) 6700 (save-excursion 6701 (goto-char (org-element-begin el)) 6702 (let* ((category (org-get-category)) 6703 (effort (save-match-data 6704 (or (get-text-property (point) 'effort) 6705 (org-element-property (intern (concat ":" (upcase org-effort-property))) el)))) 6706 (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6707 (inherited-tags 6708 (or (eq org-agenda-show-inherited-tags 'always) 6709 (and (listp org-agenda-show-inherited-tags) 6710 (memq 'agenda org-agenda-show-inherited-tags)) 6711 (and (eq org-agenda-show-inherited-tags t) 6712 (or (eq org-agenda-use-tag-inheritance t) 6713 (memq 'agenda 6714 org-agenda-use-tag-inheritance))))) 6715 (tags (org-get-tags el (not inherited-tags))) 6716 (level (make-string (org-element-property :level el) 6717 ?\s)) 6718 (head (save-excursion 6719 (goto-char (org-element-begin el)) 6720 (re-search-forward org-outline-regexp-bol) 6721 (buffer-substring (point) (line-end-position)))) 6722 (time 6723 (cond 6724 ;; No time of day designation if it is only a 6725 ;; reminder, except for habits, which always show 6726 ;; the time of day. Habits are an exception 6727 ;; because if there is a time of day, that is 6728 ;; interpreted to mean they should usually happen 6729 ;; then, even if doing the habit was missed. 6730 ((and 6731 (not habitp) 6732 (/= current schedule) 6733 (/= current repeat)) 6734 nil) 6735 ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) 6736 (concat (substring s (match-beginning 1)) " ")) 6737 (t 'time))) 6738 (item 6739 (org-agenda-format-item 6740 (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders)) 6741 ;; Show a reminder of a past scheduled today. 6742 (if (and todayp pastschedp) 6743 (format past diff) 6744 first)) 6745 (org-add-props head nil 6746 'effort effort 6747 'effort-minutes effort-minutes) 6748 level category tags time nil habitp)) 6749 (face (cond ((and (not habitp) pastschedp) 6750 'org-scheduled-previously) 6751 ((and habitp futureschedp) 6752 'org-agenda-done) 6753 (todayp 'org-scheduled-today) 6754 (t 'org-scheduled))) 6755 (habitp (and habitp (org-habit-parse-todo (org-element-begin el))))) 6756 (org-add-props item props 6757 'undone-face face 6758 'face (if donep 'org-agenda-done face) 6759 'org-marker (org-agenda-new-marker pos) 6760 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 6761 'type (if pastschedp "past-scheduled" "scheduled") 6762 'date (if pastschedp schedule date) 6763 'ts-date schedule 6764 'warntime warntime 6765 'level level 6766 'effort effort 'effort-minutes effort-minutes 6767 'urgency (if habitp (org-habit-get-urgency habitp) 6768 (+ 99 diff (org-get-priority item))) 6769 'priority (org-get-priority item) 6770 'org-habit-p habitp 6771 'todo-state todo-state) 6772 (push item scheduled-items))))))) 6773 :next-re regexp 6774 :fail-re regexp 6775 :narrow t) 6776 (nreverse scheduled-items))) 6777 6778 (defun org-agenda-get-blocks () 6779 "Return the date-range information for agenda display." 6780 (with-no-warnings (defvar date)) 6781 (let* ((props (list 'org-not-done-regexp org-not-done-regexp 6782 'org-todo-regexp org-todo-regexp 6783 'org-complex-heading-regexp org-complex-heading-regexp 6784 'mouse-face 'highlight 6785 'help-echo 6786 (format "mouse-2 or RET jump to org file %s" 6787 (abbreviate-file-name buffer-file-name)))) 6788 (regexp (if org-agenda-include-inactive-timestamps 6789 org-tr-regexp-both org-tr-regexp)) 6790 (d0 (calendar-absolute-from-gregorian date)) 6791 face marker hdmarker ee txt d1 d2 s1 s2 category level 6792 todo-state tags pos head donep inherited-tags effort 6793 effort-minutes inactive?) 6794 (goto-char (point-min)) 6795 (while (re-search-forward regexp nil t) 6796 (catch :skip 6797 (org-agenda-skip) 6798 (setq pos (point)) 6799 (setq inactive? (eq ?\[ (char-after (match-beginning 0)))) 6800 (let ((start-time (match-string 1)) 6801 (end-time (match-string 2))) 6802 (setq s1 (match-string 1) 6803 s2 (match-string 2) 6804 d1 (time-to-days 6805 (condition-case err 6806 (org-time-string-to-time s1) 6807 (error 6808 (error 6809 "Bad timestamp %S at %d in buffer %S\nError was: %s" 6810 s1 6811 pos 6812 (current-buffer) 6813 (error-message-string err))))) 6814 d2 (time-to-days 6815 (condition-case err 6816 (org-time-string-to-time s2) 6817 (error 6818 (error 6819 "Bad timestamp %S at %d in buffer %S\nError was: %s" 6820 s2 6821 pos 6822 (current-buffer) 6823 (error-message-string err)))))) 6824 (when (and (> (- d0 d1) -1) (> (- d2 d0) -1)) 6825 ;; Only allow days between the limits, because the normal 6826 ;; date stamps will catch the limits. 6827 (save-excursion 6828 (setq todo-state (org-get-todo-state)) 6829 (setq donep (member todo-state org-done-keywords)) 6830 (when (and donep org-agenda-skip-timestamp-if-done) 6831 (throw :skip t)) 6832 (setq face (if (= d1 d2) 6833 'org-agenda-calendar-event 6834 'org-agenda-calendar-daterange)) 6835 (setq marker (org-agenda-new-marker (point)) 6836 category (org-get-category)) 6837 (setq effort (save-match-data (or (get-text-property (point) 'effort) 6838 (org-entry-get (point) org-effort-property)))) 6839 (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort)))) 6840 (if (not (re-search-backward org-outline-regexp-bol nil t)) 6841 (throw :skip nil) 6842 (goto-char (match-beginning 0)) 6843 (setq hdmarker (org-agenda-new-marker (point)) 6844 inherited-tags 6845 (or (eq org-agenda-show-inherited-tags 'always) 6846 (and (listp org-agenda-show-inherited-tags) 6847 (memq 'agenda org-agenda-show-inherited-tags)) 6848 (and (eq org-agenda-show-inherited-tags t) 6849 (or (eq org-agenda-use-tag-inheritance t) 6850 (memq 'agenda org-agenda-use-tag-inheritance)))) 6851 tags (org-get-tags nil (not inherited-tags))) 6852 (setq level (make-string (org-reduced-level (org-outline-level)) ? )) 6853 (looking-at "\\*+[ \t]+\\(.*\\)") 6854 (setq head (match-string 1)) 6855 (let ((remove-re 6856 (if org-agenda-remove-timeranges-from-blocks 6857 (concat 6858 "<" (regexp-quote s1) ".*?>" 6859 "--" 6860 "<" (regexp-quote s2) ".*?>") 6861 nil))) 6862 (setq txt (org-agenda-format-item 6863 (concat 6864 (when inactive? org-agenda-inactive-leader) 6865 (format 6866 (nth (if (= d1 d2) 0 1) 6867 org-agenda-timerange-leaders) 6868 (1+ (- d0 d1)) (1+ (- d2 d1)))) 6869 (org-add-props head nil 6870 'effort effort 6871 'effort-minutes effort-minutes) 6872 level category tags 6873 (cond 6874 ((and (= d1 d0) (= d2 d0)) 6875 (concat "<" start-time ">--<" end-time ">")) 6876 ((= d1 d0) 6877 (concat "<" start-time ">")) 6878 ((= d2 d0) 6879 (concat "<" end-time ">"))) 6880 remove-re)))) 6881 (org-add-props txt props 6882 'face face 6883 'org-marker marker 'org-hd-marker hdmarker 6884 'type "block" 'date date 6885 'level level 6886 'effort effort 'effort-minutes effort-minutes 6887 'todo-state todo-state 6888 'urgency (org-get-priority txt) 6889 'priority (org-get-priority txt)) 6890 (push txt ee)))) 6891 (goto-char pos))) 6892 ;; Sort the entries by expiration date. 6893 (nreverse ee))) 6894 6895 ;;; Agenda presentation and sorting 6896 6897 (defvar org-prefix-has-time nil 6898 "A flag, set by `org-compile-prefix-format'. 6899 The flag is set if the currently compiled format contains a `%t'.") 6900 (defvar org-prefix-has-tag nil 6901 "A flag, set by `org-compile-prefix-format'. 6902 The flag is set if the currently compiled format contains a `%T'.") 6903 (defvar org-prefix-has-effort nil 6904 "A flag, set by `org-compile-prefix-format'. 6905 The flag is set if the currently compiled format contains a `%e'.") 6906 (defvar org-prefix-has-breadcrumbs nil 6907 "A flag, set by `org-compile-prefix-format'. 6908 The flag is set if the currently compiled format contains a `%b'.") 6909 (defvar org-prefix-category-length nil 6910 "Used by `org-compile-prefix-format' to remember the category field width.") 6911 (defvar org-prefix-category-max-length nil 6912 "Used by `org-compile-prefix-format' to remember the category field width.") 6913 6914 (defun org-agenda-get-category-icon (category) 6915 "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." 6916 (cl-dolist (entry org-agenda-category-icon-alist) 6917 (when (string-match-p (car entry) category) 6918 (if (listp (cadr entry)) 6919 (cl-return (cadr entry)) 6920 (cl-return (apply #'create-image (cdr entry))))))) 6921 6922 (defun org-agenda-format-item (extra txt &optional with-level with-category tags dotime 6923 remove-re habitp) 6924 "Format TXT to be inserted into the agenda buffer. 6925 In particular, add the prefix and corresponding text properties. 6926 6927 EXTRA must be a string to replace the `%s' specifier in the prefix format. 6928 WITH-LEVEL may be a string to replace the `%l' specifier. 6929 WITH-CATEGORY (a string, a symbol or nil) may be used to overrule the default 6930 category taken from local variable or file name. It will replace the `%c' 6931 specifier in the format. 6932 DOTIME, when non-nil, indicates that a time-of-day should be extracted from 6933 TXT for sorting of this entry, and for the `%t' specifier in the format. 6934 When DOTIME is a string, this string is searched for a time before TXT is. 6935 TAGS can be the tags of the headline. 6936 Any match of REMOVE-RE will be removed from TXT." 6937 ;; We keep the org-prefix-* variable values along with a compiled 6938 ;; formatter, so that multiple agendas existing at the same time do 6939 ;; not step on each other toes. 6940 ;; 6941 ;; It was inconvenient to make these variables buffer local in 6942 ;; Agenda buffers, because this function expects to be called with 6943 ;; the buffer where item comes from being current, and not agenda 6944 ;; buffer 6945 (let* ((bindings (car org-prefix-format-compiled)) 6946 (formatter (cadr org-prefix-format-compiled))) 6947 (cl-loop for (var value) in bindings 6948 do (set var value)) 6949 (save-match-data 6950 ;; Diary entries sometimes have extra whitespace at the beginning 6951 (setq txt (org-trim txt)) 6952 6953 ;; Fix the tags part in txt 6954 (setq txt (org-agenda-fix-displayed-tags 6955 txt tags 6956 org-agenda-show-inherited-tags 6957 org-agenda-hide-tags-regexp)) 6958 6959 (with-no-warnings 6960 ;; `time', `tag', `effort' are needed for the eval of the prefix format. 6961 ;; Based on what I see in `org-compile-prefix-format', I added 6962 ;; a few more. 6963 (defvar breadcrumbs) (defvar category) (defvar category-icon) 6964 (defvar effort) (defvar extra) 6965 (defvar level) (defvar tag) (defvar time)) 6966 (let* ((category (or with-category 6967 (if buffer-file-name 6968 (file-name-sans-extension 6969 (file-name-nondirectory buffer-file-name)) 6970 ""))) 6971 (full-category category) 6972 (category-icon (org-agenda-get-category-icon category)) 6973 (category-icon (if category-icon 6974 (propertize " " 'display category-icon) 6975 "")) 6976 (effort (and (not (string= txt "")) 6977 (get-text-property 1 'effort txt))) 6978 (tag (if tags (nth (1- (length tags)) tags) "")) 6979 (time-grid-trailing-characters (nth 2 org-agenda-time-grid)) 6980 (extra (or (and (not habitp) extra) "")) 6981 time 6982 (ts (when dotime (concat 6983 (if (stringp dotime) dotime "") 6984 (and org-agenda-search-headline-for-time 6985 ;; Do not search inside 6986 ;; timestamps. They are handled 6987 ;; separately. 6988 (replace-regexp-in-string 6989 org-ts-regexp-both "" 6990 txt))))) 6991 (time-of-day (and dotime (org-get-time-of-day ts))) 6992 stamp plain s0 s1 s2 rtn srp l 6993 duration breadcrumbs) 6994 (and (derived-mode-p 'org-mode) buffer-file-name 6995 (add-to-list 'org-agenda-contributing-files buffer-file-name)) 6996 (when (and dotime time-of-day) 6997 ;; Extract starting and ending time and move them to prefix 6998 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) 6999 (setq plain (string-match org-plain-time-of-day-regexp ts))) 7000 (setq s0 (match-string 0 ts) 7001 srp (and stamp (match-end 3)) 7002 s1 (match-string (if plain 1 2) ts) 7003 s2 (match-string (if plain 8 (if srp 4 6)) ts)) 7004 7005 ;; If the times are in TXT (not in DOTIMES), and the prefix will list 7006 ;; them, we might want to remove them there to avoid duplication. 7007 ;; The user can turn this off with a variable. 7008 (when (and org-prefix-has-time 7009 org-agenda-remove-times-when-in-prefix (or stamp plain) 7010 (string-match (concat (regexp-quote s0) " *") txt) 7011 (not (equal ?\] (string-to-char (substring txt (match-end 0))))) 7012 (if (eq org-agenda-remove-times-when-in-prefix 'beg) 7013 (= (match-beginning 0) 0) 7014 t)) 7015 (setq txt (replace-match "" nil nil txt)))) 7016 ;; Normalize the time(s) to 24 hour. 7017 (when s1 (setq s1 (org-get-time-of-day s1 t))) 7018 (when s2 (setq s2 (org-get-time-of-day s2 t))) 7019 ;; Try to set s2 if s1 and 7020 ;; `org-agenda-default-appointment-duration' are set 7021 (when (and s1 (not s2) org-agenda-default-appointment-duration) 7022 (setq s2 7023 (org-duration-from-minutes 7024 (+ (org-duration-to-minutes s1 t) 7025 org-agenda-default-appointment-duration) 7026 nil t))) 7027 ;; Compute the duration 7028 (when s2 7029 (setq duration (- (org-duration-to-minutes s2) 7030 (org-duration-to-minutes s1)))) 7031 ;; Format S1 and S2 for display. 7032 (when s1 (setq s1 (format "%5s" (org-get-time-of-day s1 'overtime)))) 7033 (when s2 (setq s2 (org-get-time-of-day s2 'overtime)))) 7034 (when (string-match org-tag-group-re txt) 7035 ;; Tags are in the string 7036 (if (or (eq org-agenda-remove-tags t) 7037 (and org-agenda-remove-tags 7038 org-prefix-has-tag)) 7039 (setq txt (replace-match "" t t txt)) 7040 (setq txt (replace-match 7041 (concat (make-string (max (- 50 (length txt)) 1) ?\ ) 7042 (match-string 1 txt)) 7043 t t txt)))) 7044 7045 (when remove-re 7046 (while (string-match remove-re txt) 7047 (setq txt (replace-match "" t t txt)))) 7048 7049 ;; Set org-heading property on `txt' to mark the start of the 7050 ;; heading. 7051 (add-text-properties 0 (length txt) '(org-heading t) txt) 7052 7053 ;; Prepare the variables needed in the eval of the compiled format 7054 (when org-prefix-has-breadcrumbs 7055 (setq breadcrumbs 7056 ;; When called from Org buffer, remain in position. 7057 ;; When called from Agenda buffer, jump to headline position first. 7058 (org-with-point-at (org-get-at-bol 'org-marker) 7059 (let ((s (if (derived-mode-p 'org-mode) 7060 (org-format-outline-path (org-get-outline-path) 7061 (1- (frame-width)) 7062 nil org-agenda-breadcrumbs-separator) 7063 ;; Not in Org buffer. This can happen, 7064 ;; for example, in 7065 ;; `org-agenda-add-time-grid-maybe' where 7066 ;; time grid does not correspond to a 7067 ;; particular heading. 7068 ""))) 7069 (if (equal "" s) "" (concat s org-agenda-breadcrumbs-separator)))))) 7070 (setq time (cond (s2 (concat 7071 (org-agenda-time-of-day-to-ampm-maybe s1) 7072 "-" (org-agenda-time-of-day-to-ampm-maybe s2) 7073 (when org-agenda-timegrid-use-ampm " "))) 7074 (s1 (concat 7075 (org-agenda-time-of-day-to-ampm-maybe s1) 7076 (if org-agenda-timegrid-use-ampm 7077 (concat time-grid-trailing-characters " ") 7078 time-grid-trailing-characters))) 7079 (t "")) 7080 category (if (symbolp category) (symbol-name category) category) 7081 level (or with-level "")) 7082 (if (string-match org-link-bracket-re category) 7083 (progn 7084 (setq l (string-width (or (match-string 2) (match-string 1)))) 7085 (when (< l (or org-prefix-category-length 0)) 7086 (setq category (copy-sequence category)) 7087 (org-add-props category nil 7088 'extra-space (make-string 7089 (- org-prefix-category-length l 1) ?\ )))) 7090 (when (and org-prefix-category-max-length 7091 (>= (length category) org-prefix-category-max-length)) 7092 (setq category (substring category 0 (1- org-prefix-category-max-length))))) 7093 ;; Evaluate the compiled format 7094 (setq rtn (concat (eval formatter t) txt)) 7095 7096 ;; And finally add the text properties 7097 (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) 7098 (org-add-props rtn nil 7099 ;; CATEGORY might be truncated. Store the full category in 7100 ;; the properties. 7101 'org-category full-category 7102 'tags tags 7103 'org-priority-highest org-priority-highest 7104 'org-priority-lowest org-priority-lowest 7105 'time-of-day time-of-day 7106 'duration duration 7107 'breadcrumbs breadcrumbs 7108 'txt txt 7109 'level level 7110 'time time 7111 'extra extra 7112 'format org-prefix-format-compiled 7113 'dotime dotime))))) 7114 7115 (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) 7116 "Remove tags string from TXT, and add a modified list of tags. 7117 The modified list may contain inherited tags, and tags matched by 7118 `org-agenda-hide-tags-regexp' will be removed." 7119 (when (or add-inherited hide-re) 7120 (when (string-match org-tag-group-re txt) 7121 (setq txt (substring txt 0 (match-beginning 0)))) 7122 (setq tags 7123 (delq nil 7124 (mapcar (lambda (tg) 7125 (if (or (and hide-re (string-match hide-re tg)) 7126 (and (not add-inherited) 7127 (get-text-property 0 'inherited tg))) 7128 nil 7129 tg)) 7130 tags))) 7131 (when tags 7132 (let ((have-i (get-text-property 0 'inherited (car tags))) 7133 i) 7134 (setq txt (concat txt " :" 7135 (mapconcat 7136 (lambda (x) 7137 (setq i (get-text-property 0 'inherited x)) 7138 (if (and have-i (not i)) 7139 (progn 7140 (setq have-i nil) 7141 (concat ":" x)) 7142 x)) 7143 tags ":") 7144 (if have-i "::" ":")))))) 7145 txt) 7146 7147 (defvar org-agenda-sorting-strategy) ;; because the def is in a let form 7148 7149 (defun org-agenda-add-time-grid-maybe (list ndays todayp) 7150 "Add a time-grid for agenda items which need it. 7151 7152 LIST is the list of agenda items formatted by `org-agenda-list'. 7153 NDAYS is the span of the current agenda view. 7154 TODAYP is t when the current agenda view is on today." 7155 (catch 'exit 7156 (cond ((not org-agenda-use-time-grid) (throw 'exit list)) 7157 ((and todayp (member 'today (car org-agenda-time-grid)))) 7158 ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) 7159 ((member 'weekly (car org-agenda-time-grid))) 7160 (t (throw 'exit list))) 7161 (let* ((have (delq nil (mapcar 7162 (lambda (x) (get-text-property 1 'time-of-day x)) 7163 list))) 7164 (string (nth 3 org-agenda-time-grid)) 7165 (gridtimes (nth 1 org-agenda-time-grid)) 7166 (req (car org-agenda-time-grid)) 7167 (remove (member 'remove-match req)) 7168 new time 7169 ;; We abuse `org-agenda-format-item' to format grid lines 7170 ;; here. Prevent it from adding default duration, if any 7171 ;; to the grid lines. 7172 (org-agenda-default-appointment-duration nil)) 7173 (when (and (member 'require-timed req) (not have)) 7174 ;; don't show empty grid 7175 (throw 'exit list)) 7176 (while (setq time (pop gridtimes)) 7177 (unless (and remove (member time have)) 7178 (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) 7179 (push (org-agenda-format-item 7180 nil string nil "" nil 7181 (concat (substring time 0 -2) ":" (substring time -2))) 7182 new) 7183 (put-text-property 7184 2 (length (car new)) 'face 'org-time-grid (car new)))) 7185 (when (and todayp org-agenda-show-current-time-in-grid) 7186 (push (org-agenda-format-item 7187 nil org-agenda-current-time-string nil "" nil 7188 (format-time-string "%H:%M ")) 7189 new) 7190 (put-text-property 7191 2 (length (car new)) 'face 'org-agenda-current-time (car new))) 7192 7193 (if (member 'time-up org-agenda-sorting-strategy-selected) 7194 (append new list) 7195 (append list new))))) 7196 7197 (defun org-compile-prefix-format (key) 7198 "Compile the prefix format into a Lisp form that can be evaluated. 7199 KEY is the agenda type (see `org-agenda-prefix-format'). 7200 The resulting form and associated variable bindings is returned 7201 and stored in the variable `org-prefix-format-compiled'." 7202 (setq org-prefix-has-time nil 7203 org-prefix-has-tag nil 7204 org-prefix-category-length nil 7205 org-prefix-has-effort nil 7206 org-prefix-has-breadcrumbs nil) 7207 (let ((s (cond 7208 ((stringp org-agenda-prefix-format) 7209 org-agenda-prefix-format) 7210 ((assq key org-agenda-prefix-format) 7211 (cdr (assq key org-agenda-prefix-format))) 7212 (t " %-12:c%?-12t% s"))) 7213 (start 0) 7214 varform vars var c f opt) ;; e 7215 (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+?)\\)" 7216 s start) 7217 (setq var (or (cdr (assoc (match-string 4 s) 7218 '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) 7219 ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs)))) 7220 'eval) 7221 c (or (match-string 3 s) "") 7222 opt (match-beginning 1) 7223 start (1+ (match-beginning 0))) 7224 (cl-case var 7225 (time (setq org-prefix-has-time t)) 7226 (tag (setq org-prefix-has-tag t)) 7227 (effort (setq org-prefix-has-effort t)) 7228 (breadcrumbs (setq org-prefix-has-breadcrumbs t))) 7229 (setq f (concat "%" (match-string 2 s) "s")) 7230 (when (eq var 'category) 7231 (setq org-prefix-category-length 7232 (floor (abs (string-to-number (match-string 2 s))))) 7233 (setq org-prefix-category-max-length 7234 (let ((x (match-string 2 s))) 7235 (save-match-data 7236 (and (string-match "\\.[0-9]+" x) 7237 (string-to-number (substring (match-string 0 x) 1))))))) 7238 (if (eq var 'eval) 7239 (setq varform `(format ,f (org-eval ,(read (substring s (match-beginning 4)))))) 7240 (if opt 7241 (setq varform 7242 `(if (member ,var '("" nil)) 7243 "" 7244 (format ,f (concat ,var ,c)))) 7245 (setq varform 7246 `(format ,f (if (member ,var '("" nil)) "" 7247 (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) 7248 (if (eq var 'eval) 7249 (setf (substring s (match-beginning 0) 7250 (+ (match-beginning 4) 7251 (length (format "%S" (read (substring s (match-beginning 4))))))) 7252 "%s") 7253 (setq s (replace-match "%s" t nil s))) 7254 (push varform vars)) 7255 (setq vars (nreverse vars)) 7256 (with-current-buffer (or org-agenda-buffer (current-buffer)) 7257 (setq org-prefix-format-compiled 7258 (list 7259 `((org-prefix-has-time ,org-prefix-has-time) 7260 (org-prefix-has-tag ,org-prefix-has-tag) 7261 (org-prefix-category-length ,org-prefix-category-length) 7262 (org-prefix-has-effort ,org-prefix-has-effort) 7263 (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs)) 7264 `(format ,s ,@vars)))))) 7265 7266 (defun org-set-sorting-strategy (key) 7267 (setq org-agenda-sorting-strategy-selected 7268 (if (symbolp (car org-agenda-sorting-strategy)) 7269 ;; the old format 7270 org-agenda-sorting-strategy 7271 (or (cdr (assq key org-agenda-sorting-strategy)) 7272 (cdr (assq 'agenda org-agenda-sorting-strategy)) 7273 '(time-up category-keep urgency-down))))) 7274 7275 (defun org-get-time-of-day (s &optional string) 7276 "Check string S for a time of day. 7277 7278 If found, return it as a military time number between 0 and 2400. 7279 If not found, return nil. 7280 7281 The optional STRING argument forces conversion into a 5 character wide string 7282 HH:MM. When it is `overtime', any time above 24:00 is turned into \"+H:MM\" 7283 where H:MM is the duration above midnight." 7284 (let ((case-fold-search t) 7285 (time-regexp 7286 (rx word-start 7287 (group (opt (any "012")) digit) ;group 1: hours 7288 (or (and ":" (group (any "012345") digit) ;group 2: minutes 7289 (opt (group (or "am" "pm")))) ;group 3: am/pm 7290 ;; Special "HHam/pm" case. 7291 (group-n 3 (or "am" "pm"))) 7292 word-end))) 7293 (save-match-data 7294 (when (and (string-match time-regexp s) 7295 (not (eq 'org-link (get-text-property 1 'face s)))) 7296 (let ((hours 7297 (let* ((ampm (and (match-end 3) (downcase (match-string 3 s)))) 7298 (am-p (equal ampm "am"))) 7299 (pcase (string-to-number (match-string 1 s)) 7300 ((and (guard (not ampm)) h) h) 7301 (12 (if am-p 0 12)) 7302 (h (+ h (if am-p 0 12)))))) 7303 (minutes 7304 (if (match-end 2) 7305 (string-to-number (match-string 2 s)) 7306 0))) 7307 (pcase string 7308 (`nil (+ minutes (* hours 100))) 7309 ((and `overtime 7310 (guard (or (> hours 24) 7311 (and (= hours 24) 7312 (> minutes 0))))) 7313 (format "+%d:%02d" (- hours 24) minutes)) 7314 ((guard org-agenda-time-leading-zero) 7315 (format "%02d:%02d" hours minutes)) 7316 (_ 7317 (format "%d:%02d" hours minutes)))))))) 7318 7319 (defvar org-agenda-before-sorting-filter-function nil 7320 "Function to be applied to agenda items prior to sorting. 7321 Prior to sorting also means just before they are inserted into the agenda. 7322 7323 To aid sorting, you may revisit the original entries and add more text 7324 properties which will later be used by the sorting functions. 7325 7326 The function should take a string argument, an agenda line. 7327 It has access to the text properties in that line, which contain among 7328 other things, the property `org-hd-marker' that points to the entry 7329 where the line comes from. Note that not all lines going into the agenda 7330 have this property, only most. 7331 7332 The function should return the modified string. It is probably best 7333 to ONLY change text properties. 7334 7335 You can also use this function as a filter, by returning nil for lines 7336 you don't want to have in the agenda at all. For this application, you 7337 could bind the variable in the options section of a custom command.") 7338 7339 (defun org-agenda-finalize-entries (list &optional type) 7340 "Sort, limit and concatenate the LIST of agenda items. 7341 The optional argument TYPE tells the agenda type." 7342 (let ((max-effort (cond ((listp org-agenda-max-effort) 7343 (cdr (assoc type org-agenda-max-effort))) 7344 (t org-agenda-max-effort))) 7345 (max-todo (cond ((listp org-agenda-max-todos) 7346 (cdr (assoc type org-agenda-max-todos))) 7347 (t org-agenda-max-todos))) 7348 (max-tags (cond ((listp org-agenda-max-tags) 7349 (cdr (assoc type org-agenda-max-tags))) 7350 (t org-agenda-max-tags))) 7351 (max-entries (cond ((listp org-agenda-max-entries) 7352 (cdr (assoc type org-agenda-max-entries))) 7353 (t org-agenda-max-entries)))) 7354 (when org-agenda-before-sorting-filter-function 7355 (setq list 7356 (delq nil 7357 (mapcar 7358 org-agenda-before-sorting-filter-function list)))) 7359 (setq list (mapcar #'org-agenda-highlight-todo list) 7360 list (mapcar #'identity (sort list #'org-entries-lessp))) 7361 (when max-effort 7362 (setq list (org-agenda-limit-entries 7363 list 'effort-minutes max-effort 7364 (lambda (e) (or e (if org-agenda-sort-noeffort-is-high 7365 32767 -1)))))) 7366 (when max-todo 7367 (setq list (org-agenda-limit-entries list 'todo-state max-todo))) 7368 (when max-tags 7369 (setq list (org-agenda-limit-entries list 'tags max-tags))) 7370 (when max-entries 7371 (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) 7372 (when (and org-agenda-dim-blocked-tasks org-blocker-hook) 7373 (setq list (mapcar #'org-agenda--mark-blocked-entry list))) 7374 (mapconcat #'identity list "\n"))) 7375 7376 (defun org-agenda-limit-entries (list prop limit &optional fn) 7377 "Limit the number of agenda entries." 7378 (let ((include (and limit (< limit 0)))) 7379 (if limit 7380 (let ((fun (or fn (lambda (p) (when p 1)))) 7381 (lim 0)) 7382 (delq nil 7383 (mapcar 7384 (lambda (e) 7385 (let ((pval (funcall 7386 fun (get-text-property (1- (length e)) 7387 prop e)))) 7388 (when pval (setq lim (+ lim pval))) 7389 (cond ((and pval (<= lim (abs limit))) e) 7390 ((and include (not pval)) e)))) 7391 list))) 7392 list))) 7393 7394 (defun org-agenda-limit-interactively (remove) 7395 "In agenda, interactively limit entries to various maximums." 7396 (interactive "P") 7397 (if remove 7398 (progn (setq org-agenda-max-entries nil 7399 org-agenda-max-todos nil 7400 org-agenda-max-tags nil 7401 org-agenda-max-effort nil) 7402 (org-agenda-redo)) 7403 (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) 7404 (msg (cond ((= max ?E) "How many minutes? ") 7405 ((= max ?e) "How many entries? ") 7406 ((= max ?t) "How many TODO entries? ") 7407 ((= max ?T) "How many tagged entries? ") 7408 (t (user-error "Wrong input")))) 7409 (num (string-to-number (read-from-minibuffer msg)))) 7410 (cond ((equal max ?e) 7411 (let ((org-agenda-max-entries num)) (org-agenda-redo))) 7412 ((equal max ?t) 7413 (let ((org-agenda-max-todos num)) (org-agenda-redo))) 7414 ((equal max ?T) 7415 (let ((org-agenda-max-tags num)) (org-agenda-redo))) 7416 ((equal max ?E) 7417 (let ((org-agenda-max-effort num)) (org-agenda-redo)))))) 7418 (org-agenda-fit-window-to-buffer)) 7419 7420 (defun org-agenda-highlight-todo (x) 7421 (let ((org-done-keywords org-done-keywords-for-agenda) 7422 (case-fold-search nil) 7423 re) 7424 (if (eq x 'line) 7425 (save-excursion 7426 (forward-line 0) 7427 (setq re (org-get-at-bol 'org-todo-regexp)) 7428 (goto-char (or (text-property-any (line-beginning-position) 7429 (line-end-position) 7430 'org-heading t) 7431 (point))) 7432 (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) 7433 (add-text-properties (match-beginning 0) (match-end 1) 7434 (list 'face (org-get-todo-face 1))) 7435 (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) 7436 (delete-region (match-beginning 1) (1- (match-end 0))) 7437 (goto-char (match-beginning 1)) 7438 (insert (format org-agenda-todo-keyword-format s))))) 7439 (let ((pl (text-property-any 0 (length x) 'org-heading t x))) 7440 (setq re (get-text-property 0 'org-todo-regexp x)) 7441 (when (and re 7442 ;; Test `pl' because if there's no heading content, 7443 ;; there's no point matching to highlight. Note 7444 ;; that if we didn't test `pl' first, and there 7445 ;; happened to be no keyword from `org-todo-regexp' 7446 ;; on this heading line, then the `equal' comparison 7447 ;; afterwards would spuriously succeed in the case 7448 ;; where `pl' is nil -- causing an args-out-of-range 7449 ;; error when we try to add text properties to text 7450 ;; that isn't there. 7451 pl 7452 (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") 7453 x pl) 7454 pl)) 7455 (add-text-properties 7456 (or (match-end 1) (match-end 0)) (match-end 0) 7457 (list 'face (org-get-todo-face (match-string 2 x))) 7458 x) 7459 (when (match-end 1) 7460 (setq x 7461 (concat 7462 (substring x 0 (match-end 1)) 7463 (unless (string= org-agenda-todo-keyword-format "") 7464 (format org-agenda-todo-keyword-format 7465 (match-string 2 x))) 7466 (unless (string= org-agenda-todo-keyword-format "") 7467 ;; Remove `display' property as the icon could leak 7468 ;; on the white space. 7469 (apply #'propertize " " (org-plist-delete (text-properties-at 0 x) 'display))) 7470 (substring x (match-end 3))))))) 7471 x))) 7472 7473 (defsubst org-cmp-values (a b property) 7474 "Compare the numeric value of text PROPERTY for string A and B." 7475 (let ((pa (or (get-text-property (1- (length a)) property a) 0)) 7476 (pb (or (get-text-property (1- (length b)) property b) 0))) 7477 (cond ((> pa pb) +1) 7478 ((< pa pb) -1)))) 7479 7480 (defsubst org-cmp-effort (a b) 7481 "Compare the effort values of string A and B." 7482 (let* ((def (if org-agenda-sort-noeffort-is-high 32767 -1)) 7483 ;; `effort-minutes' property is not directly accessible from 7484 ;; the strings, but is stored as a property in `txt'. 7485 (ea (or (get-text-property 7486 0 'effort-minutes (get-text-property 0 'txt a)) 7487 def)) 7488 (eb (or (get-text-property 7489 0 'effort-minutes (get-text-property 0 'txt b)) 7490 def))) 7491 (cond ((> ea eb) +1) 7492 ((< ea eb) -1)))) 7493 7494 (defsubst org-cmp-category (a b) 7495 "Compare the string values of categories of strings A and B." 7496 (let ((ca (or (get-text-property (1- (length a)) 'org-category a) "")) 7497 (cb (or (get-text-property (1- (length b)) 'org-category b) ""))) 7498 (cond ((org-string< ca cb) -1) 7499 ((org-string< cb ca) +1)))) 7500 7501 (defsubst org-cmp-todo-state (a b) 7502 "Compare the todo states of strings A and B." 7503 (let* ((ma (or (get-text-property 1 'org-marker a) 7504 (get-text-property 1 'org-hd-marker a))) 7505 (mb (or (get-text-property 1 'org-marker b) 7506 (get-text-property 1 'org-hd-marker b))) 7507 (fa (and ma (marker-buffer ma))) 7508 (fb (and mb (marker-buffer mb))) 7509 (todo-kwds 7510 (or (and fa (with-current-buffer fa org-todo-keywords-1)) 7511 (and fb (with-current-buffer fb org-todo-keywords-1)))) 7512 (ta (or (get-text-property 1 'todo-state a) "")) 7513 (tb (or (get-text-property 1 'todo-state b) "")) 7514 (la (- (length (member ta todo-kwds)))) 7515 (lb (- (length (member tb todo-kwds)))) 7516 (donepa (member ta org-done-keywords-for-agenda)) 7517 (donepb (member tb org-done-keywords-for-agenda))) 7518 (cond ((and donepa (not donepb)) -1) 7519 ((and (not donepa) donepb) +1) 7520 ((< la lb) -1) 7521 ((< lb la) +1)))) 7522 7523 (defsubst org-cmp-alpha (a b) 7524 "Compare the headlines, alphabetically." 7525 (let* ((pla (text-property-any 0 (length a) 'org-heading t a)) 7526 (plb (text-property-any 0 (length b) 'org-heading t b)) 7527 (ta (and pla (substring a pla))) 7528 (tb (and plb (substring b plb))) 7529 (case-fold-search nil)) 7530 (when pla 7531 (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") 7532 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") 7533 ta) 7534 (setq ta (substring ta (match-end 0)))) 7535 (setq ta (downcase ta))) 7536 (when plb 7537 (when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") 7538 "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") 7539 tb) 7540 (setq tb (substring tb (match-end 0)))) 7541 (setq tb (downcase tb))) 7542 (cond ((not (or ta tb)) nil) 7543 ((not ta) +1) 7544 ((not tb) -1) 7545 ((org-string< ta tb) -1) 7546 ((org-string< tb ta) +1)))) 7547 7548 (defsubst org-cmp-tag (a b) 7549 "Compare the string values of the first tags of A and B." 7550 (let ((ta (car (last (get-text-property 1 'tags a)))) 7551 (tb (car (last (get-text-property 1 'tags b))))) 7552 (cond ((not (or ta tb)) nil) 7553 ((not ta) +1) 7554 ((not tb) -1) 7555 ((funcall (or org-tags-sort-function #'org-string<) ta tb) -1) 7556 ((funcall (or org-tags-sort-function #'org-string<) tb ta) +1)))) 7557 7558 (defsubst org-cmp-time (a b) 7559 "Compare the time-of-day values of strings A and B." 7560 (let* ((def (if org-agenda-sort-notime-is-late 9901 -1)) 7561 (ta (or (get-text-property 1 'time-of-day a) def)) 7562 (tb (or (get-text-property 1 'time-of-day b) def))) 7563 (cond ((< ta tb) -1) 7564 ((< tb ta) +1)))) 7565 7566 (defsubst org-cmp-ts (a b type) 7567 "Compare the timestamps values of entries A and B. 7568 When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or 7569 \"timestamp_ia\", compare within each of these type. When TYPE 7570 is the empty string, compare all timestamps without respect of 7571 their type." 7572 (let* ((def (if org-agenda-sort-notime-is-late 99999999 -1)) 7573 (ta (or (and (string-match type (or (get-text-property 1 'type a) "")) 7574 (get-text-property 1 'ts-date a)) 7575 def)) 7576 (tb (or (and (string-match type (or (get-text-property 1 'type b) "")) 7577 (get-text-property 1 'ts-date b)) 7578 def))) 7579 (cond ((if ta (and tb (< ta tb)) tb) -1) 7580 ((if tb (and ta (< tb ta)) ta) +1)))) 7581 7582 (defsubst org-cmp-habit-p (a b) 7583 "Compare the todo states of strings A and B." 7584 (let ((ha (get-text-property 1 'org-habit-p a)) 7585 (hb (get-text-property 1 'org-habit-p b))) 7586 (cond ((and ha (not hb)) -1) 7587 ((and (not ha) hb) +1)))) 7588 7589 (defun org-entries-lessp (a b) 7590 "Predicate for sorting agenda entries." 7591 ;; The following variables will be used when the form is evaluated. 7592 ;; So even though the compiler complains, keep them. 7593 (let ((ss org-agenda-sorting-strategy-selected)) 7594 (org-dlet 7595 ((timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) 7596 (org-cmp-ts a b ""))) 7597 (timestamp-down (if timestamp-up (- timestamp-up) nil)) 7598 (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) 7599 (org-cmp-ts a b "scheduled"))) 7600 (scheduled-down (if scheduled-up (- scheduled-up) nil)) 7601 (deadline-up (and (org-em 'deadline-up 'deadline-down ss) 7602 (org-cmp-ts a b "deadline"))) 7603 (deadline-down (if deadline-up (- deadline-up) nil)) 7604 (tsia-up (and (org-em 'tsia-up 'tsia-down ss) 7605 (org-cmp-ts a b "timestamp_ia"))) 7606 (tsia-down (if tsia-up (- tsia-up) nil)) 7607 (ts-up (and (org-em 'ts-up 'ts-down ss) 7608 (org-cmp-ts a b "timestamp"))) 7609 (ts-down (if ts-up (- ts-up) nil)) 7610 (time-up (and (org-em 'time-up 'time-down ss) 7611 (org-cmp-time a b))) 7612 (time-down (if time-up (- time-up) nil)) 7613 (stats-up (and (org-em 'stats-up 'stats-down ss) 7614 (org-cmp-values a b 'org-stats))) 7615 (stats-down (if stats-up (- stats-up) nil)) 7616 (priority-up (and (org-em 'priority-up 'priority-down ss) 7617 (org-cmp-values a b 'priority))) 7618 (priority-down (if priority-up (- priority-up) nil)) 7619 (urgency-up (and (org-em 'urgency-up 'urgency-down ss) 7620 (org-cmp-values a b 'urgency))) 7621 (urgency-down (if urgency-up (- urgency-up) nil)) 7622 (effort-up (and (org-em 'effort-up 'effort-down ss) 7623 (org-cmp-effort a b))) 7624 (effort-down (if effort-up (- effort-up) nil)) 7625 (category-up (and (or (org-em 'category-up 'category-down ss) 7626 (memq 'category-keep ss)) 7627 (org-cmp-category a b))) 7628 (category-down (if category-up (- category-up) nil)) 7629 (category-keep (if category-up +1 nil)) 7630 (tag-up (and (org-em 'tag-up 'tag-down ss) 7631 (org-cmp-tag a b))) 7632 (tag-down (if tag-up (- tag-up) nil)) 7633 (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) 7634 (org-cmp-todo-state a b))) 7635 (todo-state-down (if todo-state-up (- todo-state-up) nil)) 7636 (habit-up (and (org-em 'habit-up 'habit-down ss) 7637 (org-cmp-habit-p a b))) 7638 (habit-down (if habit-up (- habit-up) nil)) 7639 (alpha-up (and (org-em 'alpha-up 'alpha-down ss) 7640 (org-cmp-alpha a b))) 7641 (alpha-down (if alpha-up (- alpha-up) nil)) 7642 (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) 7643 user-defined-up user-defined-down) 7644 (when (and need-user-cmp org-agenda-cmp-user-defined 7645 (functionp org-agenda-cmp-user-defined)) 7646 (setq user-defined-up 7647 (funcall org-agenda-cmp-user-defined a b) 7648 user-defined-down (if user-defined-up (- user-defined-up) nil))) 7649 (cdr (assoc 7650 (eval (cons 'or org-agenda-sorting-strategy-selected) t) 7651 '((-1 . t) (1 . nil) (nil . nil))))))) 7652 7653 ;;; Agenda restriction lock 7654 7655 (defvar org-agenda-restriction-lock-overlay (make-overlay 1 1) 7656 "Overlay to mark the headline to which agenda commands are restricted.") 7657 (overlay-put org-agenda-restriction-lock-overlay 7658 'face 'org-agenda-restriction-lock) 7659 (overlay-put org-agenda-restriction-lock-overlay 7660 'help-echo "Agendas are currently limited to this subtree.") 7661 (delete-overlay org-agenda-restriction-lock-overlay) 7662 7663 (defun org-agenda-set-restriction-lock-from-agenda (arg) 7664 "Set the restriction lock to the agenda item at point from within the agenda. 7665 When called with a `\\[universal-argument]' prefix, restrict to 7666 the file which contains the item. 7667 Argument ARG is the prefix argument." 7668 (interactive "P") 7669 (unless (derived-mode-p 'org-agenda-mode) 7670 (user-error "Not in an Org agenda buffer")) 7671 (let* ((marker (or (org-get-at-bol 'org-marker) 7672 (org-agenda-error))) 7673 (buffer (marker-buffer marker)) 7674 (pos (marker-position marker))) 7675 (with-current-buffer buffer 7676 (goto-char pos) 7677 (org-agenda-set-restriction-lock arg)))) 7678 7679 ;;;###autoload 7680 (defun org-agenda-set-restriction-lock (&optional type) 7681 "Set restriction lock for agenda to current subtree or file. 7682 When in a restricted subtree, remove it. 7683 7684 The restriction will span over the entire file if TYPE is `file', 7685 or if TYPE is (4), or if the cursor is before the first headline 7686 in the file. Otherwise, only apply the restriction to the current 7687 subtree." 7688 (interactive "P") 7689 (if (and org-agenda-overriding-restriction 7690 (member org-agenda-restriction-lock-overlay 7691 (overlays-at (point))) 7692 (equal (overlay-start org-agenda-restriction-lock-overlay) 7693 (point))) 7694 (org-agenda-remove-restriction-lock 'noupdate) 7695 (org-agenda-remove-restriction-lock 'noupdate) 7696 (and (equal type '(4)) (setq type 'file)) 7697 (setq type (cond 7698 (type type) 7699 ((org-at-heading-p) 'subtree) 7700 ((condition-case nil (org-back-to-heading t) (error nil)) 7701 'subtree) 7702 (t 'file))) 7703 (if (eq type 'subtree) 7704 (progn 7705 (setq org-agenda-restrict (current-buffer)) 7706 (setq org-agenda-overriding-restriction 'subtree) 7707 (put 'org-agenda-files 'org-restrict 7708 (list (buffer-file-name (buffer-base-buffer)))) 7709 (org-back-to-heading t) 7710 (move-overlay org-agenda-restriction-lock-overlay 7711 (point) 7712 (if org-agenda-restriction-lock-highlight-subtree 7713 (save-excursion (org-end-of-subtree t t) (point)) 7714 (line-end-position))) 7715 (move-marker org-agenda-restrict-begin (point)) 7716 (move-marker org-agenda-restrict-end 7717 (save-excursion (org-end-of-subtree t t))) 7718 (message "Locking agenda restriction to subtree")) 7719 (put 'org-agenda-files 'org-restrict 7720 (list (buffer-file-name (buffer-base-buffer)))) 7721 (setq org-agenda-restrict t) 7722 (setq org-agenda-overriding-restriction 'file) 7723 (move-marker org-agenda-restrict-begin nil) 7724 (move-marker org-agenda-restrict-end nil) 7725 (message "Locking agenda restriction to file")) 7726 (setq current-prefix-arg nil)) 7727 (org-agenda-maybe-redo)) 7728 7729 (defun org-agenda-remove-restriction-lock (&optional noupdate) 7730 "Remove agenda restriction lock." 7731 (interactive "P") 7732 (if (not org-agenda-restrict) 7733 (message "No agenda restriction to remove.") 7734 (delete-overlay org-agenda-restriction-lock-overlay) 7735 (delete-overlay org-speedbar-restriction-lock-overlay) 7736 (setq org-agenda-overriding-restriction nil) 7737 (setq org-agenda-restrict nil) 7738 (put 'org-agenda-files 'org-restrict nil) 7739 (move-marker org-agenda-restrict-begin nil) 7740 (move-marker org-agenda-restrict-end nil) 7741 (setq current-prefix-arg nil) 7742 (message "Agenda restriction lock removed") 7743 (or noupdate (org-agenda-maybe-redo)))) 7744 7745 (defun org-agenda-maybe-redo () 7746 "If there is any window showing the agenda view, update it." 7747 (let ((w (get-buffer-window (or org-agenda-this-buffer-name 7748 org-agenda-buffer-name) 7749 t)) 7750 (w0 (selected-window))) 7751 (when w 7752 (select-window w) 7753 (org-agenda-redo) 7754 (select-window w0) 7755 (if org-agenda-overriding-restriction 7756 (message "Agenda view shifted to new %s restriction" 7757 org-agenda-overriding-restriction) 7758 (message "Agenda restriction lock removed"))))) 7759 7760 ;;; Agenda commands 7761 7762 (defun org-agenda-check-type (error &rest types) 7763 "Check if agenda buffer or component is of allowed type. 7764 If ERROR is non-nil, throw an error, otherwise just return nil. 7765 Allowed types are `agenda' `todo' `tags' `search'." 7766 (cond ((not org-agenda-type) 7767 (error "No Org agenda currently displayed")) 7768 ((memq org-agenda-type types) t) 7769 (error 7770 (error "Not allowed in '%s'-type agenda buffer or component" org-agenda-type)) 7771 (t nil))) 7772 7773 (defun org-agenda-Quit () 7774 "Exit the agenda, killing the agenda buffer. 7775 Like `org-agenda-quit', but kill the buffer even when 7776 `org-agenda-sticky' is non-nil." 7777 (interactive) 7778 (org-agenda--quit)) 7779 7780 (defun org-agenda-quit () 7781 "Exit the agenda. 7782 7783 When `org-agenda-sticky' is non-nil, bury the agenda buffer 7784 instead of killing it. 7785 7786 When `org-agenda-restore-windows-after-quit' is non-nil, restore 7787 the pre-agenda window configuration. 7788 7789 When column view is active, exit column view instead of the 7790 agenda." 7791 (interactive) 7792 (org-agenda--quit org-agenda-sticky)) 7793 7794 (defun org-agenda--quit (&optional bury) 7795 (if org-agenda-columns-active 7796 (org-columns-quit) 7797 (let ((wconf org-agenda-pre-window-conf) 7798 (buf (current-buffer)) 7799 (org-agenda-last-indirect-window 7800 (and (eq org-indirect-buffer-display 'other-window) 7801 org-agenda-last-indirect-buffer 7802 (get-buffer-window org-agenda-last-indirect-buffer)))) 7803 (cond 7804 ((eq org-agenda-window-setup 'other-frame) 7805 (delete-frame)) 7806 ((eq org-agenda-window-setup 'other-tab) 7807 (if (fboundp 'tab-bar-close-tab) 7808 (tab-bar-close-tab) 7809 (user-error "Your version of Emacs does not have tab bar mode support"))) 7810 ((and org-agenda-restore-windows-after-quit 7811 wconf) 7812 ;; Maybe restore the pre-agenda window configuration. Reset 7813 ;; `org-agenda-pre-window-conf' before running 7814 ;; `set-window-configuration', which loses the current buffer. 7815 (setq org-agenda-pre-window-conf nil) 7816 (set-window-configuration wconf)) 7817 (t 7818 (when org-agenda-last-indirect-window 7819 (delete-window org-agenda-last-indirect-window)) 7820 (and (not (eq org-agenda-window-setup 'current-window)) 7821 (not (one-window-p)) 7822 (delete-window)))) 7823 (if bury 7824 ;; Set the agenda buffer as the current buffer instead of 7825 ;; passing it as an argument to `bury-buffer' so that 7826 ;; `bury-buffer' removes it from the window. 7827 (with-current-buffer buf 7828 (bury-buffer)) 7829 (kill-buffer buf) 7830 (setq org-agenda-archives-mode nil 7831 org-agenda-buffer nil))))) 7832 7833 (defun org-agenda-exit () 7834 "Exit the agenda, killing Org buffers loaded by the agenda. 7835 Like `org-agenda-Quit', but kill any buffers that were created by 7836 the agenda. Org buffers visited directly by the user will not be 7837 touched. Also, exit the agenda even if it is in column view." 7838 (interactive) 7839 (when org-agenda-columns-active 7840 (org-columns-quit)) 7841 (org-release-buffers org-agenda-new-buffers) 7842 (setq org-agenda-new-buffers nil) 7843 (org-agenda-Quit)) 7844 7845 (defun org-agenda-kill-all-agenda-buffers () 7846 "Kill all buffers in `org-agenda-mode'. 7847 This is used when toggling sticky agendas." 7848 (interactive) 7849 (let (blist) 7850 (dolist (buf (buffer-list)) 7851 (when (with-current-buffer buf (eq major-mode 'org-agenda-mode)) 7852 (push buf blist))) 7853 (mapc #'kill-buffer blist))) 7854 7855 (defun org-agenda-execute (arg) 7856 "Execute another agenda command, keeping same window. 7857 So this is just a shortcut for \\<global-map>`\\[org-agenda]', available 7858 in the agenda." 7859 (interactive "P") 7860 (let ((org-agenda-window-setup 'current-window)) 7861 (org-agenda arg))) 7862 7863 (defun org-agenda-redo (&optional all) 7864 "Rebuild possibly ALL agenda view(s) in the current buffer." 7865 (interactive "P") 7866 (defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used? 7867 (let* ((p (or (and (looking-at "\\'") (1- (point))) (point))) 7868 (cpa (unless (eq all t) current-prefix-arg)) 7869 (org-agenda-doing-sticky-redo org-agenda-sticky) 7870 (org-agenda-sticky nil) 7871 (org-agenda-buffer-name (or org-agenda-this-buffer-name 7872 org-agenda-buffer-name)) 7873 (org-agenda-keep-modes t) 7874 (tag-filter org-agenda-tag-filter) 7875 (tag-preset (assoc-default 'tag org-agenda-filters-preset)) 7876 (top-hl-filter org-agenda-top-headline-filter) 7877 (cat-filter org-agenda-category-filter) 7878 (cat-preset (assoc-default 'category org-agenda-filters-preset)) 7879 (re-filter org-agenda-regexp-filter) 7880 (re-preset (assoc-default 'regexp org-agenda-filters-preset)) 7881 (effort-filter org-agenda-effort-filter) 7882 (effort-preset (assoc-default 'effort org-agenda-filters-preset)) 7883 (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) 7884 (cols org-agenda-columns-active) 7885 (line (org-current-line)) 7886 (window-line (- line (org-current-line (window-start)))) 7887 (lprops (get-text-property p 'org-lprops)) 7888 (redo-cmd (get-text-property p 'org-redo-cmd)) 7889 (last-args (get-text-property p 'org-last-args)) 7890 (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd)) 7891 (org-agenda-overriding-cmd-arguments 7892 (unless (eq all t) 7893 (cond ((listp last-args) 7894 (cons (or cpa (car last-args)) (cdr last-args))) 7895 ((stringp last-args) 7896 last-args)))) 7897 (series-redo-cmd (get-text-property p 'org-series-redo-cmd))) 7898 (and cols (org-columns-quit)) 7899 (message "Rebuilding agenda buffer...") 7900 (if series-redo-cmd 7901 (eval series-redo-cmd t) 7902 (cl-progv 7903 (mapcar #'car lprops) 7904 (mapcar (lambda (binding) (eval (cadr binding) t)) lprops) 7905 (eval redo-cmd t)) 7906 (let ((inhibit-read-only t)) 7907 (add-text-properties (point-min) (point-max) `(org-lprops ,lprops)))) 7908 (setq org-agenda-undo-list nil 7909 org-agenda-pending-undo-list nil 7910 org-agenda-tag-filter tag-filter 7911 org-agenda-category-filter cat-filter 7912 org-agenda-regexp-filter re-filter 7913 org-agenda-effort-filter effort-filter 7914 org-agenda-top-headline-filter top-hl-filter) 7915 (message "Rebuilding agenda buffer...done") 7916 (let ((tag (or tag-filter tag-preset)) 7917 (cat (or cat-filter cat-preset)) 7918 (effort (or effort-filter effort-preset)) 7919 (re (or re-filter re-preset))) 7920 (when tag (org-agenda-filter-apply tag 'tag t)) 7921 (when cat (org-agenda-filter-apply cat 'category)) 7922 (when effort (org-agenda-filter-apply effort 'effort)) 7923 (when re (org-agenda-filter-apply re 'regexp))) 7924 (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) 7925 (and cols (called-interactively-p 'any) (org-agenda-columns)) 7926 (org-goto-line line) 7927 (when (called-interactively-p 'any) (recenter window-line)))) 7928 7929 (defun org-agenda-redo-all (&optional exhaustive) 7930 "Rebuild all agenda views in the current buffer. 7931 With a prefix argument, do so in all agenda buffers." 7932 (interactive "P") 7933 (if exhaustive 7934 (dolist (buffer (buffer-list)) 7935 (with-current-buffer buffer 7936 (when (derived-mode-p 'org-agenda-mode) 7937 (org-agenda-redo t)))) 7938 (org-agenda-redo t))) 7939 7940 (defvar org-global-tags-completion-table nil) 7941 (defvar org-agenda-filter-form nil) 7942 (defvar org-agenda-filtered-by-category nil) 7943 7944 (defsubst org-agenda-get-category () 7945 "Return the category of the agenda line." 7946 (org-get-at-bol 'org-category)) 7947 7948 (defun org-agenda-filter-by-category (strip) 7949 "Filter lines in the agenda buffer that have a specific category. 7950 The category is that of the current line. 7951 With a `\\[universal-argument]' prefix argument, exclude the lines of that category. 7952 When there is already a category filter in place, this command removes the 7953 filter." 7954 (interactive "P") 7955 (if (and org-agenda-filtered-by-category 7956 org-agenda-category-filter) 7957 (org-agenda-filter-show-all-cat) 7958 (let ((cat (org-no-properties (org-agenda-get-category)))) 7959 (cond 7960 ((and cat strip) 7961 (org-agenda-filter-apply 7962 (push (concat "-" cat) org-agenda-category-filter) 'category)) 7963 (cat 7964 (org-agenda-filter-apply 7965 (setq org-agenda-category-filter 7966 (list (concat "+" cat))) 7967 'category)) 7968 (t (error "No category at point")))))) 7969 7970 (defun org-find-top-headline (&optional pos) 7971 "Find the topmost parent headline and return it. 7972 POS when non-nil is the marker or buffer position to start the 7973 search from." 7974 (save-excursion 7975 (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) 7976 (when pos (goto-char pos)) 7977 ;; Skip up to the topmost parent. 7978 (while (org-up-heading-safe)) 7979 (ignore-errors 7980 (replace-regexp-in-string 7981 "^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" "" 7982 (nth 4 (org-heading-components))))))) 7983 7984 (defvar org-agenda-filtered-by-top-headline nil) 7985 (defun org-agenda-filter-by-top-headline (strip) 7986 "Keep only those lines that are descendants from the same top headline. 7987 The top headline is that of the current line. With prefix arg STRIP, hide 7988 all lines of the category at point." 7989 (interactive "P") 7990 (if org-agenda-filtered-by-top-headline 7991 (progn 7992 (setq org-agenda-filtered-by-top-headline nil 7993 org-agenda-top-headline-filter nil) 7994 (org-agenda-filter-show-all-top-filter)) 7995 (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker)))) 7996 (if toph (org-agenda-filter-top-headline-apply toph strip) 7997 (error "No top-level headline at point"))))) 7998 7999 (defvar org-agenda-regexp-filter nil) 8000 (defun org-agenda-filter-by-regexp (strip-or-accumulate) 8001 "Filter agenda entries by a regular expressions. 8002 You will be prompted for the regular expression, and the agenda 8003 view will only show entries that are matched by that expression. 8004 8005 With one `\\[universal-argument]' prefix argument, hide entries matching the regexp. 8006 When there is already a regexp filter active, this command removed the 8007 filter. However, with two `\\[universal-argument]' prefix arguments, add a new condition to 8008 an already existing regexp filter." 8009 (interactive "P") 8010 (let* ((strip (equal strip-or-accumulate '(4))) 8011 (accumulate (equal strip-or-accumulate '(16)))) 8012 (cond 8013 ((and org-agenda-regexp-filter (not accumulate)) 8014 (org-agenda-filter-show-all-re) 8015 (message "Regexp filter removed")) 8016 (t (let ((flt (concat (if strip "-" "+") 8017 (read-from-minibuffer 8018 (if strip 8019 "Hide entries matching regexp: " 8020 "Narrow to entries matching regexp: "))))) 8021 (push flt org-agenda-regexp-filter) 8022 (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)))))) 8023 8024 (defvar org-agenda-effort-filter nil) 8025 (defun org-agenda-filter-by-effort (strip-or-accumulate) 8026 "Filter agenda entries by effort. 8027 With no `\\[universal-argument]' prefix argument, keep entries matching the effort condition. 8028 With one `\\[universal-argument]' prefix argument, filter out entries matching the condition. 8029 With two `\\[universal-argument]' prefix arguments, add a second condition to the existing filter. 8030 This last option is in practice not very useful, but it is available for 8031 consistency with the other filter commands." 8032 (interactive "P") 8033 (let* ((efforts (split-string 8034 (or (cdr (assoc-string (concat org-effort-property "_ALL") 8035 org-global-properties 8036 t)) 8037 "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00"))) 8038 ;; XXX: the following handles only up to 10 different 8039 ;; effort values. 8040 (allowed-keys (if (null efforts) nil 8041 (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0 8042 (number-sequence 1 (length efforts))))) 8043 (keep (equal strip-or-accumulate '(16))) 8044 (negative (equal strip-or-accumulate '(4))) 8045 (current org-agenda-effort-filter) 8046 (op nil)) 8047 (while (not (memq op '(?< ?> ?= ?_))) 8048 (setq op (read-char-exclusive 8049 "Effort operator? (> = or <) or press `_' again to remove filter"))) 8050 ;; Select appropriate duration. Ignore non-digit characters. 8051 (if (eq op ?_) 8052 (progn 8053 (org-agenda-filter-show-all-effort) 8054 (message "Effort filter removed")) 8055 (let ((prompt 8056 (apply #'format 8057 (concat "Effort %c " 8058 (mapconcat (lambda (s) (concat "[%d]" s)) 8059 efforts 8060 " ")) 8061 op allowed-keys)) 8062 (eff -1)) 8063 (while (not (memq eff allowed-keys)) 8064 (message prompt) 8065 (setq eff (- (read-char-exclusive) 48))) 8066 (org-agenda-filter-show-all-effort) 8067 (setq org-agenda-effort-filter 8068 (append 8069 (list (concat (if negative "-" "+") 8070 (char-to-string op) 8071 ;; Numbering is 1 2 3 ... 9 0, but we want 8072 ;; 0 1 2 ... 8 9. 8073 (nth (mod (1- eff) 10) efforts))) 8074 (if keep current nil))) 8075 (org-agenda-filter-apply org-agenda-effort-filter 'effort))))) 8076 8077 (defun org-agenda-filter (&optional strip-or-accumulate) 8078 "Prompt for a general filter string and apply it to the agenda. 8079 8080 The string may contain filter elements like 8081 8082 +category 8083 +tag 8084 +<effort > and = are also allowed as effort operators 8085 +/regexp/ 8086 8087 Instead of `+', `-' is allowed to strip the agenda of matching entries. 8088 `+' is optional if it is not required to separate two string parts. 8089 Multiple filter elements can be concatenated without spaces, for example 8090 8091 +work-John<0:10-/plot/ 8092 8093 selects entries with category `work' and effort estimates below 10 minutes, 8094 and deselects entries with tag `John' or matching the regexp `plot'. 8095 8096 During entry of the filter, completion for tags, categories and effort 8097 values is offered. Since the syntax for categories and tags is identical 8098 there should be no overlap between categories and tags. If there is, tags 8099 get priority. 8100 8101 A single `\\[universal-argument]' prefix arg STRIP-OR-ACCUMULATE will negate the 8102 entire filter, which can be useful in connection with the prompt history. 8103 8104 A double `\\[universal-argument] \\[universal-argument]' prefix arg will add the new filter elements to the 8105 existing ones. A shortcut for this is to add an additional `+' at the 8106 beginning of the string, like `+-John'. 8107 8108 With a triple prefix argument, execute the computed filtering defined in 8109 the variable `org-agenda-auto-exclude-function'." 8110 (interactive "P") 8111 (if (equal strip-or-accumulate '(64)) 8112 ;; Execute the auto-exclude action 8113 (if (not org-agenda-auto-exclude-function) 8114 (user-error "`org-agenda-auto-exclude-function' is undefined") 8115 (org-agenda-filter-show-all-tag) 8116 (setq org-agenda-tag-filter nil) 8117 (dolist (tag (org-agenda-get-represented-tags)) 8118 (let ((modifier (funcall org-agenda-auto-exclude-function tag))) 8119 (when modifier 8120 (push modifier org-agenda-tag-filter)))) 8121 (unless (null org-agenda-tag-filter) 8122 (org-agenda-filter-apply org-agenda-tag-filter 'tag 'expand))) 8123 ;; Prompt for a filter and act 8124 (let* ((tag-list (org-agenda-get-represented-tags)) 8125 (category-list (org-agenda-get-represented-categories)) 8126 (negate (equal strip-or-accumulate '(4))) 8127 (cf (mapconcat #'identity org-agenda-category-filter "")) 8128 (tf (mapconcat #'identity org-agenda-tag-filter "")) 8129 ;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) "")))) 8130 (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) ""))) 8131 (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) ""))) 8132 (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/")))) 8133 (f-string (completing-read 8134 (concat 8135 (if negate "Negative filter" "Filter") 8136 " [+cat-tag<0:10-/regexp/]: ") 8137 #'org-agenda-filter-completion-function 8138 nil nil ff)) 8139 (keep (or (if (string-match "^\\+[+-]" f-string) 8140 (progn (setq f-string (substring f-string 1)) t)) 8141 (equal strip-or-accumulate '(16)))) 8142 (fc (if keep org-agenda-category-filter)) 8143 (ft (if keep org-agenda-tag-filter)) 8144 (fe (if keep org-agenda-effort-filter)) 8145 (fr (if keep org-agenda-regexp-filter)) 8146 pm s) 8147 ;; If the filter contains a double-quoted string, replace a 8148 ;; single hyphen by the arbitrary and temporary string "~~~" 8149 ;; to disambiguate such hyphens from syntactic ones. 8150 (setq f-string (replace-regexp-in-string 8151 "\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string)) 8152 (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string) 8153 (setq pm (if (match-beginning 1) (match-string 1 f-string) "+")) 8154 (when negate 8155 (setq pm (if (equal pm "+") "-" "+"))) 8156 (cond 8157 ((match-beginning 3) 8158 ;; category or tag 8159 (setq s (replace-regexp-in-string ; Remove the temporary special string. 8160 "~~~" "-" (match-string 3 f-string))) 8161 (cond 8162 ((member s tag-list) 8163 (org-pushnew-to-end (concat pm s) ft)) 8164 ((member s category-list) 8165 (org-pushnew-to-end (concat pm ; Remove temporary double quotes. 8166 (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s)) 8167 fc)) 8168 (t (message 8169 "`%s%s' filter ignored because tag/category is not represented" 8170 pm s)))) 8171 ((match-beginning 4) 8172 ;; effort 8173 (org-pushnew-to-end (concat pm (match-string 4 f-string)) fe)) 8174 ((match-beginning 5) 8175 ;; regexp 8176 (org-pushnew-to-end (concat pm (match-string 6 f-string)) fr))) 8177 (setq f-string (substring f-string (match-end 0)))) 8178 (org-agenda-filter-remove-all) 8179 (and fc (org-agenda-filter-apply 8180 (setq org-agenda-category-filter fc) 'category)) 8181 (and ft (org-agenda-filter-apply 8182 (setq org-agenda-tag-filter ft) 'tag 'expand)) 8183 (and fe (org-agenda-filter-apply 8184 (setq org-agenda-effort-filter fe) 'effort)) 8185 (and fr (org-agenda-filter-apply 8186 (setq org-agenda-regexp-filter fr) 'regexp)) 8187 (run-hooks 'org-agenda-filter-hook)))) 8188 8189 (defun org-agenda-filter-completion-function (string _predicate &optional flag) 8190 "Complete a complex filter string. 8191 FLAG specifies the type of completion operation to perform. This 8192 function is passed as a collection function to `completing-read', 8193 which see." 8194 (let ((completion-ignore-case t) ;tags are case-sensitive 8195 (confirm (lambda (x) (stringp x))) 8196 (prefix "") 8197 (operator "") 8198 table 8199 begin) 8200 (when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string) 8201 (setq prefix (match-string 1 string) 8202 operator (match-string 2 string) 8203 begin (match-beginning 3) 8204 string (match-string 3 string))) 8205 (cond 8206 ((member operator '("+" "-" "" nil)) 8207 (setq table (append (org-agenda-get-represented-categories) 8208 (org-agenda-get-represented-tags)))) 8209 ((member operator '("<" ">" "=")) 8210 (setq table (split-string 8211 (or (cdr (assoc-string (concat org-effort-property "_ALL") 8212 org-global-properties 8213 t)) 8214 "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00") 8215 " +"))) 8216 (t (setq table nil))) 8217 (pcase flag 8218 (`t (all-completions string table confirm)) 8219 (`lambda (assoc string table)) ;exact match? 8220 (`(boundaries . ,suffix) 8221 (let ((end (if (string-match "[-+<>=]" suffix) 8222 (match-string 0 suffix) 8223 (length suffix)))) 8224 `(boundaries ,(or begin 0) . ,end))) 8225 (`nil 8226 (pcase (try-completion string table confirm) 8227 ((and completion (pred stringp)) 8228 (concat prefix completion)) 8229 (completion completion))) 8230 (_ nil)))) 8231 8232 (defun org-agenda-filter-remove-all () 8233 "Remove all filters from the current agenda buffer." 8234 (interactive) 8235 (when org-agenda-tag-filter 8236 (org-agenda-filter-show-all-tag)) 8237 (when org-agenda-category-filter 8238 (org-agenda-filter-show-all-cat)) 8239 (when org-agenda-regexp-filter 8240 (org-agenda-filter-show-all-re)) 8241 (when org-agenda-top-headline-filter 8242 (org-agenda-filter-show-all-top-filter)) 8243 (when org-agenda-effort-filter 8244 (org-agenda-filter-show-all-effort)) 8245 (org-agenda-finalize) 8246 (when (called-interactively-p 'interactive) 8247 (message "All agenda filters removed"))) 8248 8249 (defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude) 8250 "Keep only those lines in the agenda buffer that have a specific tag. 8251 8252 The tag is selected with its fast selection letter, as configured. 8253 8254 With a `\\[universal-argument]' prefix, apply the filter negatively, stripping all matches. 8255 8256 With a `\\[universal-argument] \\[universal-argument]' prefix, add the new tag to the existing filter 8257 instead of replacing it. 8258 8259 With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \ 8260 i.e. don't 8261 filter on all its group members. 8262 8263 A Lisp caller can specify CHAR. EXCLUDE means that the new tag 8264 should be used to exclude the search - the interactive user can 8265 also press `-' or `+' to switch between filtering and excluding." 8266 (interactive "P") 8267 (let* ((alist org-tag-alist-for-agenda) 8268 (seen-chars nil) 8269 (tag-chars (mapconcat 8270 (lambda (x) (if (and (not (symbolp (car x))) 8271 (cdr x) 8272 (not (member (cdr x) seen-chars))) 8273 (progn 8274 (push (cdr x) seen-chars) 8275 (char-to-string (cdr x))) 8276 "")) 8277 org-tag-alist-for-agenda "")) 8278 (valid-char-list (append '(?\t ?\r ?\\ ?. ?\s ?q) 8279 (string-to-list tag-chars))) 8280 (exclude (or exclude (equal strip-or-accumulate '(4)))) 8281 (accumulate (equal strip-or-accumulate '(16))) 8282 (expand (not (equal strip-or-accumulate '(64)))) 8283 (inhibit-read-only t) 8284 (current org-agenda-tag-filter) 8285 a tag) ;; n 8286 (unless char 8287 (while (not (memq char valid-char-list)) 8288 (org-unlogged-message 8289 "%s by tag%s: [%s ]tag-char [TAB]tag %s[\\]off [q]uit" 8290 (if exclude "Exclude[+]" "Filter[-]") 8291 (if expand "" " (no grouptag expand)") 8292 tag-chars 8293 (if org-agenda-auto-exclude-function "[RET] " "")) 8294 (setq char (read-char-exclusive)) 8295 ;; Excluding or filtering down 8296 (cond ((eq char ?-) (setq exclude t)) 8297 ((eq char ?+) (setq exclude nil))))) 8298 (when (eq char ?\t) 8299 (unless (local-variable-p 'org-global-tags-completion-table) 8300 (setq-local org-global-tags-completion-table 8301 (org-global-tags-completion-table))) 8302 (let ((completion-ignore-case t)) 8303 (setq tag (completing-read 8304 "Tag: " org-global-tags-completion-table nil t)))) 8305 (cond 8306 ((eq char ?\r) 8307 (org-agenda-filter-show-all-tag) 8308 (when org-agenda-auto-exclude-function 8309 (setq org-agenda-tag-filter nil) 8310 (dolist (tag (org-agenda-get-represented-tags)) 8311 (let ((modifier (funcall org-agenda-auto-exclude-function tag))) 8312 (when modifier 8313 (push modifier org-agenda-tag-filter)))) 8314 (unless (null org-agenda-tag-filter) 8315 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))) 8316 ((eq char ?\\) 8317 (org-agenda-filter-show-all-tag) 8318 (when (assoc-default 'tag org-agenda-filters-preset) 8319 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))) 8320 ((eq char ?.) 8321 (setq org-agenda-tag-filter 8322 (mapcar (lambda(tag) (concat "+" tag)) 8323 (org-get-at-bol 'tags))) 8324 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)) 8325 ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...) 8326 ((or (eq char ?\s) 8327 (setq a (rassoc char alist)) 8328 (and tag (setq a (cons tag nil)))) 8329 (org-agenda-filter-show-all-tag) 8330 (setq tag (car a)) 8331 (setq org-agenda-tag-filter 8332 (cons (concat (if exclude "-" "+") tag) 8333 (if accumulate current nil))) 8334 (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)) 8335 (t (error "Invalid tag selection character %c" char))))) 8336 8337 (defun org-agenda-get-represented-categories () 8338 "Return a list of all categories used in this agenda buffer." 8339 (or org-agenda-represented-categories 8340 (when (derived-mode-p 'org-agenda-mode) 8341 (let ((pos (point-min)) categories) 8342 (while (and (< pos (point-max)) 8343 (setq pos (next-single-property-change 8344 pos 'org-category nil (point-max)))) 8345 (push (get-text-property pos 'org-category) categories)) 8346 (setq org-agenda-represented-categories 8347 ;; Enclose category names with a hyphen in double 8348 ;; quotes to process them specially in `org-agenda-filter'. 8349 (mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s)) 8350 (nreverse (org-uniquify (delq nil categories))))))))) 8351 8352 (defvar org-tag-groups-alist-for-agenda) 8353 (defun org-agenda-get-represented-tags () 8354 "Return a list of all tags used in this agenda buffer. 8355 These will be lower-case, for filtering." 8356 (or org-agenda-represented-tags 8357 (when (derived-mode-p 'org-agenda-mode) 8358 (let ((pos (point-min)) tags-lists tt) 8359 (while (and (< pos (point-max)) 8360 (setq pos (next-single-property-change 8361 pos 'tags nil (point-max)))) 8362 (setq tt (get-text-property pos 'tags)) 8363 (if tt (push tt tags-lists))) 8364 (setq tags-lists 8365 (nreverse (org-uniquify 8366 (delq nil (apply #'append tags-lists))))) 8367 (dolist (tag tags-lists) 8368 (mapc 8369 (lambda (group) 8370 (when (member tag group) 8371 (push (car group) tags-lists))) 8372 org-tag-groups-alist-for-agenda)) 8373 (setq org-agenda-represented-tags tags-lists))))) 8374 8375 (defun org-agenda-filter-make-matcher (filter type &optional expand) 8376 "Create the form that tests a line for agenda filter. 8377 Optional argument EXPAND can be used for the TYPE tag and will 8378 expand the tags in the FILTER if any of the tags in FILTER are 8379 grouptags." 8380 (let ((multi-pos-cats 8381 (and (eq type 'category) 8382 (string-match-p "\\+.*\\+" 8383 (mapconcat (lambda (cat) (substring cat 0 1)) 8384 filter "")))) 8385 f f1) 8386 (cond 8387 ;; Tag filter 8388 ((eq type 'tag) 8389 (setq filter 8390 (delete-dups 8391 (append (assoc-default 'tag org-agenda-filters-preset) 8392 filter))) 8393 (dolist (x filter) 8394 (let ((op (string-to-char x))) 8395 (if expand (setq x (org-agenda-filter-expand-tags (list x) t)) 8396 (setq x (list x))) 8397 (setq f1 (org-agenda-filter-make-matcher-tag-exp x op)) 8398 (push f1 f)))) 8399 ;; Category filter 8400 ((eq type 'category) 8401 (setq filter 8402 (delete-dups 8403 (append (assoc-default 'category org-agenda-filters-preset) 8404 filter))) 8405 (dolist (x filter) 8406 (if (equal "-" (substring x 0 1)) 8407 (setq f1 (list 'not (list 'equal (substring x 1) 'cat))) 8408 (setq f1 (list 'equal (substring x 1) 'cat))) 8409 (push f1 f))) 8410 ;; Regexp filter 8411 ((eq type 'regexp) 8412 (setq filter 8413 (delete-dups 8414 (append (assoc-default 'regexp org-agenda-filters-preset) 8415 filter))) 8416 (dolist (x filter) 8417 (if (equal "-" (substring x 0 1)) 8418 (setq f1 (list 'not (list 'string-match (substring x 1) 'txt))) 8419 (setq f1 (list 'string-match (substring x 1) 'txt))) 8420 (push f1 f))) 8421 ;; Effort filter 8422 ((eq type 'effort) 8423 (setq filter 8424 (delete-dups 8425 (append (assoc-default 'effort org-agenda-filters-preset) 8426 filter))) 8427 (dolist (x filter) 8428 (push (org-agenda-filter-effort-form x) f)))) 8429 (cons (if multi-pos-cats 'or 'and) (nreverse f)))) 8430 8431 (defun org-agenda-filter-make-matcher-tag-exp (tags op) 8432 "Return a form associated to tag-expression TAGS. 8433 Build a form testing a line for agenda filter for 8434 tag-expressions. OP is an operator of type CHAR that allows the 8435 function to set the right switches in the returned form." 8436 (let (form) 8437 ;; Any of the expressions can match if OP is +, all must match if 8438 ;; the operator is -. 8439 (dolist (x tags (cons (if (eq op ?-) 'and 'or) form)) 8440 (let* ((tag (substring x 1)) 8441 (f (cond 8442 ((string= "" tag) 'tags) 8443 ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag)) 8444 ;; TAG is a regexp. 8445 (list 'org-match-any-p (substring tag 1 -1) 'tags)) 8446 (t (list 'member tag 'tags))))) 8447 (push (if (eq op ?-) (list 'not f) f) form))))) 8448 8449 (defun org-agenda-filter-effort-form (e) 8450 "Return the form to compare the effort of the current line with what E says. 8451 E looks like \"+<2:25\"." 8452 (let (op) 8453 (setq e (substring e 1)) 8454 (setq op (string-to-char e) e (substring e 1)) 8455 (setq op (cond ((equal op ?<) '<=) 8456 ((equal op ?>) '>=) 8457 ((equal op ??) op) 8458 (t '=))) 8459 (list 'org-agenda-compare-effort (list 'quote op) 8460 (org-duration-to-minutes e)))) 8461 8462 (defun org-agenda-compare-effort (op value) 8463 "Compare the effort of the current line with VALUE, using OP. 8464 If the line does not have an effort defined, return nil." 8465 ;; `effort-minutes' property cannot be extracted directly from 8466 ;; current line but is stored as a property in `txt'. 8467 (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt)))) 8468 (funcall op 8469 (or effort (if org-agenda-sort-noeffort-is-high 32767 -1)) 8470 value))) 8471 8472 (defun org-agenda-filter-expand-tags (filter &optional no-operator) 8473 "Expand group tags in FILTER for the agenda. 8474 When NO-OPERATOR is non-nil, do not add the + operator to 8475 returned tags." 8476 (if org-group-tags 8477 (let (case-fold-search rtn) 8478 (mapc 8479 (lambda (f) 8480 (let (f0 dir) 8481 (if (string-match "^\\([+-]\\)\\(.+\\)" f) 8482 (setq dir (match-string 1 f) f0 (match-string 2 f)) 8483 (setq dir (if no-operator "" "+") f0 f)) 8484 (setq rtn (append (mapcar (lambda(f1) (concat dir f1)) 8485 (org-tags-expand f0 t)) 8486 rtn)))) 8487 filter) 8488 (reverse rtn)) 8489 filter)) 8490 8491 (defun org-agenda-filter-apply (filter type &optional expand) 8492 "Set FILTER as the new agenda filter and apply it. 8493 Optional argument EXPAND can be used for the TYPE tag and will 8494 expand the tags in the FILTER if any of the tags in FILTER are 8495 grouptags." 8496 ;; Deactivate `org-agenda-entry-text-mode' when filtering 8497 (when org-agenda-entry-text-mode (org-agenda-entry-text-mode)) 8498 (setq org-agenda-filter-form (org-agenda-filter-make-matcher 8499 filter type expand)) 8500 ;; Only set `org-agenda-filtered-by-category' to t when a unique 8501 ;; category is used as the filter: 8502 (setq org-agenda-filtered-by-category 8503 (and (eq type 'category) 8504 (not (equal (substring (car filter) 0 1) "-")))) 8505 (org-agenda-set-mode-name) 8506 (save-excursion 8507 (goto-char (point-min)) 8508 (while (not (eobp)) 8509 (when (or (org-get-at-bol 'org-hd-marker) 8510 (org-get-at-bol 'org-marker)) 8511 (org-dlet 8512 ((tags (org-get-at-bol 'tags)) 8513 (cat (org-agenda-get-category)) 8514 (txt (or (org-get-at-bol 'txt) ""))) 8515 (unless (eval org-agenda-filter-form t) 8516 (org-agenda-filter-hide-line type)))) 8517 (forward-line 1))) 8518 (when (get-char-property (point) 'invisible) 8519 (ignore-errors (org-agenda-previous-line)))) 8520 8521 (defun org-agenda-filter-top-headline-apply (hl &optional negative) 8522 "Filter by top headline HL." 8523 (org-agenda-set-mode-name) 8524 (save-excursion 8525 (goto-char (point-min)) 8526 (while (not (eobp)) 8527 (let* ((pos (org-get-at-bol 'org-hd-marker)) 8528 (tophl (and pos (org-find-top-headline pos)))) 8529 (when (and tophl (funcall (if negative 'identity 'not) 8530 (string= hl tophl))) 8531 (org-agenda-filter-hide-line 'top-headline))) 8532 (forward-line 1))) 8533 (when (get-char-property (point) 'invisible) 8534 (org-agenda-previous-line)) 8535 (setq org-agenda-top-headline-filter hl 8536 org-agenda-filtered-by-top-headline t)) 8537 8538 (defun org-agenda-filter-hide-line (type) 8539 "If current line is TYPE, hide it in the agenda buffer." 8540 (let* (buffer-invisibility-spec 8541 (beg (max (point-min) (1- (line-beginning-position)))) 8542 (end (line-end-position))) 8543 (let ((inhibit-read-only t)) 8544 (add-text-properties 8545 beg end `(invisible org-filtered org-filter-type ,type))))) 8546 8547 (defun org-agenda-remove-filter (type) 8548 "Remove filter of type TYPE from the agenda buffer." 8549 (interactive) 8550 (save-excursion 8551 (goto-char (point-min)) 8552 (let ((inhibit-read-only t) pos) 8553 (while (setq pos (text-property-any (point) (point-max) 8554 'org-filter-type type)) 8555 (goto-char pos) 8556 (remove-text-properties 8557 (point) (next-single-property-change (point) 'org-filter-type) 8558 `(invisible org-filtered org-filter-type ,type)))) 8559 (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil) 8560 (setq org-agenda-filter-form nil) 8561 (org-agenda-set-mode-name) 8562 (org-agenda-finalize))) 8563 8564 (defun org-agenda-filter-show-all-tag nil 8565 (org-agenda-remove-filter 'tag)) 8566 (defun org-agenda-filter-show-all-re nil 8567 (org-agenda-remove-filter 'regexp)) 8568 (defun org-agenda-filter-show-all-effort nil 8569 (org-agenda-remove-filter 'effort)) 8570 (defun org-agenda-filter-show-all-cat nil 8571 (org-agenda-remove-filter 'category)) 8572 (defun org-agenda-filter-show-all-top-filter nil 8573 (org-agenda-remove-filter 'top-headline)) 8574 8575 (defun org-agenda-manipulate-query-add () 8576 "Manipulate the query by adding a search term with positive selection. 8577 Positive selection means the term must be matched for selection of an entry." 8578 (interactive) 8579 (org-agenda-manipulate-query ?\[)) 8580 (defun org-agenda-manipulate-query-subtract () 8581 "Manipulate the query by adding a search term with negative selection. 8582 Negative selection means term must not be matched for selection of an entry." 8583 (interactive) 8584 (org-agenda-manipulate-query ?\])) 8585 (defun org-agenda-manipulate-query-add-re () 8586 "Manipulate the query by adding a search regexp with positive selection. 8587 Positive selection means the regexp must match for selection of an entry." 8588 (interactive) 8589 (org-agenda-manipulate-query ?\{)) 8590 (defun org-agenda-manipulate-query-subtract-re () 8591 "Manipulate the query by adding a search regexp with negative selection. 8592 Negative selection means regexp must not match for selection of an entry." 8593 (interactive) 8594 (org-agenda-manipulate-query ?\})) 8595 (defun org-agenda-manipulate-query (char) 8596 (cond 8597 ((eq org-agenda-type 'agenda) 8598 (let ((org-agenda-include-inactive-timestamps t)) 8599 (org-agenda-redo)) 8600 (message "Display now includes inactive timestamps as well")) 8601 ((eq org-agenda-type 'search) 8602 ;; Previous calls to `org-agenda-manipulate-query' could already 8603 ;; add trailing text to the query. Prevent duplicating it. 8604 ;; Trim the trailing spaces and +/. 8605 (setq org-agenda-query-string 8606 (replace-regexp-in-string 8607 (rx (or (1+ " ") (seq (1+ " ") (any "+-") (opt "{}"))) eos) 8608 "" 8609 org-agenda-query-string)) 8610 (org-add-to-string 8611 'org-agenda-query-string 8612 (if org-agenda-last-search-view-search-was-boolean 8613 (cdr (assoc char '((?\[ . " +") (?\] . " -") 8614 (?\{ . " +{}") (?\} . " -{}")))) 8615 " ")) 8616 (setq org-agenda-redo-command 8617 (list 'org-search-view 8618 (car (get-text-property (min (1- (point-max)) (point)) 8619 'org-last-args)) 8620 org-agenda-query-string 8621 (+ (length org-agenda-query-string) 8622 (if (member char '(?\{ ?\})) 0 1)))) 8623 (set-register org-agenda-query-register org-agenda-query-string) 8624 (let ((org-agenda-overriding-arguments 8625 (cdr org-agenda-redo-command))) 8626 (org-agenda-redo))) 8627 (t (error "Cannot manipulate query for %s-type agenda buffers" 8628 org-agenda-type)))) 8629 8630 (defun org-add-to-string (var string) 8631 (set var (concat (symbol-value var) string))) 8632 8633 (defun org-agenda-goto-date (date) 8634 "Jump to DATE in the agenda buffer. 8635 8636 When called interactively, prompt for the date. 8637 When called from Lisp, DATE should be a date as returned by 8638 `org-read-date'. 8639 8640 See also: 8641 `org-agenda-earlier' (\\[org-agenda-earlier]) 8642 `org-agenda-later' (\\[org-agenda-later]) 8643 `org-agenda-goto-today' (\\[org-agenda-goto-today])" 8644 (interactive 8645 (list 8646 (let ((org-read-date-prefer-future org-agenda-jump-prefer-future)) 8647 (org-read-date)))) 8648 (org-agenda-check-type t 'agenda) 8649 (let* ((day (time-to-days (org-time-string-to-time date))) 8650 (org-agenda-sticky-orig org-agenda-sticky) 8651 (org-agenda-buffer-tmp-name (buffer-name)) 8652 (args (get-text-property (min (1- (point-max)) (point)) 8653 'org-last-args)) 8654 (0-arg (or current-prefix-arg (car args))) 8655 (2-arg (nth 2 args)) 8656 (with-hour-p (nth 4 org-agenda-redo-command)) 8657 (newcmd (list 'org-agenda-list 0-arg date 8658 (org-agenda-span-to-ndays 8659 2-arg (org-time-string-to-absolute date)) 8660 with-hour-p)) 8661 (newargs (cdr newcmd)) 8662 (inhibit-read-only t) 8663 org-agenda-sticky) 8664 (add-text-properties (point-min) (point-max) 8665 `(org-redo-cmd ,newcmd org-last-args ,newargs)) 8666 (org-agenda-redo) 8667 (goto-char (point-min)) 8668 (while (not (or (= (or (get-text-property (point) 'day) 0) day) 8669 (save-excursion (move-beginning-of-line 2) (eobp)))) 8670 (move-beginning-of-line 2)) 8671 (setq org-agenda-sticky org-agenda-sticky-orig 8672 org-agenda-this-buffer-is-sticky org-agenda-sticky))) 8673 8674 (defun org-agenda-goto-today () 8675 "Go to today's date in the agenda buffer. 8676 8677 See also: 8678 `org-agenda-later' (\\[org-agenda-later]) 8679 `org-agenda-earlier' (\\[org-agenda-earlier]) 8680 `org-agenda-goto-date' (\\[org-agenda-goto-date])" 8681 (interactive) 8682 (org-agenda-check-type t 'agenda) 8683 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8684 (curspan (nth 2 args)) 8685 (tdpos (text-property-any (point-min) (point-max) 'org-today t))) 8686 (cond 8687 (tdpos (goto-char tdpos)) 8688 ((eq org-agenda-type 'agenda) 8689 (let* ((sd (org-agenda-compute-starting-span 8690 (org-today) (or curspan org-agenda-span))) 8691 (org-agenda-overriding-arguments args)) 8692 (setf (nth 1 org-agenda-overriding-arguments) sd) 8693 (org-agenda-redo) 8694 (org-agenda-find-same-or-today-or-agenda))) 8695 (t (error "Cannot find today"))))) 8696 8697 (defun org-agenda-find-same-or-today-or-agenda (&optional cnt) 8698 (goto-char 8699 (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) 8700 (text-property-any (point-min) (point-max) 'org-today t) 8701 (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) 8702 (and (get-text-property (min (1- (point-max)) (point)) 'org-series) 8703 (org-agenda-backward-block)) 8704 (point-min)))) 8705 8706 (defun org-agenda-backward-block () 8707 "Move backward by one agenda block." 8708 (interactive) 8709 (org-agenda-forward-block 'backward)) 8710 8711 (defun org-agenda-forward-block (&optional backward) 8712 "Move forward by one agenda block. 8713 When optional argument BACKWARD is set, go backward." 8714 (interactive) 8715 (cond ((not (derived-mode-p 'org-agenda-mode)) 8716 (user-error 8717 "Cannot execute this command outside of org-agenda-mode buffers")) 8718 ((looking-at (if backward "\\`" "\\'")) 8719 (message "Already at the %s block" (if backward "first" "last"))) 8720 (t (let ((_pos (prog1 (point) 8721 (ignore-errors (if backward (backward-char 1) 8722 (move-end-of-line 1))))) 8723 (f (if backward 8724 #'previous-single-property-change 8725 #'next-single-property-change)) 8726 moved dest) 8727 (while (and (setq dest (funcall 8728 f (point) 'org-agenda-structural-header)) 8729 (not (get-text-property 8730 (point) 'org-agenda-structural-header))) 8731 (setq moved t) 8732 (goto-char dest)) 8733 (if moved (move-beginning-of-line 1) 8734 (goto-char (if backward (point-min) (point-max))) 8735 (move-beginning-of-line 1) 8736 (message "No %s block" (if backward "previous" "further"))))))) 8737 8738 (defun org-agenda-later (arg) 8739 "Go forward in time by the current span in the agenda buffer. 8740 With prefix ARG, go forward that many times the current span. 8741 8742 See also: 8743 `org-agenda-earlier' (\\[org-agenda-earlier]) 8744 `org-agenda-goto-today' (\\[org-agenda-goto-today]) 8745 `org-agenda-goto-date' (\\[org-agenda-goto-date])" 8746 (interactive "p") 8747 (org-agenda-check-type t 'agenda) 8748 (let* ((wstart (window-start)) 8749 (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8750 (span (or (nth 2 args) org-agenda-current-span)) 8751 (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day)) 8752 (greg (calendar-gregorian-from-absolute sd)) 8753 (cnt (org-get-at-bol 'org-day-cnt)) 8754 greg2) 8755 (cond 8756 ((numberp span) 8757 (setq sd (+ (* span arg) sd))) 8758 ((eq span 'day) 8759 (setq sd (+ arg sd))) 8760 ((eq span 'week) 8761 (setq sd (+ (* 7 arg) sd))) 8762 ((eq span 'fortnight) 8763 (setq sd (+ (* 14 arg) sd))) 8764 ((eq span 'month) 8765 (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) 8766 sd (calendar-absolute-from-gregorian greg2)) 8767 (setcar greg2 (1+ (car greg2)))) 8768 ((eq span 'year) 8769 (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) 8770 sd (calendar-absolute-from-gregorian greg2)) 8771 (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) 8772 (t 8773 (setq sd (+ (* span arg) sd)))) 8774 (let ((org-agenda-overriding-cmd 8775 ;; `cmd' may have been set by `org-agenda-run-series' which 8776 ;; uses `org-agenda-overriding-cmd' to decide whether 8777 ;; overriding is allowed for `cmd' 8778 (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) 8779 (org-agenda-overriding-arguments 8780 (list (car args) sd span))) 8781 (org-agenda-redo) 8782 (org-agenda-find-same-or-today-or-agenda cnt)) 8783 (set-window-start nil wstart))) 8784 8785 (defun org-agenda-earlier (arg) 8786 "Go backward in time by the current span in the agenda buffer. 8787 With prefix ARG, go backward that many times the current span. 8788 8789 See also: 8790 `org-agenda-later' (\\[org-agenda-later]) 8791 `org-agenda-goto-today' (\\[org-agenda-goto-today]) 8792 `org-agenda-goto-date' (\\[org-agenda-goto-date])" 8793 (interactive "p") 8794 (org-agenda-later (- arg))) 8795 8796 (defun org-agenda-view-mode-dispatch () 8797 "Call one of the view mode commands." 8798 (interactive) 8799 (org-unlogged-message 8800 "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort 8801 time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck 8802 [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") 8803 (pcase (read-char-exclusive) 8804 (?\ (call-interactively 'org-agenda-reset-view)) 8805 (?d (call-interactively 'org-agenda-day-view)) 8806 (?w (call-interactively 'org-agenda-week-view)) 8807 (?t (call-interactively 'org-agenda-fortnight-view)) 8808 (?m (call-interactively 'org-agenda-month-view)) 8809 (?y (call-interactively 'org-agenda-year-view)) 8810 (?l (call-interactively 'org-agenda-log-mode)) 8811 (?L (org-agenda-log-mode '(4))) 8812 (?c (org-agenda-log-mode 'clockcheck)) 8813 ((or ?F ?f) (call-interactively 'org-agenda-follow-mode)) 8814 (?a (call-interactively 'org-agenda-archives-mode)) 8815 (?A (org-agenda-archives-mode 'files)) 8816 ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode)) 8817 ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode)) 8818 (?G (call-interactively 'org-agenda-toggle-time-grid)) 8819 (?D (call-interactively 'org-agenda-toggle-diary)) 8820 (?\! (call-interactively 'org-agenda-toggle-deadlines)) 8821 (?\[ (let ((org-agenda-include-inactive-timestamps t)) 8822 (org-agenda-check-type t 'agenda) 8823 (org-agenda-redo)) 8824 (message "Display now includes inactive timestamps as well")) 8825 (?q (message "Abort")) 8826 (key (user-error "Invalid key: %s" key)))) 8827 8828 (defun org-agenda-reset-view () 8829 "Switch to default view for agenda." 8830 (interactive) 8831 (org-agenda-change-time-span org-agenda-span)) 8832 8833 (defun org-agenda-day-view (&optional day-of-month) 8834 "Switch to daily view for agenda. 8835 With argument DAY-OF-MONTH, switch to that day of the month." 8836 (interactive "P") 8837 (org-agenda-change-time-span 'day day-of-month)) 8838 8839 (defun org-agenda-week-view (&optional iso-week) 8840 "Switch to weekly view for agenda. 8841 With argument ISO-WEEK, switch to the corresponding ISO week. 8842 If ISO-WEEK has more then 2 digits, only the last two encode 8843 the week. Any digits before this encode a year. So 200712 8844 means week 12 of year 2007. Years ranging from 70 years ago 8845 to 30 years in the future can also be written as 2-digit years." 8846 (interactive "P") 8847 (org-agenda-change-time-span 'week iso-week)) 8848 8849 (defun org-agenda-fortnight-view (&optional iso-week) 8850 "Switch to fortnightly view for agenda. 8851 With argument ISO-WEEK, switch to the corresponding ISO week. 8852 If ISO-WEEK has more then 2 digits, only the last two encode 8853 the week. Any digits before this encode a year. So 200712 8854 means week 12 of year 2007. Years ranging from 70 years ago 8855 to 30 years in the future can also be written as 2-digit years." 8856 (interactive "P") 8857 (org-agenda-change-time-span 'fortnight iso-week)) 8858 8859 (defun org-agenda-month-view (&optional month) 8860 "Switch to monthly view for agenda. 8861 With argument MONTH, switch to that month. If MONTH has more 8862 then 2 digits, only the last two encode the month. Any digits 8863 before this encode a year. So 200712 means December year 2007. 8864 Years ranging from 70 years ago to 30 years in the future can 8865 also be written as 2-digit years." 8866 (interactive "P") 8867 (org-agenda-change-time-span 'month month)) 8868 8869 (defun org-agenda-year-view (&optional year) 8870 "Switch to yearly view for agenda. 8871 With argument YEAR, switch to that year. Years ranging from 70 8872 years ago to 30 years in the future can also be written as 8873 2-digit years." 8874 (interactive "P") 8875 (when year 8876 (setq year (org-small-year-to-year year))) 8877 (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") 8878 (org-agenda-change-time-span 'year year) 8879 (error "Abort"))) 8880 8881 (defun org-agenda-change-time-span (span &optional n) 8882 "Change the agenda view to SPAN. 8883 SPAN may be `day', `week', `fortnight', `month', `year'." 8884 (org-agenda-check-type t 'agenda) 8885 (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) 8886 (curspan (nth 2 args))) 8887 (when (and (not n) (equal curspan span)) 8888 (error "Viewing span is already \"%s\"" span)) 8889 (let* ((sd (or (org-get-at-bol 'day) 8890 (nth 1 args) 8891 org-starting-day)) 8892 (sd (org-agenda-compute-starting-span sd span n)) 8893 (org-agenda-overriding-cmd 8894 (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) 8895 (org-agenda-overriding-arguments 8896 (list (car args) sd span))) 8897 (org-agenda-redo) 8898 (org-agenda-find-same-or-today-or-agenda)) 8899 (org-agenda-set-mode-name) 8900 (message "Switched to %s view" span))) 8901 8902 (defun org-agenda-compute-starting-span (sd span &optional n) 8903 "Compute starting date for agenda. 8904 SPAN may be `day', `week', `fortnight', `month', `year'. The return value 8905 is a cons cell with the starting date and the number of days, 8906 so that the date SD will be in that range." 8907 (let* ((greg (calendar-gregorian-from-absolute sd)) 8908 ;; (dg (nth 1 greg)) 8909 (mg (car greg)) 8910 (yg (nth 2 greg))) 8911 (cond 8912 ((eq span 'day) 8913 (when n 8914 (setq sd (+ (calendar-absolute-from-gregorian 8915 (list mg 1 yg)) 8916 n -1)))) 8917 ((or (eq span 'week) (eq span 'fortnight)) 8918 (let* ((nt (calendar-day-of-week 8919 (calendar-gregorian-from-absolute sd))) 8920 (d (if org-agenda-start-on-weekday 8921 (- nt org-agenda-start-on-weekday) 8922 0)) 8923 y1) 8924 (setq sd (- sd (+ (if (< d 0) 7 0) d))) 8925 (when n 8926 (require 'cal-iso) 8927 (when (> n 99) 8928 (setq y1 (org-small-year-to-year (/ n 100)) 8929 n (mod n 100))) 8930 (setq sd 8931 (calendar-iso-to-absolute 8932 (list n 1 8933 (or y1 (nth 2 (calendar-iso-from-absolute sd))))))))) 8934 ((eq span 'month) 8935 (let (y1) 8936 (when (and n (> n 99)) 8937 (setq y1 (org-small-year-to-year (/ n 100)) 8938 n (mod n 100))) 8939 (setq sd (calendar-absolute-from-gregorian 8940 (list (or n mg) 1 (or y1 yg)))))) 8941 ((eq span 'year) 8942 (setq sd (calendar-absolute-from-gregorian 8943 (list 1 1 (or n yg)))))) 8944 sd)) 8945 8946 (defun org-agenda-next-date-line (&optional arg) 8947 "Jump to the next line indicating a date in agenda buffer." 8948 (interactive "p") 8949 (org-agenda-check-type t 'agenda) 8950 (forward-line 0) 8951 ;; This does not work if user makes date format that starts with a blank 8952 (when (looking-at-p "^\\S-") (forward-char 1)) 8953 (unless (re-search-forward "^\\S-" nil t arg) 8954 (backward-char 1) 8955 (error "No next date after this line in this buffer")) 8956 (goto-char (match-beginning 0))) 8957 8958 (defun org-agenda-previous-date-line (&optional arg) 8959 "Jump to the previous line indicating a date in agenda buffer." 8960 (interactive "p") 8961 (org-agenda-check-type t 'agenda) 8962 (forward-line 0) 8963 (unless (re-search-backward "^\\S-" nil t arg) 8964 (error "No previous date before this line in this buffer"))) 8965 8966 ;; Initialize the highlight 8967 (defvar org-hl (make-overlay 1 1)) 8968 (overlay-put org-hl 'face 'highlight) 8969 8970 (defun org-highlight (begin end &optional buffer) 8971 "Highlight a region with overlay." 8972 (move-overlay org-hl begin end (or buffer (current-buffer)))) 8973 8974 (defun org-unhighlight () 8975 "Detach overlay INDEX." 8976 (delete-overlay org-hl)) 8977 8978 (defun org-unhighlight-once () 8979 "Remove the highlight from its position, and this function from the hook." 8980 (remove-hook 'pre-command-hook #'org-unhighlight-once) 8981 (org-unhighlight)) 8982 8983 (defvar org-agenda-pre-follow-window-conf nil) 8984 (defun org-agenda-follow-mode () 8985 "Toggle follow mode in an agenda buffer." 8986 (interactive) 8987 (unless org-agenda-follow-mode 8988 (setq org-agenda-pre-follow-window-conf 8989 (current-window-configuration))) 8990 (setq org-agenda-follow-mode (not org-agenda-follow-mode)) 8991 (unless org-agenda-follow-mode 8992 (set-window-configuration org-agenda-pre-follow-window-conf)) 8993 (org-agenda-set-mode-name) 8994 (org-agenda-do-context-action) 8995 (message "Follow mode is %s" 8996 (if org-agenda-follow-mode "on" "off"))) 8997 8998 (defun org-agenda-entry-text-mode (&optional arg) 8999 "Toggle entry text mode in an agenda buffer." 9000 (interactive "P") 9001 (if (or org-agenda-tag-filter 9002 org-agenda-category-filter 9003 org-agenda-regexp-filter 9004 org-agenda-top-headline-filter) 9005 (user-error "Can't show entry text in filtered views") 9006 (setq org-agenda-entry-text-mode (or (integerp arg) 9007 (not org-agenda-entry-text-mode))) 9008 (org-agenda-entry-text-hide) 9009 (and org-agenda-entry-text-mode 9010 (let ((org-agenda-entry-text-maxlines 9011 (if (integerp arg) arg org-agenda-entry-text-maxlines))) 9012 (org-agenda-entry-text-show))) 9013 (org-agenda-set-mode-name) 9014 (message "Entry text mode is %s%s" 9015 (if org-agenda-entry-text-mode "on" "off") 9016 (if (not org-agenda-entry-text-mode) "" 9017 (format " (maximum number of lines is %d)" 9018 (if (integerp arg) arg org-agenda-entry-text-maxlines)))))) 9019 9020 (defun org-agenda-clockreport-mode () 9021 "Toggle clocktable mode in an agenda buffer." 9022 (interactive) 9023 (org-agenda-check-type t 'agenda) 9024 (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)) 9025 (org-agenda-set-mode-name) 9026 (org-agenda-redo) 9027 (message "Clocktable mode is %s" 9028 (if org-agenda-clockreport-mode "on" "off"))) 9029 9030 (defun org-agenda-log-mode (&optional special) 9031 "Toggle log mode in an agenda buffer. 9032 9033 With argument SPECIAL, show all possible log items, not only the ones 9034 configured in `org-agenda-log-mode-items'. 9035 9036 With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ 9037 log items, nothing else." 9038 (interactive "P") 9039 (org-agenda-check-type t 'agenda) 9040 (setq org-agenda-show-log 9041 (cond 9042 ((equal special '(16)) 'only) 9043 ((eq special 'clockcheck) 9044 (if (eq org-agenda-show-log 'clockcheck) 9045 nil 'clockcheck)) 9046 (special '(closed clock state)) 9047 (t (not org-agenda-show-log)))) 9048 (org-agenda-set-mode-name) 9049 (org-agenda-redo) 9050 (message "Log mode is %s" (if org-agenda-show-log "on" "off"))) 9051 9052 (defun org-agenda-archives-mode (&optional with-files) 9053 "Toggle inclusion of items in trees marked with :ARCHIVE:. 9054 When called with a prefix argument, include all archive files as well." 9055 (interactive "P") 9056 (setq org-agenda-archives-mode 9057 (cond ((and with-files (eq org-agenda-archives-mode t)) nil) 9058 (with-files t) 9059 (org-agenda-archives-mode nil) 9060 (t 'trees))) 9061 (org-agenda-set-mode-name) 9062 (org-agenda-redo) 9063 (message 9064 "%s" 9065 (cond 9066 ((eq org-agenda-archives-mode nil) 9067 "No archives are included") 9068 ((eq org-agenda-archives-mode 'trees) 9069 (format "Trees with :%s: tag are included" org-archive-tag)) 9070 ((eq org-agenda-archives-mode t) 9071 (format "Trees with :%s: tag and all active archive files are included" 9072 org-archive-tag))))) 9073 9074 (defun org-agenda-toggle-diary () 9075 "Toggle diary inclusion in an agenda buffer." 9076 (interactive) 9077 (org-agenda-check-type t 'agenda) 9078 (setq org-agenda-include-diary (not org-agenda-include-diary)) 9079 (org-agenda-redo) 9080 (org-agenda-set-mode-name) 9081 (message "Diary inclusion turned %s" 9082 (if org-agenda-include-diary "on" "off"))) 9083 9084 (defun org-agenda-toggle-deadlines () 9085 "Toggle inclusion of entries with a deadline in an agenda buffer." 9086 (interactive) 9087 (org-agenda-check-type t 'agenda) 9088 (setq org-agenda-include-deadlines (not org-agenda-include-deadlines)) 9089 (org-agenda-redo) 9090 (org-agenda-set-mode-name) 9091 (message "Deadlines inclusion turned %s" 9092 (if org-agenda-include-deadlines "on" "off"))) 9093 9094 (defun org-agenda-toggle-time-grid () 9095 "Toggle time grid in an agenda buffer." 9096 (interactive) 9097 (org-agenda-check-type t 'agenda) 9098 (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) 9099 (org-agenda-redo) 9100 (org-agenda-set-mode-name) 9101 (message "Time-grid turned %s" 9102 (if org-agenda-use-time-grid "on" "off"))) 9103 9104 (defun org-agenda-set-mode-name () 9105 "Set the mode name to indicate all the small mode settings." 9106 (setq mode-name 9107 (list "Org-Agenda" 9108 (if (get 'org-agenda-files 'org-restrict) " []" "") 9109 " " 9110 '(:eval (org-agenda-span-name org-agenda-current-span)) 9111 (if org-agenda-follow-mode " Follow" "") 9112 (if org-agenda-entry-text-mode " ETxt" "") 9113 (if org-agenda-include-diary " Diary" "") 9114 (if org-agenda-include-deadlines " Ddl" "") 9115 (if org-agenda-use-time-grid " Grid" "") 9116 (if (and (boundp 'org-habit-show-habits) 9117 org-habit-show-habits) 9118 " Habit" "") 9119 (cond 9120 ((consp org-agenda-show-log) " LogAll") 9121 ((eq org-agenda-show-log 'clockcheck) " ClkCk") 9122 (org-agenda-show-log " Log") 9123 (t "")) 9124 (if (org-agenda-filter-any) " " "") 9125 (if (or org-agenda-category-filter 9126 (assoc-default 'category org-agenda-filters-preset)) 9127 '(:eval (propertize 9128 (concat "[" 9129 (mapconcat 9130 #'identity 9131 (append 9132 (assoc-default 'category org-agenda-filters-preset) 9133 org-agenda-category-filter) 9134 "") 9135 "]") 9136 'face 'org-agenda-filter-category 9137 'help-echo "Category used in filtering")) 9138 "") 9139 (if (or org-agenda-tag-filter 9140 (assoc-default 'tag org-agenda-filters-preset)) 9141 '(:eval (propertize 9142 (concat (mapconcat 9143 #'identity 9144 (append 9145 (assoc-default 'tag org-agenda-filters-preset) 9146 org-agenda-tag-filter) 9147 "")) 9148 'face 'org-agenda-filter-tags 9149 'help-echo "Tags used in filtering")) 9150 "") 9151 (if (or org-agenda-effort-filter 9152 (assoc-default 'effort org-agenda-filters-preset)) 9153 '(:eval (propertize 9154 (concat (mapconcat 9155 #'identity 9156 (append 9157 (assoc-default 'effort org-agenda-filters-preset) 9158 org-agenda-effort-filter) 9159 "")) 9160 'face 'org-agenda-filter-effort 9161 'help-echo "Effort conditions used in filtering")) 9162 "") 9163 (if (or org-agenda-regexp-filter 9164 (assoc-default 'regexp org-agenda-filters-preset)) 9165 '(:eval (propertize 9166 (concat (mapconcat 9167 (lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/")) 9168 (append 9169 (assoc-default 'regexp org-agenda-filters-preset) 9170 org-agenda-regexp-filter) 9171 "")) 9172 'face 'org-agenda-filter-regexp 9173 'help-echo "Regexp used in filtering")) 9174 "") 9175 (if org-agenda-archives-mode 9176 (if (eq org-agenda-archives-mode t) 9177 " Archives" 9178 (format " :%s:" org-archive-tag)) 9179 "") 9180 (if org-agenda-clockreport-mode " Clock" ""))) 9181 (force-mode-line-update)) 9182 9183 (defun org-agenda-update-agenda-type () 9184 "Update the agenda type after each command." 9185 (setq org-agenda-type 9186 (or (get-text-property (point) 'org-agenda-type) 9187 (get-text-property (max (point-min) (1- (point))) 'org-agenda-type)))) 9188 9189 (defun org-agenda-next-line () 9190 "Move cursor to the next line, and show if follow mode is active." 9191 (interactive) 9192 (call-interactively 'next-line) 9193 (org-agenda-do-context-action)) 9194 9195 (defun org-agenda-previous-line () 9196 "Move cursor to the previous line, and show if follow mode is active." 9197 (interactive) 9198 (call-interactively 'previous-line) 9199 (org-agenda-do-context-action)) 9200 9201 (defun org-agenda-next-item (n) 9202 "Move cursor to next agenda item." 9203 (interactive "p") 9204 (let ((col (current-column))) 9205 (dotimes (_ n) 9206 (when (next-single-property-change (line-end-position) 'org-marker) 9207 (move-end-of-line 1) 9208 (goto-char (next-single-property-change (point) 'org-marker)))) 9209 (org-move-to-column col)) 9210 (org-agenda-do-context-action)) 9211 9212 (defun org-agenda-previous-item (n) 9213 "Move cursor to next agenda item." 9214 (interactive "p") 9215 (dotimes (_ n) 9216 (let ((col (current-column)) 9217 (goto (save-excursion 9218 (move-end-of-line 0) 9219 (previous-single-property-change (point) 'org-marker)))) 9220 (when goto (goto-char goto)) 9221 (org-move-to-column col))) 9222 (org-agenda-do-context-action)) 9223 9224 (defun org-agenda-do-context-action () 9225 "Show outline path and, maybe, follow mode window." 9226 (let ((m (org-get-at-bol 'org-marker))) 9227 (when (and (markerp m) (marker-buffer m)) 9228 (and org-agenda-follow-mode 9229 (if org-agenda-follow-indirect 9230 (let ((org-indirect-buffer-display 'other-window)) 9231 (org-agenda-tree-to-indirect-buffer nil)) 9232 (org-agenda-show))) 9233 (and org-agenda-show-outline-path 9234 (org-with-point-at m (org-display-outline-path org-agenda-show-outline-path)))))) 9235 9236 (defun org-agenda-show-tags () 9237 "Show the tags applicable to the current item." 9238 (interactive) 9239 (let* ((tags (org-get-at-bol 'tags))) 9240 (if tags 9241 (message "Tags are :%s:" 9242 (org-no-properties (mapconcat #'identity tags ":"))) 9243 (message "No tags associated with this line")))) 9244 9245 (defun org-agenda-goto (&optional highlight) 9246 "Go to the entry at point in the corresponding Org file." 9247 (interactive) 9248 (let* ((marker (or (org-get-at-bol 'org-marker) 9249 (org-agenda-error))) 9250 (buffer (marker-buffer marker)) 9251 (pos (marker-position marker))) 9252 (switch-to-buffer-other-window buffer) 9253 (widen) 9254 (push-mark) 9255 (goto-char pos) 9256 (when (derived-mode-p 'org-mode) 9257 (org-fold-show-context 'agenda) 9258 (recenter (/ (window-height) 2)) 9259 (org-back-to-heading t) 9260 (let ((case-fold-search nil)) 9261 (when (re-search-forward org-complex-heading-regexp nil t) 9262 (goto-char (match-beginning 4))))) 9263 (run-hooks 'org-agenda-after-show-hook) 9264 (and highlight (org-highlight (line-beginning-position) 9265 (line-end-position))))) 9266 9267 (defvar org-agenda-after-show-hook nil 9268 "Normal hook run after an item has been shown from the agenda. 9269 Point is in the buffer where the item originated.") 9270 9271 ;; Defined later in org-agenda.el 9272 (defvar org-agenda-loop-over-headlines-in-active-region nil) 9273 9274 (defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete) 9275 "Between region BEG and END, call agenda command CMD. 9276 When optional argument ARG is non-nil or FORCE-ARG is t, pass 9277 ARG to CMD. When optional argument DELETE is non-nil, assume CMD 9278 deletes the agenda entry and don't move to the next entry." 9279 (save-excursion 9280 (goto-char beg) 9281 (let ((mend (move-marker (make-marker) end)) 9282 (all (eq org-agenda-loop-over-headlines-in-active-region t)) 9283 (match (and (stringp org-agenda-loop-over-headlines-in-active-region) 9284 org-agenda-loop-over-headlines-in-active-region)) 9285 (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level) 9286 (org-get-at-bol 'level)))) 9287 (while (< (point) mend) 9288 (let ((ov (make-overlay (point) (line-end-position)))) 9289 (if (not (or all 9290 (and match (looking-at-p match)) 9291 (eq level (org-get-at-bol 'level)))) 9292 (org-agenda-next-item 1) 9293 (overlay-put ov 'face 'region) 9294 (if (or arg force-arg) (funcall cmd arg) (funcall cmd)) 9295 (when (not delete) (org-agenda-next-item 1)) 9296 (delete-overlay ov))))))) 9297 9298 ;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*, 9299 ;; kill,set-property,set-effort] commands may loop over agenda 9300 ;; entries. Commands `org-agenda-set-tags' and `org-agenda-bulk-mark' 9301 ;; use their own mechanisms on active regions. 9302 (defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body) 9303 "Maybe loop over agenda entries and perform CMD. 9304 Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." 9305 (declare (debug t)) 9306 `(if (and (called-interactively-p 'any) 9307 org-agenda-loop-over-headlines-in-active-region 9308 (org-region-active-p)) 9309 (org-agenda-do-in-region 9310 (region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete) 9311 ,@body)) 9312 9313 (defun org-agenda-kill () 9314 "Kill the entry or subtree belonging to the current agenda entry." 9315 (interactive) 9316 (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) 9317 (org-agenda-maybe-loop 9318 #'org-agenda-kill nil nil t 9319 (let* ((bufname-orig (buffer-name)) 9320 (marker (or (org-get-at-bol 'org-marker) 9321 (org-agenda-error))) 9322 (buffer (marker-buffer marker)) 9323 (type (org-get-at-bol 'type)) 9324 dbeg dend (n 0)) 9325 (org-with-remote-undo buffer 9326 (org-with-point-at marker 9327 (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) 9328 (setq dbeg (progn (org-back-to-heading t) (point)) 9329 dend (org-end-of-subtree t t)) 9330 (setq dbeg (line-beginning-position) 9331 dend (min (point-max) (1+ (line-end-position))))) 9332 (goto-char dbeg) 9333 (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))) 9334 (when (or (eq t org-agenda-confirm-kill) 9335 (and (numberp org-agenda-confirm-kill) 9336 (> n org-agenda-confirm-kill))) 9337 (let ((win-conf (current-window-configuration))) 9338 (unwind-protect 9339 (and 9340 (prog2 9341 (org-agenda-tree-to-indirect-buffer nil) 9342 (not (y-or-n-p 9343 (format "Delete entry with %d lines in buffer \"%s\"? " 9344 n (buffer-name buffer)))) 9345 (kill-buffer org-last-indirect-buffer)) 9346 (error "Abort")) 9347 (set-window-configuration win-conf)))) 9348 (let ((org-agenda-buffer-name bufname-orig)) 9349 (org-remove-subtree-entries-from-agenda buffer dbeg dend)) 9350 (org-with-point-at marker (delete-region dbeg dend)) 9351 (message "Agenda item and source killed"))))) 9352 9353 (defvar org-archive-default-command) ; defined in org-archive.el 9354 (defun org-agenda-archive-default () 9355 "Archive the entry or subtree belonging to the current agenda entry." 9356 (interactive) 9357 (require 'org-archive) 9358 (funcall-interactively 9359 #'org-agenda-archive-with org-archive-default-command)) 9360 9361 (defun org-agenda-archive-default-with-confirmation () 9362 "Archive the entry or subtree belonging to the current agenda entry." 9363 (interactive) 9364 (require 'org-archive) 9365 (funcall-interactively 9366 #'org-agenda-archive-with org-archive-default-command 'confirm)) 9367 9368 (defun org-agenda-archive () 9369 "Archive the entry or subtree belonging to the current agenda entry." 9370 (interactive) 9371 (funcall-interactively 9372 #'org-agenda-archive-with 'org-archive-subtree)) 9373 9374 (defun org-agenda-archive-to-archive-sibling () 9375 "Move the entry to the archive sibling." 9376 (interactive) 9377 (funcall-interactively 9378 #'org-agenda-archive-with 'org-archive-to-archive-sibling)) 9379 9380 (defvar org-archive-from-agenda) 9381 9382 (defun org-agenda-archive-with (cmd &optional confirm) 9383 "Move the entry to the archive sibling." 9384 (interactive) 9385 (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda")) 9386 (org-agenda-maybe-loop 9387 #'org-agenda-archive-with cmd nil t 9388 (let* ((bufname-orig (buffer-name)) 9389 (marker (or (org-get-at-bol 'org-marker) 9390 (org-agenda-error))) 9391 (buffer (marker-buffer marker)) 9392 (pos (marker-position marker))) 9393 (org-with-remote-undo buffer 9394 (with-current-buffer buffer 9395 (if (derived-mode-p 'org-mode) 9396 (if (and confirm 9397 (not (y-or-n-p "Archive this subtree or entry? "))) 9398 (error "Abort") 9399 (save-window-excursion 9400 (goto-char pos) 9401 (let ((org-agenda-buffer-name bufname-orig)) 9402 (org-remove-subtree-entries-from-agenda)) 9403 (org-back-to-heading t) 9404 (let ((org-archive-from-agenda t)) 9405 (funcall cmd)))) 9406 (error "Archiving works only in Org files"))))))) 9407 9408 (defun org-remove-subtree-entries-from-agenda (&optional buf beg end) 9409 "Remove all lines in the agenda that correspond to a given subtree. 9410 The subtree is the one in buffer BUF, starting at BEG and ending at END. 9411 If this information is not given, the function uses the tree at point." 9412 (let ((buf (or buf (current-buffer))) m p) 9413 (org-with-wide-buffer 9414 (unless (and beg end) 9415 (org-back-to-heading t) 9416 (setq beg (point)) 9417 (org-end-of-subtree t) 9418 (setq end (point))) 9419 (set-buffer (get-buffer org-agenda-buffer-name)) 9420 (save-excursion 9421 (goto-char (point-max)) 9422 (forward-line 0) 9423 (while (not (bobp)) 9424 (when (and (setq m (org-get-at-bol 'org-marker)) 9425 (equal buf (marker-buffer m)) 9426 (setq p (marker-position m)) 9427 (>= p beg) 9428 (< p end)) 9429 (let ((inhibit-read-only t)) 9430 (delete-region (line-beginning-position) 9431 (1+ (line-end-position))))) 9432 (forward-line -1)))))) 9433 9434 (defun org-agenda-refile (&optional goto rfloc no-update) 9435 "Refile the item at point. 9436 9437 When called with `\\[universal-argument] \\[universal-argument]', \ 9438 go to the location of the last 9439 refiled item. 9440 9441 When called with `\\[universal-argument] \\[universal-argument] \ 9442 \\[universal-argument]' prefix or when GOTO is 0, clear 9443 the refile cache. 9444 9445 RFLOC can be a refile location obtained in a different way. 9446 9447 When NO-UPDATE is non-nil, don't redo the agenda buffer." 9448 (interactive "P") 9449 (cond 9450 ((member goto '(0 (64))) 9451 (org-refile-cache-clear)) 9452 ((equal goto '(16)) 9453 (org-refile-goto-last-stored)) 9454 (t 9455 (let* ((buffer-orig (buffer-name)) 9456 (marker (or (org-get-at-bol 'org-hd-marker) 9457 (org-agenda-error))) 9458 (buffer (marker-buffer marker)) 9459 ;; (pos (marker-position marker)) 9460 (rfloc (or rfloc 9461 (org-refile-get-location 9462 (if goto "Goto" "Refile to") buffer 9463 org-refile-allow-creating-parent-nodes)))) 9464 (with-current-buffer buffer 9465 (org-with-wide-buffer 9466 (goto-char marker) 9467 (let ((org-agenda-buffer-name buffer-orig)) 9468 (org-remove-subtree-entries-from-agenda)) 9469 (org-refile goto buffer rfloc)))) 9470 (unless no-update (org-agenda-redo))))) 9471 9472 (defun org-agenda-open-link (&optional arg) 9473 "Open the link(s) in the current entry, if any. 9474 This looks for a link in the displayed line in the agenda. 9475 It also looks at the text of the entry itself." 9476 (interactive "P") 9477 (let* ((marker (or (org-get-at-bol 'org-hd-marker) 9478 (org-get-at-bol 'org-marker))) 9479 (buffer (and marker (marker-buffer marker))) 9480 (prefix (buffer-substring (line-beginning-position) 9481 (line-end-position))) 9482 (lkall (and buffer (org-offer-links-in-entry 9483 buffer marker arg prefix))) 9484 (lk0 (car lkall)) 9485 (lk (if (stringp lk0) (list lk0) lk0)) 9486 (lkend (cdr lkall)) 9487 trg) 9488 (cond 9489 ((and buffer lk) 9490 (mapcar (lambda(l) 9491 (with-current-buffer buffer 9492 (setq trg (and (string-match org-link-bracket-re l) 9493 (match-string 1 l))) 9494 (if (or (not trg) (string-match org-link-any-re trg)) 9495 ;; Don't use `org-with-wide-buffer' here as 9496 ;; opening the link may result in moving the point 9497 (save-restriction 9498 (widen) 9499 (goto-char marker) 9500 (when (search-forward l nil lkend) 9501 (goto-char (match-beginning 0)) 9502 (org-open-at-point))) 9503 (switch-to-buffer-other-window buffer) 9504 ;; This is an internal link, widen the buffer 9505 (widen) 9506 (goto-char marker) 9507 (when (search-forward l nil lkend) 9508 (goto-char (match-beginning 0)) 9509 (org-open-at-point))))) 9510 lk)) 9511 ((or (org-in-regexp (concat "\\(" org-link-bracket-re "\\)")) 9512 (save-excursion 9513 (forward-line 0) 9514 (looking-at (concat ".*?\\(" org-link-bracket-re "\\)")))) 9515 (org-link-open-from-string (match-string 1))) 9516 (t (message "No link to open here"))))) 9517 9518 (defun org-agenda-copy-local-variable (var) 9519 "Get a variable from a referenced buffer and install it here." 9520 (let ((m (org-get-at-bol 'org-marker))) 9521 (when (and m (buffer-live-p (marker-buffer m))) 9522 (set (make-local-variable var) 9523 (with-current-buffer (marker-buffer m) 9524 (symbol-value var)))))) 9525 9526 (defun org-agenda-switch-to (&optional delete-other-windows) 9527 "Go to the Org mode file which contains the item at point. 9528 When optional argument DELETE-OTHER-WINDOWS is non-nil, the 9529 displayed Org file fills the frame." 9530 (interactive) 9531 (if (and org-return-follows-link 9532 (not (org-get-at-bol 'org-marker)) 9533 (org-in-regexp org-link-bracket-re)) 9534 (org-link-open-from-string (match-string 0)) 9535 (let* ((marker (or (org-get-at-bol 'org-marker) 9536 (org-agenda-error))) 9537 (buffer (marker-buffer marker)) 9538 (pos (marker-position marker))) 9539 (unless buffer (user-error "Trying to switch to non-existent buffer")) 9540 (pop-to-buffer-same-window buffer) 9541 (when delete-other-windows 9542 (display-buffer (current-buffer) '(org-display-buffer-full-frame))) 9543 (widen) 9544 (goto-char pos) 9545 (when (derived-mode-p 'org-mode) 9546 (org-fold-show-context 'agenda) 9547 (run-hooks 'org-agenda-after-show-hook))))) 9548 9549 (defun org-agenda-goto-mouse (ev) 9550 "Go to the Org file which contains the item at the mouse click." 9551 (interactive "e") 9552 (mouse-set-point ev) 9553 (org-agenda-goto)) 9554 9555 (defun org-agenda-show (&optional full-entry) 9556 "Display the Org file which contains the item at point. 9557 With prefix argument FULL-ENTRY, make the entire entry visible 9558 if it was hidden in the outline." 9559 (interactive "P") 9560 (let ((win (selected-window))) 9561 (org-agenda-goto t) 9562 (when full-entry (org-fold-show-entry 'hide-drawers)) 9563 (select-window win))) 9564 9565 (defvar org-agenda-show-window nil) 9566 (defun org-agenda-show-and-scroll-up (&optional arg) 9567 "Display the Org file which contains the item at point. 9568 9569 When called repeatedly, scroll the window that is displaying the buffer. 9570 9571 With a `\\[universal-argument]' prefix argument, display the item, but \ 9572 fold drawers." 9573 (interactive "P") 9574 (let ((win (selected-window))) 9575 (if (and (window-live-p org-agenda-show-window) 9576 (eq this-command last-command)) 9577 (progn 9578 (select-window org-agenda-show-window) 9579 (ignore-errors (scroll-up))) 9580 (org-agenda-goto t) 9581 (org-fold-show-entry 'hide-drawers) 9582 (if arg (org-cycle-hide-drawers 'children) 9583 (org-with-wide-buffer 9584 (narrow-to-region (org-entry-beginning-position) 9585 (org-entry-end-position)) 9586 (org-fold-show-all '(drawers)))) 9587 (setq org-agenda-show-window (selected-window))) 9588 (select-window win))) 9589 9590 (defun org-agenda-show-scroll-down () 9591 "Scroll down the window showing the agenda." 9592 (interactive) 9593 (let ((win (selected-window))) 9594 (when (window-live-p org-agenda-show-window) 9595 (select-window org-agenda-show-window) 9596 (ignore-errors (scroll-down)) 9597 (select-window win)))) 9598 9599 (defun org-agenda-show-1 (&optional more) 9600 "Display the Org file which contains the item at point. 9601 The prefix arg selects the amount of information to display: 9602 9603 0 hide the subtree 9604 1 just show the entry according to defaults. 9605 2 show the children view 9606 3 show the subtree view 9607 4 show the entire subtree and any drawers 9608 With prefix argument FULL-ENTRY, make the entire entry visible 9609 if it was hidden in the outline." 9610 (interactive "p") 9611 (let ((win (selected-window))) 9612 (org-agenda-goto t) 9613 (org-back-to-heading) 9614 (set-window-start (selected-window) (line-beginning-position)) 9615 (cond 9616 ((= more 0) 9617 (org-fold-subtree t) 9618 (save-excursion 9619 (org-back-to-heading) 9620 (run-hook-with-args 'org-cycle-hook 'folded)) 9621 (message "Remote: FOLDED")) 9622 ((and (called-interactively-p 'any) (= more 1)) 9623 (message "Remote: show with default settings")) 9624 ((= more 2) 9625 (org-fold-show-entry 'hide-drawers) 9626 (org-fold-show-children) 9627 (save-excursion 9628 (org-back-to-heading) 9629 (run-hook-with-args 'org-cycle-hook 'children)) 9630 (message "Remote: CHILDREN")) 9631 ((= more 3) 9632 (org-fold-show-subtree) 9633 (save-excursion 9634 (org-back-to-heading) 9635 (run-hook-with-args 'org-cycle-hook 'subtree)) 9636 (message "Remote: SUBTREE")) 9637 ((> more 3) 9638 (org-fold-show-subtree) 9639 (message "Remote: SUBTREE AND ALL DRAWERS"))) 9640 (select-window win))) 9641 9642 (defvar org-agenda-cycle-counter nil) 9643 (defun org-agenda-cycle-show (&optional n) 9644 "Show the current entry in another window, with default settings. 9645 9646 Default settings are taken from `org-show-context-detail'. When 9647 use repeatedly in immediate succession, the remote entry will 9648 cycle through visibility 9649 9650 children -> subtree -> folded 9651 9652 When called with a numeric prefix arg, that arg will be passed through to 9653 `org-agenda-show-1'. For the interpretation of that argument, see the 9654 docstring of `org-agenda-show-1'." 9655 (interactive "P") 9656 (if (integerp n) 9657 (setq org-agenda-cycle-counter n) 9658 (if (not (eq last-command this-command)) 9659 (setq org-agenda-cycle-counter 1) 9660 (if (equal org-agenda-cycle-counter 0) 9661 (setq org-agenda-cycle-counter 2) 9662 (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) 9663 (when (> org-agenda-cycle-counter 3) 9664 (setq org-agenda-cycle-counter 0))))) 9665 (org-agenda-show-1 org-agenda-cycle-counter)) 9666 9667 (defun org-agenda-recenter (arg) 9668 "Display the Org file which contains the item at point and recenter." 9669 (interactive "P") 9670 (let ((win (selected-window))) 9671 (org-agenda-goto t) 9672 (recenter arg) 9673 (select-window win))) 9674 9675 (defun org-agenda-show-mouse (ev) 9676 "Display the Org file which contains the item at the mouse click." 9677 (interactive "e") 9678 (mouse-set-point ev) 9679 (org-agenda-show)) 9680 9681 (defun org-agenda-check-no-diary () 9682 "Check if the entry is a diary link and abort if yes." 9683 (when (org-get-at-bol 'org-agenda-diary-link) 9684 (org-agenda-error))) 9685 9686 (defun org-agenda-error () 9687 "Throw an error when a command is not allowed in the agenda." 9688 (user-error "Command not allowed in this line")) 9689 9690 (defun org-agenda-tree-to-indirect-buffer (arg) 9691 "Show the subtree corresponding to the current entry in an indirect buffer. 9692 This calls the command `org-tree-to-indirect-buffer' from the original buffer. 9693 9694 With a numerical prefix ARG, go up to this level and then take that tree. 9695 With a negative numeric ARG, go up by this number of levels. 9696 9697 With a `\\[universal-argument]' prefix, make a separate frame for this tree, \ 9698 i.e. don't use 9699 the dedicated frame." 9700 (interactive "P") 9701 (org-agenda-check-no-diary) 9702 (let* ((marker (or (org-get-at-bol 'org-marker) 9703 (org-agenda-error))) 9704 (buffer (marker-buffer marker)) 9705 (pos (marker-position marker))) 9706 (with-current-buffer buffer 9707 (save-excursion 9708 (goto-char pos) 9709 (org-tree-to-indirect-buffer arg)))) 9710 (setq org-agenda-last-indirect-buffer org-last-indirect-buffer)) 9711 9712 (defvar org-last-heading-marker (make-marker) 9713 "Marker pointing to the headline that last changed its TODO state 9714 by a remote command from the agenda.") 9715 9716 (defun org-agenda-todo-nextset () 9717 "Switch TODO entry to next sequence." 9718 (interactive) 9719 (org-agenda-todo 'nextset)) 9720 9721 (defun org-agenda-todo-previousset () 9722 "Switch TODO entry to previous sequence." 9723 (interactive) 9724 (org-agenda-todo 'previousset)) 9725 9726 (defvar org-agenda-headline-snapshot-before-repeat) 9727 9728 (defun org-agenda-todo (&optional arg) 9729 "Cycle TODO state of line at point, also in Org file. 9730 This changes the line at point, all other lines in the agenda referring to 9731 the same tree node, and the headline of the tree node in the Org file." 9732 (interactive "P") 9733 (org-agenda-check-no-diary) 9734 (org-agenda-maybe-loop 9735 #'org-agenda-todo arg nil nil 9736 (let* ((col (current-column)) 9737 (marker (or (org-get-at-bol 'org-marker) 9738 (org-agenda-error))) 9739 (buffer (marker-buffer marker)) 9740 (pos (marker-position marker)) 9741 (hdmarker (org-get-at-bol 'org-hd-marker)) 9742 (todayp (org-agenda-today-p (org-get-at-bol 'day))) 9743 (inhibit-read-only t) 9744 org-loop-over-headlines-in-active-region 9745 org-agenda-headline-snapshot-before-repeat newhead just-one) 9746 (org-with-remote-undo buffer 9747 (with-current-buffer buffer 9748 (widen) 9749 (goto-char pos) 9750 (org-fold-show-context 'agenda) 9751 (let ((current-prefix-arg arg)) 9752 (call-interactively 'org-todo) 9753 ;; Make sure that log is recorded in current undo. 9754 (when (and org-log-setup 9755 (not (eq org-log-note-how 'note))) 9756 (org-add-log-note))) 9757 (and (bolp) (forward-char 1)) 9758 (setq newhead (org-get-heading)) 9759 (when (and org-agenda-headline-snapshot-before-repeat 9760 (not (equal org-agenda-headline-snapshot-before-repeat 9761 newhead)) 9762 todayp) 9763 (setq newhead org-agenda-headline-snapshot-before-repeat 9764 just-one t)) 9765 (save-excursion 9766 (org-back-to-heading) 9767 (move-marker org-last-heading-marker (point)))) 9768 (forward-line 0) 9769 (save-window-excursion 9770 (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) 9771 (when (bound-and-true-p org-clock-out-when-done) 9772 (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda)) 9773 newhead) 9774 (org-agenda-unmark-clocking-task)) 9775 (org-move-to-column col) 9776 (org-agenda-mark-clocking-task))))) 9777 9778 (defun org-agenda-add-note (&optional _arg) 9779 "Add a time-stamped note to the entry at point." 9780 (interactive) ;; "P" 9781 (org-agenda-check-no-diary) 9782 (let* ((marker (or (org-get-at-bol 'org-marker) 9783 (org-agenda-error))) 9784 (buffer (marker-buffer marker)) 9785 (pos (marker-position marker)) 9786 (_hdmarker (org-get-at-bol 'org-hd-marker)) 9787 (inhibit-read-only t)) 9788 (with-current-buffer buffer 9789 (widen) 9790 (goto-char pos) 9791 (org-fold-show-context 'agenda) 9792 (org-add-note)))) 9793 9794 (defun org-agenda-change-all-lines (newhead hdmarker 9795 &optional fixface just-this) 9796 "Change all lines in the agenda buffer which match HDMARKER. 9797 The new content of the line will be NEWHEAD (as modified by 9798 `org-agenda-format-item'). HDMARKER is checked with 9799 `equal' against all `org-hd-marker' text properties in the file. 9800 If FIXFACE is non-nil, the face of each item is modified according to 9801 the new TODO state. 9802 If JUST-THIS is non-nil, change just the current line, not all. 9803 If FORCE-TAGS is non-nil, the car of it returns the new tags." 9804 (let* ((inhibit-read-only t) 9805 (line (org-current-line)) 9806 (org-agenda-buffer (current-buffer)) 9807 (thetags (with-current-buffer (marker-buffer hdmarker) 9808 (org-get-tags hdmarker))) 9809 props m undone-face done-face finish new dotime level cat tags 9810 effort effort-minutes) ;; pl 9811 (save-excursion 9812 (goto-char (point-max)) 9813 (forward-line 0) 9814 (while (not finish) 9815 (setq finish (bobp)) 9816 (when (and (setq m (org-get-at-bol 'org-hd-marker)) 9817 (or (not just-this) (= (org-current-line) line)) 9818 (equal m hdmarker)) 9819 (setq props (text-properties-at (point)) 9820 dotime (org-get-at-bol 'dotime) 9821 cat (org-agenda-get-category) 9822 level (org-get-at-bol 'level) 9823 tags thetags 9824 effort (org-get-at-bol 'effort) 9825 effort-minutes (org-get-at-bol 'effort-minutes) 9826 new 9827 (let ((org-prefix-format-compiled 9828 (or (get-text-property (min (1- (point-max)) (point)) 'format) 9829 org-prefix-format-compiled)) 9830 (extra (org-get-at-bol 'extra))) 9831 (with-current-buffer (marker-buffer hdmarker) 9832 (org-with-wide-buffer 9833 (org-agenda-format-item extra 9834 (org-add-props newhead nil 9835 'effort effort 9836 'effort-minutes effort-minutes) 9837 level cat tags dotime)))) 9838 ;; pl (text-property-any (line-beginning-position) 9839 ;; (line-end-position) 'org-heading t) 9840 undone-face (org-get-at-bol 'undone-face) 9841 done-face (org-get-at-bol 'done-face)) 9842 (forward-line 0) 9843 (cond 9844 ((equal new "") (delete-region (point) (line-beginning-position 2))) 9845 ((looking-at ".*") 9846 ;; When replacing the whole line, preserve bulk mark 9847 ;; overlay, if any. 9848 (let ((mark (catch :overlay 9849 (dolist (o (overlays-in (point) (+ 2 (point)))) 9850 (when (eq (overlay-get o 'type) 9851 'org-marked-entry-overlay) 9852 (throw :overlay o)))))) 9853 (replace-match new t t) 9854 (forward-line 0) 9855 (when mark (move-overlay mark (point) (+ 2 (point))))) 9856 (add-text-properties (line-beginning-position) 9857 (line-end-position) props) 9858 (when fixface 9859 (add-text-properties 9860 (line-beginning-position) (line-end-position) 9861 (list 'face 9862 (if org-last-todo-state-is-todo 9863 undone-face done-face)))) 9864 (org-agenda-highlight-todo 'line) 9865 (forward-line 0)) 9866 (t (error "Line update did not work"))) 9867 (save-restriction 9868 (narrow-to-region (line-beginning-position) (line-end-position)) 9869 (org-agenda-finalize))) 9870 (forward-line -1))))) 9871 9872 (defun org-agenda-align-tags (&optional line) 9873 "Align all tags in agenda items to `org-agenda-tags-column'. 9874 When optional argument LINE is non-nil, align tags only on the 9875 current line." 9876 (let ((inhibit-read-only t) 9877 (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column) 9878 (- (window-max-chars-per-line)) 9879 org-agenda-tags-column)) 9880 (end (and line (line-end-position))) 9881 l c) 9882 (org-fold-core-ignore-modifications 9883 (save-excursion 9884 (goto-char (if line (line-beginning-position) (point-min))) 9885 (while (re-search-forward org-tag-group-re end t) 9886 (add-text-properties 9887 (match-beginning 1) (match-end 1) 9888 (list 'face (delq nil (let ((prop (get-text-property 9889 (match-beginning 1) 'face))) 9890 (or (listp prop) (setq prop (list prop))) 9891 (if (memq 'org-tag prop) 9892 prop 9893 (cons 'org-tag prop)))))) 9894 (setq l (string-width (match-string 1)) 9895 c (if (< org-agenda-tags-column 0) 9896 (- (abs org-agenda-tags-column) l) 9897 org-agenda-tags-column)) 9898 (goto-char (match-beginning 1)) 9899 (delete-region (save-excursion (skip-chars-backward " \t") (point)) 9900 (point)) 9901 (insert (org-add-props 9902 (make-string (max 1 (- c (current-column))) ?\s) 9903 (plist-put (copy-sequence (text-properties-at (point))) 9904 'face nil)))) 9905 (goto-char (point-min)) 9906 (org-font-lock-add-tag-faces (point-max)))))) 9907 9908 (defun org-agenda-priority-up () 9909 "Increase the priority of line at point, also in Org file." 9910 (interactive) 9911 (org-agenda-priority 'up)) 9912 9913 (defun org-agenda-priority-down () 9914 "Decrease the priority of line at point, also in Org file." 9915 (interactive) 9916 (org-agenda-priority 'down)) 9917 9918 (defun org-agenda-priority (&optional force-direction) 9919 "Set the priority of line at point, also in Org file. 9920 This changes the line at point, all other lines in the agenda 9921 referring to the same tree node, and the headline of the tree 9922 node in the Org file. 9923 9924 Called with one universal prefix arg, show the priority instead 9925 of setting it. 9926 9927 When called programmatically, FORCE-DIRECTION can be `set', `up', 9928 `down', or a character." 9929 (interactive "P") 9930 (unless org-priority-enable-commands 9931 (user-error "Priority commands are disabled")) 9932 (org-agenda-check-no-diary) 9933 (let* ((col (current-column)) 9934 (hdmarker (org-get-at-bol 'org-hd-marker)) 9935 (buffer (marker-buffer hdmarker)) 9936 (pos (marker-position hdmarker)) 9937 (inhibit-read-only t) 9938 newhead) 9939 (org-with-remote-undo buffer 9940 (with-current-buffer buffer 9941 (widen) 9942 (goto-char pos) 9943 (org-fold-show-context 'agenda) 9944 (org-priority force-direction) 9945 (end-of-line 1) 9946 (setq newhead (org-get-heading))) 9947 (org-agenda-change-all-lines newhead hdmarker) 9948 (org-move-to-column col)))) 9949 9950 ;; FIXME: should fix the tags property of the agenda line. 9951 (defun org-agenda-set-tags (&optional tag onoff) 9952 "Set tags for the current headline." 9953 (interactive) 9954 (org-agenda-check-no-diary) 9955 (if (and (org-region-active-p) (called-interactively-p 'any)) 9956 (call-interactively 'org-change-tag-in-region) 9957 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 9958 (org-agenda-error))) 9959 (buffer (marker-buffer hdmarker)) 9960 (pos (marker-position hdmarker)) 9961 (inhibit-read-only t) 9962 newhead) 9963 (org-with-remote-undo buffer 9964 (with-current-buffer buffer 9965 (widen) 9966 (goto-char pos) 9967 (org-fold-show-context 'agenda) 9968 (if tag 9969 (org-toggle-tag tag onoff) 9970 (call-interactively #'org-set-tags-command)) 9971 (end-of-line 1) 9972 (setq newhead (org-get-heading))) 9973 (org-agenda-change-all-lines newhead hdmarker) 9974 (forward-line 0))))) 9975 9976 (defun org-agenda-set-property () 9977 "Set a property for the current headline." 9978 (interactive) 9979 (org-agenda-check-no-diary) 9980 (org-agenda-maybe-loop 9981 #'org-agenda-set-property nil nil nil 9982 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 9983 (org-agenda-error))) 9984 (buffer (marker-buffer hdmarker)) 9985 (pos (marker-position hdmarker)) 9986 (inhibit-read-only t) 9987 ) ;; newhead 9988 (org-with-remote-undo buffer 9989 (with-current-buffer buffer 9990 (widen) 9991 (goto-char pos) 9992 (org-fold-show-context 'agenda) 9993 (call-interactively 'org-set-property)))))) 9994 9995 (defun org-agenda-set-effort () 9996 "Set the effort property for the current headline." 9997 (interactive) 9998 (org-agenda-check-no-diary) 9999 (org-agenda-maybe-loop 10000 #'org-agenda-set-effort nil nil nil 10001 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 10002 (org-agenda-error))) 10003 (buffer (marker-buffer hdmarker)) 10004 (pos (marker-position hdmarker)) 10005 (inhibit-read-only t) 10006 newhead) 10007 (org-with-remote-undo buffer 10008 (with-current-buffer buffer 10009 (widen) 10010 (goto-char pos) 10011 (org-fold-show-context 'agenda) 10012 (call-interactively 'org-set-effort) 10013 (end-of-line 1) 10014 (setq newhead (org-get-heading))) 10015 (org-agenda-change-all-lines newhead hdmarker))))) 10016 10017 (defun org-agenda-toggle-archive-tag () 10018 "Toggle the archive tag for the current entry." 10019 (interactive) 10020 (org-agenda-check-no-diary) 10021 (org-agenda-maybe-loop 10022 #'org-agenda-toggle-archive-tag nil nil nil 10023 (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) 10024 (org-agenda-error))) 10025 (buffer (marker-buffer hdmarker)) 10026 (pos (marker-position hdmarker)) 10027 (inhibit-read-only t) 10028 newhead) 10029 (org-with-remote-undo buffer 10030 (with-current-buffer buffer 10031 (widen) 10032 (goto-char pos) 10033 (org-fold-show-context 'agenda) 10034 (call-interactively 'org-toggle-archive-tag) 10035 (end-of-line 1) 10036 (setq newhead (org-get-heading))) 10037 (org-agenda-change-all-lines newhead hdmarker) 10038 (forward-line 0))))) 10039 10040 (defun org-agenda-do-date-later (arg) 10041 (interactive "P") 10042 (cond 10043 ((or (equal arg '(16)) 10044 (memq last-command 10045 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) 10046 (setq this-command 'org-agenda-date-later-minutes) 10047 (org-agenda-date-later-minutes 1)) 10048 ((or (equal arg '(4)) 10049 (memq last-command 10050 '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) 10051 (setq this-command 'org-agenda-date-later-hours) 10052 (org-agenda-date-later-hours 1)) 10053 (t 10054 (org-agenda-date-later (prefix-numeric-value arg))))) 10055 10056 (defun org-agenda-do-date-earlier (arg) 10057 (interactive "P") 10058 (cond 10059 ((or (equal arg '(16)) 10060 (memq last-command 10061 '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) 10062 (setq this-command 'org-agenda-date-earlier-minutes) 10063 (org-agenda-date-earlier-minutes 1)) 10064 ((or (equal arg '(4)) 10065 (memq last-command 10066 '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) 10067 (setq this-command 'org-agenda-date-earlier-hours) 10068 (org-agenda-date-earlier-hours 1)) 10069 (t 10070 (org-agenda-date-earlier (prefix-numeric-value arg))))) 10071 10072 (defun org-agenda-date-later (arg &optional what) 10073 "Change the date of this item to ARG day(s) later." 10074 (interactive "p") 10075 (org-agenda-check-type t 'agenda) 10076 (org-agenda-check-no-diary) 10077 (let* ((marker (or (org-get-at-bol 'org-marker) 10078 (org-agenda-error))) 10079 (buffer (marker-buffer marker)) 10080 (pos (marker-position marker)) 10081 cdate today) 10082 (org-with-remote-undo buffer 10083 (with-current-buffer buffer 10084 (widen) 10085 (goto-char pos) 10086 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) 10087 (when (and org-agenda-move-date-from-past-immediately-to-today 10088 (equal arg 1) 10089 (or (not what) (eq what 'day)) 10090 (not (save-match-data (org-at-date-range-p)))) 10091 (setq cdate (org-parse-time-string (match-string 0) 'nodefault) 10092 cdate (calendar-absolute-from-gregorian 10093 (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate))) 10094 today (org-today)) 10095 (when (> today cdate) 10096 ;; immediately shift to today 10097 (setq arg (- today cdate)))) 10098 (org-timestamp-change arg (or what 'day)) 10099 (when (and (org-at-date-range-p) 10100 (re-search-backward org-tr-regexp-both 10101 (line-beginning-position))) 10102 (let ((end org-last-changed-timestamp)) 10103 (org-timestamp-change arg (or what 'day)) 10104 (setq org-last-changed-timestamp 10105 (concat org-last-changed-timestamp "--" end))))) 10106 (org-agenda-show-new-time marker org-last-changed-timestamp)) 10107 (message "Time stamp changed to %s" org-last-changed-timestamp))) 10108 10109 (defun org-agenda-date-earlier (arg &optional what) 10110 "Change the date of this item to ARG day(s) earlier." 10111 (interactive "p") 10112 (org-agenda-date-later (- arg) what)) 10113 10114 (defun org-agenda-date-later-minutes (arg) 10115 "Change the time of this item, in units of `org-timestamp-rounding-minutes'." 10116 (interactive "p") 10117 (setq arg (* arg (cadr org-timestamp-rounding-minutes))) 10118 (org-agenda-date-later arg 'minute)) 10119 10120 (defun org-agenda-date-earlier-minutes (arg) 10121 "Change the time of this item, in units of `org-timestamp-rounding-minutes'." 10122 (interactive "p") 10123 (setq arg (* arg (cadr org-timestamp-rounding-minutes))) 10124 (org-agenda-date-earlier arg 'minute)) 10125 10126 (defun org-agenda-date-later-hours (arg) 10127 "Change the time of this item, in hour steps." 10128 (interactive "p") 10129 (org-agenda-date-later arg 'hour)) 10130 10131 (defun org-agenda-date-earlier-hours (arg) 10132 "Change the time of this item, in hour steps." 10133 (interactive "p") 10134 (org-agenda-date-earlier arg 'hour)) 10135 10136 (defun org-agenda-show-new-time (marker stamp &optional prefix) 10137 "Show new date stamp via text properties." 10138 ;; We use text properties to make this undoable 10139 (let ((inhibit-read-only t)) 10140 (setq stamp (concat prefix " => " stamp " ")) 10141 (save-excursion 10142 (goto-char (point-max)) 10143 (while (not (bobp)) 10144 (when (equal marker (org-get-at-bol 'org-marker)) 10145 (remove-text-properties (line-beginning-position) 10146 (line-end-position) 10147 '(display nil)) 10148 (org-move-to-column 10149 (max 10150 1 ;; narrow buffer and wide timestamp 10151 (- (window-max-chars-per-line) 10152 (length stamp))) 10153 t) 10154 (add-text-properties 10155 (1- (point)) (line-end-position) 10156 (list 'display (org-add-props stamp nil 10157 'face '(secondary-selection default)))) 10158 (forward-line 0)) 10159 (forward-line -1))))) 10160 10161 (defun org-agenda-date-prompt (arg) 10162 "Change the date of this item. Date is prompted for, with default today. 10163 The prefix ARG is passed to the `org-timestamp' command and can therefore 10164 be used to request time specification in the time stamp." 10165 (interactive "P") 10166 (org-agenda-check-type t 'agenda) 10167 (org-agenda-check-no-diary) 10168 (org-agenda-maybe-loop 10169 #'org-agenda-date-prompt arg t nil 10170 (let* ((marker (or (org-get-at-bol 'org-marker) 10171 (org-agenda-error))) 10172 (buffer (marker-buffer marker)) 10173 (pos (marker-position marker))) 10174 (org-with-remote-undo buffer 10175 (with-current-buffer buffer 10176 (widen) 10177 (goto-char pos) 10178 (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp")) 10179 (org-timestamp arg (equal (char-after (match-beginning 0)) ?\[))) 10180 (org-agenda-show-new-time marker org-last-changed-timestamp)) 10181 (message "Time stamp changed to %s" org-last-changed-timestamp)))) 10182 10183 (defun org-agenda-schedule (arg &optional time) 10184 "Schedule the item at point. 10185 ARG is passed through to `org-schedule'." 10186 (interactive "P") 10187 (org-agenda-check-type t 'agenda 'todo 'tags 'search) 10188 (org-agenda-check-no-diary) 10189 (org-agenda-maybe-loop 10190 #'org-agenda-schedule arg t nil 10191 (let* ((marker (or (org-get-at-bol 'org-marker) 10192 (org-agenda-error))) 10193 ;; (type (marker-insertion-type marker)) 10194 (buffer (marker-buffer marker)) 10195 (pos (marker-position marker)) 10196 ts) 10197 (set-marker-insertion-type marker t) 10198 (org-with-remote-undo buffer 10199 (with-current-buffer buffer 10200 (widen) 10201 (goto-char pos) 10202 (setq ts (org-schedule arg time))) 10203 (org-agenda-show-new-time marker ts " S")) 10204 (message "%s" ts)))) 10205 10206 (defun org-agenda-deadline (arg &optional time) 10207 "Schedule the item at point. 10208 ARG is passed through to `org-deadline'." 10209 (interactive "P") 10210 (org-agenda-check-type t 'agenda 'todo 'tags 'search) 10211 (org-agenda-check-no-diary) 10212 (org-agenda-maybe-loop 10213 #'org-agenda-deadline arg t nil 10214 (let* ((marker (or (org-get-at-bol 'org-marker) 10215 (org-agenda-error))) 10216 (buffer (marker-buffer marker)) 10217 (pos (marker-position marker)) 10218 ts) 10219 (org-with-remote-undo buffer 10220 (with-current-buffer buffer 10221 (widen) 10222 (goto-char pos) 10223 (setq ts (org-deadline arg time))) 10224 (org-agenda-show-new-time marker ts " D")) 10225 (message "%s" ts)))) 10226 10227 (defun org-agenda-clock-in (&optional arg) 10228 "Start the clock on the currently selected item." 10229 (interactive "P") 10230 (org-agenda-check-no-diary) 10231 (if (equal arg '(4)) 10232 (org-clock-in arg) 10233 (let* ((marker (or (org-get-at-bol 'org-marker) 10234 (org-agenda-error))) 10235 (hdmarker (or (org-get-at-bol 'org-hd-marker) marker)) 10236 (pos (marker-position marker)) 10237 (col (current-column)) 10238 newhead) 10239 (org-with-remote-undo (marker-buffer marker) 10240 (with-current-buffer (marker-buffer marker) 10241 (widen) 10242 (goto-char pos) 10243 (org-fold-show-context 'agenda) 10244 (org-clock-in arg) 10245 (setq newhead (org-get-heading))) 10246 (org-agenda-change-all-lines newhead hdmarker)) 10247 (org-move-to-column col)))) 10248 10249 (defun org-agenda-clock-out () 10250 "Stop the currently running clock." 10251 (interactive) 10252 (unless (marker-buffer org-clock-marker) 10253 (user-error "No running clock")) 10254 (let ((marker (make-marker)) (col (current-column)) newhead) 10255 (org-with-remote-undo (marker-buffer org-clock-marker) 10256 (with-current-buffer (marker-buffer org-clock-marker) 10257 (org-with-wide-buffer 10258 (goto-char org-clock-marker) 10259 (org-back-to-heading t) 10260 (move-marker marker (point)) 10261 (org-clock-out) 10262 (setq newhead (org-get-heading))))) 10263 (org-agenda-change-all-lines newhead marker) 10264 (move-marker marker nil) 10265 (org-move-to-column col) 10266 (org-agenda-unmark-clocking-task))) 10267 10268 (defun org-agenda-clock-cancel (&optional _arg) 10269 "Cancel the currently running clock." 10270 (interactive) ;; "P" 10271 (unless (marker-buffer org-clock-marker) 10272 (user-error "No running clock")) 10273 (org-with-remote-undo (marker-buffer org-clock-marker) 10274 (org-clock-cancel)) 10275 (org-agenda-unmark-clocking-task)) 10276 10277 (defun org-agenda-clock-goto () 10278 "Jump to the currently clocked in task within the agenda. 10279 If the currently clocked in task is not listed in the agenda 10280 buffer, display it in another window." 10281 (interactive) 10282 (let (pos) 10283 (mapc (lambda (o) 10284 (when (eq (overlay-get o 'type) 'org-agenda-clocking) 10285 (setq pos (overlay-start o)))) 10286 (overlays-in (point-min) (point-max))) 10287 (cond (pos (goto-char pos)) 10288 ;; If the currently clocked entry is not in the agenda 10289 ;; buffer, we visit it in another window: 10290 ((bound-and-true-p org-clock-current-task) 10291 (switch-to-buffer-other-window (org-clock-goto))) 10292 (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) 10293 10294 (defun org-agenda-diary-entry-in-org-file () 10295 "Make a diary entry in the file `org-agenda-diary-file'." 10296 (let (d1 d2 char (text "") dp1 dp2) 10297 (if (equal (buffer-name) calendar-buffer) 10298 (setq d1 (calendar-cursor-to-date t) 10299 d2 (car calendar-mark-ring)) 10300 (setq dp1 (get-text-property (line-beginning-position) 'day)) 10301 (unless dp1 (user-error "No date defined in current line")) 10302 (setq d1 (calendar-gregorian-from-absolute dp1) 10303 d2 (and (ignore-errors (mark)) 10304 (save-excursion 10305 (goto-char (mark)) 10306 (setq dp2 (get-text-property (line-beginning-position) 'day))) 10307 (calendar-gregorian-from-absolute dp2)))) 10308 (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree") 10309 (setq char (read-char-exclusive)) 10310 (cond 10311 ((equal char ?d) 10312 (setq text (read-string "Day entry: ")) 10313 (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1) 10314 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) 10315 ((equal char ?a) 10316 (setq d1 (list (car d1) (nth 1 d1) 10317 (read-number (format "Reference year [%d]: " (nth 2 d1)) 10318 (nth 2 d1)))) 10319 (setq text (read-string "Anniversary (use %d to show years): ")) 10320 (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1) 10321 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) 10322 ((equal char ?b) 10323 (setq text (read-string "Block entry: ")) 10324 (unless (and d1 d2 (not (equal d1 d2))) 10325 (user-error "No block of days selected")) 10326 (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2) 10327 (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) 10328 ((equal char ?j) 10329 (switch-to-buffer-other-window 10330 (find-file-noselect org-agenda-diary-file)) 10331 (require 'org-datetree) 10332 (org-datetree-find-date-create d1) 10333 (org-fold-reveal t)) 10334 (t (user-error "Invalid selection character `%c'" char))))) 10335 10336 (defcustom org-agenda-insert-diary-strategy 'date-tree 10337 "Where in `org-agenda-diary-file' should new entries be added? 10338 Valid values: 10339 10340 date-tree in the date tree, as first child of the date 10341 date-tree-last in the date tree, as last child of the date 10342 top-level as top-level entries at the end of the file." 10343 :group 'org-agenda 10344 :type '(choice 10345 (const :tag "first in a date tree" date-tree) 10346 (const :tag "last in a date tree" date-tree-last) 10347 (const :tag "as top level at end of file" top-level))) 10348 10349 (defcustom org-agenda-insert-diary-extract-time nil 10350 "Non-nil means extract any time specification from the diary entry." 10351 :group 'org-agenda 10352 :version "24.1" 10353 :type 'boolean) 10354 10355 (defcustom org-agenda-bulk-mark-char ">" 10356 "A single-character string to be used as the bulk mark." 10357 :group 'org-agenda 10358 :version "24.1" 10359 :type 'string) 10360 10361 (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) 10362 "Add a diary entry with TYPE to `org-agenda-diary-file'. 10363 If TEXT is not empty, it will become the headline of the new entry, and 10364 the resulting entry will not be shown. When TEXT is empty, switch to 10365 `org-agenda-diary-file' and let the user finish the entry there." 10366 (let ((cw (current-window-configuration))) 10367 (switch-to-buffer-other-window 10368 (find-file-noselect org-agenda-diary-file)) 10369 (widen) 10370 (goto-char (point-min)) 10371 (cl-case type 10372 (anniversary 10373 (or (re-search-forward "^\\*[ \t]+Anniversaries" nil t) 10374 (progn 10375 (or (org-at-heading-p) 10376 (progn 10377 (outline-next-heading) 10378 (insert "* Anniversaries\n\n") 10379 (forward-line -2))))) 10380 (outline-next-heading) 10381 (org-back-over-empty-lines) 10382 (backward-char 1) 10383 (insert "\n") 10384 (insert (format "%%%%(org-anniversary %d %2d %2d) %s" 10385 (nth 2 d1) (car d1) (nth 1 d1) text))) 10386 (day 10387 (let ((org-prefix-has-time t) 10388 (org-agenda-time-leading-zero t) 10389 fmt time time2) 10390 (when org-agenda-insert-diary-extract-time 10391 ;; Use org-agenda-format-item to parse text for a time-range and 10392 ;; remove it. FIXME: This is a hack, we should refactor 10393 ;; that function to make time extraction available separately 10394 (setq fmt (org-agenda-format-item nil text nil nil nil t) 10395 time (get-text-property 0 'time fmt) 10396 time2 (if (> (length time) 0) 10397 ;; split-string removes trailing ...... if 10398 ;; no end time given. First space 10399 ;; separates time from date. 10400 (concat " " (car (split-string time "\\."))) 10401 nil) 10402 text (get-text-property 0 'txt fmt))) 10403 (if (eq org-agenda-insert-diary-strategy 'top-level) 10404 (org-agenda-insert-diary-as-top-level text) 10405 (require 'org-datetree) 10406 (org-datetree-find-date-create d1) 10407 (org-agenda-insert-diary-make-new-entry text)) 10408 (org-insert-timestamp (org-time-from-absolute 10409 (calendar-absolute-from-gregorian d1)) 10410 nil nil nil nil time2)) 10411 (end-of-line 0)) 10412 ((block) ;; Wrap this in (strictly unnecessary) parens because 10413 ;; otherwise the indentation gets confused by the 10414 ;; special meaning of 'block 10415 (when (> (calendar-absolute-from-gregorian d1) 10416 (calendar-absolute-from-gregorian d2)) 10417 (setq d1 (prog1 d2 (setq d2 d1)))) 10418 (if (eq org-agenda-insert-diary-strategy 'top-level) 10419 (org-agenda-insert-diary-as-top-level text) 10420 (require 'org-datetree) 10421 (org-datetree-find-date-create d1) 10422 (org-agenda-insert-diary-make-new-entry text)) 10423 (org-insert-timestamp (org-time-from-absolute 10424 (calendar-absolute-from-gregorian d1))) 10425 (insert "--") 10426 (org-insert-timestamp (org-time-from-absolute 10427 (calendar-absolute-from-gregorian d2))) 10428 (end-of-line 0))) 10429 (if (string-match "\\S-" text) 10430 (progn 10431 (set-window-configuration cw) 10432 (message "%s entry added to %s" 10433 (capitalize (symbol-name type)) 10434 (abbreviate-file-name org-agenda-diary-file))) 10435 (org-fold-reveal t) 10436 (message "Please finish entry here")))) 10437 10438 (defun org-agenda-insert-diary-as-top-level (text) 10439 "Make new entry as a top-level entry at the end of the file. 10440 Add TEXT as headline, and position the cursor in the second line so that 10441 a timestamp can be added there." 10442 (widen) 10443 (goto-char (point-max)) 10444 (unless (bolp) (insert "\n")) 10445 (org-insert-heading nil t t) 10446 (insert text) 10447 (org-end-of-meta-data) 10448 (unless (bolp) (insert "\n")) 10449 (when org-adapt-indentation (indent-to-column 2))) 10450 10451 (defun org-agenda-insert-diary-make-new-entry (text) 10452 "Make a new entry with TEXT as a child of the current subtree. 10453 Position the point in the heading's first body line so that 10454 a timestamp can be added there." 10455 (cond 10456 ((eq org-agenda-insert-diary-strategy 'date-tree-last) 10457 (end-of-line) 10458 (org-insert-heading '(4) t) 10459 (org-do-demote)) 10460 (t 10461 (outline-next-heading) 10462 (org-back-over-empty-lines) 10463 (unless (looking-at "[ \t]*$") (save-excursion (insert "\n"))) 10464 (org-insert-heading nil t) 10465 (org-do-demote))) 10466 (let ((col (current-column))) 10467 (insert text) 10468 (org-end-of-meta-data) 10469 ;; Ensure point is left on a blank line, at proper indentation. 10470 (unless (bolp) (insert "\n")) 10471 (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n"))) 10472 (when org-adapt-indentation (indent-to-column col))) 10473 (org-fold-show-set-visibility 'lineage)) 10474 10475 (defun org-agenda-diary-entry () 10476 "Make a diary entry, like the `i' command from the calendar. 10477 All the standard commands work: block, weekly etc. 10478 When `org-agenda-diary-file' points to a file, 10479 `org-agenda-diary-entry-in-org-file' is called instead to create 10480 entries in that Org file." 10481 (interactive) 10482 (if (not (eq org-agenda-diary-file 'diary-file)) 10483 (org-agenda-diary-entry-in-org-file) 10484 (require 'diary-lib) 10485 (let* ((char (read-char-exclusive 10486 "Diary entry: [d]ay [w]eekly [m]onthly [y]early\ 10487 [a]nniversary [b]lock [c]yclic")) 10488 (cmd (cdr (assoc char 10489 '((?d . diary-insert-entry) 10490 (?w . diary-insert-weekly-entry) 10491 (?m . diary-insert-monthly-entry) 10492 (?y . diary-insert-yearly-entry) 10493 (?a . diary-insert-anniversary-entry) 10494 (?b . diary-insert-block-entry) 10495 (?c . diary-insert-cyclic-entry))))) 10496 (oldf (symbol-function 'calendar-cursor-to-date)) 10497 ;; (buf (get-file-buffer (substitute-in-file-name diary-file))) 10498 (point (point)) 10499 (mark (or (mark t) (point)))) 10500 (unless cmd 10501 (user-error "No command associated with <%c>" char)) 10502 (unless (and (get-text-property point 'day) 10503 (or (not (equal ?b char)) 10504 (get-text-property mark 'day))) 10505 (user-error "Don't know which date to use for diary entry")) 10506 ;; We implement this by hacking the `calendar-cursor-to-date' function 10507 ;; and the `calendar-mark-ring' variable. Saves a lot of code. 10508 (let ((calendar-mark-ring 10509 (list (calendar-gregorian-from-absolute 10510 (or (get-text-property mark 'day) 10511 (get-text-property point 'day)))))) 10512 (unwind-protect 10513 (progn 10514 (fset 'calendar-cursor-to-date 10515 (lambda (&optional _error _dummy) 10516 (calendar-gregorian-from-absolute 10517 (get-text-property point 'day)))) 10518 (call-interactively cmd)) 10519 (fset 'calendar-cursor-to-date oldf)))))) 10520 10521 (defun org-agenda-execute-calendar-command (cmd) 10522 "Execute a calendar command from the agenda with date from cursor." 10523 (org-agenda-check-type t 'agenda) 10524 (require 'diary-lib) 10525 (unless (get-text-property (min (1- (point-max)) (point)) 'day) 10526 (user-error "Don't know which date to use for the calendar command")) 10527 (let* ((oldf (symbol-function 'calendar-cursor-to-date)) 10528 (point (point)) 10529 (date (calendar-gregorian-from-absolute 10530 (get-text-property point 'day)))) 10531 ;; the following 2 vars are needed in the calendar 10532 (org-dlet 10533 ((displayed-month (car date)) 10534 (displayed-year (nth 2 date))) 10535 (unwind-protect 10536 (progn 10537 (fset 'calendar-cursor-to-date 10538 (lambda (&optional _error _dummy) 10539 (calendar-gregorian-from-absolute 10540 (get-text-property point 'day)))) 10541 (call-interactively cmd)) 10542 (fset 'calendar-cursor-to-date oldf))))) 10543 10544 (defun org-agenda-phases-of-moon () 10545 "Display the phases of the moon for the 3 months around the cursor date." 10546 (interactive) 10547 (org-agenda-execute-calendar-command 'calendar-lunar-phases)) 10548 10549 (defun org-agenda-holidays () 10550 "Display the holidays for the 3 months around the cursor date." 10551 (interactive) 10552 (org-agenda-execute-calendar-command 'calendar-list-holidays)) 10553 10554 (defvar calendar-longitude) ; defined in calendar.el 10555 (defvar calendar-latitude) ; defined in calendar.el 10556 (defvar calendar-location-name) ; defined in calendar.el 10557 10558 (defun org-agenda-sunrise-sunset (arg) 10559 "Display sunrise and sunset for the cursor date. 10560 Latitude and longitude can be specified with the variables 10561 `calendar-latitude' and `calendar-longitude'. When called with prefix 10562 argument, latitude and longitude will be prompted for." 10563 (interactive "P") 10564 (require 'solar) 10565 (let ((calendar-longitude (if arg nil calendar-longitude)) 10566 (calendar-latitude (if arg nil calendar-latitude)) 10567 (calendar-location-name 10568 (if arg "the given coordinates" calendar-location-name))) 10569 (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) 10570 10571 (defun org-agenda-goto-calendar () 10572 "Open the Emacs calendar with the date at the cursor." 10573 (interactive) 10574 (org-agenda-check-type t 'agenda) 10575 (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) 10576 (user-error "Don't know which date to open in calendar"))) 10577 (date (calendar-gregorian-from-absolute day)) 10578 (calendar-move-hook nil) 10579 (calendar-view-holidays-initially-flag nil) 10580 (calendar-view-diary-initially-flag nil)) 10581 (calendar) 10582 (calendar-goto-date date))) 10583 10584 ;;;###autoload 10585 (defun org-calendar-goto-agenda () 10586 "Compute the Org agenda for the calendar date displayed at the cursor. 10587 This is a command that has to be installed in `calendar-mode-map'." 10588 (interactive) 10589 ;; Temporarily disable sticky agenda since user clearly wants to 10590 ;; refresh view anyway. 10591 (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*") 10592 (org-agenda-sticky nil)) 10593 (org-agenda-list nil (calendar-absolute-from-gregorian 10594 (calendar-cursor-to-date)) 10595 nil))) 10596 10597 (defun org-agenda-convert-date () 10598 (interactive) 10599 (org-agenda-check-type t 'agenda) 10600 (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) 10601 date s) 10602 (unless day 10603 (user-error "Don't know which date to convert")) 10604 (setq date (calendar-gregorian-from-absolute day)) 10605 (setq s (concat 10606 "Gregorian: " (calendar-date-string date) "\n" 10607 "ISO: " (calendar-iso-date-string date) "\n" 10608 "Day of Yr: " (calendar-day-of-year-string date) "\n" 10609 "Julian: " (calendar-julian-date-string date) "\n" 10610 "Astron. JD: " (calendar-astro-date-string date) 10611 " (Julian date number at noon UTC)\n" 10612 "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" 10613 "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" 10614 "French: " (calendar-french-date-string date) "\n" 10615 "Bahá’í: " (calendar-bahai-date-string date) " (until sunset)\n" 10616 "Mayan: " (calendar-mayan-date-string date) "\n" 10617 "Coptic: " (calendar-coptic-date-string date) "\n" 10618 "Ethiopic: " (calendar-ethiopic-date-string date) "\n" 10619 "Persian: " (calendar-persian-date-string date) "\n" 10620 "Chinese: " (calendar-chinese-date-string date) "\n")) 10621 (with-output-to-temp-buffer "*Dates*" 10622 (princ s)) 10623 (org-fit-window-to-buffer (get-buffer-window "*Dates*")))) 10624 10625 ;;; Bulk commands 10626 10627 (defun org-agenda-bulk-marked-p () 10628 "Non-nil when current entry is marked for bulk action." 10629 (eq (get-char-property (line-beginning-position) 'type) 10630 'org-marked-entry-overlay)) 10631 10632 (defun org-agenda-bulk-mark (&optional arg) 10633 "Mark entries for future bulk action. 10634 10635 When ARG is nil or one and region is not active then mark the 10636 entry at point. 10637 10638 When ARG is nil or one and region is active then mark the entries 10639 in the region. 10640 10641 When ARG is greater than one mark ARG lines." 10642 (interactive "p") 10643 (when (and (or (not arg) (= arg 1)) (use-region-p)) 10644 (setq arg (count-lines (region-beginning) (region-end))) 10645 (goto-char (region-beginning)) 10646 (deactivate-mark)) 10647 (dotimes (_ (or arg 1)) 10648 (unless (org-get-at-bol 'org-agenda-diary-link) 10649 (let* ((m (org-get-at-bol 'org-hd-marker)) 10650 ov) 10651 (unless (org-agenda-bulk-marked-p) 10652 (unless m (user-error "Nothing to mark at point")) 10653 (push m org-agenda-bulk-marked-entries) 10654 (setq ov (make-overlay (line-beginning-position) 10655 (+ 2 (line-beginning-position)))) 10656 ;; Display using 'before-string to make the overlay 10657 ;; compatible with column view in agenda that uses an 10658 ;; overlay with higher priority. 10659 (overlay-put ov 'before-string 10660 (propertize org-agenda-bulk-mark-char 10661 'face (org-get-todo-face "TODO"))) 10662 ;; We cannot completely hide the overlay to make point 10663 ;; adjustment not move point out of overlay (to previous 10664 ;; line) when moving lines with n/p. 10665 (org-overlay-display ov " " nil 'evaporate) 10666 (overlay-put ov 'type 'org-marked-entry-overlay)) 10667 (end-of-line 1) 10668 (or (ignore-errors 10669 (goto-char (next-single-property-change (point) 'org-hd-marker))) 10670 (forward-line 1)) 10671 (while (and (get-char-property (point) 'invisible) (not (eobp))) 10672 (forward-line 1))))) 10673 (message "%d entries marked for bulk action" 10674 (length org-agenda-bulk-marked-entries))) 10675 10676 (defun org-agenda-bulk-mark-all () 10677 "Mark all entries for future agenda bulk action." 10678 (interactive) 10679 (org-agenda-bulk-mark-regexp ".")) 10680 10681 (defun org-agenda-bulk-mark-regexp (regexp) 10682 "Mark entries matching REGEXP for future agenda bulk action." 10683 (interactive "sMark entries matching regexp: ") 10684 (let ((entries-marked 0) txt-at-point) 10685 (save-excursion 10686 (goto-char (point-min)) 10687 (goto-char (next-single-property-change (point) 'org-hd-marker)) 10688 (while (and (re-search-forward regexp nil t) 10689 (setq txt-at-point 10690 (get-text-property (match-beginning 0) 'txt))) 10691 (if (get-char-property (point) 'invisible) 10692 (forward-line 1) 10693 (when (string-match-p regexp txt-at-point) 10694 (setq entries-marked (1+ entries-marked)) 10695 (call-interactively 'org-agenda-bulk-mark))))) 10696 (unless entries-marked 10697 (message "No entry matching this regexp.")))) 10698 10699 (defun org-agenda-bulk-unmark (&optional arg) 10700 "Unmark the entry at point for future bulk action." 10701 (interactive "P") 10702 (if arg 10703 (org-agenda-bulk-unmark-all) 10704 (cond ((org-agenda-bulk-marked-p) 10705 (org-agenda-bulk-remove-overlays 10706 (line-beginning-position) (+ 2 (line-beginning-position))) 10707 (setq org-agenda-bulk-marked-entries 10708 (delete (org-get-at-bol 'org-hd-marker) 10709 org-agenda-bulk-marked-entries)) 10710 (end-of-line 1) 10711 (or (ignore-errors 10712 (goto-char (next-single-property-change (point) 'txt))) 10713 (forward-line 1)) 10714 (while (and (get-char-property (point) 'invisible) (not (eobp))) 10715 (forward-line 1)) 10716 (message "%d entries left marked for bulk action" 10717 (length org-agenda-bulk-marked-entries))) 10718 (t (message "No entry to unmark here"))))) 10719 10720 (defun org-agenda-bulk-toggle-all () 10721 "Toggle all marks for bulk action." 10722 (interactive) 10723 (save-excursion 10724 (goto-char (point-min)) 10725 (while (ignore-errors 10726 (goto-char (next-single-property-change (point) 'org-hd-marker))) 10727 (org-agenda-bulk-toggle)))) 10728 10729 (defun org-agenda-bulk-toggle () 10730 "Toggle the mark at point for bulk action." 10731 (interactive) 10732 (if (org-agenda-bulk-marked-p) 10733 (org-agenda-bulk-unmark) 10734 (org-agenda-bulk-mark))) 10735 10736 (defun org-agenda-bulk-remove-overlays (&optional beg end) 10737 "Remove the mark overlays between BEG and END in the agenda buffer. 10738 BEG and END default to the buffer limits. 10739 10740 This only removes the overlays, it does not remove the markers 10741 from the list in `org-agenda-bulk-marked-entries'." 10742 (interactive) 10743 (mapc (lambda (ov) 10744 (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay) 10745 (delete-overlay ov))) 10746 (overlays-in (or beg (point-min)) (or end (point-max))))) 10747 10748 (defun org-agenda-bulk-unmark-all () 10749 "Remove all marks in the agenda buffer. 10750 This will remove the markers and the overlays." 10751 (interactive) 10752 (if (null org-agenda-bulk-marked-entries) 10753 (message "No entry to unmark") 10754 (setq org-agenda-bulk-marked-entries nil) 10755 (org-agenda-bulk-remove-overlays (point-min) (point-max)))) 10756 10757 (defcustom org-agenda-persistent-marks nil 10758 "Non-nil means marked items will stay marked after a bulk action. 10759 You can toggle this interactively by typing `p' when prompted for a 10760 bulk action." 10761 :group 'org-agenda 10762 :version "24.1" 10763 :type 'boolean) 10764 10765 (defcustom org-agenda-loop-over-headlines-in-active-region t 10766 "Shall some commands act upon headlines in the active region? 10767 10768 When set to t, some commands will be performed in all headlines 10769 within the active region. 10770 10771 When set to `start-level', some commands will be performed in all 10772 headlines within the active region, provided that these headlines 10773 are of the same level than the first one. 10774 10775 When set to a regular expression, those commands will be 10776 performed on the matching headlines within the active region. 10777 10778 The list of commands is: `org-agenda-schedule', 10779 `org-agenda-deadline', `org-agenda-date-prompt', 10780 `org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'. 10781 10782 See `org-loop-over-headlines-in-active-region' for the equivalent 10783 option for Org buffers." 10784 :type '(choice (const :tag "Don't loop" nil) 10785 (const :tag "All headlines in active region" t) 10786 (const :tag "In active region, headlines at the same level than the first one" start-level) 10787 (regexp :tag "Regular expression matcher")) 10788 :version "27.1" 10789 :package-version '(Org . "9.4") 10790 :group 'org-agenda) 10791 10792 (defun org-agenda-bulk-action (&optional arg) 10793 "Execute an remote-editing action on all marked entries. 10794 The prefix arg is passed through to the command if possible." 10795 (interactive "P") 10796 ;; When there is no mark, act on the agenda entry at point. 10797 (if (not org-agenda-bulk-marked-entries) 10798 (save-excursion (org-agenda-bulk-mark))) 10799 (dolist (m org-agenda-bulk-marked-entries) 10800 (unless (and (markerp m) 10801 (marker-buffer m) 10802 (buffer-live-p (marker-buffer m)) 10803 (marker-position m)) 10804 (user-error "Marker %s for bulk command is invalid" m))) 10805 10806 ;; Prompt for the bulk command. 10807 (org-unlogged-message 10808 (concat "Bulk (" (if org-agenda-persistent-marks "" "don't ") "[p]ersist marks): " 10809 "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " 10810 "[S]catter [f]unction " 10811 (and org-agenda-bulk-custom-functions 10812 (format " Custom: [%s]" 10813 (mapconcat (lambda (f) (char-to-string (car f))) 10814 org-agenda-bulk-custom-functions 10815 ""))))) 10816 (catch 'exit 10817 (let* ((org-log-refile (if org-log-refile 'time nil)) 10818 (entries (reverse org-agenda-bulk-marked-entries)) 10819 (org-overriding-default-time 10820 (and (get-text-property (point) 'org-agenda-date-header) 10821 (org-get-cursor-date))) 10822 redo-at-end 10823 cmd) 10824 (pcase (read-char-exclusive) 10825 (?p 10826 (let ((org-agenda-persistent-marks 10827 (not org-agenda-persistent-marks))) 10828 (org-agenda-bulk-action) 10829 (throw 'exit nil))) 10830 10831 (?$ 10832 (setq cmd #'org-agenda-archive)) 10833 10834 (?A 10835 (setq cmd #'org-agenda-archive-to-archive-sibling)) 10836 10837 ((or ?r ?w) 10838 (let ((refile-location 10839 (org-refile-get-location 10840 "Refile to" 10841 (marker-buffer (car entries)) 10842 org-refile-allow-creating-parent-nodes))) 10843 (when (nth 3 refile-location) 10844 (setcar (nthcdr 3 refile-location) 10845 (move-marker 10846 (make-marker) 10847 (nth 3 refile-location) 10848 (or (get-file-buffer (nth 1 refile-location)) 10849 (find-buffer-visiting (nth 1 refile-location)) 10850 (error "This should not happen"))))) 10851 10852 (setq cmd (lambda () (org-agenda-refile nil refile-location t))) 10853 (setq redo-at-end t))) 10854 10855 (?t 10856 (let ((state (completing-read 10857 "Todo state: " 10858 (with-current-buffer (marker-buffer (car entries)) 10859 (mapcar #'list org-todo-keywords-1))))) 10860 (setq cmd (lambda () 10861 (let ((org-inhibit-blocking t) 10862 (org-inhibit-logging 'note)) 10863 (org-agenda-todo state)))))) 10864 10865 ((and (or ?- ?+) action) 10866 (let ((tag (completing-read 10867 (format "Tag to %s: " (if (eq action ?+) "add" "remove")) 10868 (with-current-buffer (marker-buffer (car entries)) 10869 (delq nil 10870 (mapcar (lambda (x) (and (stringp (car x)) x)) 10871 org-current-tag-alist)))))) 10872 (setq cmd 10873 (lambda () 10874 (org-agenda-set-tags tag 10875 (if (eq action ?+) 'on 'off)))))) 10876 10877 ((and (or ?s ?d) c) 10878 (let* ((schedule? (eq c ?s)) 10879 (prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to")) 10880 (time 10881 (and (not arg) 10882 (let ((new (org-read-date 10883 nil nil nil prompt org-overriding-default-time))) 10884 ;; A "double plus" answer applies to every 10885 ;; scheduled time. Do not turn it into 10886 ;; a fixed date yet. 10887 (if (string-match-p "\\`[ \t]*\\+\\+" 10888 org-read-date-final-answer) 10889 org-read-date-final-answer 10890 new))))) 10891 ;; Make sure to not prompt for a note when bulk 10892 ;; rescheduling/resetting deadline as Org cannot cope with 10893 ;; simultaneous notes. Besides, it could be annoying 10894 ;; depending on the number of marked items. 10895 (setq cmd 10896 (if schedule? 10897 (lambda () 10898 (let ((org-log-reschedule 10899 (and org-log-reschedule 'time))) 10900 (org-agenda-schedule arg time))) 10901 (lambda () 10902 (let ((org-log-redeadline (and org-log-redeadline 'time))) 10903 (org-agenda-deadline arg time))))))) 10904 10905 (?S 10906 (unless (org-agenda-check-type nil 'agenda 'todo) 10907 (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)) 10908 (let ((days (read-number 10909 (format "Scatter tasks across how many %sdays: " 10910 (if arg "week" "")) 10911 7))) 10912 (setq cmd 10913 (lambda () 10914 (let ((distance (1+ (random days)))) 10915 (when arg 10916 (let ((dist distance) 10917 (day-of-week 10918 (calendar-day-of-week 10919 (calendar-gregorian-from-absolute (org-today))))) 10920 (dotimes (_ (1+ dist)) 10921 (while (member day-of-week org-agenda-weekend-days) 10922 (cl-incf distance) 10923 (cl-incf day-of-week) 10924 (when (= day-of-week 7) 10925 (setq day-of-week 0))) 10926 (cl-incf day-of-week) 10927 (when (= day-of-week 7) 10928 (setq day-of-week 0))))) 10929 ;; Silently fail when try to replan a sexp entry. 10930 (ignore-errors 10931 (let* ((date (calendar-gregorian-from-absolute 10932 (+ (org-today) distance))) 10933 (time (org-encode-time 10934 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 10935 (org-agenda-schedule nil time)))))))) 10936 10937 (?f 10938 (setq cmd 10939 (intern 10940 (completing-read "Function: " obarray #'fboundp t nil nil)))) 10941 10942 (action 10943 (setq cmd 10944 (pcase (assoc action org-agenda-bulk-custom-functions) 10945 (`(,_ ,fn) 10946 fn) 10947 (`(,_ ,fn ,arg-fn) 10948 (apply #'apply-partially fn (funcall arg-fn))) 10949 (_ 10950 (user-error "Invalid bulk action: %c" action)))) 10951 (setq redo-at-end t))) 10952 ;; Sort the markers, to make sure that parents are handled 10953 ;; before children. 10954 (setq entries (sort entries 10955 (lambda (a b) 10956 (cond 10957 ((eq (marker-buffer a) (marker-buffer b)) 10958 (< (marker-position a) (marker-position b))) 10959 (t 10960 (string< (buffer-name (marker-buffer a)) 10961 (buffer-name (marker-buffer b)))))))) 10962 10963 ;; Now loop over all markers and apply CMD. 10964 (let ((processed 0) 10965 (skipped 0)) 10966 (dolist (e entries) 10967 (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e))) 10968 (if (not pos) 10969 (progn (message "Skipping removed entry at %s" e) 10970 (cl-incf skipped)) 10971 (goto-char pos) 10972 (let (org-loop-over-headlines-in-active-region) (funcall cmd)) 10973 ;; `post-command-hook' is not run yet. We make sure any 10974 ;; pending log note is processed. 10975 (when org-log-setup (org-add-log-note)) 10976 (cl-incf processed)))) 10977 (when redo-at-end (org-agenda-redo)) 10978 (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all)) 10979 (message "Acted on %d entries%s%s" 10980 processed 10981 (if (= skipped 0) 10982 "" 10983 (format ", skipped %d (disappeared before their turn)" 10984 skipped)) 10985 (if (not org-agenda-persistent-marks) "" " (kept marked)")))))) 10986 10987 (defun org-agenda-capture (&optional with-time) 10988 "Call `org-capture' with the date at point. 10989 With a `C-1' prefix, use the HH:MM value at point (if any) or the 10990 current HH:MM time." 10991 (interactive "P") 10992 (if (not (eq major-mode 'org-agenda-mode)) 10993 (user-error "You cannot do this outside of agenda buffers") 10994 (let ((org-overriding-default-time 10995 (org-get-cursor-date (equal with-time 1)))) 10996 (call-interactively 'org-capture)))) 10997 10998 ;;; Dragging agenda lines forward/backward 10999 11000 (defun org-agenda-reapply-filters () 11001 "Re-apply all agenda filters." 11002 (mapcar 11003 (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t))) 11004 `((,org-agenda-tag-filter tag) 11005 (,org-agenda-category-filter category) 11006 (,org-agenda-regexp-filter regexp) 11007 (,org-agenda-effort-filter effort) 11008 (,(assoc-default 'tag org-agenda-filters-preset) tag) 11009 (,(assoc-default 'category org-agenda-filters-preset) category) 11010 (,(assoc-default 'effort org-agenda-filters-preset) effort) 11011 (,(assoc-default 'regexp org-agenda-filters-preset) regexp)))) 11012 11013 (defun org-agenda-drag-line-forward (arg &optional backward) 11014 "Drag an agenda line forward by ARG lines. 11015 When the optional argument `backward' is non-nil, move backward." 11016 (interactive "p") 11017 (let ((inhibit-read-only t) lst line) 11018 (if (or (not (get-text-property (point) 'txt)) 11019 (save-excursion 11020 (dotimes (_ arg) 11021 (move-beginning-of-line (if backward 0 2)) 11022 (push (not (get-text-property (point) 'txt)) lst)) 11023 (delq nil lst))) 11024 (message "Cannot move line forward") 11025 (let ((end (save-excursion (move-beginning-of-line 2) (point)))) 11026 (move-beginning-of-line 1) 11027 (setq line (buffer-substring (point) end)) 11028 (delete-region (point) end) 11029 (move-beginning-of-line (funcall (if backward '1- '1+) arg)) 11030 (insert line) 11031 (org-agenda-reapply-filters) 11032 (org-agenda-mark-clocking-task) 11033 (move-beginning-of-line 0))))) 11034 11035 (defun org-agenda-drag-line-backward (arg) 11036 "Drag an agenda line backward by ARG lines." 11037 (interactive "p") 11038 (org-agenda-drag-line-forward arg t)) 11039 11040 ;;; Flagging notes 11041 11042 (defun org-agenda-show-the-flagging-note () 11043 "Display the flagging note in the other window. 11044 When called a second time in direct sequence, offer to remove the FLAGGING 11045 tag and (if present) the flagging note." 11046 (interactive) 11047 (let ((hdmarker (org-get-at-bol 'org-hd-marker)) 11048 (win (selected-window)) 11049 note) ;; heading newhead 11050 (unless hdmarker 11051 (user-error "No linked entry at point")) 11052 (if (and (eq this-command last-command) 11053 (y-or-n-p "Unflag and remove any flagging note? ")) 11054 (progn 11055 (org-agenda-remove-flag hdmarker) 11056 (let ((win (get-buffer-window "*Flagging Note*"))) 11057 (and win (delete-window win))) 11058 (message "Entry unflagged")) 11059 (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE")) 11060 (unless note 11061 (user-error "No flagging note")) 11062 (org-kill-new note) 11063 (switch-to-buffer-other-window "*Flagging Note*") 11064 (erase-buffer) 11065 (insert note) 11066 (goto-char (point-min)) 11067 (while (re-search-forward "\\\\n" nil t) 11068 (replace-match "\n" t t)) 11069 (goto-char (point-min)) 11070 (select-window win) 11071 (message "%s" (substitute-command-keys "Flagging note pushed to \ 11072 kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \ 11073 tag and note"))))) 11074 11075 (defun org-agenda-remove-flag (marker) 11076 "Remove the FLAGGED tag and any flagging note in the entry." 11077 (let ((newhead 11078 (org-with-point-at marker 11079 (org-toggle-tag "FLAGGED" 'off) 11080 (org-entry-delete nil "THEFLAGGINGNOTE") 11081 (org-get-heading)))) 11082 (org-agenda-change-all-lines newhead marker) 11083 (message "Entry unflagged"))) 11084 11085 (defun org-agenda-get-any-marker (&optional pos) 11086 (or (get-text-property (or pos (line-beginning-position)) 'org-hd-marker) 11087 (get-text-property (or pos (line-beginning-position)) 'org-marker))) 11088 11089 ;;; Appointment reminders 11090 11091 (defvar appt-time-msg-list) ; defined in appt.el 11092 11093 ;;;###autoload 11094 (defun org-agenda-to-appt (&optional refresh filter &rest args) 11095 "Activate appointments found in `org-agenda-files'. 11096 11097 With a `\\[universal-argument]' prefix, refresh the list of \ 11098 appointments. 11099 11100 If FILTER is t, interactively prompt the user for a regular 11101 expression, and filter out entries that don't match it. 11102 11103 If FILTER is a string, use this string as a regular expression 11104 for filtering entries out. 11105 11106 If FILTER is a function, filter out entries against which 11107 calling the function returns nil. This function takes one 11108 argument: an entry from `org-agenda-get-day-entries'. 11109 11110 FILTER can also be an alist with the car of each cell being 11111 either `headline' or `category'. For example: 11112 11113 ((headline \"IMPORTANT\") 11114 (category \"Work\")) 11115 11116 will only add headlines containing IMPORTANT or headlines 11117 belonging to the \"Work\" category. 11118 11119 ARGS are symbols indicating what kind of entries to consider. 11120 By default `org-agenda-to-appt' will use :deadline*, :scheduled* 11121 \(i.e., deadlines and scheduled items with a hh:mm specification) 11122 and :timestamp entries. See the docstring of `org-diary' for 11123 details and examples. 11124 11125 If an entry has a APPT_WARNTIME property, its value will be used 11126 to override `appt-message-warning-time'." 11127 (interactive "P") 11128 (when refresh (setq appt-time-msg-list nil)) 11129 (when (eq filter t) 11130 (setq filter (read-from-minibuffer "Regexp filter: "))) 11131 (let* ((cnt 0) ; count added events 11132 (scope (or args '(:deadline* :scheduled* :timestamp))) 11133 (org-agenda-new-buffers nil) 11134 (org-deadline-warning-days 0) 11135 ;; Do not use `org-today' here because appt only takes 11136 ;; time and without date as argument, so it may pass wrong 11137 ;; information otherwise 11138 (today (org-date-to-gregorian 11139 (time-to-days nil))) 11140 (org-agenda-restrict nil) 11141 (files (org-agenda-files 'unrestricted)) entries file 11142 (org-agenda-buffer nil)) 11143 ;; Get all entries which may contain an appt 11144 (org-agenda-prepare-buffers files) 11145 (while (setq file (pop files)) 11146 (setq entries 11147 (delq nil 11148 (append entries 11149 (apply #'org-agenda-get-day-entries 11150 file today scope))))) 11151 ;; Map through entries and find if we should filter them out 11152 (mapc 11153 (lambda (x) 11154 (let* ((evt (org-trim 11155 (replace-regexp-in-string 11156 org-link-bracket-re "\\2" 11157 (or (get-text-property 1 'txt x) "")))) 11158 (cat (get-text-property (1- (length x)) 'org-category x)) 11159 (tod (get-text-property 1 'time-of-day x)) 11160 (ok (or (null filter) 11161 (and (stringp filter) (string-match filter evt)) 11162 (and (functionp filter) (funcall filter x)) 11163 (and (listp filter) 11164 (let ((cat-filter (cadr (assq 'category filter))) 11165 (evt-filter (cadr (assq 'headline filter)))) 11166 (or (and (stringp cat-filter) 11167 (string-match cat-filter cat)) 11168 (and (stringp evt-filter) 11169 (string-match evt-filter evt))))))) 11170 (wrn (get-text-property 1 'warntime x)) 11171 (todo-regexp (get-text-property 1 'org-todo-regexp x)) 11172 (not-done-regexp (get-text-property 1 'org-not-done-regexp x))) 11173 ;; FIXME: Shall we remove text-properties for the appt text? 11174 ;; (setq evt (set-text-properties 0 (length evt) nil evt)) 11175 (when (and ok tod 11176 ;; Exclude done items unconditionally. 11177 (or (not (and todo-regexp (string-match-p todo-regexp evt))) ; no todo keyword 11178 (and not-done-regexp (string-match-p not-done-regexp evt)) ; or not done 11179 )) 11180 (setq tod (concat "00" (number-to-string tod))) 11181 (setq tod (when (string-match 11182 "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) 11183 (concat (match-string 1 tod) ":" 11184 (match-string 2 tod)))) 11185 (when (appt-add tod evt wrn) 11186 (setq cnt (1+ cnt)))))) 11187 entries) 11188 (org-release-buffers org-agenda-new-buffers) 11189 (if (eq cnt 0) 11190 (message "No event to add") 11191 (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) 11192 11193 (defun org-agenda-today-p (date) 11194 "Non-nil when DATE means today. 11195 DATE is either a list of the form (month day year) or a number of 11196 days as returned by `calendar-absolute-from-gregorian' or 11197 `org-today'. This function considers `org-extend-today-until' 11198 when defining today." 11199 (eq (org-today) 11200 (if (consp date) (calendar-absolute-from-gregorian date) date))) 11201 11202 (defun org-agenda-todo-yesterday (&optional arg) 11203 "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday." 11204 (interactive "P") 11205 (let* ((org-use-effective-time t) 11206 (hour (nth 2 (decode-time (org-current-time)))) 11207 (org-extend-today-until (1+ hour))) 11208 (org-agenda-todo arg))) 11209 11210 (defun org-agenda-ctrl-c-ctrl-c () 11211 "Set tags in agenda buffer." 11212 (interactive) 11213 (org-agenda-set-tags)) 11214 11215 (provide 'org-agenda) 11216 11217 ;;; org-agenda.el ends here