org.el (833881B)
1 ;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*- 2 3 ;; Carstens outline-mode for keeping track of everything. 4 ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. 5 ;; 6 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 7 ;; Maintainer: Bastien Guerry <bzg@gnu.org> 8 ;; Keywords: outlines, hypermedia, calendar, wp 9 ;; Homepage: https://orgmode.org 10 ;; Package-Requires: ((emacs "25.1")) 11 12 ;; Version: 9.5 13 14 ;; This file is part of GNU Emacs. 15 ;; 16 ;; GNU Emacs is free software: you can redistribute it and/or modify 17 ;; it under the terms of the GNU General Public License as published by 18 ;; the Free Software Foundation, either version 3 of the License, or 19 ;; (at your option) any later version. 20 21 ;; GNU Emacs is distributed in the hope that it will be useful, 22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 ;; GNU General Public License for more details. 25 26 ;; You should have received a copy of the GNU General Public License 27 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 28 ;; 29 ;;; Commentary: 30 ;; 31 ;; Org is a mode for keeping notes, maintaining ToDo lists, and doing 32 ;; project planning with a fast and effective plain-text system. 33 ;; 34 ;; Org mode develops organizational tasks around NOTES files that 35 ;; contain information about projects as plain text. Org mode is 36 ;; implemented on top of outline-mode, which makes it possible to keep 37 ;; the content of large files well structured. Visibility cycling and 38 ;; structure editing help to work with the tree. Tables are easily 39 ;; created with a built-in table editor. Org mode supports ToDo 40 ;; items, deadlines, time stamps, and scheduling. It dynamically 41 ;; compiles entries into an agenda that utilizes and smoothly 42 ;; integrates much of the Emacs calendar and diary. Plain text 43 ;; URL-like links connect to websites, emails, Usenet messages, BBDB 44 ;; entries, and any files related to the projects. For printing and 45 ;; sharing of notes, an Org file can be exported as a structured ASCII 46 ;; file, as HTML, or (todo and agenda items only) as an iCalendar 47 ;; file. It can also serve as a publishing tool for a set of linked 48 ;; webpages. 49 ;; 50 ;; Installation and Activation 51 ;; --------------------------- 52 ;; See the corresponding sections in the manual at 53 ;; 54 ;; https://orgmode.org/org.html#Installation 55 ;; 56 ;; Documentation 57 ;; ------------- 58 ;; The documentation of Org mode can be found in the TeXInfo file. The 59 ;; distribution also contains a PDF version of it. At the homepage of 60 ;; Org mode, you can read the same text online as HTML. There is also an 61 ;; excellent reference card made by Philip Rooke. This card can be found 62 ;; in the doc/ directory. 63 ;; 64 ;; A list of recent changes can be found at 65 ;; https://orgmode.org/Changes.html 66 ;; 67 ;;; Code: 68 69 (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param 70 (defvar org-inlinetask-min-level) 71 72 ;;;; Require other packages 73 74 (require 'cl-lib) 75 76 (eval-when-compile (require 'gnus-sum)) 77 78 (require 'calendar) 79 (require 'find-func) 80 (require 'format-spec) 81 82 (or (eq this-command 'eval-buffer) 83 (condition-case nil 84 (load (concat (file-name-directory load-file-name) 85 "org-loaddefs.el") 86 nil t t t) 87 (error 88 (message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.") 89 (sit-for 3) 90 (message "You need to run \"make\" or \"make autoloads\" from Org lisp directory") 91 (sit-for 3)))) 92 93 (eval-and-compile (require 'org-macs)) 94 (require 'org-compat) 95 (require 'org-keys) 96 (require 'ol) 97 (require 'oc) 98 (require 'org-table) 99 100 ;; `org-outline-regexp' ought to be a defconst but is let-bound in 101 ;; some places -- e.g. see the macro `org-with-limited-levels'. 102 (defvar org-outline-regexp "\\*+ " 103 "Regexp to match Org headlines.") 104 105 (defvar org-outline-regexp-bol "^\\*+ " 106 "Regexp to match Org headlines. 107 This is similar to `org-outline-regexp' but additionally makes 108 sure that we are at the beginning of the line.") 109 110 (defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" 111 "Matches a headline, putting stars and text into groups. 112 Stars are put in group 1 and the trimmed body in group 2.") 113 114 (declare-function calendar-check-holidays "holidays" (date)) 115 (declare-function cdlatex-environment "ext:cdlatex" (environment item)) 116 (declare-function cdlatex-math-symbol "ext:cdlatex") 117 (declare-function Info-goto-node "info" (nodename &optional fork strict-case)) 118 (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) 119 (declare-function org-add-archive-files "org-archive" (files)) 120 (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) 121 (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) 122 (declare-function org-agenda-redo "org-agenda" (&optional all)) 123 (declare-function org-agenda-remove-restriction-lock "org-agenda" (&optional noupdate)) 124 (declare-function org-archive-subtree "org-archive" (&optional find-done)) 125 (declare-function org-archive-subtree-default "org-archive" ()) 126 (declare-function org-archive-to-archive-sibling "org-archive" ()) 127 (declare-function org-attach "org-attach" ()) 128 (declare-function org-attach-dir "org-attach" 129 (&optional create-if-not-exists-p no-fs-check)) 130 (declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t) 131 (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) 132 (declare-function org-beamer-mode "ox-beamer" (&optional prefix) t) 133 (declare-function org-clock-auto-clockout "org-clock" ()) 134 (declare-function org-clock-cancel "org-clock" ()) 135 (declare-function org-clock-display "org-clock" (&optional arg)) 136 (declare-function org-clock-get-last-clock-out-time "org-clock" ()) 137 (declare-function org-clock-goto "org-clock" (&optional select)) 138 (declare-function org-clock-in "org-clock" (&optional select start-time)) 139 (declare-function org-clock-in-last "org-clock" (&optional arg)) 140 (declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) 141 (declare-function org-clock-out-if-current "org-clock" ()) 142 (declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove)) 143 (declare-function org-clock-report "org-clock" (&optional arg)) 144 (declare-function org-clock-sum "org-clock" (&optional tstart tend headline-filter propname)) 145 (declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) 146 (declare-function org-clock-timestamps-down "org-clock" (&optional n)) 147 (declare-function org-clock-timestamps-up "org-clock" (&optional n)) 148 (declare-function org-clock-update-time-maybe "org-clock" ()) 149 (declare-function org-clocktable-shift "org-clock" (dir n)) 150 (declare-function org-columns-quit "org-colview" ()) 151 (declare-function org-columns-insert-dblock "org-colview" ()) 152 (declare-function org-duration-from-minutes "org-duration" (minutes &optional fmt canonical)) 153 (declare-function org-duration-to-minutes "org-duration" (duration &optional canonical)) 154 (declare-function org-element-at-point "org-element" ()) 155 (declare-function org-element-cache-refresh "org-element" (pos)) 156 (declare-function org-element-cache-reset "org-element" (&optional all)) 157 (declare-function org-element-contents "org-element" (element)) 158 (declare-function org-element-context "org-element" (&optional element)) 159 (declare-function org-element-copy "org-element" (datum)) 160 (declare-function org-element-create "org-element" (type &optional props &rest children)) 161 (declare-function org-element-extract-element "org-element" (element)) 162 (declare-function org-element-insert-before "org-element" (element location)) 163 (declare-function org-element-interpret-data "org-element" (data)) 164 (declare-function org-element-lineage "org-element" (blob &optional types with-self)) 165 (declare-function org-element-link-parser "org-element" ()) 166 (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) 167 (declare-function org-element-nested-p "org-element" (elem-a elem-b)) 168 (declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) 169 (declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) 170 (declare-function org-element-property "org-element" (property element)) 171 (declare-function org-element-put-property "org-element" (element property value)) 172 (declare-function org-element-restriction "org-element" (element)) 173 (declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) 174 (declare-function org-element-timestamp-parser "org-element" ()) 175 (declare-function org-element-type "org-element" (element)) 176 (declare-function org-export-dispatch "ox" (&optional arg)) 177 (declare-function org-export-get-backend "ox" (name)) 178 (declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist)) 179 (declare-function org-feed-goto-inbox "org-feed" (feed)) 180 (declare-function org-feed-update-all "org-feed" ()) 181 (declare-function org-goto "org-goto" (&optional alternative-interface)) 182 (declare-function org-id-find-id-file "org-id" (id)) 183 (declare-function org-id-get-create "org-id" (&optional force)) 184 (declare-function org-inlinetask-at-task-p "org-inlinetask" ()) 185 (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) 186 (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) 187 (declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?)) 188 (declare-function org-num-mode "org-num" (&optional arg)) 189 (declare-function org-plot/gnuplot "org-plot" (&optional params)) 190 (declare-function org-tags-view "org-agenda" (&optional todo-only match)) 191 (declare-function org-timer "org-timer" (&optional restart no-insert)) 192 (declare-function org-timer-item "org-timer" (&optional arg)) 193 (declare-function org-timer-pause-or-continue "org-timer" (&optional stop)) 194 (declare-function org-timer-set-timer "org-timer" (&optional opt)) 195 (declare-function org-timer-start "org-timer" (&optional offset)) 196 (declare-function org-timer-stop "org-timer" ()) 197 (declare-function org-toggle-archive-tag "org-archive" (&optional find-done)) 198 (declare-function org-update-radio-target-regexp "ol" ()) 199 200 (defvar org-element-paragraph-separate) 201 (defvar org-indent-indentation-per-level) 202 (defvar org-radio-target-regexp) 203 (defvar org-target-link-regexp) 204 (defvar org-target-regexp) 205 (defvar org-id-overriding-file-name) 206 207 ;; load languages based on value of `org-babel-load-languages' 208 (defvar org-babel-load-languages) 209 210 (defvar crm-separator) ; dynamically scoped param 211 212 ;;;###autoload 213 (defun org-babel-do-load-languages (sym value) 214 "Load the languages defined in `org-babel-load-languages'." 215 (set-default sym value) 216 (dolist (pair org-babel-load-languages) 217 (let ((active (cdr pair)) (lang (symbol-name (car pair)))) 218 (if active 219 (require (intern (concat "ob-" lang))) 220 (fmakunbound 221 (intern (concat "org-babel-execute:" lang))) 222 (fmakunbound 223 (intern (concat "org-babel-expand-body:" lang))))))) 224 225 226 ;;;###autoload 227 (defun org-babel-load-file (file &optional compile) 228 "Load Emacs Lisp source code blocks in the Org FILE. 229 This function exports the source code using `org-babel-tangle' 230 and then loads the resulting file using `load-file'. With 231 optional prefix argument COMPILE, the tangled Emacs Lisp file is 232 byte-compiled before it is loaded." 233 (interactive "fFile to load: \nP") 234 (let ((tangled-file (concat (file-name-sans-extension file) ".el"))) 235 ;; Tangle only if the Org file is newer than the Elisp file. 236 (unless (org-file-newer-than-p 237 tangled-file 238 (file-attribute-modification-time 239 (file-attributes (file-truename file)))) 240 (org-babel-tangle-file file 241 tangled-file 242 (rx string-start 243 (or "emacs-lisp" "elisp") 244 string-end))) 245 (if compile 246 (progn 247 (byte-compile-file tangled-file) 248 (load tangled-file) 249 (message "Compiled and loaded %s" tangled-file)) 250 (load-file tangled-file) 251 (message "Loaded %s" tangled-file)))) 252 253 (defcustom org-babel-load-languages '((emacs-lisp . t)) 254 "Languages which can be evaluated in Org buffers. 255 \\<org-mode-map> 256 This list can be used to load support for any of the languages 257 below. Each language will depend on a different set of system 258 executables and/or Emacs modes. 259 260 When a language is \"loaded\", code blocks in that language can 261 be evaluated with `org-babel-execute-src-block', which is bound 262 by default to \\[org-ctrl-c-ctrl-c]. 263 264 The `org-babel-no-eval-on-ctrl-c-ctrl-c' option can be set to 265 remove code block evaluation from \\[org-ctrl-c-ctrl-c]. By 266 default, only Emacs Lisp is loaded, since it has no specific 267 requirement." 268 :group 'org-babel 269 :set 'org-babel-do-load-languages 270 :version "24.1" 271 :type '(alist :tag "Babel Languages" 272 :key-type 273 (choice 274 (const :tag "Awk" awk) 275 (const :tag "C" C) 276 (const :tag "R" R) 277 (const :tag "Calc" calc) 278 (const :tag "Clojure" clojure) 279 (const :tag "CSS" css) 280 (const :tag "Ditaa" ditaa) 281 (const :tag "Dot" dot) 282 (const :tag "Emacs Lisp" emacs-lisp) 283 (const :tag "Forth" forth) 284 (const :tag "Fortran" fortran) 285 (const :tag "Gnuplot" gnuplot) 286 (const :tag "Haskell" haskell) 287 (const :tag "Java" java) 288 (const :tag "Javascript" js) 289 (const :tag "LaTeX" latex) 290 (const :tag "Lilypond" lilypond) 291 (const :tag "Lisp" lisp) 292 (const :tag "Makefile" makefile) 293 (const :tag "Maxima" maxima) 294 (const :tag "Matlab" matlab) 295 (const :tag "Ocaml" ocaml) 296 (const :tag "Octave" octave) 297 (const :tag "Org" org) 298 (const :tag "Perl" perl) 299 (const :tag "Pico Lisp" picolisp) 300 (const :tag "PlantUML" plantuml) 301 (const :tag "Python" python) 302 (const :tag "Ruby" ruby) 303 (const :tag "Sass" sass) 304 (const :tag "Scala" scala) 305 (const :tag "Scheme" scheme) 306 (const :tag "Screen" screen) 307 (const :tag "Shell Script" shell) 308 (const :tag "Sql" sql) 309 (const :tag "Sqlite" sqlite) 310 (const :tag "Stan" stan)) 311 :value-type (boolean :tag "Activate" :value t))) 312 313 ;;;; Customization variables 314 (defcustom org-clone-delete-id nil 315 "Remove ID property of clones of a subtree. 316 When non-nil, clones of a subtree don't inherit the ID property. 317 Otherwise they inherit the ID property with a new unique 318 identifier." 319 :type 'boolean 320 :version "24.1" 321 :group 'org-id) 322 323 ;;; Version 324 (org-check-version) 325 326 ;;;###autoload 327 (defun org-version (&optional here full message) 328 "Show the Org version. 329 Interactively, or when MESSAGE is non-nil, show it in echo area. 330 With prefix argument, or when HERE is non-nil, insert it at point. 331 In non-interactive uses, a reduced version string is output unless 332 FULL is given." 333 (interactive (list current-prefix-arg t (not current-prefix-arg))) 334 (let ((org-dir (ignore-errors (org-find-library-dir "org"))) 335 (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) 336 (load-suffixes (list ".el")) 337 (org-install-dir 338 (ignore-errors (org-find-library-dir "org-loaddefs")))) 339 (unless (and (fboundp 'org-release) (fboundp 'org-git-version)) 340 (org-load-noerror-mustsuffix (concat org-dir "org-version"))) 341 (let* ((load-suffixes save-load-suffixes) 342 (release (org-release)) 343 (git-version (org-git-version)) 344 (version (format "Org mode version %s (%s @ %s)" 345 release 346 git-version 347 (if org-install-dir 348 (if (string= org-dir org-install-dir) 349 org-install-dir 350 (concat "mixed installation! " 351 org-install-dir 352 " and " 353 org-dir)) 354 "org-loaddefs.el can not be found!"))) 355 (version1 (if full version release))) 356 (when here (insert version1)) 357 (when message (message "%s" version1)) 358 version1))) 359 360 (defconst org-version (org-version)) 361 362 363 ;;; Syntax Constants 364 ;;;; Comments 365 (defconst org-comment-regexp 366 (rx (seq bol (zero-or-more (any "\t ")) "#" (or " " eol))) 367 "Regular expression for comment lines.") 368 369 ;;;; Keyword 370 (defconst org-keyword-regexp "^[ \t]*#\\+\\(\\S-+?\\):[ \t]*\\(.*\\)$" 371 "Regular expression for keyword-lines.") 372 373 ;;;; Block 374 375 (defconst org-block-regexp 376 "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" 377 "Regular expression for hiding blocks.") 378 379 (defconst org-dblock-start-re 380 "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" 381 "Matches the start line of a dynamic block, with parameters.") 382 383 (defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" 384 "Matches the end of a dynamic block.") 385 386 ;;;; Timestamp 387 388 (defconst org-ts--internal-regexp 389 (rx (seq 390 (= 4 digit) "-" (= 2 digit) "-" (= 2 digit) 391 (optional " " (*? nonl)))) 392 "Regular expression matching the innards of a time stamp.") 393 394 (defconst org-ts-regexp (format "<\\(%s\\)>" org-ts--internal-regexp) 395 "Regular expression for fast time stamp matching.") 396 397 (defconst org-ts-regexp-inactive 398 (format "\\[\\(%s\\)\\]" org-ts--internal-regexp) 399 "Regular expression for fast inactive time stamp matching.") 400 401 (defconst org-ts-regexp-both (format "[[<]\\(%s\\)[]>]" org-ts--internal-regexp) 402 "Regular expression for fast time stamp matching.") 403 404 (defconst org-ts-regexp0 405 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" 406 "Regular expression matching time strings for analysis. 407 This one does not require the space after the date, so it can be used 408 on a string that terminates immediately after the date.") 409 410 (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" 411 "Regular expression matching time strings for analysis.") 412 413 (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") 414 "Regular expression matching time stamps, with groups.") 415 416 (defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") 417 "Regular expression matching time stamps (also [..]), with groups.") 418 419 (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) 420 "Regular expression matching a time stamp range.") 421 422 (defconst org-tr-regexp-both 423 (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) 424 "Regular expression matching a time stamp range.") 425 426 (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" 427 org-ts-regexp "\\)?") 428 "Regular expression matching a time stamp or time stamp range.") 429 430 (defconst org-tsr-regexp-both 431 (concat org-ts-regexp-both "\\(--?-?" 432 org-ts-regexp-both "\\)?") 433 "Regular expression matching a time stamp or time stamp range. 434 The time stamps may be either active or inactive.") 435 436 (defconst org-repeat-re 437 "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\ 438 \\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" 439 "Regular expression for specifying repeated events. 440 After a match, group 1 contains the repeat expression.") 441 442 (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") 443 "Formats for `format-time-string' which are used for time stamps.") 444 445 ;;;; Clock and Planning 446 447 (defconst org-clock-string "CLOCK:" 448 "String used as prefix for timestamps clocking work hours on an item.") 449 450 (defvar org-closed-string "CLOSED:" 451 "String used as the prefix for timestamps logging closing a TODO entry.") 452 453 (defvar org-deadline-string "DEADLINE:" 454 "String to mark deadline entries. 455 \\<org-mode-map> 456 A deadline is this string, followed by a time stamp. It must be 457 a word, terminated by a colon. You can insert a schedule keyword 458 and a timestamp with `\\[org-deadline]'.") 459 460 (defvar org-scheduled-string "SCHEDULED:" 461 "String to mark scheduled TODO entries. 462 \\<org-mode-map> 463 A schedule is this string, followed by a time stamp. It must be 464 a word, terminated by a colon. You can insert a schedule keyword 465 and a timestamp with `\\[org-schedule]'.") 466 467 (defconst org-ds-keyword-length 468 (+ 2 469 (apply #'max 470 (mapcar #'length 471 (list org-deadline-string org-scheduled-string 472 org-clock-string org-closed-string)))) 473 "Maximum length of the DEADLINE and SCHEDULED keywords.") 474 475 (defconst org-planning-line-re 476 (concat "^[ \t]*" 477 (regexp-opt 478 (list org-closed-string org-deadline-string org-scheduled-string) 479 t)) 480 "Matches a line with planning info. 481 Matched keyword is in group 1.") 482 483 (defconst org-clock-line-re 484 (concat "^[ \t]*" org-clock-string) 485 "Matches a line with clock info.") 486 487 (defconst org-deadline-regexp (concat "\\<" org-deadline-string) 488 "Matches the DEADLINE keyword.") 489 490 (defconst org-deadline-time-regexp 491 (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") 492 "Matches the DEADLINE keyword together with a time stamp.") 493 494 (defconst org-deadline-time-hour-regexp 495 (concat "\\<" org-deadline-string 496 " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy/ \t.-]*\\)>") 497 "Matches the DEADLINE keyword together with a time-and-hour stamp.") 498 499 (defconst org-deadline-line-regexp 500 (concat "\\<\\(" org-deadline-string "\\).*") 501 "Matches the DEADLINE keyword and the rest of the line.") 502 503 (defconst org-scheduled-regexp (concat "\\<" org-scheduled-string) 504 "Matches the SCHEDULED keyword.") 505 506 (defconst org-scheduled-time-regexp 507 (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") 508 "Matches the SCHEDULED keyword together with a time stamp.") 509 510 (defconst org-scheduled-time-hour-regexp 511 (concat "\\<" org-scheduled-string 512 " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy/ \t.-]*\\)>") 513 "Matches the SCHEDULED keyword together with a time-and-hour stamp.") 514 515 (defconst org-closed-time-regexp 516 (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") 517 "Matches the CLOSED keyword together with a time stamp.") 518 519 (defconst org-keyword-time-regexp 520 (concat "\\<" 521 (regexp-opt 522 (list org-scheduled-string org-deadline-string org-closed-string 523 org-clock-string) 524 t) 525 " *[[<]\\([^]>]+\\)[]>]") 526 "Matches any of the 4 keywords, together with the time stamp.") 527 528 (defconst org-keyword-time-not-clock-regexp 529 (concat 530 "\\<" 531 (regexp-opt 532 (list org-scheduled-string org-deadline-string org-closed-string) t) 533 " *[[<]\\([^]>]+\\)[]>]") 534 "Matches any of the 3 keywords, together with the time stamp.") 535 536 (defconst org-all-time-keywords 537 (mapcar (lambda (w) (substring w 0 -1)) 538 (list org-scheduled-string org-deadline-string 539 org-clock-string org-closed-string)) 540 "List of time keywords.") 541 542 ;;;; Drawer 543 544 (defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$" 545 "Matches first or last line of a hidden block. 546 Group 1 contains drawer's name or \"END\".") 547 548 (defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" 549 "Regular expression matching the first line of a property drawer.") 550 551 (defconst org-property-end-re "^[ \t]*:END:[ \t]*$" 552 "Regular expression matching the last line of a property drawer.") 553 554 (defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" 555 "Regular expression matching the first line of a clock drawer.") 556 557 (defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" 558 "Regular expression matching the last line of a clock drawer.") 559 560 (defconst org-logbook-drawer-re 561 (rx (seq bol (0+ (any "\t ")) ":LOGBOOK:" (0+ (any "\t ")) "\n" 562 (*? (0+ nonl) "\n") 563 (0+ (any "\t ")) ":END:" (0+ (any "\t ")) eol)) 564 "Matches an entire LOGBOOK drawer.") 565 566 (defconst org-property-drawer-re 567 (concat "^[ \t]*:PROPERTIES:[ \t]*\n" 568 "\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?" 569 "[ \t]*:END:[ \t]*$") 570 "Matches an entire property drawer.") 571 572 (defconst org-clock-drawer-re 573 (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\(" 574 org-clock-drawer-end-re "\\)\n?") 575 "Matches an entire clock drawer.") 576 577 ;;;; Headline 578 579 (defconst org-heading-keyword-regexp-format 580 "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" 581 "Printf format for a regexp matching a headline with some keyword. 582 This regexp will match the headline of any node which has the 583 exact keyword that is put into the format. The keyword isn't in 584 any group by default, but the stars and the body are.") 585 586 (defconst org-heading-keyword-maybe-regexp-format 587 "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" 588 "Printf format for a regexp matching a headline, possibly with some keyword. 589 This regexp can match any headline with the specified keyword, or 590 without a keyword. The keyword isn't in any group by default, 591 but the stars and the body are.") 592 593 (defconst org-archive-tag "ARCHIVE" 594 "The tag that marks a subtree as archived. 595 An archived subtree does not open during visibility cycling, and does 596 not contribute to the agenda listings.") 597 598 (defconst org-tag-re "[[:alnum:]_@#%]+" 599 "Regexp matching a single tag.") 600 601 (defconst org-tag-group-re "[ \t]+\\(:\\([[:alnum:]_@#%:]+\\):\\)[ \t]*$" 602 "Regexp matching the tag group at the end of a line, with leading spaces. 603 Tags are stored in match group 1. Match group 2 stores the tags 604 without the enclosing colons.") 605 606 (defconst org-tag-line-re 607 "^\\*+ \\(?:.*[ \t]\\)?\\(:\\([[:alnum:]_@#%:]+\\):\\)[ \t]*$" 608 "Regexp matching tags in a headline. 609 Tags are stored in match group 1. Match group 2 stores the tags 610 without the enclosing colons.") 611 612 (eval-and-compile 613 (defconst org-comment-string "COMMENT" 614 "Entries starting with this keyword will never be exported. 615 \\<org-mode-map> 616 An entry can be toggled between COMMENT and normal with 617 `\\[org-toggle-comment]'.")) 618 619 620 ;;;; LaTeX Environments and Fragments 621 622 (defconst org-latex-regexps 623 '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) 624 ;; ("$" "\\([ \t(]\\|^\\)\\(\\(\\([$]\\)\\([^ \t\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \t\n,.$]\\)\\4\\)\\)\\([ \t.,?;:'\")]\\|$\\)" 2 nil) 625 ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p 626 ("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil) 627 ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil) 628 ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) 629 ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) 630 ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) 631 "Regular expressions for matching embedded LaTeX.") 632 633 ;;;; Node Property 634 635 (defconst org-effort-property "Effort" 636 "The property that is being used to keep track of effort estimates. 637 Effort estimates given in this property need to be in the format 638 defined in org-duration.el.") 639 640 641 ;;; The custom variables 642 643 (defgroup org nil 644 "Outline-based notes management and organizer." 645 :tag "Org" 646 :group 'outlines 647 :group 'calendar) 648 649 (defcustom org-mode-hook nil 650 "Mode hook for Org mode, run after the mode was turned on." 651 :group 'org 652 :type 'hook) 653 654 (defcustom org-load-hook nil 655 "Hook that is run after org.el has been loaded." 656 :group 'org 657 :type 'hook) 658 659 (make-obsolete-variable 660 'org-load-hook 661 "use `with-eval-after-load' instead." "9.5") 662 663 (defcustom org-log-buffer-setup-hook nil 664 "Hook that is run after an Org log buffer is created." 665 :group 'org 666 :version "24.1" 667 :type 'hook) 668 669 (defvar org-modules) ; defined below 670 (defvar org-modules-loaded nil 671 "Have the modules been loaded already?") 672 673 ;;;###autoload 674 (defun org-load-modules-maybe (&optional force) 675 "Load all extensions listed in `org-modules'." 676 (when (or force (not org-modules-loaded)) 677 (dolist (ext org-modules) 678 (condition-case nil (require ext) 679 (error (message "Problems while trying to load feature `%s'" ext)))) 680 (setq org-modules-loaded t))) 681 682 (defun org-set-modules (var value) 683 "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag." 684 (set var value) 685 (when (featurep 'org) 686 (org-load-modules-maybe 'force) 687 (org-element-cache-reset 'all))) 688 689 (defcustom org-modules '(ol-doi ol-w3m ol-bbdb ol-bibtex ol-docview ol-gnus ol-info ol-irc ol-mhe ol-rmail ol-eww) 690 "Modules that should always be loaded together with org.el. 691 692 If a description starts with <C>, the file is not part of Emacs and Org mode, 693 so loading it will require that you have properly installed org-contrib 694 package from NonGNU Emacs Lisp Package Archive 695 http://elpa.nongnu.org/nongnu/org-contrib.html 696 697 You can also use this system to load external packages (i.e. neither Org 698 core modules, nor org-contrib modules). Just add symbols 699 to the end of the list. If the package is called org-xyz.el, then you need 700 to add the symbol `xyz', and the package must have a call to: 701 702 (provide \\='org-xyz) 703 704 For export specific modules, see also `org-export-backends'." 705 :group 'org 706 :set 'org-set-modules 707 :package-version '(Org . "9.5") 708 :type 709 '(set :greedy t 710 (const :tag " bbdb: Links to BBDB entries" ol-bbdb) 711 (const :tag " bibtex: Links to BibTeX entries" ol-bibtex) 712 (const :tag " crypt: Encryption of subtrees" org-crypt) 713 (const :tag " ctags: Access to Emacs tags with links" org-ctags) 714 (const :tag " docview: Links to Docview buffers" ol-docview) 715 (const :tag " doi: Links to DOI references" ol-doi) 716 (const :tag " eww: Store link to URL of Eww" ol-eww) 717 (const :tag " gnus: Links to GNUS folders/messages" ol-gnus) 718 (const :tag " habit: Track your consistency with habits" org-habit) 719 (const :tag " id: Global IDs for identifying entries" org-id) 720 (const :tag " info: Links to Info nodes" ol-info) 721 (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask) 722 (const :tag " irc: Links to IRC/ERC chat sessions" ol-irc) 723 (const :tag " mhe: Links to MHE folders/messages" ol-mhe) 724 (const :tag " mouse: Additional mouse support" org-mouse) 725 (const :tag " protocol: Intercept calls from emacsclient" org-protocol) 726 (const :tag " rmail: Links to RMAIL folders/messages" ol-rmail) 727 (const :tag " tempo: Fast completion for structures" org-tempo) 728 (const :tag " w3m: Special cut/paste from w3m to Org mode." ol-w3m) 729 (const :tag " eshell: Links to working directories in Eshell" ol-eshell) 730 731 (const :tag "C annotate-file: Annotate a file with Org syntax" org-annotate-file) 732 (const :tag "C bookmark: Links to bookmarks" ol-bookmark) 733 (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) 734 (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) 735 (const :tag "C collector: Collect properties into tables" org-collector) 736 (const :tag "C depend: TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) 737 (const :tag "C elisp-symbol: Links to emacs-lisp symbols" ol-elisp-symbol) 738 (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) 739 (const :tag "C eval: Include command output as text" org-eval) 740 (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry) 741 (const :tag "C git-link: Links to specific file version" ol-git-link) 742 (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) 743 (const :tag "C invoice: Help manage client invoices in Org mode" org-invoice) 744 (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) 745 (const :tag "C mac-iCal: Imports events from iCal.app to the Emacs diary" org-mac-iCal) 746 (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link) 747 (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix) 748 (const :tag "C man: Links to man pages in Org mode" ol-man) 749 (const :tag "C mew: Links to Mew folders/messages" ol-mew) 750 (const :tag "C notify: Notifications for Org mode" org-notify) 751 (const :tag "C notmuch: Provide Org links to notmuch searches or messages" ol-notmuch) 752 (const :tag "C panel: Simple routines for us with bad memory" org-panel) 753 (const :tag "C registry: A registry for Org links" org-registry) 754 (const :tag "C screen: Visit screen sessions through links" org-screen) 755 (const :tag "C screenshot: Take and manage screenshots in Org files" org-screenshot) 756 (const :tag "C secretary: Team management with Org" org-secretary) 757 (const :tag "C sqlinsert: Convert Org tables to SQL insertions" orgtbl-sqlinsert) 758 (const :tag "C toc: Table of contents for Org buffer" org-toc) 759 (const :tag "C track: Keep up with Org mode development" org-track) 760 (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) 761 (const :tag "C vm: Links to VM folders/messages" ol-vm) 762 (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) 763 (const :tag "C wl: Links to Wanderlust folders/messages" ol-wl) 764 (repeat :tag "External packages" :inline t (symbol :tag "Package")))) 765 766 (defvar org-export-registered-backends) ; From ox.el. 767 (declare-function org-export-derived-backend-p "ox" (backend &rest backends)) 768 (declare-function org-export-backend-name "ox" (backend) t) 769 (defcustom org-export-backends '(ascii html icalendar latex odt) 770 "List of export back-ends that should be always available. 771 772 If a description starts with <C>, the file is not part of Emacs and Org mode, 773 so loading it will require that you have properly installed org-contrib 774 package from NonGNU Emacs Lisp Package Archive 775 http://elpa.nongnu.org/nongnu/org-contrib.html 776 777 Unlike to `org-modules', libraries in this list will not be 778 loaded along with Org, but only once the export framework is 779 needed. 780 781 This variable needs to be set before org.el is loaded. If you 782 need to make a change while Emacs is running, use the customize 783 interface or run the following code, where VAL stands for the new 784 value of the variable, after updating it: 785 786 (progn 787 (setq org-export-registered-backends 788 (cl-remove-if-not 789 (lambda (backend) 790 (let ((name (org-export-backend-name backend))) 791 (or (memq name val) 792 (catch \\='parentp 793 (dolist (b val) 794 (and (org-export-derived-backend-p b name) 795 (throw \\='parentp t))))))) 796 org-export-registered-backends)) 797 (let ((new-list (mapcar #\\='org-export-backend-name 798 org-export-registered-backends))) 799 (dolist (backend val) 800 (cond 801 ((not (load (format \"ox-%s\" backend) t t)) 802 (message \"Problems while trying to load export back-end \\=`%s\\='\" 803 backend)) 804 ((not (memq backend new-list)) (push backend new-list)))) 805 (set-default \\='org-export-backends new-list))) 806 807 Adding a back-end to this list will also pull the back-end it 808 depends on, if any." 809 :group 'org 810 :group 'org-export 811 :version "26.1" 812 :package-version '(Org . "9.0") 813 :initialize 'custom-initialize-set 814 :set (lambda (var val) 815 (if (not (featurep 'ox)) (set-default var val) 816 ;; Any back-end not required anymore (not present in VAL and not 817 ;; a parent of any back-end in the new value) is removed from the 818 ;; list of registered back-ends. 819 (setq org-export-registered-backends 820 (cl-remove-if-not 821 (lambda (backend) 822 (let ((name (org-export-backend-name backend))) 823 (or (memq name val) 824 (catch 'parentp 825 (dolist (b val) 826 (and (org-export-derived-backend-p b name) 827 (throw 'parentp t))))))) 828 org-export-registered-backends)) 829 ;; Now build NEW-LIST of both new back-ends and required 830 ;; parents. 831 (let ((new-list (mapcar #'org-export-backend-name 832 org-export-registered-backends))) 833 (dolist (backend val) 834 (cond 835 ((not (load (format "ox-%s" backend) t t)) 836 (message "Problems while trying to load export back-end `%s'" 837 backend)) 838 ((not (memq backend new-list)) (push backend new-list)))) 839 ;; Set VAR to that list with fixed dependencies. 840 (set-default var new-list)))) 841 :type '(set :greedy t 842 (const :tag " ascii Export buffer to ASCII format" ascii) 843 (const :tag " beamer Export buffer to Beamer presentation" beamer) 844 (const :tag " html Export buffer to HTML format" html) 845 (const :tag " icalendar Export buffer to iCalendar format" icalendar) 846 (const :tag " latex Export buffer to LaTeX format" latex) 847 (const :tag " man Export buffer to MAN format" man) 848 (const :tag " md Export buffer to Markdown format" md) 849 (const :tag " odt Export buffer to ODT format" odt) 850 (const :tag " org Export buffer to Org format" org) 851 (const :tag " texinfo Export buffer to Texinfo format" texinfo) 852 (const :tag "C confluence Export buffer to Confluence Wiki format" confluence) 853 (const :tag "C deck Export buffer to deck.js presentations" deck) 854 (const :tag "C freemind Export buffer to Freemind mindmap format" freemind) 855 (const :tag "C groff Export buffer to Groff format" groff) 856 (const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter) 857 (const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss) 858 (const :tag "C s5 Export buffer to s5 presentations" s5) 859 (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler))) 860 861 (eval-after-load 'ox 862 '(dolist (backend org-export-backends) 863 (condition-case nil (require (intern (format "ox-%s" backend))) 864 (error (message "Problems while trying to load export back-end `%s'" 865 backend))))) 866 867 (defcustom org-support-shift-select nil 868 "Non-nil means make shift-cursor commands select text when possible. 869 \\<org-mode-map> 870 In Emacs 23, when `shift-select-mode' is on, shifted cursor keys 871 start selecting a region, or enlarge regions started in this way. 872 In Org mode, in special contexts, these same keys are used for 873 other purposes, important enough to compete with shift selection. 874 Org tries to balance these needs by supporting `shift-select-mode' 875 outside these special contexts, under control of this variable. 876 877 The default of this variable is nil, to avoid confusing behavior. Shifted 878 cursor keys will then execute Org commands in the following contexts: 879 - on a headline, changing TODO state (left/right) and priority (up/down) 880 - on a time stamp, changing the time 881 - in a plain list item, changing the bullet type 882 - in a property definition line, switching between allowed values 883 - in the BEGIN line of a clock table (changing the time block). 884 - in a table, moving the cell in the specified direction. 885 Outside these contexts, the commands will throw an error. 886 887 When this variable is t and the cursor is not in a special 888 context, Org mode will support shift-selection for making and 889 enlarging regions. To make this more effective, the bullet 890 cycling will no longer happen anywhere in an item line, but only 891 if the cursor is exactly on the bullet. 892 893 If you set this variable to the symbol `always', then the keys 894 will not be special in headlines, property lines, item lines, and 895 table cells, to make shift selection work there as well. If this is 896 what you want, you can use the following alternative commands: 897 `\\[org-todo]' and `\\[org-priority]' \ 898 to change TODO state and priority, 899 `\\[universal-argument] \\[universal-argument] \\[org-todo]' \ 900 can be used to switch TODO sets, 901 `\\[org-ctrl-c-minus]' to cycle item bullet types, 902 and properties can be edited by hand or in column view. 903 904 However, when the cursor is on a timestamp, shift-cursor commands 905 will still edit the time stamp - this is just too good to give up." 906 :group 'org 907 :type '(choice 908 (const :tag "Never" nil) 909 (const :tag "When outside special context" t) 910 (const :tag "Everywhere except timestamps" always))) 911 912 (defcustom org-loop-over-headlines-in-active-region t 913 "Shall some commands act upon headlines in the active region? 914 915 When set to t, some commands will be performed in all headlines 916 within the active region. 917 918 When set to `start-level', some commands will be performed in all 919 headlines within the active region, provided that these headlines 920 are of the same level than the first one. 921 922 When set to a string, those commands will be performed on the 923 matching headlines within the active region. Such string must be 924 a tags/property/todo match as it is used in the agenda tags view. 925 926 The list of commands is: `org-schedule', `org-deadline', 927 `org-todo', `org-set-tags-command', `org-archive-subtree', 928 `org-archive-set-tag', `org-toggle-archive-tag' and 929 `org-archive-to-archive-sibling'. The archiving commands skip 930 already archived entries. 931 932 See `org-agenda-loop-over-headlines-in-active-region' for the 933 equivalent option for agenda views." 934 :type '(choice (const :tag "Don't loop" nil) 935 (const :tag "All headlines in active region" t) 936 (const :tag "In active region, headlines at the same level than the first one" start-level) 937 (string :tag "Tags/Property/Todo matcher")) 938 :package-version '(Org . "9.4") 939 :group 'org-todo 940 :group 'org-archive) 941 942 (defcustom org-startup-folded 'showeverything 943 "Non-nil means entering Org mode will switch to OVERVIEW. 944 945 This can also be configured on a per-file basis by adding one of 946 the following lines anywhere in the buffer: 947 948 #+STARTUP: fold (or `overview', this is equivalent) 949 #+STARTUP: nofold (or `showall', this is equivalent) 950 #+STARTUP: content 951 #+STARTUP: show<n>levels (<n> = 2..5) 952 #+STARTUP: showeverything 953 954 Set `org-agenda-inhibit-startup' to a non-nil value if you want 955 to ignore this option when Org opens agenda files for the first 956 time." 957 :group 'org-startup 958 :package-version '(Org . "9.4") 959 :type '(choice 960 (const :tag "nofold: show all" nil) 961 (const :tag "fold: overview" t) 962 (const :tag "fold: show two levels" show2levels) 963 (const :tag "fold: show three levels" show3levels) 964 (const :tag "fold: show four levels" show4evels) 965 (const :tag "fold: show five levels" show5levels) 966 (const :tag "content: all headlines" content) 967 (const :tag "show everything, even drawers" showeverything))) 968 969 (defcustom org-startup-truncated t 970 "Non-nil means entering Org mode will set `truncate-lines'. 971 This is useful since some lines containing links can be very long and 972 uninteresting. Also tables look terrible when wrapped. 973 974 The variable `org-startup-truncated' allows to configure 975 truncation for Org mode different to the other modes that use the 976 variable `truncate-lines' and as a shortcut instead of putting 977 the variable `truncate-lines' into the `org-mode-hook'. If one 978 wants to configure truncation for Org mode not statically but 979 dynamically e.g. in a hook like `ediff-prepare-buffer-hook' then 980 the variable `truncate-lines' has to be used because in such a 981 case it is too late to set the variable `org-startup-truncated'." 982 :group 'org-startup 983 :type 'boolean) 984 985 (defcustom org-startup-indented nil 986 "Non-nil means turn on `org-indent-mode' on startup. 987 This can also be configured on a per-file basis by adding one of 988 the following lines anywhere in the buffer: 989 990 #+STARTUP: indent 991 #+STARTUP: noindent" 992 :group 'org-structure 993 :type '(choice 994 (const :tag "Not" nil) 995 (const :tag "Globally (slow on startup in large files)" t))) 996 997 (defcustom org-startup-numerated nil 998 "Non-nil means turn on `org-num-mode' on startup. 999 This can also be configured on a per-file basis by adding one of 1000 the following lines anywhere in the buffer: 1001 1002 #+STARTUP: num 1003 #+STARTUP: nonum" 1004 :group 'org-structure 1005 :package-version '(Org . "9.4") 1006 :type '(choice 1007 (const :tag "Not" nil) 1008 (const :tag "Globally" t))) 1009 1010 (defcustom org-use-sub-superscripts t 1011 "Non-nil means interpret \"_\" and \"^\" for display. 1012 1013 If you want to control how Org exports those characters, see 1014 `org-export-with-sub-superscripts'. 1015 1016 When this option is turned on, you can use TeX-like syntax for 1017 sub- and superscripts within the buffer. Several characters after 1018 \"_\" or \"^\" will be considered as a single item - so grouping 1019 with {} is normally not needed. For example, the following things 1020 will be parsed as single sub- or superscripts: 1021 1022 10^24 or 10^tau several digits will be considered 1 item. 1023 10^-12 or 10^-tau a leading sign with digits or a word 1024 x^2-y^3 will be read as x^2 - y^3, because items are 1025 terminated by almost any nonword/nondigit char. 1026 x_{i^2} or x^(2-i) braces or parenthesis do grouping. 1027 1028 Still, ambiguity is possible. So when in doubt, use {} to enclose 1029 the sub/superscript. If you set this variable to the symbol `{}', 1030 the braces are *required* in order to trigger interpretations as 1031 sub/superscript. This can be helpful in documents that need \"_\" 1032 frequently in plain text." 1033 :group 'org-startup 1034 :version "24.4" 1035 :package-version '(Org . "8.0") 1036 :type '(choice 1037 (const :tag "Always interpret" t) 1038 (const :tag "Only with braces" {}) 1039 (const :tag "Never interpret" nil))) 1040 1041 (defcustom org-startup-with-beamer-mode nil 1042 "Non-nil means turn on `org-beamer-mode' on startup. 1043 This can also be configured on a per-file basis by adding one of 1044 the following lines anywhere in the buffer: 1045 1046 #+STARTUP: beamer" 1047 :group 'org-startup 1048 :version "24.1" 1049 :type 'boolean) 1050 1051 (defcustom org-startup-align-all-tables nil 1052 "Non-nil means align all tables when visiting a file. 1053 This can also be configured on a per-file basis by adding one of 1054 the following lines anywhere in the buffer: 1055 #+STARTUP: align 1056 #+STARTUP: noalign" 1057 :group 'org-startup 1058 :type 'boolean) 1059 1060 (defcustom org-startup-shrink-all-tables nil 1061 "Non-nil means shrink all table columns with a width cookie. 1062 This can also be configured on a per-file basis by adding one of 1063 the following lines anywhere in the buffer: 1064 #+STARTUP: shrink" 1065 :group 'org-startup 1066 :type 'boolean 1067 :version "27.1" 1068 :package-version '(Org . "9.2") 1069 :safe #'booleanp) 1070 1071 (defcustom org-startup-with-inline-images nil 1072 "Non-nil means show inline images when loading a new Org file. 1073 This can also be configured on a per-file basis by adding one of 1074 the following lines anywhere in the buffer: 1075 #+STARTUP: inlineimages 1076 #+STARTUP: noinlineimages" 1077 :group 'org-startup 1078 :version "24.1" 1079 :type 'boolean) 1080 1081 (defcustom org-startup-with-latex-preview nil 1082 "Non-nil means preview LaTeX fragments when loading a new Org file. 1083 1084 This can also be configured on a per-file basis by adding one of 1085 the following lines anywhere in the buffer: 1086 #+STARTUP: latexpreview 1087 #+STARTUP: nolatexpreview" 1088 :group 'org-startup 1089 :version "24.4" 1090 :package-version '(Org . "8.0") 1091 :type 'boolean) 1092 1093 (defcustom org-insert-mode-line-in-empty-file nil 1094 "Non-nil means insert the first line setting Org mode in empty files. 1095 When the function `org-mode' is called interactively in an empty file, this 1096 normally means that the file name does not automatically trigger Org mode. 1097 To ensure that the file will always be in Org mode in the future, a 1098 line enforcing Org mode will be inserted into the buffer, if this option 1099 has been set." 1100 :group 'org-startup 1101 :type 'boolean) 1102 1103 (defcustom org-ellipsis nil 1104 "The ellipsis to use in the Org mode outline. 1105 1106 When nil, just use the standard three dots. When a non-empty string, 1107 use that string instead. 1108 1109 The change affects only Org mode (which will then use its own display table). 1110 Changing this requires executing `\\[org-mode]' in a buffer to become 1111 effective. It cannot be set as a local variable." 1112 :group 'org-startup 1113 :type '(choice (const :tag "Default" nil) 1114 (string :tag "String" :value "...#"))) 1115 1116 (defvar org-display-table nil 1117 "The display table for Org mode, in case `org-ellipsis' is non-nil.") 1118 1119 (defcustom org-directory "~/org" 1120 "Directory with Org files. 1121 This is just a default location to look for Org files. There is no need 1122 at all to put your files into this directory. It is used in the 1123 following situations: 1124 1125 1. When a capture template specifies a target file that is not an 1126 absolute path. The path will then be interpreted relative to 1127 `org-directory' 1128 2. When the value of variable `org-agenda-files' is a single file, any 1129 relative paths in this file will be taken as relative to 1130 `org-directory'." 1131 :group 'org-refile 1132 :group 'org-capture 1133 :type 'directory) 1134 1135 (defcustom org-default-notes-file (convert-standard-filename "~/.notes") 1136 "Default target for storing notes. 1137 Used as a fall back file for org-capture.el, for templates that 1138 do not specify a target file." 1139 :group 'org-refile 1140 :group 'org-capture 1141 :type 'file) 1142 1143 (defcustom org-reverse-note-order nil 1144 "Non-nil means store new notes at the beginning of a file or entry. 1145 When nil, new notes will be filed to the end of a file or entry. 1146 This can also be a list with cons cells of regular expressions that 1147 are matched against file names, and values." 1148 :group 'org-capture 1149 :group 'org-refile 1150 :type '(choice 1151 (const :tag "Reverse always" t) 1152 (const :tag "Reverse never" nil) 1153 (repeat :tag "By file name regexp" 1154 (cons regexp boolean)))) 1155 1156 (defgroup org-keywords nil 1157 "Keywords in Org mode." 1158 :tag "Org Keywords" 1159 :group 'org) 1160 1161 (defcustom org-closed-keep-when-no-todo nil 1162 "Remove CLOSED: time-stamp when switching back to a non-todo state?" 1163 :group 'org-todo 1164 :group 'org-keywords 1165 :version "24.4" 1166 :package-version '(Org . "8.0") 1167 :type 'boolean) 1168 1169 (defgroup org-structure nil 1170 "Options concerning the general structure of Org files." 1171 :tag "Org Structure" 1172 :group 'org) 1173 1174 (defgroup org-reveal-location nil 1175 "Options about how to make context of a location visible." 1176 :tag "Org Reveal Location" 1177 :group 'org-structure) 1178 1179 (defcustom org-show-context-detail '((agenda . local) 1180 (bookmark-jump . lineage) 1181 (isearch . lineage) 1182 (default . ancestors)) 1183 "Alist between context and visibility span when revealing a location. 1184 1185 \\<org-mode-map>Some actions may move point into invisible 1186 locations. As a consequence, Org always exposes a neighborhood 1187 around point. How much is shown depends on the initial action, 1188 or context. Valid contexts are 1189 1190 agenda when exposing an entry from the agenda 1191 org-goto when using the command `org-goto' (`\\[org-goto]') 1192 occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /') 1193 tags-tree when constructing a sparse tree based on tags matches 1194 link-search when exposing search matches associated with a link 1195 mark-goto when exposing the jump goal of a mark 1196 bookmark-jump when exposing a bookmark location 1197 isearch when exiting from an incremental search 1198 default default for all contexts not set explicitly 1199 1200 Allowed visibility spans are 1201 1202 minimal show current headline; if point is not on headline, 1203 also show entry 1204 1205 local show current headline, entry and next headline 1206 1207 ancestors show current headline and its direct ancestors; if 1208 point is not on headline, also show entry 1209 1210 ancestors-full show current subtree and its direct ancestors 1211 1212 lineage show current headline, its direct ancestors and all 1213 their children; if point is not on headline, also show 1214 entry and first child 1215 1216 tree show current headline, its direct ancestors and all 1217 their children; if point is not on headline, also show 1218 entry and all children 1219 1220 canonical show current headline, its direct ancestors along with 1221 their entries and children; if point is not located on 1222 the headline, also show current entry and all children 1223 1224 As special cases, a nil or t value means show all contexts in 1225 `minimal' or `canonical' view, respectively. 1226 1227 Some views can make displayed information very compact, but also 1228 make it harder to edit the location of the match. In such 1229 a case, use the command `org-reveal' (`\\[org-reveal]') to show 1230 more context." 1231 :group 'org-reveal-location 1232 :version "26.1" 1233 :package-version '(Org . "9.0") 1234 :type '(choice 1235 (const :tag "Canonical" t) 1236 (const :tag "Minimal" nil) 1237 (repeat :greedy t :tag "Individual contexts" 1238 (cons 1239 (choice :tag "Context" 1240 (const agenda) 1241 (const org-goto) 1242 (const occur-tree) 1243 (const tags-tree) 1244 (const link-search) 1245 (const mark-goto) 1246 (const bookmark-jump) 1247 (const isearch) 1248 (const default)) 1249 (choice :tag "Detail level" 1250 (const minimal) 1251 (const local) 1252 (const ancestors) 1253 (const ancestors-full) 1254 (const lineage) 1255 (const tree) 1256 (const canonical)))))) 1257 1258 (defcustom org-indirect-buffer-display 'other-window 1259 "How should indirect tree buffers be displayed? 1260 1261 This applies to indirect buffers created with the commands 1262 `org-tree-to-indirect-buffer' and `org-agenda-tree-to-indirect-buffer'. 1263 1264 Valid values are: 1265 current-window Display in the current window 1266 other-window Just display in another window. 1267 dedicated-frame Create one new frame, and re-use it each time. 1268 new-frame Make a new frame each time. Note that in this case 1269 previously-made indirect buffers are kept, and you need to 1270 kill these buffers yourself." 1271 :group 'org-structure 1272 :group 'org-agenda-windows 1273 :type '(choice 1274 (const :tag "In current window" current-window) 1275 (const :tag "In current frame, other window" other-window) 1276 (const :tag "Each time a new frame" new-frame) 1277 (const :tag "One dedicated frame" dedicated-frame))) 1278 1279 (defconst org-file-apps-gnu 1280 '((remote . emacs) 1281 (system . mailcap) 1282 (t . mailcap)) 1283 "Default file applications on a UNIX or GNU/Linux system. 1284 See `org-file-apps'.") 1285 1286 (defconst org-file-apps-macos 1287 '((remote . emacs) 1288 (system . "open %s") 1289 ("ps.gz" . "gv %s") 1290 ("eps.gz" . "gv %s") 1291 ("dvi" . "xdvi %s") 1292 ("fig" . "xfig %s") 1293 (t . "open %s")) 1294 "Default file applications on a macOS system. 1295 The system \"open\" is known as a default, but we use X11 applications 1296 for some files for which the OS does not have a good default. 1297 See `org-file-apps'.") 1298 1299 (defconst org-file-apps-windowsnt 1300 (list '(remote . emacs) 1301 (cons 'system (lambda (file _path) 1302 (with-no-warnings (w32-shell-execute "open" file)))) 1303 (cons t (lambda (file _path) 1304 (with-no-warnings (w32-shell-execute "open" file))))) 1305 "Default file applications on a Windows NT system. 1306 The system \"open\" is used for most files. 1307 See `org-file-apps'.") 1308 1309 (defcustom org-file-apps 1310 '((auto-mode . emacs) 1311 (directory . emacs) 1312 ("\\.mm\\'" . default) 1313 ("\\.x?html?\\'" . default) 1314 ("\\.pdf\\'" . default)) 1315 "Applications for opening `file:path' items in a document. 1316 1317 \\<org-mode-map> 1318 Org mode uses system defaults for different file types, but you 1319 can use this variable to set the application for a given file 1320 extension. The entries in this list are cons cells where the car 1321 identifies files and the cdr the corresponding command. 1322 1323 Possible values for the file identifier are: 1324 1325 \"string\" A string as a file identifier can be interpreted in different 1326 ways, depending on its contents: 1327 1328 - Alphanumeric characters only: 1329 Match links with this file extension. 1330 Example: (\"pdf\" . \"evince %s\") 1331 to open PDFs with evince. 1332 1333 - Regular expression: Match links where the 1334 filename matches the regexp. If you want to 1335 use groups here, use shy groups. 1336 1337 Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\") 1338 (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\") 1339 to open *.html and *.xhtml with firefox. 1340 1341 - Regular expression which contains (non-shy) groups: 1342 Match links where the whole link, including \"::\", and 1343 anything after that, matches the regexp. 1344 In a custom command string, %1, %2, etc. are replaced with 1345 the parts of the link that were matched by the groups. 1346 For backwards compatibility, if a command string is given 1347 that does not use any of the group matches, this case is 1348 handled identically to the second one (i.e. match against 1349 file name only). 1350 In a custom function, you can access the group matches with 1351 (match-string n link). 1352 1353 Example: (\"\\\\.pdf::\\\\([0-9]+\\\\)\\\\\\='\" . \ 1354 \"evince -p %1 %s\") 1355 to open [[file:document.pdf::5]] with evince at page 5. 1356 1357 `directory' Matches a directory 1358 `remote' Matches a remote file, accessible through tramp or efs. 1359 Remote files most likely should be visited through Emacs 1360 because external applications cannot handle such paths. 1361 `auto-mode' Matches files that are matched by any entry in `auto-mode-alist', 1362 so all files Emacs knows how to handle. Using this with 1363 command `emacs' will open most files in Emacs. Beware that this 1364 will also open html files inside Emacs, unless you add 1365 (\"html\" . default) to the list as well. 1366 `system' The system command to open files, like `open' on Windows 1367 and macOS, and mailcap under GNU/Linux. This is the command 1368 that will be selected if you call `org-open-at-point' with a 1369 double prefix argument (`\\[universal-argument] \ 1370 \\[universal-argument] \\[org-open-at-point]'). 1371 t Default for files not matched by any of the other options. 1372 1373 Possible values for the command are: 1374 1375 `emacs' The file will be visited by the current Emacs process. 1376 `default' Use the default application for this file type, which is the 1377 association for t in the list, most likely in the system-specific 1378 part. This can be used to overrule an unwanted setting in the 1379 system-specific variable. 1380 `system' Use the system command for opening files, like \"open\". 1381 This command is specified by the entry whose car is `system'. 1382 Most likely, the system-specific version of this variable 1383 does define this command, but you can overrule/replace it 1384 here. 1385 `mailcap' Use command specified in the mailcaps. 1386 string A command to be executed by a shell; %s will be replaced 1387 by the path to the file. 1388 function A Lisp function, which will be called with two arguments: 1389 the file path and the original link string, without the 1390 \"file:\" prefix. 1391 1392 For more examples, see the system specific constants 1393 `org-file-apps-macos' 1394 `org-file-apps-windowsnt' 1395 `org-file-apps-gnu'." 1396 :group 'org 1397 :package-version '(Org . "9.4") 1398 :type '(repeat 1399 (cons (choice :value "" 1400 (string :tag "Extension") 1401 (const :tag "System command to open files" system) 1402 (const :tag "Default for unrecognized files" t) 1403 (const :tag "Remote file" remote) 1404 (const :tag "Links to a directory" directory) 1405 (const :tag "Any files that have Emacs modes" 1406 auto-mode)) 1407 (choice :value "" 1408 (const :tag "Visit with Emacs" emacs) 1409 (const :tag "Use default" default) 1410 (const :tag "Use the system command" system) 1411 (string :tag "Command") 1412 (function :tag "Function"))))) 1413 1414 (defcustom org-open-non-existing-files nil 1415 "Non-nil means `org-open-file' opens non-existing files. 1416 1417 When nil, an error is thrown. 1418 1419 This variable applies only to external applications because they 1420 might choke on non-existing files. If the link is to a file that 1421 will be opened in Emacs, the variable is ignored." 1422 :group 'org 1423 :type 'boolean 1424 :safe #'booleanp) 1425 1426 (defcustom org-open-directory-means-index-dot-org nil 1427 "When non-nil a link to a directory really means to \"index.org\". 1428 When nil, following a directory link runs Dired or opens 1429 a finder/explorer window on that directory." 1430 :group 'org 1431 :type 'boolean 1432 :safe #'booleanp) 1433 1434 (defcustom org-bookmark-names-plist 1435 '(:last-capture "org-capture-last-stored" 1436 :last-refile "org-refile-last-stored" 1437 :last-capture-marker "org-capture-last-stored-marker") 1438 "Names for bookmarks automatically set by some Org commands. 1439 This can provide strings as names for a number of bookmarks Org sets 1440 automatically. The following keys are currently implemented: 1441 :last-capture 1442 :last-capture-marker 1443 :last-refile 1444 When a key does not show up in the property list, the corresponding bookmark 1445 is not set." 1446 :group 'org-structure 1447 :type 'plist) 1448 1449 (defgroup org-cycle nil 1450 "Options concerning visibility cycling in Org mode." 1451 :tag "Org Cycle" 1452 :group 'org-structure) 1453 1454 (defcustom org-cycle-skip-children-state-if-no-children t 1455 "Non-nil means skip CHILDREN state in entries that don't have any." 1456 :group 'org-cycle 1457 :type 'boolean) 1458 1459 (defcustom org-cycle-max-level nil 1460 "Maximum level which should still be subject to visibility cycling. 1461 Levels higher than this will, for cycling, be treated as text, not a headline. 1462 When `org-odd-levels-only' is set, a value of N in this variable actually 1463 means 2N-1 stars as the limiting headline. 1464 When nil, cycle all levels. 1465 Note that the limiting level of cycling is also influenced by 1466 `org-inlinetask-min-level'. When `org-cycle-max-level' is not set but 1467 `org-inlinetask-min-level' is, cycling will be limited to levels one less 1468 than its value." 1469 :group 'org-cycle 1470 :type '(choice 1471 (const :tag "No limit" nil) 1472 (integer :tag "Maximum level"))) 1473 1474 (defcustom org-hide-block-startup nil 1475 "Non-nil means entering Org mode will fold all blocks. 1476 This can also be set in on a per-file basis with 1477 1478 #+STARTUP: hideblocks 1479 #+STARTUP: showblocks" 1480 :group 'org-startup 1481 :group 'org-cycle 1482 :type 'boolean) 1483 1484 (defcustom org-cycle-global-at-bob nil 1485 "Cycle globally if cursor is at beginning of buffer and not at a headline. 1486 1487 This makes it possible to do global cycling without having to use `S-TAB' 1488 or `\\[universal-argument] TAB'. For this special case to work, the first \ 1489 line of the buffer 1490 must not be a headline -- it may be empty or some other text. 1491 1492 When used in this way, `org-cycle-hook' is disabled temporarily to make 1493 sure the cursor stays at the beginning of the buffer. 1494 1495 When this option is nil, don't do anything special at the beginning of 1496 the buffer." 1497 :group 'org-cycle 1498 :type 'boolean) 1499 1500 (defcustom org-cycle-level-after-item/entry-creation t 1501 "Non-nil means cycle entry level or item indentation in new empty entries. 1502 1503 When the cursor is at the end of an empty headline, i.e., with only stars 1504 and maybe a TODO keyword, TAB will then switch the entry to become a child, 1505 and then all possible ancestor states, before returning to the original state. 1506 This makes data entry extremely fast: M-RET to create a new headline, 1507 on TAB to make it a child, two or more tabs to make it a (grand-)uncle. 1508 1509 When the cursor is at the end of an empty plain list item, one TAB will 1510 make it a subitem, two or more tabs will back up to make this an item 1511 higher up in the item hierarchy." 1512 :group 'org-cycle 1513 :type 'boolean) 1514 1515 (defcustom org-cycle-emulate-tab t 1516 "Where should `org-cycle' emulate TAB. 1517 nil Never 1518 white Only in completely white lines 1519 whitestart Only at the beginning of lines, before the first non-white char 1520 t Everywhere except in headlines 1521 exc-hl-bol Everywhere except at the start of a headline 1522 If TAB is used in a place where it does not emulate TAB, the current subtree 1523 visibility is cycled." 1524 :group 'org-cycle 1525 :type '(choice (const :tag "Never" nil) 1526 (const :tag "Only in completely white lines" white) 1527 (const :tag "Before first char in a line" whitestart) 1528 (const :tag "Everywhere except in headlines" t) 1529 (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) 1530 1531 (defcustom org-cycle-separator-lines 2 1532 "Number of empty lines needed to keep an empty line between collapsed trees. 1533 If you leave an empty line between the end of a subtree and the following 1534 headline, this empty line is hidden when the subtree is folded. 1535 Org mode will leave (exactly) one empty line visible if the number of 1536 empty lines is equal or larger to the number given in this variable. 1537 So the default 2 means at least 2 empty lines after the end of a subtree 1538 are needed to produce free space between a collapsed subtree and the 1539 following headline. 1540 1541 If the number is negative, and the number of empty lines is at least -N, 1542 all empty lines are shown. 1543 1544 Special case: when 0, never leave empty lines in collapsed view." 1545 :group 'org-cycle 1546 :type 'integer) 1547 (put 'org-cycle-separator-lines 'safe-local-variable 'integerp) 1548 1549 (defcustom org-pre-cycle-hook nil 1550 "Hook that is run before visibility cycling is happening. 1551 The function(s) in this hook must accept a single argument which indicates 1552 the new state that will be set right after running this hook. The 1553 argument is a symbol. Before a global state change, it can have the values 1554 `overview', `content', or `all'. Before a local state change, it can have 1555 the values `folded', `children', or `subtree'." 1556 :group 'org-cycle 1557 :type 'hook) 1558 1559 (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees 1560 org-cycle-hide-drawers 1561 org-cycle-show-empty-lines 1562 org-optimize-window-after-visibility-change) 1563 "Hook that is run after `org-cycle' has changed the buffer visibility. 1564 The function(s) in this hook must accept a single argument which indicates 1565 the new state that was set by the most recent `org-cycle' command. The 1566 argument is a symbol. After a global state change, it can have the values 1567 `overview', `contents', or `all'. After a local state change, it can have 1568 the values `folded', `children', or `subtree'." 1569 :group 'org-cycle 1570 :package-version '(Org . "9.4") 1571 :type 'hook) 1572 1573 (defgroup org-edit-structure nil 1574 "Options concerning structure editing in Org mode." 1575 :tag "Org Edit Structure" 1576 :group 'org-structure) 1577 1578 (defcustom org-odd-levels-only nil 1579 "Non-nil means skip even levels and only use odd levels for the outline. 1580 This has the effect that two stars are being added/taken away in 1581 promotion/demotion commands. It also influences how levels are 1582 handled by the exporters. 1583 Changing it requires restart of `font-lock-mode' to become effective 1584 for fontification also in regions already fontified. 1585 You may also set this on a per-file basis by adding one of the following 1586 lines to the buffer: 1587 1588 #+STARTUP: odd 1589 #+STARTUP: oddeven" 1590 :group 'org-edit-structure 1591 :group 'org-appearance 1592 :type 'boolean) 1593 1594 (defcustom org-adapt-indentation nil 1595 "Non-nil means adapt indentation to outline node level. 1596 1597 When set to t, Org assumes that you write outlines by indenting 1598 text in each node to align with the headline, after the stars. 1599 1600 When this variable is set to `headline-data', Org only adapts the 1601 indentation of the data lines right below the headline, such as 1602 planning/clock lines and property/logbook drawers. 1603 1604 The following issues are influenced by this variable: 1605 1606 - The indentation is increased by one space in a demotion 1607 command, and decreased by one in a promotion command. However, 1608 in the latter case, if shifting some line in the entry body 1609 would alter document structure (e.g., insert a new headline), 1610 indentation is not changed at all. 1611 1612 - Property drawers and planning information is inserted indented 1613 when this variable is set. When nil, they will not be indented. 1614 1615 - TAB indents a line relative to current level. The lines below 1616 a headline will be indented when this variable is set to t. 1617 1618 Note that this is all about true indentation, by adding and 1619 removing space characters. See also \"org-indent.el\" which does 1620 level-dependent indentation in a virtual way, i.e. at display 1621 time in Emacs." 1622 :group 'org-edit-structure 1623 :type '(choice 1624 (const :tag "Adapt indentation for all lines" t) 1625 (const :tag "Adapt indentation for headline data lines" 1626 headline-data) 1627 (const :tag "Do not adapt indentation at all" nil)) 1628 :safe (lambda (x) (memq x '(t nil headline-data)))) 1629 1630 (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) 1631 1632 (defcustom org-special-ctrl-a/e nil 1633 "Non-nil means `C-a' and `C-e' behave specially in headlines and items. 1634 1635 When t, `C-a' will bring back the cursor to the beginning of the 1636 headline text, i.e. after the stars and after a possible TODO 1637 keyword. In an item, this will be the position after bullet and 1638 check-box, if any. When the cursor is already at that position, 1639 another `C-a' will bring it to the beginning of the line. 1640 1641 `C-e' will jump to the end of the headline, ignoring the presence 1642 of tags in the headline. A second `C-e' will then jump to the 1643 true end of the line, after any tags. This also means that, when 1644 this variable is non-nil, `C-e' also will never jump beyond the 1645 end of the heading of a folded section, i.e. not after the 1646 ellipses. 1647 1648 When set to the symbol `reversed', the first `C-a' or `C-e' works 1649 normally, going to the true line boundary first. Only a directly 1650 following, identical keypress will bring the cursor to the 1651 special positions. 1652 1653 This may also be a cons cell where the behavior for `C-a' and 1654 `C-e' is set separately." 1655 :group 'org-edit-structure 1656 :type '(choice 1657 (const :tag "off" nil) 1658 (const :tag "on: after stars/bullet and before tags first" t) 1659 (const :tag "reversed: true line boundary first" reversed) 1660 (cons :tag "Set C-a and C-e separately" 1661 (choice :tag "Special C-a" 1662 (const :tag "off" nil) 1663 (const :tag "on: after stars/bullet first" t) 1664 (const :tag "reversed: before stars/bullet first" reversed)) 1665 (choice :tag "Special C-e" 1666 (const :tag "off" nil) 1667 (const :tag "on: before tags first" t) 1668 (const :tag "reversed: after tags first" reversed))))) 1669 1670 (defcustom org-special-ctrl-k nil 1671 "Non-nil means `C-k' will behave specially in headlines. 1672 When nil, `C-k' will call the default `kill-line' command. 1673 When t, the following will happen while the cursor is in the headline: 1674 1675 - When at the beginning of a headline, kill the entire subtree. 1676 - When in the middle of the headline text, kill the text up to the tags. 1677 - When after the headline text and before the tags, kill all the tags." 1678 :group 'org-edit-structure 1679 :type 'boolean) 1680 1681 (defcustom org-ctrl-k-protect-subtree nil 1682 "Non-nil means, do not delete a hidden subtree with `C-k'. 1683 When set to the symbol `error', simply throw an error when `C-k' is 1684 used to kill (part-of) a headline that has hidden text behind it. 1685 Any other non-nil value will result in a query to the user, if it is 1686 OK to kill that hidden subtree. When nil, kill without remorse." 1687 :group 'org-edit-structure 1688 :version "24.1" 1689 :type '(choice 1690 (const :tag "Do not protect hidden subtrees" nil) 1691 (const :tag "Protect hidden subtrees with a security query" t) 1692 (const :tag "Never kill a hidden subtree with C-k" error))) 1693 1694 (defcustom org-special-ctrl-o t 1695 "Non-nil means, make `C-o' insert a row in tables." 1696 :group 'org-edit-structure 1697 :type 'boolean) 1698 1699 (defcustom org-catch-invisible-edits nil 1700 "Check if in invisible region before inserting or deleting a character. 1701 Valid values are: 1702 1703 nil Do not check, so just do invisible edits. 1704 error Throw an error and do nothing. 1705 show Make point visible, and do the requested edit. 1706 show-and-error Make point visible, then throw an error and abort the edit. 1707 smart Make point visible, and do insertion/deletion if it is 1708 adjacent to visible text and the change feels predictable. 1709 Never delete a previously invisible character or add in the 1710 middle or right after an invisible region. Basically, this 1711 allows insertion and backward-delete right before ellipses. 1712 FIXME: maybe in this case we should not even show?" 1713 :group 'org-edit-structure 1714 :version "24.1" 1715 :type '(choice 1716 (const :tag "Do not check" nil) 1717 (const :tag "Throw error when trying to edit" error) 1718 (const :tag "Unhide, but do not do the edit" show-and-error) 1719 (const :tag "Show invisible part and do the edit" show) 1720 (const :tag "Be smart and do the right thing" smart))) 1721 1722 (defcustom org-yank-folded-subtrees t 1723 "Non-nil means when yanking subtrees, fold them. 1724 If the kill is a single subtree, or a sequence of subtrees, i.e. if 1725 it starts with a heading and all other headings in it are either children 1726 or siblings, then fold all the subtrees. However, do this only if no 1727 text after the yank would be swallowed into a folded tree by this action." 1728 :group 'org-edit-structure 1729 :type 'boolean) 1730 1731 (defcustom org-yank-adjusted-subtrees nil 1732 "Non-nil means when yanking subtrees, adjust the level. 1733 With this setting, `org-paste-subtree' is used to insert the subtree, see 1734 this function for details." 1735 :group 'org-edit-structure 1736 :type 'boolean) 1737 1738 (defcustom org-M-RET-may-split-line '((default . t)) 1739 "Non-nil means M-RET will split the line at the cursor position. 1740 When nil, it will go to the end of the line before making a 1741 new line. 1742 You may also set this option in a different way for different 1743 contexts. Valid contexts are: 1744 1745 headline when creating a new headline 1746 item when creating a new item 1747 table in a table field 1748 default the value to be used for all contexts not explicitly 1749 customized" 1750 :group 'org-structure 1751 :group 'org-table 1752 :type '(choice 1753 (const :tag "Always" t) 1754 (const :tag "Never" nil) 1755 (repeat :greedy t :tag "Individual contexts" 1756 (cons 1757 (choice :tag "Context" 1758 (const headline) 1759 (const item) 1760 (const table) 1761 (const default)) 1762 (boolean))))) 1763 1764 1765 (defcustom org-insert-heading-respect-content nil 1766 "Non-nil means insert new headings after the current subtree. 1767 \\<org-mode-map> 1768 When nil, the new heading is created directly after the current line. 1769 The commands `\\[org-insert-heading-respect-content]' and \ 1770 `\\[org-insert-todo-heading-respect-content]' turn this variable on 1771 for the duration of the command." 1772 :group 'org-structure 1773 :type 'boolean) 1774 1775 (defcustom org-blank-before-new-entry '((heading . auto) 1776 (plain-list-item . auto)) 1777 "Should `org-insert-heading' leave a blank line before new heading/item? 1778 The value is an alist, with `heading' and `plain-list-item' as CAR, 1779 and a boolean flag as CDR. The cdr may also be the symbol `auto', in 1780 which case Org will look at the surrounding headings/items and try to 1781 make an intelligent decision whether to insert a blank line or not." 1782 :group 'org-edit-structure 1783 :type '(list 1784 (cons (const heading) 1785 (choice (const :tag "Never" nil) 1786 (const :tag "Always" t) 1787 (const :tag "Auto" auto))) 1788 (cons (const plain-list-item) 1789 (choice (const :tag "Never" nil) 1790 (const :tag "Always" t) 1791 (const :tag "Auto" auto))))) 1792 1793 (defcustom org-insert-heading-hook nil 1794 "Hook being run after inserting a new heading." 1795 :group 'org-edit-structure 1796 :type 'hook) 1797 1798 (defgroup org-sparse-trees nil 1799 "Options concerning sparse trees in Org mode." 1800 :tag "Org Sparse Trees" 1801 :group 'org-structure) 1802 1803 (defcustom org-highlight-sparse-tree-matches t 1804 "Non-nil means highlight all matches that define a sparse tree. 1805 The highlights will automatically disappear the next time the buffer is 1806 changed by an edit command." 1807 :group 'org-sparse-trees 1808 :type 'boolean) 1809 1810 (defcustom org-remove-highlights-with-change t 1811 "Non-nil means any change to the buffer will remove temporary highlights. 1812 \\<org-mode-map>\ 1813 Such highlights are created by `org-occur' and `org-clock-display'. 1814 When nil, `\\[org-ctrl-c-ctrl-c]' needs to be used \ 1815 to get rid of the highlights. 1816 The highlights created by `org-latex-preview' always need 1817 `\\[org-latex-preview]' to be removed." 1818 :group 'org-sparse-trees 1819 :group 'org-time 1820 :type 'boolean) 1821 1822 (defcustom org-occur-case-fold-search t 1823 "Non-nil means `org-occur' should be case-insensitive. 1824 If set to `smart' the search will be case-insensitive only if it 1825 doesn't specify any upper case character." 1826 :group 'org-sparse-trees 1827 :version "26.1" 1828 :type '(choice 1829 (const :tag "Case-sensitive" nil) 1830 (const :tag "Case-insensitive" t) 1831 (const :tag "Case-insensitive for lower case searches only" smart))) 1832 1833 (defcustom org-occur-hook '(org-first-headline-recenter) 1834 "Hook that is run after `org-occur' has constructed a sparse tree. 1835 This can be used to recenter the window to show as much of the structure 1836 as possible." 1837 :group 'org-sparse-trees 1838 :type 'hook) 1839 1840 (defcustom org-self-insert-cluster-for-undo nil 1841 "Non-nil means cluster self-insert commands for undo when possible. 1842 If this is set, then, like in the Emacs command loop, 20 consecutive 1843 characters will be undone together. 1844 This is configurable, because there is some impact on typing performance." 1845 :group 'org-table 1846 :type 'boolean) 1847 1848 (defvaralias 'org-activate-links 'org-highlight-links) 1849 (defcustom org-highlight-links '(bracket angle plain radio tag date footnote) 1850 "Types of links that should be highlighted in Org files. 1851 1852 This is a list of symbols, each one of them leading to the 1853 highlighting of a certain link type. 1854 1855 You can still open links that are not highlighted. 1856 1857 In principle, it does not hurt to turn on highlighting for all 1858 link types. There may be a small gain when turning off unused 1859 link types. The types are: 1860 1861 bracket The recommended [[link][description]] or [[link]] links with hiding. 1862 angle Links in angular brackets that may contain whitespace like 1863 <bbdb:Carsten Dominik>. 1864 plain Plain links in normal text, no whitespace, like https://gnu.org. 1865 radio Text that is matched by a radio target, see manual for details. 1866 tag Tag settings in a headline (link to tag search). 1867 date Time stamps (link to calendar). 1868 footnote Footnote labels. 1869 1870 If you set this variable during an Emacs session, use `org-mode-restart' 1871 in the Org buffer so that the change takes effect." 1872 :group 'org-appearance 1873 :type '(set :greedy t 1874 (const :tag "Double bracket links" bracket) 1875 (const :tag "Angular bracket links" angle) 1876 (const :tag "Plain text links" plain) 1877 (const :tag "Radio target matches" radio) 1878 (const :tag "Tags" tag) 1879 (const :tag "Timestamps" date) 1880 (const :tag "Footnotes" footnote))) 1881 1882 (defcustom org-mark-ring-length 4 1883 "Number of different positions to be recorded in the ring. 1884 Changing this requires a restart of Emacs to work correctly." 1885 :group 'org-link-follow 1886 :type 'integer) 1887 1888 (defgroup org-todo nil 1889 "Options concerning TODO items in Org mode." 1890 :tag "Org TODO" 1891 :group 'org) 1892 1893 (defgroup org-progress nil 1894 "Options concerning Progress logging in Org mode." 1895 :tag "Org Progress" 1896 :group 'org-time) 1897 1898 (defvar org-todo-interpretation-widgets 1899 '((:tag "Sequence (cycling hits every state)" sequence) 1900 (:tag "Type (cycling directly to DONE)" type)) 1901 "The available interpretation symbols for customizing `org-todo-keywords'. 1902 Interested libraries should add to this list.") 1903 1904 (defcustom org-todo-keywords '((sequence "TODO" "DONE")) 1905 "List of TODO entry keyword sequences and their interpretation. 1906 \\<org-mode-map>This is a list of sequences. 1907 1908 Each sequence starts with a symbol, either `sequence' or `type', 1909 indicating if the keywords should be interpreted as a sequence of 1910 action steps, or as different types of TODO items. The first 1911 keywords are states requiring action - these states will select a headline 1912 for inclusion into the global TODO list Org produces. If one of the 1913 \"keywords\" is the vertical bar, \"|\", the remaining keywords 1914 signify that no further action is necessary. If \"|\" is not found, 1915 the last keyword is treated as the only DONE state of the sequence. 1916 1917 The command `\\[org-todo]' cycles an entry through these states, and one 1918 additional state where no keyword is present. For details about this 1919 cycling, see the manual. 1920 1921 TODO keywords and interpretation can also be set on a per-file basis with 1922 the special #+SEQ_TODO and #+TYP_TODO lines. 1923 1924 Each keyword can optionally specify a character for fast state selection 1925 \(in combination with the variable `org-use-fast-todo-selection') 1926 and specifiers for state change logging, using the same syntax that 1927 is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that 1928 the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" 1929 indicates to record a time stamp each time this state is selected. 1930 1931 Each keyword may also specify if a timestamp or a note should be 1932 recorded when entering or leaving the state, by adding additional 1933 characters in the parenthesis after the keyword. This looks like this: 1934 \"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to 1935 record only the time of the state change. With X and Y being either 1936 \"@\" or \"!\", \"X/Y\" means use X when entering the state, and use 1937 Y when leaving the state if and only if the *target* state does not 1938 define X. You may omit any of the fast-selection key or X or /Y, 1939 so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid. 1940 1941 For backward compatibility, this variable may also be just a list 1942 of keywords. In this case the interpretation (sequence or type) will be 1943 taken from the (otherwise obsolete) variable `org-todo-interpretation'." 1944 :group 'org-todo 1945 :group 'org-keywords 1946 :type '(choice 1947 (repeat :tag "Old syntax, just keywords" 1948 (string :tag "Keyword")) 1949 (repeat :tag "New syntax" 1950 (cons 1951 (choice 1952 :tag "Interpretation" 1953 ;;Quick and dirty way to see 1954 ;;`org-todo-interpretation'. This takes the 1955 ;;place of item arguments 1956 :convert-widget 1957 (lambda (widget) 1958 (widget-put widget 1959 :args (mapcar 1960 (lambda (x) 1961 (widget-convert 1962 (cons 'const x))) 1963 org-todo-interpretation-widgets)) 1964 widget)) 1965 (repeat 1966 (string :tag "Keyword")))))) 1967 1968 (defvar-local org-todo-keywords-1 nil 1969 "All TODO and DONE keywords active in a buffer.") 1970 (defvar org-todo-keywords-for-agenda nil) 1971 (defvar org-done-keywords-for-agenda nil) 1972 (defvar org-todo-keyword-alist-for-agenda nil) 1973 (defvar org-tag-alist-for-agenda nil 1974 "Alist of all tags from all agenda files.") 1975 (defvar org-tag-groups-alist-for-agenda nil 1976 "Alist of all groups tags from all current agenda files.") 1977 (defvar-local org-tag-groups-alist nil) 1978 (defvar org-agenda-contributing-files nil) 1979 (defvar-local org-current-tag-alist nil 1980 "Alist of all tag groups in current buffer. 1981 This variable takes into consideration `org-tag-alist', 1982 `org-tag-persistent-alist' and TAGS keywords in the buffer.") 1983 (defvar-local org-not-done-keywords nil) 1984 (defvar-local org-done-keywords nil) 1985 (defvar-local org-todo-heads nil) 1986 (defvar-local org-todo-sets nil) 1987 (defvar-local org-todo-log-states nil) 1988 (defvar-local org-todo-kwd-alist nil) 1989 (defvar-local org-todo-key-alist nil) 1990 (defvar-local org-todo-key-trigger nil) 1991 1992 (defcustom org-todo-interpretation 'sequence 1993 "Controls how TODO keywords are interpreted. 1994 This variable is in principle obsolete and is only used for 1995 backward compatibility, if the interpretation of todo keywords is 1996 not given already in `org-todo-keywords'. See that variable for 1997 more information." 1998 :group 'org-todo 1999 :group 'org-keywords 2000 :type '(choice (const sequence) 2001 (const type))) 2002 2003 (defcustom org-use-fast-todo-selection 'auto 2004 "\\<org-mode-map>\ 2005 Non-nil means use the fast todo selection scheme with `\\[org-todo]'. 2006 This variable describes if and under what circumstances the cycling 2007 mechanism for TODO keywords will be replaced by a single-key, direct 2008 selection scheme, where the choices are displayed in a little window. 2009 2010 When nil, fast selection is never used. This means that the command 2011 will always switch to the next state. 2012 2013 When it is the symbol `auto', fast selection is whenever selection 2014 keys have been defined. 2015 2016 `expert' is like `auto', but no special window with the keyword 2017 will be shown, choices will only be listed in the prompt. 2018 2019 In all cases, the special interface is only used if access keys have 2020 actually been assigned by the user, i.e. if keywords in the configuration 2021 are followed by a letter in parenthesis, like TODO(t)." 2022 :group 'org-todo 2023 :set (lambda (var val) 2024 (cond 2025 ((eq var t) (set var 'auto)) 2026 ((eq var 'prefix) (set var nil)) 2027 (t (set var val)))) 2028 :type '(choice 2029 (const :tag "Never" nil) 2030 (const :tag "Automatically, when key letter have been defined" auto) 2031 (const :tag "Automatically, but don't show the selection window" expert))) 2032 2033 (defcustom org-provide-todo-statistics t 2034 "Non-nil means update todo statistics after insert and toggle. 2035 ALL-HEADLINES means update todo statistics by including headlines 2036 with no TODO keyword as well, counting them as not done. 2037 A list of TODO keywords means the same, but skip keywords that are 2038 not in this list. 2039 When set to a list of two lists, the first list contains keywords 2040 to consider as TODO keywords, the second list contains keywords 2041 to consider as DONE keywords. 2042 2043 When this is set, todo statistics is updated in the parent of the 2044 current entry each time a todo state is changed." 2045 :group 'org-todo 2046 :type '(choice 2047 (const :tag "Yes, only for TODO entries" t) 2048 (const :tag "Yes, including all entries" all-headlines) 2049 (repeat :tag "Yes, for TODOs in this list" 2050 (string :tag "TODO keyword")) 2051 (list :tag "Yes, for TODOs and DONEs in these lists" 2052 (repeat (string :tag "TODO keyword")) 2053 (repeat (string :tag "DONE keyword"))) 2054 (other :tag "No TODO statistics" nil))) 2055 2056 (defcustom org-hierarchical-todo-statistics t 2057 "Non-nil means TODO statistics covers just direct children. 2058 When nil, all entries in the subtree are considered. 2059 This has only an effect if `org-provide-todo-statistics' is set. 2060 To set this to nil for only a single subtree, use a COOKIE_DATA 2061 property and include the word \"recursive\" into the value." 2062 :group 'org-todo 2063 :type 'boolean) 2064 2065 (defcustom org-after-todo-state-change-hook nil 2066 "Hook which is run after the state of a TODO item was changed. 2067 The new state (a string with a TODO keyword, or nil) is available in the 2068 Lisp variable `org-state'." 2069 :group 'org-todo 2070 :type 'hook) 2071 2072 (defvar org-blocker-hook nil 2073 "Hook for functions that are allowed to block a state change. 2074 2075 Functions in this hook should not modify the buffer. 2076 Each function gets as its single argument a property list, 2077 see `org-trigger-hook' for more information about this list. 2078 2079 If any of the functions in this hook returns nil, the state change 2080 is blocked.") 2081 2082 (defvar org-trigger-hook nil 2083 "Hook for functions that are triggered by a state change. 2084 2085 Each function gets as its single argument a property list with at 2086 least the following elements: 2087 2088 (:type type-of-change :position pos-at-entry-start 2089 :from old-state :to new-state) 2090 2091 Depending on the type, more properties may be present. 2092 2093 This mechanism is currently implemented for: 2094 2095 TODO state changes 2096 ------------------ 2097 :type todo-state-change 2098 :from previous state (keyword as a string), or nil, or a symbol 2099 `todo' or `done', to indicate the general type of state. 2100 :to new state, like in :from") 2101 2102 (defcustom org-enforce-todo-dependencies nil 2103 "Non-nil means undone TODO entries will block switching the parent to DONE. 2104 Also, if a parent has an :ORDERED: property, switching an entry to DONE will 2105 be blocked if any prior sibling is not yet done. 2106 Finally, if the parent is blocked because of ordered siblings of its own, 2107 the child will also be blocked." 2108 :set (lambda (var val) 2109 (set var val) 2110 (if val 2111 (add-hook 'org-blocker-hook 2112 'org-block-todo-from-children-or-siblings-or-parent) 2113 (remove-hook 'org-blocker-hook 2114 'org-block-todo-from-children-or-siblings-or-parent))) 2115 :group 'org-todo 2116 :type 'boolean) 2117 2118 (defcustom org-enforce-todo-checkbox-dependencies nil 2119 "Non-nil means unchecked boxes will block switching the parent to DONE. 2120 When this is nil, checkboxes have no influence on switching TODO states. 2121 When non-nil, you first need to check off all check boxes before the TODO 2122 entry can be switched to DONE. 2123 This variable needs to be set before org.el is loaded, and you need to 2124 restart Emacs after a change to make the change effective. The only way 2125 to change it while Emacs is running is through the customize interface." 2126 :set (lambda (var val) 2127 (set var val) 2128 (if val 2129 (add-hook 'org-blocker-hook 2130 'org-block-todo-from-checkboxes) 2131 (remove-hook 'org-blocker-hook 2132 'org-block-todo-from-checkboxes))) 2133 :group 'org-todo 2134 :type 'boolean) 2135 2136 (defcustom org-treat-insert-todo-heading-as-state-change nil 2137 "Non-nil means inserting a TODO heading is treated as state change. 2138 So when the command `\\[org-insert-todo-heading]' is used, state change 2139 logging will apply if appropriate. When nil, the new TODO item will 2140 be inserted directly, and no logging will take place." 2141 :group 'org-todo 2142 :type 'boolean) 2143 2144 (defcustom org-treat-S-cursor-todo-selection-as-state-change t 2145 "Non-nil means switching TODO states with S-cursor counts as state change. 2146 This is the default behavior. However, setting this to nil allows a 2147 convenient way to select a TODO state and bypass any logging associated 2148 with that." 2149 :group 'org-todo 2150 :type 'boolean) 2151 2152 (defcustom org-todo-state-tags-triggers nil 2153 "Tag changes that should be triggered by TODO state changes. 2154 This is a list. Each entry is 2155 2156 (state-change (tag . flag) .......) 2157 2158 State-change can be a string with a state, and empty string to indicate the 2159 state that has no TODO keyword, or it can be one of the symbols `todo' 2160 or `done', meaning any not-done or done state, respectively." 2161 :group 'org-todo 2162 :group 'org-tags 2163 :type '(repeat 2164 (cons (choice :tag "When changing to" 2165 (const :tag "Not-done state" todo) 2166 (const :tag "Done state" done) 2167 (string :tag "State")) 2168 (repeat 2169 (cons :tag "Tag action" 2170 (string :tag "Tag") 2171 (choice (const :tag "Add" t) (const :tag "Remove" nil))))))) 2172 2173 (defcustom org-log-done nil 2174 "Information to record when a task moves to the DONE state. 2175 2176 Possible values are: 2177 2178 nil Don't add anything, just change the keyword 2179 time Add a time stamp to the task 2180 note Prompt for a note and add it with template `org-log-note-headings' 2181 2182 This option can also be set with on a per-file-basis with 2183 2184 #+STARTUP: nologdone 2185 #+STARTUP: logdone 2186 #+STARTUP: lognotedone 2187 2188 You can have local logging settings for a subtree by setting the LOGGING 2189 property to one or more of these keywords." 2190 :group 'org-todo 2191 :group 'org-progress 2192 :type '(choice 2193 (const :tag "No logging" nil) 2194 (const :tag "Record CLOSED timestamp" time) 2195 (const :tag "Record CLOSED timestamp with note." note))) 2196 2197 ;; Normalize old uses of org-log-done. 2198 (cond 2199 ((eq org-log-done t) (setq org-log-done 'time)) 2200 ((and (listp org-log-done) (memq 'done org-log-done)) 2201 (setq org-log-done 'note))) 2202 2203 (defcustom org-log-reschedule nil 2204 "Information to record when the scheduling date of a task is modified. 2205 2206 Possible values are: 2207 2208 nil Don't add anything, just change the date 2209 time Add a time stamp to the task 2210 note Prompt for a note and add it with template `org-log-note-headings' 2211 2212 This option can also be set with on a per-file-basis with 2213 2214 #+STARTUP: nologreschedule 2215 #+STARTUP: logreschedule 2216 #+STARTUP: lognotereschedule 2217 2218 You can have local logging settings for a subtree by setting the LOGGING 2219 property to one or more of these keywords. 2220 2221 This variable has an effect when calling `org-schedule' or 2222 `org-agenda-schedule' only." 2223 :group 'org-todo 2224 :group 'org-progress 2225 :type '(choice 2226 (const :tag "No logging" nil) 2227 (const :tag "Record timestamp" time) 2228 (const :tag "Record timestamp with note" note))) 2229 2230 (defcustom org-log-redeadline nil 2231 "Information to record when the deadline date of a task is modified. 2232 2233 Possible values are: 2234 2235 nil Don't add anything, just change the date 2236 time Add a time stamp to the task 2237 note Prompt for a note and add it with template `org-log-note-headings' 2238 2239 This option can also be set with on a per-file-basis with 2240 2241 #+STARTUP: nologredeadline 2242 #+STARTUP: logredeadline 2243 #+STARTUP: lognoteredeadline 2244 2245 You can have local logging settings for a subtree by setting the LOGGING 2246 property to one or more of these keywords. 2247 2248 This variable has an effect when calling `org-deadline' or 2249 `org-agenda-deadline' only." 2250 :group 'org-todo 2251 :group 'org-progress 2252 :type '(choice 2253 (const :tag "No logging" nil) 2254 (const :tag "Record timestamp" time) 2255 (const :tag "Record timestamp with note." note))) 2256 2257 (defcustom org-log-note-clock-out nil 2258 "Non-nil means record a note when clocking out of an item. 2259 This can also be configured on a per-file basis by adding one of 2260 the following lines anywhere in the buffer: 2261 2262 #+STARTUP: lognoteclock-out 2263 #+STARTUP: nolognoteclock-out" 2264 :group 'org-todo 2265 :group 'org-progress 2266 :type 'boolean) 2267 2268 (defcustom org-log-done-with-time t 2269 "Non-nil means the CLOSED time stamp will contain date and time. 2270 When nil, only the date will be recorded." 2271 :group 'org-progress 2272 :type 'boolean) 2273 2274 (defcustom org-log-note-headings 2275 '((done . "CLOSING NOTE %t") 2276 (state . "State %-12s from %-12S %t") 2277 (note . "Note taken on %t") 2278 (reschedule . "Rescheduled from %S on %t") 2279 (delschedule . "Not scheduled, was %S on %t") 2280 (redeadline . "New deadline from %S on %t") 2281 (deldeadline . "Removed deadline, was %S on %t") 2282 (refile . "Refiled on %t") 2283 (clock-out . "")) 2284 "Headings for notes added to entries. 2285 2286 The value is an alist, with the car being a symbol indicating the 2287 note context, and the cdr is the heading to be used. The heading 2288 may also be the empty string. The following placeholders can be 2289 used: 2290 2291 %t a time stamp. 2292 %T an active time stamp instead the default inactive one 2293 %d a short-format time stamp. 2294 %D an active short-format time stamp. 2295 %s the new TODO state or time stamp (inactive), in double quotes. 2296 %S the old TODO state or time stamp (inactive), in double quotes. 2297 %u the user name. 2298 %U full user name. 2299 2300 In fact, it is not a good idea to change the `state' entry, 2301 because Agenda Log mode depends on the format of these entries." 2302 :group 'org-todo 2303 :group 'org-progress 2304 :type '(list :greedy t 2305 (cons (const :tag "Heading when closing an item" done) string) 2306 (cons (const :tag 2307 "Heading when changing todo state (todo sequence only)" 2308 state) string) 2309 (cons (const :tag "Heading when just taking a note" note) string) 2310 (cons (const :tag "Heading when rescheduling" reschedule) string) 2311 (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) 2312 (cons (const :tag "Heading when changing deadline" redeadline) string) 2313 (cons (const :tag "Heading when deleting a deadline" deldeadline) string) 2314 (cons (const :tag "Heading when refiling" refile) string) 2315 (cons (const :tag "Heading when clocking out" clock-out) string))) 2316 2317 (unless (assq 'note org-log-note-headings) 2318 (push '(note . "%t") org-log-note-headings)) 2319 2320 (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) 2321 2322 (defcustom org-log-into-drawer nil 2323 "Non-nil means insert state change notes and time stamps into a drawer. 2324 When nil, state changes notes will be inserted after the headline and 2325 any scheduling and clock lines, but not inside a drawer. 2326 2327 The value of this variable should be the name of the drawer to use. 2328 LOGBOOK is proposed as the default drawer for this purpose, you can 2329 also set this to a string to define the drawer of your choice. 2330 2331 A value of t is also allowed, representing \"LOGBOOK\". 2332 2333 A value of t or nil can also be set with on a per-file-basis with 2334 2335 #+STARTUP: logdrawer 2336 #+STARTUP: nologdrawer 2337 2338 If this variable is set, `org-log-state-notes-insert-after-drawers' 2339 will be ignored. 2340 2341 You can set the property LOG_INTO_DRAWER to overrule this setting for 2342 a subtree. 2343 2344 Do not check directly this variable in a Lisp program. Call 2345 function `org-log-into-drawer' instead." 2346 :group 'org-todo 2347 :group 'org-progress 2348 :type '(choice 2349 (const :tag "Not into a drawer" nil) 2350 (const :tag "LOGBOOK" t) 2351 (string :tag "Other"))) 2352 2353 (defun org-log-into-drawer () 2354 "Name of the log drawer, as a string, or nil. 2355 This is the value of `org-log-into-drawer'. However, if the 2356 current entry has or inherits a LOG_INTO_DRAWER property, it will 2357 be used instead of the default value." 2358 (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t))) 2359 (cond ((equal p "nil") nil) 2360 ((equal p "t") "LOGBOOK") 2361 ((stringp p) p) 2362 (p "LOGBOOK") 2363 ((stringp org-log-into-drawer) org-log-into-drawer) 2364 (org-log-into-drawer "LOGBOOK")))) 2365 2366 (defcustom org-log-state-notes-insert-after-drawers nil 2367 "Non-nil means insert state change notes after any drawers in entry. 2368 Only the drawers that *immediately* follow the headline and the 2369 deadline/scheduled line are skipped. 2370 When nil, insert notes right after the heading and perhaps the line 2371 with deadline/scheduling if present. 2372 2373 This variable will have no effect if `org-log-into-drawer' is 2374 set." 2375 :group 'org-todo 2376 :group 'org-progress 2377 :type 'boolean) 2378 2379 (defcustom org-log-states-order-reversed t 2380 "Non-nil means the latest state note will be directly after heading. 2381 When nil, the state change notes will be ordered according to time. 2382 2383 This option can also be set with on a per-file-basis with 2384 2385 #+STARTUP: logstatesreversed 2386 #+STARTUP: nologstatesreversed" 2387 :group 'org-todo 2388 :group 'org-progress 2389 :type 'boolean) 2390 2391 (defcustom org-todo-repeat-to-state nil 2392 "The TODO state to which a repeater should return the repeating task. 2393 By default this is the first task of a TODO sequence or the 2394 previous state of a TYPE_TODO set. But you can specify to use 2395 the previous state in a TODO sequence or a string. 2396 2397 Alternatively, you can set the :REPEAT_TO_STATE: property of the 2398 entry, which has precedence over this option." 2399 :group 'org-todo 2400 :version "24.1" 2401 :type '(choice (const :tag "Use the previous TODO state" t) 2402 (const :tag "Use the head of the TODO sequence" nil) 2403 (string :tag "Use a specific TODO state"))) 2404 2405 (defcustom org-log-repeat 'time 2406 "Non-nil means record moving through the DONE state when triggering repeat. 2407 An auto-repeating task is immediately switched back to TODO when 2408 marked DONE. If you are not logging state changes (by adding \"@\" 2409 or \"!\" to the TODO keyword definition), or set `org-log-done' to 2410 record a closing note, there will be no record of the task moving 2411 through DONE. This variable forces taking a note anyway. 2412 2413 nil Don't force a record 2414 time Record a time stamp 2415 note Prompt for a note and add it with template `org-log-note-headings' 2416 2417 This option can also be set with on a per-file-basis with 2418 2419 #+STARTUP: nologrepeat 2420 #+STARTUP: logrepeat 2421 #+STARTUP: lognoterepeat 2422 2423 You can have local logging settings for a subtree by setting the LOGGING 2424 property to one or more of these keywords." 2425 :group 'org-todo 2426 :group 'org-progress 2427 :type '(choice 2428 (const :tag "Don't force a record" nil) 2429 (const :tag "Force recording the DONE state" time) 2430 (const :tag "Force recording a note with the DONE state" note))) 2431 2432 (defcustom org-todo-repeat-hook nil 2433 "Hook that is run after a task has been repeated." 2434 :package-version '(Org . "9.2") 2435 :group 'org-todo 2436 :type 'hook) 2437 2438 (defgroup org-priorities nil 2439 "Priorities in Org mode." 2440 :tag "Org Priorities" 2441 :group 'org-todo) 2442 2443 (defvaralias 'org-enable-priority-commands 'org-priority-enable-commands) 2444 (defcustom org-priority-enable-commands t 2445 "Non-nil means priority commands are active. 2446 When nil, these commands will be disabled, so that you never accidentally 2447 set a priority." 2448 :group 'org-priorities 2449 :type 'boolean) 2450 2451 (defvaralias 'org-highest-priority 'org-priority-highest) 2452 2453 (defcustom org-priority-highest ?A 2454 "The highest priority of TODO items. 2455 2456 A character like ?A, ?B, etc., or a numeric value like 1, 2, etc. 2457 2458 The default is the character ?A, which is 65 as a numeric value. 2459 2460 If you set `org-priority-highest' to a numeric value inferior to 2461 65, Org assumes you want to use digits for the priority cookie. 2462 If you set it to >=65, Org assumes you want to use alphabetical 2463 characters. 2464 2465 In both cases, the value of `org-priority-highest' must be 2466 smaller than `org-priority-lowest': for example, if \"A\" is the 2467 highest priority, it is smaller than the lowest \"C\" priority: 2468 65 < 67." 2469 :group 'org-priorities 2470 :type '(choice 2471 (character :tag "Character") 2472 (integer :tag "Integer (< 65)"))) 2473 2474 (defvaralias 'org-lowest-priority 'org-priority-lowest) 2475 (defcustom org-priority-lowest ?C 2476 "The lowest priority of TODO items. 2477 2478 A character like ?C, ?B, etc., or a numeric value like 9, 8, etc. 2479 2480 The default is the character ?C, which is 67 as a numeric value. 2481 2482 If you set `org-priority-lowest' to a numeric value inferior to 2483 65, Org assumes you want to use digits for the priority cookie. 2484 If you set it to >=65, Org assumes you want to use alphabetical 2485 characters. 2486 2487 In both cases, the value of `org-priority-lowest' must be greater 2488 than `org-priority-highest': for example, if \"C\" is the lowest 2489 priority, it is greater than the highest \"A\" priority: 67 > 2490 65." 2491 :group 'org-priorities 2492 :type '(choice 2493 (character :tag "Character") 2494 (integer :tag "Integer (< 65)"))) 2495 2496 (defvaralias 'org-default-priority 'org-priority-default) 2497 (defcustom org-priority-default ?B 2498 "The default priority of TODO items. 2499 This is the priority an item gets if no explicit priority is given. 2500 When starting to cycle on an empty priority the first step in the cycle 2501 depends on `org-priority-start-cycle-with-default'. The resulting first 2502 step priority must not exceed the range from `org-priority-highest' to 2503 `org-priority-lowest' which means that `org-priority-default' has to be 2504 in this range exclusive or inclusive to the range boundaries. Else the 2505 first step refuses to set the default and the second will fall back on 2506 \(depending on the command used) the highest or lowest priority." 2507 :group 'org-priorities 2508 :type '(choice 2509 (character :tag "Character") 2510 (integer :tag "Integer (< 65)"))) 2511 2512 (defcustom org-priority-start-cycle-with-default t 2513 "Non-nil means start with default priority when starting to cycle. 2514 When this is nil, the first step in the cycle will be (depending on the 2515 command used) one higher or lower than the default priority. 2516 See also `org-priority-default'." 2517 :group 'org-priorities 2518 :type 'boolean) 2519 2520 (defvaralias 'org-get-priority-function 'org-priority-get-priority-function) 2521 (defcustom org-priority-get-priority-function nil 2522 "Function to extract the priority from a string. 2523 The string is normally the headline. If this is nil, Org 2524 computes the priority from the priority cookie like [#A] in the 2525 headline. It returns an integer, increasing by 1000 for each 2526 priority level. 2527 2528 The user can set a different function here, which should take a 2529 string as an argument and return the numeric priority." 2530 :group 'org-priorities 2531 :version "24.1" 2532 :type '(choice 2533 (const nil) 2534 (function))) 2535 2536 (defgroup org-time nil 2537 "Options concerning time stamps and deadlines in Org mode." 2538 :tag "Org Time" 2539 :group 'org) 2540 2541 (defcustom org-time-stamp-rounding-minutes '(0 5) 2542 "Number of minutes to round time stamps to. 2543 \\<org-mode-map>\ 2544 These are two values, the first applies when first creating a time stamp. 2545 The second applies when changing it with the commands `S-up' and `S-down'. 2546 When changing the time stamp, this means that it will change in steps 2547 of N minutes, as given by the second value. 2548 2549 When a setting is 0 or 1, insert the time unmodified. Useful rounding 2550 numbers should be factors of 60, so for example 5, 10, 15. 2551 2552 When this is larger than 1, you can still force an exact time stamp by using 2553 a double prefix argument to a time stamp command like \ 2554 `\\[org-time-stamp]' or `\\[org-time-stamp-inactive], 2555 and by using a prefix arg to `S-up/down' to specify the exact number 2556 of minutes to shift." 2557 :group 'org-time 2558 :get (lambda (var) ; Make sure both elements are there 2559 (if (integerp (default-value var)) 2560 (list (default-value var) 5) 2561 (default-value var))) 2562 :type '(list 2563 (integer :tag "when inserting times") 2564 (integer :tag "when modifying times"))) 2565 2566 ;; Normalize old customizations of this variable. 2567 (when (integerp org-time-stamp-rounding-minutes) 2568 (setq org-time-stamp-rounding-minutes 2569 (list org-time-stamp-rounding-minutes 2570 org-time-stamp-rounding-minutes))) 2571 2572 (defcustom org-display-custom-times nil 2573 "Non-nil means overlay custom formats over all time stamps. 2574 The formats are defined through the variable `org-time-stamp-custom-formats'. 2575 To turn this on on a per-file basis, insert anywhere in the file: 2576 #+STARTUP: customtime" 2577 :group 'org-time 2578 :set 'set-default 2579 :type 'sexp) 2580 (make-variable-buffer-local 'org-display-custom-times) 2581 2582 (defcustom org-time-stamp-custom-formats 2583 '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american 2584 "Custom formats for time stamps. See `format-time-string' for the syntax. 2585 These are overlaid over the default ISO format if the variable 2586 `org-display-custom-times' is set. Time like %H:%M should be at the 2587 end of the second format. The custom formats are also honored by export 2588 commands, if custom time display is turned on at the time of export." 2589 :group 'org-time 2590 :type 'sexp) 2591 2592 (defun org-time-stamp-format (&optional long inactive) 2593 "Get the right format for a time string." 2594 (let ((f (if long (cdr org-time-stamp-formats) 2595 (car org-time-stamp-formats)))) 2596 (if inactive 2597 (concat "[" (substring f 1 -1) "]") 2598 f))) 2599 2600 (defcustom org-deadline-warning-days 14 2601 "Number of days before expiration during which a deadline becomes active. 2602 This variable governs the display in sparse trees and in the agenda. 2603 When 0 or negative, it means use this number (the absolute value of it) 2604 even if a deadline has a different individual lead time specified. 2605 2606 Custom commands can set this variable in the options section." 2607 :group 'org-time 2608 :group 'org-agenda-daily/weekly 2609 :type 'integer) 2610 2611 (defcustom org-scheduled-delay-days 0 2612 "Number of days before a scheduled item becomes active. 2613 This variable governs the display in sparse trees and in the agenda. 2614 The default value (i.e. 0) means: don't delay scheduled item. 2615 When negative, it means use this number (the absolute value of it) 2616 even if a scheduled item has a different individual delay time 2617 specified. 2618 2619 Custom commands can set this variable in the options section." 2620 :group 'org-time 2621 :group 'org-agenda-daily/weekly 2622 :version "24.4" 2623 :package-version '(Org . "8.0") 2624 :type 'integer) 2625 2626 (defcustom org-read-date-prefer-future t 2627 "Non-nil means assume future for incomplete date input from user. 2628 This affects the following situations: 2629 1. The user gives a month but not a year. 2630 For example, if it is April and you enter \"feb 2\", this will be read 2631 as Feb 2, *next* year. \"May 5\", however, will be this year. 2632 2. The user gives a day, but no month. 2633 For example, if today is the 15th, and you enter \"3\", Org will read 2634 this as the third of *next* month. However, if you enter \"17\", 2635 it will be considered as *this* month. 2636 2637 If you set this variable to the symbol `time', then also the following 2638 will work: 2639 2640 3. If the user gives a time. 2641 If the time is before now, it will be interpreted as tomorrow. 2642 2643 Currently none of this works for ISO week specifications. 2644 2645 When this option is nil, the current day, month and year will always be 2646 used as defaults. 2647 2648 See also `org-agenda-jump-prefer-future'." 2649 :group 'org-time 2650 :type '(choice 2651 (const :tag "Never" nil) 2652 (const :tag "Check month and day" t) 2653 (const :tag "Check month, day, and time" time))) 2654 2655 (defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future 2656 "Should the agenda jump command prefer the future for incomplete dates? 2657 The default is to do the same as configured in `org-read-date-prefer-future'. 2658 But you can also set a deviating value here. 2659 This may t or nil, or the symbol `org-read-date-prefer-future'." 2660 :group 'org-agenda 2661 :group 'org-time 2662 :version "24.1" 2663 :type '(choice 2664 (const :tag "Use org-read-date-prefer-future" 2665 org-read-date-prefer-future) 2666 (const :tag "Never" nil) 2667 (const :tag "Always" t))) 2668 2669 (defcustom org-read-date-force-compatible-dates t 2670 "Should date/time prompt force dates that are guaranteed to work in Emacs? 2671 2672 Depending on the system Emacs is running on, certain dates cannot 2673 be represented with the type used internally to represent time. 2674 Dates between 1970-1-1 and 2038-1-1 can always be represented 2675 correctly. Some systems allow for earlier dates, some for later, 2676 some for both. One way to find out is to insert any date into an 2677 Org buffer, putting the cursor on the year and hitting S-up and 2678 S-down to test the range. 2679 2680 When this variable is set to t, the date/time prompt will not let 2681 you specify dates outside the 1970-2037 range, so it is certain that 2682 these dates will work in whatever version of Emacs you are 2683 running, and also that you can move a file from one Emacs implementation 2684 to another. Whenever Org is forcing the year for you, it will display 2685 a message and beep. 2686 2687 When this variable is nil, Org will check if the date is 2688 representable in the specific Emacs implementation you are using. 2689 If not, it will force a year, usually the current year, and beep 2690 to remind you. Currently this setting is not recommended because 2691 the likelihood that you will open your Org files in an Emacs that 2692 has limited date range is not negligible. 2693 2694 A workaround for this problem is to use diary sexp dates for time 2695 stamps outside of this range." 2696 :group 'org-time 2697 :version "24.1" 2698 :type 'boolean) 2699 2700 (defcustom org-read-date-display-live t 2701 "Non-nil means display current interpretation of date prompt live. 2702 This display will be in an overlay, in the minibuffer. Note that 2703 live display is only active when `org-read-date-popup-calendar' 2704 is non-nil." 2705 :group 'org-time 2706 :type 'boolean) 2707 2708 (defvaralias 'org-popup-calendar-for-date-prompt 2709 'org-read-date-popup-calendar) 2710 2711 (defcustom org-read-date-popup-calendar t 2712 "Non-nil means pop up a calendar when prompting for a date. 2713 In the calendar, the date can be selected with mouse-1. However, the 2714 minibuffer will also be active, and you can simply enter the date as well. 2715 When nil, only the minibuffer will be available." 2716 :group 'org-time 2717 :type 'boolean) 2718 2719 (defcustom org-extend-today-until 0 2720 "The hour when your day really ends. Must be an integer. 2721 This has influence for the following applications: 2722 - When switching the agenda to \"today\". If it is still earlier than 2723 the time given here, the day recognized as TODAY is actually yesterday. 2724 - When a date is read from the user and it is still before the time given 2725 here, the current date and time will be assumed to be yesterday, 23:59. 2726 Also, timestamps inserted in capture templates follow this rule. 2727 2728 IMPORTANT: This is a feature whose implementation is and likely will 2729 remain incomplete. Really, it is only here because past midnight seems to 2730 be the favorite working time of John Wiegley :-)" 2731 :group 'org-time 2732 :type 'integer) 2733 2734 (defcustom org-use-effective-time nil 2735 "If non-nil, consider `org-extend-today-until' when creating timestamps. 2736 For example, if `org-extend-today-until' is 8, and it's 4am, then the 2737 \"effective time\" of any timestamps between midnight and 8am will be 2738 23:59 of the previous day." 2739 :group 'org-time 2740 :version "24.1" 2741 :type 'boolean) 2742 2743 (defcustom org-use-last-clock-out-time-as-effective-time nil 2744 "When non-nil, use the last clock out time for `org-todo'. 2745 Note that this option has precedence over the combined use of 2746 `org-use-effective-time' and `org-extend-today-until'." 2747 :group 'org-time 2748 :version "24.4" 2749 :package-version '(Org . "8.0") 2750 :type 'boolean) 2751 2752 (defcustom org-edit-timestamp-down-means-later nil 2753 "Non-nil means S-down will increase the time in a time stamp. 2754 When nil, S-up will increase." 2755 :group 'org-time 2756 :type 'boolean) 2757 2758 (defcustom org-calendar-follow-timestamp-change t 2759 "Non-nil means make the calendar window follow timestamp changes. 2760 When a timestamp is modified and the calendar window is visible, it will be 2761 moved to the new date." 2762 :group 'org-time 2763 :type 'boolean) 2764 2765 (defgroup org-tags nil 2766 "Options concerning tags in Org mode." 2767 :tag "Org Tags" 2768 :group 'org) 2769 2770 (defcustom org-tag-alist nil 2771 "Default tags available in Org files. 2772 2773 The value of this variable is an alist. Associations either: 2774 2775 (TAG) 2776 (TAG . SELECT) 2777 (SPECIAL) 2778 2779 where TAG is a tag as a string, SELECT is character, used to 2780 select that tag through the fast tag selection interface, and 2781 SPECIAL is one of the following keywords: `:startgroup', 2782 `:startgrouptag', `:grouptags', `:endgroup', `:endgrouptag' or 2783 `:newline'. These keywords are used to define a hierarchy of 2784 tags. See manual for details. 2785 2786 When this variable is nil, Org mode bases tag input on what is 2787 already in the buffer. The value can be overridden locally by 2788 using a TAGS keyword, e.g., 2789 2790 #+TAGS: tag1 tag2 2791 2792 See also `org-tag-persistent-alist' to sidestep this behavior." 2793 :group 'org-tags 2794 :type '(repeat 2795 (choice 2796 (cons :tag "Tag with key" 2797 (string :tag "Tag name") 2798 (character :tag "Access char")) 2799 (list :tag "Tag" (string :tag "Tag name")) 2800 (const :tag "Start radio group" (:startgroup)) 2801 (const :tag "Start tag group, non distinct" (:startgrouptag)) 2802 (const :tag "Group tags delimiter" (:grouptags)) 2803 (const :tag "End radio group" (:endgroup)) 2804 (const :tag "End tag group, non distinct" (:endgrouptag)) 2805 (const :tag "New line" (:newline))))) 2806 2807 (defcustom org-tag-persistent-alist nil 2808 "Tags always available in Org files. 2809 2810 The value of this variable is an alist. Associations either: 2811 2812 (TAG) 2813 (TAG . SELECT) 2814 (SPECIAL) 2815 2816 where TAG is a tag as a string, SELECT is a character, used to 2817 select that tag through the fast tag selection interface, and 2818 SPECIAL is one of the following keywords: `:startgroup', 2819 `:startgrouptag', `:grouptags', `:endgroup', `:endgrouptag' or 2820 `:newline'. These keywords are used to define a hierarchy of 2821 tags. See manual for details. 2822 2823 Unlike to `org-tag-alist', tags defined in this variable do not 2824 depend on a local TAGS keyword. Instead, to disable these tags 2825 on a per-file basis, insert anywhere in the file: 2826 2827 #+STARTUP: noptag" 2828 :group 'org-tags 2829 :type '(repeat 2830 (choice 2831 (cons :tag "Tag with key" 2832 (string :tag "Tag name") 2833 (character :tag "Access char")) 2834 (list :tag "Tag" (string :tag "Tag name")) 2835 (const :tag "Start radio group" (:startgroup)) 2836 (const :tag "Start tag group, non distinct" (:startgrouptag)) 2837 (const :tag "Group tags delimiter" (:grouptags)) 2838 (const :tag "End radio group" (:endgroup)) 2839 (const :tag "End tag group, non distinct" (:endgrouptag)) 2840 (const :tag "New line" (:newline))))) 2841 2842 (defcustom org-complete-tags-always-offer-all-agenda-tags nil 2843 "If non-nil, always offer completion for all tags of all agenda files. 2844 2845 Setting this variable locally allows for dynamic generation of tag 2846 completions in capture buffers. 2847 2848 (add-hook \\='org-capture-mode-hook 2849 (lambda () 2850 (setq-local org-complete-tags-always-offer-all-agenda-tags t)))" 2851 :group 'org-tags 2852 :version "24.1" 2853 :type 'boolean) 2854 2855 (defvar org-file-tags nil 2856 "List of tags that can be inherited by all entries in the file. 2857 The tags will be inherited if the variable `org-use-tag-inheritance' 2858 says they should be. 2859 This variable is populated from #+FILETAGS lines.") 2860 2861 (defcustom org-use-fast-tag-selection 'auto 2862 "Non-nil means use fast tag selection scheme. 2863 This is a special interface to select and deselect tags with single keys. 2864 When nil, fast selection is never used. 2865 When the symbol `auto', fast selection is used if and only if selection 2866 characters for tags have been configured, either through the variable 2867 `org-tag-alist' or through a #+TAGS line in the buffer. 2868 When t, fast selection is always used and selection keys are assigned 2869 automatically if necessary." 2870 :group 'org-tags 2871 :type '(choice 2872 (const :tag "Always" t) 2873 (const :tag "Never" nil) 2874 (const :tag "When selection characters are configured" auto))) 2875 2876 (defcustom org-fast-tag-selection-single-key nil 2877 "Non-nil means fast tag selection exits after first change. 2878 When nil, you have to press RET to exit it. 2879 During fast tag selection, you can toggle this flag with `C-c'. 2880 This variable can also have the value `expert'. In this case, the window 2881 displaying the tags menu is not even shown, until you press `C-c' again." 2882 :group 'org-tags 2883 :type '(choice 2884 (const :tag "No" nil) 2885 (const :tag "Yes" t) 2886 (const :tag "Expert" expert))) 2887 2888 (defvar org-fast-tag-selection-include-todo nil 2889 "Non-nil means fast tags selection interface will also offer TODO states. 2890 This is an undocumented feature, you should not rely on it.") 2891 2892 (defcustom org-tags-column -77 2893 "The column to which tags should be indented in a headline. 2894 If this number is positive, it specifies the column. If it is negative, 2895 it means that the tags should be flushright to that column. For example, 2896 -80 works well for a normal 80 character screen. 2897 When 0, place tags directly after headline text, with only one space in 2898 between." 2899 :group 'org-tags 2900 :type 'integer) 2901 2902 (defcustom org-auto-align-tags t 2903 "Non-nil keeps tags aligned when modifying headlines. 2904 Some operations (i.e. demoting) change the length of a headline and 2905 therefore shift the tags around. With this option turned on, after 2906 each such operation the tags are again aligned to `org-tags-column'." 2907 :group 'org-tags 2908 :type 'boolean) 2909 2910 (defcustom org-use-tag-inheritance t 2911 "Non-nil means tags in levels apply also for sublevels. 2912 When nil, only the tags directly given in a specific line apply there. 2913 This may also be a list of tags that should be inherited, or a regexp that 2914 matches tags that should be inherited. Additional control is possible 2915 with the variable `org-tags-exclude-from-inheritance' which gives an 2916 explicit list of tags to be excluded from inheritance, even if the value of 2917 `org-use-tag-inheritance' would select it for inheritance. 2918 2919 If this option is t, a match early-on in a tree can lead to a large 2920 number of matches in the subtree when constructing the agenda or creating 2921 a sparse tree. If you only want to see the first match in a tree during 2922 a search, check out the variable `org-tags-match-list-sublevels'." 2923 :group 'org-tags 2924 :type '(choice 2925 (const :tag "Not" nil) 2926 (const :tag "Always" t) 2927 (repeat :tag "Specific tags" (string :tag "Tag")) 2928 (regexp :tag "Tags matched by regexp"))) 2929 2930 (defcustom org-tags-exclude-from-inheritance nil 2931 "List of tags that should never be inherited. 2932 This is a way to exclude a few tags from inheritance. For way to do 2933 the opposite, to actively allow inheritance for selected tags, 2934 see the variable `org-use-tag-inheritance'." 2935 :group 'org-tags 2936 :type '(repeat (string :tag "Tag"))) 2937 2938 (defun org-tag-inherit-p (tag) 2939 "Check if TAG is one that should be inherited." 2940 (cond 2941 ((member tag org-tags-exclude-from-inheritance) nil) 2942 ((eq org-use-tag-inheritance t) t) 2943 ((not org-use-tag-inheritance) nil) 2944 ((stringp org-use-tag-inheritance) 2945 (string-match org-use-tag-inheritance tag)) 2946 ((listp org-use-tag-inheritance) 2947 (member tag org-use-tag-inheritance)) 2948 (t (error "Invalid setting of `org-use-tag-inheritance'")))) 2949 2950 (defcustom org-tags-match-list-sublevels t 2951 "Non-nil means list also sublevels of headlines matching a search. 2952 This variable applies to tags/property searches, and also to stuck 2953 projects because this search is based on a tags match as well. 2954 2955 When set to the symbol `indented', sublevels are indented with 2956 leading dots. 2957 2958 Because of tag inheritance (see variable `org-use-tag-inheritance'), 2959 the sublevels of a headline matching a tag search often also match 2960 the same search. Listing all of them can create very long lists. 2961 Setting this variable to nil causes subtrees of a match to be skipped. 2962 2963 This variable is semi-obsolete and probably should always be true. It 2964 is better to limit inheritance to certain tags using the variables 2965 `org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'." 2966 :group 'org-tags 2967 :type '(choice 2968 (const :tag "No, don't list them" nil) 2969 (const :tag "Yes, do list them" t) 2970 (const :tag "List them, indented with leading dots" indented))) 2971 2972 (defcustom org-tags-sort-function nil 2973 "When set, tags are sorted using this function as a comparator." 2974 :group 'org-tags 2975 :type '(choice 2976 (const :tag "No sorting" nil) 2977 (const :tag "Alphabetical" org-string-collate-lessp) 2978 (const :tag "Reverse alphabetical" org-string-collate-greaterp) 2979 (function :tag "Custom function" nil))) 2980 2981 (defvar org-tags-history nil 2982 "History of minibuffer reads for tags.") 2983 (defvar org-last-tags-completion-table nil 2984 "The last used completion table for tags.") 2985 (defvar org-after-tags-change-hook nil 2986 "Hook that is run after the tags in a line have changed.") 2987 2988 (defgroup org-properties nil 2989 "Options concerning properties in Org mode." 2990 :tag "Org Properties" 2991 :group 'org) 2992 2993 (defcustom org-property-format "%-10s %s" 2994 "How property key/value pairs should be formatted by `indent-line'. 2995 When `indent-line' hits a property definition, it will format the line 2996 according to this format, mainly to make sure that the values are 2997 lined-up with respect to each other." 2998 :group 'org-properties 2999 :type 'string) 3000 3001 (defcustom org-properties-postprocess-alist nil 3002 "Alist of properties and functions to adjust inserted values. 3003 Elements of this alist must be of the form 3004 3005 ([string] [function]) 3006 3007 where [string] must be a property name and [function] must be a 3008 lambda expression: this lambda expression must take one argument, 3009 the value to adjust, and return the new value as a string. 3010 3011 For example, this element will allow the property \"Remaining\" 3012 to be updated wrt the relation between the \"Effort\" property 3013 and the clock summary: 3014 3015 ((\"Remaining\" (lambda(value) 3016 (let ((clocksum (org-clock-sum-current-item)) 3017 (effort (org-duration-to-minutes 3018 (org-entry-get (point) \"Effort\")))) 3019 (org-minutes-to-clocksum-string (- effort clocksum))))))" 3020 :group 'org-properties 3021 :version "24.1" 3022 :type '(alist :key-type (string :tag "Property") 3023 :value-type (function :tag "Function"))) 3024 3025 (defcustom org-use-property-inheritance nil 3026 "Non-nil means properties apply also for sublevels. 3027 3028 This setting is chiefly used during property searches. Turning it on can 3029 cause significant overhead when doing a search, which is why it is not 3030 on by default. 3031 3032 When nil, only the properties directly given in the current entry count. 3033 When t, every property is inherited. The value may also be a list of 3034 properties that should have inheritance, or a regular expression matching 3035 properties that should be inherited. 3036 3037 However, note that some special properties use inheritance under special 3038 circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, 3039 and the properties ending in \"_ALL\" when they are used as descriptor 3040 for valid values of a property. 3041 3042 Note for programmers: 3043 When querying an entry with `org-entry-get', you can control if inheritance 3044 should be used. By default, `org-entry-get' looks only at the local 3045 properties. You can request inheritance by setting the inherit argument 3046 to t (to force inheritance) or to `selective' (to respect the setting 3047 in this variable)." 3048 :group 'org-properties 3049 :type '(choice 3050 (const :tag "Not" nil) 3051 (const :tag "Always" t) 3052 (repeat :tag "Specific properties" (string :tag "Property")) 3053 (regexp :tag "Properties matched by regexp"))) 3054 3055 (defun org-property-inherit-p (property) 3056 "Return a non-nil value if PROPERTY should be inherited." 3057 (cond 3058 ((eq org-use-property-inheritance t) t) 3059 ((not org-use-property-inheritance) nil) 3060 ((stringp org-use-property-inheritance) 3061 (string-match org-use-property-inheritance property)) 3062 ((listp org-use-property-inheritance) 3063 (member-ignore-case property org-use-property-inheritance)) 3064 (t (error "Invalid setting of `org-use-property-inheritance'")))) 3065 3066 (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" 3067 "The default column format, if no other format has been defined. 3068 This variable can be set on the per-file basis by inserting a line 3069 3070 #+COLUMNS: %25ITEM ....." 3071 :group 'org-properties 3072 :type 'string) 3073 3074 (defcustom org-columns-default-format-for-agenda nil 3075 "The default column format in an agenda buffer. 3076 This will be used for column view in the agenda unless a format has 3077 been set by adding `org-overriding-columns-format' to the local 3078 settings list of a custom agenda view. When nil, the columns format 3079 for the first item in the agenda list will be used, or as a fall-back, 3080 `org-columns-default-format'." 3081 :group 'org-properties 3082 :type '(choice 3083 (const :tag "No default" nil) 3084 (string :tag "Format string"))) 3085 3086 (defcustom org-columns-ellipses ".." 3087 "The ellipses to be used when a field in column view is truncated. 3088 When this is the empty string, as many characters as possible are shown, 3089 but then there will be no visual indication that the field has been truncated. 3090 When this is a string of length N, the last N characters of a truncated 3091 field are replaced by this string. If the column is narrower than the 3092 ellipses string, only part of the ellipses string will be shown." 3093 :group 'org-properties 3094 :type 'string) 3095 3096 (defconst org-global-properties-fixed 3097 '(("VISIBILITY_ALL" . "folded children content all") 3098 ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto")) 3099 "List of property/value pairs that can be inherited by any entry. 3100 3101 These are fixed values, for the preset properties. The user variable 3102 that can be used to add to this list is `org-global-properties'. 3103 3104 The entries in this list are cons cells where the car is a property 3105 name and cdr is a string with the value. If the value represents 3106 multiple items like an \"_ALL\" property, separate the items by 3107 spaces.") 3108 3109 (defcustom org-global-properties nil 3110 "List of property/value pairs that can be inherited by any entry. 3111 3112 This list will be combined with the constant `org-global-properties-fixed'. 3113 3114 The entries in this list are cons cells where the car is a property 3115 name and cdr is a string with the value. 3116 3117 Buffer local properties are added either by a document property drawer 3118 3119 :PROPERTIES: 3120 :NAME: VALUE 3121 :END: 3122 3123 or by adding lines like 3124 3125 #+PROPERTY: NAME VALUE" 3126 :group 'org-properties 3127 :type '(repeat 3128 (cons (string :tag "Property") 3129 (string :tag "Value")))) 3130 3131 (defvar-local org-keyword-properties nil 3132 "List of property/value pairs inherited by any entry. 3133 3134 Valid for the current buffer. This variable is populated from 3135 PROPERTY keywords. 3136 3137 Note that properties are defined also in property drawers. 3138 Properties defined there take precedence over properties defined 3139 as keywords.") 3140 3141 (defgroup org-agenda nil 3142 "Options concerning agenda views in Org mode." 3143 :tag "Org Agenda" 3144 :group 'org) 3145 3146 (defvar-local org-category nil 3147 "Variable used by Org files to set a category for agenda display. 3148 There are multiple ways to set the category. One way is to set 3149 it in the document property drawer. For example: 3150 3151 :PROPERTIES: 3152 :CATEGORY: ELisp 3153 :END: 3154 3155 Other ways to define it is as an Emacs file variable, for example 3156 3157 # -*- mode: org; org-category: \"ELisp\" 3158 3159 or for the file to contain a special line: 3160 3161 #+CATEGORY: ELisp 3162 3163 If the file does not specify a category, then file's base name 3164 is used instead.") 3165 (put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x)))) 3166 3167 (defcustom org-agenda-files nil 3168 "The files to be used for agenda display. 3169 3170 If an entry is a directory, all files in that directory that are matched 3171 by `org-agenda-file-regexp' will be part of the file list. 3172 3173 If the value of the variable is not a list but a single file name, then 3174 the list of agenda files is actually stored and maintained in that file, 3175 one agenda file per line. In this file paths can be given relative to 3176 `org-directory'. Tilde expansion and environment variable substitution 3177 are also made. 3178 3179 Entries may be added to this list with `\\[org-agenda-file-to-front]' 3180 and removed with `\\[org-remove-file]'." 3181 :group 'org-agenda 3182 :type '(choice 3183 (repeat :tag "List of files and directories" file) 3184 (file :tag "Store list in a file\n" :value "~/.agenda_files"))) 3185 3186 (defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'" 3187 "Regular expression to match files for `org-agenda-files'. 3188 If any element in the list in that variable contains a directory instead 3189 of a normal file, all files in that directory that are matched by this 3190 regular expression will be included." 3191 :group 'org-agenda 3192 :type 'regexp) 3193 3194 (defvaralias 'org-agenda-multi-occur-extra-files 3195 'org-agenda-text-search-extra-files) 3196 3197 (defcustom org-agenda-text-search-extra-files nil 3198 "List of extra files to be searched by text search commands. 3199 These files will be searched in addition to the agenda files by the 3200 commands `org-search-view' (`\\[org-agenda] s') \ 3201 and `org-occur-in-agenda-files'. 3202 Note that these files will only be searched for text search commands, 3203 not for the other agenda views like todo lists, tag searches or the weekly 3204 agenda. This variable is intended to list notes and possibly archive files 3205 that should also be searched by these two commands. 3206 In fact, if the first element in the list is the symbol `agenda-archives', 3207 then all archive files of all agenda files will be added to the search 3208 scope." 3209 :group 'org-agenda 3210 :type '(set :greedy t 3211 (const :tag "Agenda Archives" agenda-archives) 3212 (repeat :inline t (file)))) 3213 3214 (defcustom org-agenda-skip-unavailable-files nil 3215 "Non-nil means to just skip non-reachable files in `org-agenda-files'. 3216 A nil value means to remove them, after a query, from the list." 3217 :group 'org-agenda 3218 :type 'boolean) 3219 3220 (defgroup org-latex nil 3221 "Options for embedding LaTeX code into Org mode." 3222 :tag "Org LaTeX" 3223 :group 'org) 3224 3225 (defcustom org-format-latex-options 3226 '(:foreground default :background default :scale 1.0 3227 :html-foreground "Black" :html-background "Transparent" 3228 :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) 3229 "Options for creating images from LaTeX fragments. 3230 This is a property list with the following properties: 3231 :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". 3232 `default' means use the foreground of the default face. 3233 `auto' means use the foreground from the text face. 3234 :background the background color, or \"Transparent\". 3235 `default' means use the background of the default face. 3236 `auto' means use the background from the text face. 3237 :scale a scaling factor for the size of the images, to get more pixels 3238 :html-foreground, :html-background, :html-scale 3239 the same numbers for HTML export. 3240 :matchers a list indicating which matchers should be used to 3241 find LaTeX fragments. Valid members of this list are: 3242 \"begin\" find environments 3243 \"$1\" find single characters surrounded by $.$ 3244 \"$\" find math expressions surrounded by $...$ 3245 \"$$\" find math expressions surrounded by $$....$$ 3246 \"\\(\" find math expressions surrounded by \\(...\\) 3247 \"\\=\\[\" find math expressions surrounded by \\=\\[...\\]" 3248 :group 'org-latex 3249 :type 'plist) 3250 3251 (defcustom org-format-latex-signal-error t 3252 "Non-nil means signal an error when image creation of LaTeX snippets fails. 3253 When nil, just push out a message." 3254 :group 'org-latex 3255 :version "24.1" 3256 :type 'boolean) 3257 3258 (defcustom org-latex-to-mathml-jar-file nil 3259 "Value of\"%j\" in `org-latex-to-mathml-convert-command'. 3260 Use this to specify additional executable file say a jar file. 3261 3262 When using MathToWeb as the converter, specify the full-path to 3263 your mathtoweb.jar file." 3264 :group 'org-latex 3265 :version "24.1" 3266 :type '(choice 3267 (const :tag "None" nil) 3268 (file :tag "JAR file" :must-match t))) 3269 3270 (defcustom org-latex-to-mathml-convert-command nil 3271 "Command to convert LaTeX fragments to MathML. 3272 Replace format-specifiers in the command as noted below and use 3273 `shell-command' to convert LaTeX to MathML. 3274 %j: Executable file in fully expanded form as specified by 3275 `org-latex-to-mathml-jar-file'. 3276 %I: Input LaTeX file in fully expanded form. 3277 %i: The latex fragment to be converted. 3278 %o: Output MathML file. 3279 3280 This command is used by `org-create-math-formula'. 3281 3282 When using MathToWeb as the converter, set this option to 3283 \"java -jar %j -unicode -force -df %o %I\". 3284 3285 When using LaTeXML set this option to 3286 \"latexmlmath \"%i\" --presentationmathml=%o\"." 3287 :group 'org-latex 3288 :version "24.1" 3289 :type '(choice 3290 (const :tag "None" nil) 3291 (string :tag "\nShell command"))) 3292 3293 (defcustom org-latex-to-html-convert-command nil 3294 "Command to convert LaTeX fragments to HTML. 3295 This command is very open-ended: the output of the command will 3296 directly replace the LaTeX fragment in the resulting HTML. 3297 Replace format-specifiers in the command as noted below and use 3298 `shell-command' to convert LaTeX to HTML. 3299 %i: The LaTeX fragment to be converted. 3300 3301 For example, this could be used with LaTeXML as 3302 \"latexmlc 'literal:%i' --profile=math --preload=siunitx.sty 2>/dev/null\"." 3303 :group 'org-latex 3304 :package-version '(Org . "9.4") 3305 :type '(choice 3306 (const :tag "None" nil) 3307 (string :tag "Shell command"))) 3308 3309 (defcustom org-preview-latex-default-process 'dvipng 3310 "The default process to convert LaTeX fragments to image files. 3311 All available processes and theirs documents can be found in 3312 `org-preview-latex-process-alist', which see." 3313 :group 'org-latex 3314 :version "26.1" 3315 :package-version '(Org . "9.0") 3316 :type 'symbol) 3317 3318 (defcustom org-preview-latex-process-alist 3319 '((dvipng 3320 :programs ("latex" "dvipng") 3321 :description "dvi > png" 3322 :message "you need to install the programs: latex and dvipng." 3323 :image-input-type "dvi" 3324 :image-output-type "png" 3325 :image-size-adjust (1.0 . 1.0) 3326 :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f") 3327 :image-converter ("dvipng -D %D -T tight -bg Transparent -o %O %f")) 3328 (dvisvgm 3329 :programs ("latex" "dvisvgm") 3330 :description "dvi > svg" 3331 :message "you need to install the programs: latex and dvisvgm." 3332 :image-input-type "dvi" 3333 :image-output-type "svg" 3334 :image-size-adjust (1.7 . 1.5) 3335 :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f") 3336 :image-converter ("dvisvgm %f -n -b min -c %S -o %O")) 3337 (imagemagick 3338 :programs ("latex" "convert") 3339 :description "pdf > png" 3340 :message "you need to install the programs: latex and imagemagick." 3341 :image-input-type "pdf" 3342 :image-output-type "png" 3343 :image-size-adjust (1.0 . 1.0) 3344 :latex-compiler ("pdflatex -interaction nonstopmode -output-directory %o %f") 3345 :image-converter 3346 ("convert -density %D -trim -antialias %f -quality 100 %O"))) 3347 "Definitions of external processes for LaTeX previewing. 3348 Org mode can use some external commands to generate TeX snippet's images for 3349 previewing or inserting into HTML files, e.g., \"dvipng\". This variable tells 3350 `org-create-formula-image' how to call them. 3351 3352 The value is an alist with the pattern (NAME . PROPERTIES). NAME is a symbol. 3353 PROPERTIES accepts the following attributes: 3354 3355 :programs list of strings, required programs. 3356 :description string, describe the process. 3357 :message string, message it when required programs cannot be found. 3358 :image-input-type string, input file type of image converter (e.g., \"dvi\"). 3359 :image-output-type string, output file type of image converter (e.g., \"png\"). 3360 :image-size-adjust cons of numbers, the car element is used to adjust LaTeX 3361 image size showed in buffer and the cdr element is for 3362 HTML file. This option is only useful for process 3363 developers, users should use variable 3364 `org-format-latex-options' instead. 3365 :post-clean list of strings, files matched are to be cleaned up once 3366 the image is generated. When nil, the files with \".dvi\", 3367 \".xdv\", \".pdf\", \".tex\", \".aux\", \".log\", \".svg\", 3368 \".png\", \".jpg\", \".jpeg\" or \".out\" extension will 3369 be cleaned up. 3370 :latex-header list of strings, the LaTeX header of the snippet file. 3371 When nil, the fallback value is used instead, which is 3372 controlled by `org-format-latex-header', 3373 `org-latex-default-packages-alist' and 3374 `org-latex-packages-alist', which see. 3375 :latex-compiler list of LaTeX commands, as strings. Each of them is given 3376 to the shell. Place-holders \"%t\", \"%b\" and \"%o\" are 3377 replaced with values defined below. 3378 :image-converter list of image converter commands strings. Each of them is 3379 given to the shell and supports any of the following 3380 place-holders defined below. 3381 3382 Place-holders used by `:image-converter' and `:latex-compiler': 3383 3384 %f input file name 3385 %b base name of input file 3386 %o base directory of input file 3387 %O absolute output file name 3388 3389 Place-holders only used by `:image-converter': 3390 3391 %D dpi, which is used to adjust image size by some processing commands. 3392 %S the image size scale ratio, which is used to adjust image size by some 3393 processing commands." 3394 :group 'org-latex 3395 :version "26.1" 3396 :package-version '(Org . "9.0") 3397 :type '(alist :tag "LaTeX to image backends" 3398 :value-type (plist))) 3399 3400 (defcustom org-preview-latex-image-directory "ltximg/" 3401 "Path to store latex preview images. 3402 A relative path here creates many directories relative to the 3403 processed Org files paths. An absolute path puts all preview 3404 images at the same place." 3405 :group 'org-latex 3406 :version "26.1" 3407 :package-version '(Org . "9.0") 3408 :type 'string) 3409 3410 (defun org-format-latex-mathml-available-p () 3411 "Return t if `org-latex-to-mathml-convert-command' is usable." 3412 (save-match-data 3413 (when (and (boundp 'org-latex-to-mathml-convert-command) 3414 org-latex-to-mathml-convert-command) 3415 (let ((executable (car (split-string 3416 org-latex-to-mathml-convert-command)))) 3417 (when (executable-find executable) 3418 (if (string-match 3419 "%j" org-latex-to-mathml-convert-command) 3420 (file-readable-p org-latex-to-mathml-jar-file) 3421 t)))))) 3422 3423 (defcustom org-format-latex-header "\\documentclass{article} 3424 \\usepackage[usenames]{color} 3425 \[PACKAGES] 3426 \[DEFAULT-PACKAGES] 3427 \\pagestyle{empty} % do not remove 3428 % The settings below are copied from fullpage.sty 3429 \\setlength{\\textwidth}{\\paperwidth} 3430 \\addtolength{\\textwidth}{-3cm} 3431 \\setlength{\\oddsidemargin}{1.5cm} 3432 \\addtolength{\\oddsidemargin}{-2.54cm} 3433 \\setlength{\\evensidemargin}{\\oddsidemargin} 3434 \\setlength{\\textheight}{\\paperheight} 3435 \\addtolength{\\textheight}{-\\headheight} 3436 \\addtolength{\\textheight}{-\\headsep} 3437 \\addtolength{\\textheight}{-\\footskip} 3438 \\addtolength{\\textheight}{-3cm} 3439 \\setlength{\\topmargin}{1.5cm} 3440 \\addtolength{\\topmargin}{-2.54cm}" 3441 "The document header used for processing LaTeX fragments. 3442 It is imperative that this header make sure that no page number 3443 appears on the page. The package defined in the variables 3444 `org-latex-default-packages-alist' and `org-latex-packages-alist' 3445 will either replace the placeholder \"[PACKAGES]\" in this 3446 header, or they will be appended." 3447 :group 'org-latex 3448 :type 'string) 3449 3450 (defun org-set-packages-alist (var val) 3451 "Set the packages alist and make sure it has 3 elements per entry." 3452 (set var (mapcar (lambda (x) 3453 (if (and (consp x) (= (length x) 2)) 3454 (list (car x) (nth 1 x) t) 3455 x)) 3456 val))) 3457 3458 (defun org-get-packages-alist (var) 3459 "Get the packages alist and make sure it has 3 elements per entry." 3460 (mapcar (lambda (x) 3461 (if (and (consp x) (= (length x) 2)) 3462 (list (car x) (nth 1 x) t) 3463 x)) 3464 (default-value var))) 3465 3466 (defcustom org-latex-default-packages-alist 3467 '(("AUTO" "inputenc" t ("pdflatex")) 3468 ("T1" "fontenc" t ("pdflatex")) 3469 ("" "graphicx" t) 3470 ("" "longtable" nil) 3471 ("" "wrapfig" nil) 3472 ("" "rotating" nil) 3473 ("normalem" "ulem" t) 3474 ("" "amsmath" t) 3475 ("" "amssymb" t) 3476 ("" "capt-of" nil) 3477 ("" "hyperref" nil)) 3478 "Alist of default packages to be inserted in the header. 3479 3480 Change this only if one of the packages here causes an 3481 incompatibility with another package you are using. 3482 3483 The packages in this list are needed by one part or another of 3484 Org mode to function properly: 3485 3486 - inputenc, fontenc: for basic font and character selection 3487 - graphicx: for including images 3488 - longtable: For multipage tables 3489 - wrapfig: for figure placement 3490 - rotating: for sideways figures and tables 3491 - ulem: for underline and strike-through 3492 - amsmath: for subscript and superscript and math environments 3493 - amssymb: for various symbols used for interpreting the entities 3494 in `org-entities'. You can skip some of this package if you don't 3495 use any of the symbols. 3496 - capt-of: for captions outside of floats 3497 - hyperref: for cross references 3498 3499 Therefore you should not modify this variable unless you know 3500 what you are doing. The one reason to change it anyway is that 3501 you might be loading some other package that conflicts with one 3502 of the default packages. Each element is either a cell or 3503 a string. 3504 3505 A cell is of the format 3506 3507 (\"options\" \"package\" SNIPPET-FLAG COMPILERS) 3508 3509 If SNIPPET-FLAG is non-nil, the package also needs to be included 3510 when compiling LaTeX snippets into images for inclusion into 3511 non-LaTeX output. 3512 3513 COMPILERS is a list of compilers that should include the package, 3514 see `org-latex-compiler'. If the document compiler is not in the 3515 list, and the list is non-nil, the package will not be inserted 3516 in the final document. 3517 3518 A string will be inserted as-is in the header of the document." 3519 :group 'org-latex 3520 :group 'org-export-latex 3521 :set 'org-set-packages-alist 3522 :get 'org-get-packages-alist 3523 :version "26.1" 3524 :package-version '(Org . "8.3") 3525 :type '(repeat 3526 (choice 3527 (list :tag "options/package pair" 3528 (string :tag "options") 3529 (string :tag "package") 3530 (boolean :tag "Snippet") 3531 (choice 3532 (const :tag "For all compilers" nil) 3533 (repeat :tag "Allowed compiler" string))) 3534 (string :tag "A line of LaTeX")))) 3535 3536 (defcustom org-latex-packages-alist nil 3537 "Alist of packages to be inserted in every LaTeX header. 3538 3539 These will be inserted after `org-latex-default-packages-alist'. 3540 Each element is either a cell or a string. 3541 3542 A cell is of the format: 3543 3544 (\"options\" \"package\" SNIPPET-FLAG COMPILERS) 3545 3546 SNIPPET-FLAG, when non-nil, indicates that this package is also 3547 needed when turning LaTeX snippets into images for inclusion into 3548 non-LaTeX output. 3549 3550 COMPILERS is a list of compilers that should include the package, 3551 see `org-latex-compiler'. If the document compiler is not in the 3552 list, and the list is non-nil, the package will not be inserted 3553 in the final document. 3554 3555 A string will be inserted as-is in the header of the document. 3556 3557 Make sure that you only list packages here which: 3558 3559 - you want in every file; 3560 - do not conflict with the setup in `org-format-latex-header'; 3561 - do not conflict with the default packages in 3562 `org-latex-default-packages-alist'." 3563 :group 'org-latex 3564 :group 'org-export-latex 3565 :set 'org-set-packages-alist 3566 :get 'org-get-packages-alist 3567 :type '(repeat 3568 (choice 3569 (list :tag "options/package pair" 3570 (string :tag "options") 3571 (string :tag "package") 3572 (boolean :tag "Snippet")) 3573 (string :tag "A line of LaTeX")))) 3574 3575 (defgroup org-appearance nil 3576 "Settings for Org mode appearance." 3577 :tag "Org Appearance" 3578 :group 'org) 3579 3580 (defcustom org-level-color-stars-only nil 3581 "Non-nil means fontify only the stars in each headline. 3582 When nil, the entire headline is fontified. 3583 Changing it requires restart of `font-lock-mode' to become effective 3584 also in regions already fontified." 3585 :group 'org-appearance 3586 :type 'boolean) 3587 3588 (defcustom org-hide-leading-stars nil 3589 "Non-nil means hide the first N-1 stars in a headline. 3590 This works by using the face `org-hide' for these stars. This 3591 face is white for a light background, and black for a dark 3592 background. You may have to customize the face `org-hide' to 3593 make this work. 3594 Changing it requires restart of `font-lock-mode' to become effective 3595 also in regions already fontified. 3596 You may also set this on a per-file basis by adding one of the following 3597 lines to the buffer: 3598 3599 #+STARTUP: hidestars 3600 #+STARTUP: showstars" 3601 :group 'org-appearance 3602 :type 'boolean) 3603 3604 (defcustom org-hidden-keywords nil 3605 "List of symbols corresponding to keywords to be hidden in the Org buffer. 3606 For example, a value \\='(title) for this list makes the document's title 3607 appear in the buffer without the initial \"#+TITLE:\" part." 3608 :group 'org-appearance 3609 :package-version '(Org . "9.5") 3610 :type '(set (const :tag "#+AUTHOR" author) 3611 (const :tag "#+DATE" date) 3612 (const :tag "#+EMAIL" email) 3613 (const :tag "#+SUBTITLE" subtitle) 3614 (const :tag "#+TITLE" title))) 3615 3616 (defcustom org-custom-properties nil 3617 "List of properties (as strings) with a special meaning. 3618 The default use of these custom properties is to let the user 3619 hide them with `org-toggle-custom-properties-visibility'." 3620 :group 'org-properties 3621 :group 'org-appearance 3622 :version "24.3" 3623 :type '(repeat (string :tag "Property Name"))) 3624 3625 (defcustom org-fontify-todo-headline nil 3626 "Non-nil means change the face of a headline if it is marked as TODO. 3627 Normally, only the TODO/DONE keyword indicates the state of a headline. 3628 When this is non-nil, the headline after the keyword is set to the 3629 `org-headline-todo' as an additional indication." 3630 :group 'org-appearance 3631 :package-version '(Org . "9.4") 3632 :type 'boolean 3633 :safe t) 3634 3635 (defcustom org-fontify-done-headline t 3636 "Non-nil means change the face of a headline if it is marked DONE. 3637 Normally, only the TODO/DONE keyword indicates the state of a headline. 3638 When this is non-nil, the headline after the keyword is set to the 3639 `org-headline-done' as an additional indication." 3640 :group 'org-appearance 3641 :package-version '(Org . "9.4") 3642 :type 'boolean) 3643 3644 (defcustom org-fontify-emphasized-text t 3645 "Non-nil means fontify *bold*, /italic/ and _underlined_ text. 3646 Changing this variable requires a restart of Emacs to take effect." 3647 :group 'org-appearance 3648 :type 'boolean) 3649 3650 (defcustom org-fontify-whole-heading-line nil 3651 "Non-nil means fontify the whole line for headings. 3652 This is useful when setting a background color for the 3653 org-level-* faces." 3654 :group 'org-appearance 3655 :type 'boolean) 3656 3657 (defcustom org-fontify-whole-block-delimiter-line t 3658 "Non-nil means fontify the whole line for begin/end lines of blocks. 3659 This is useful when setting a background color for the 3660 org-block-begin-line and org-block-end-line faces." 3661 :group 'org-appearance 3662 :type 'boolean) 3663 3664 (defcustom org-highlight-latex-and-related nil 3665 "Non-nil means highlight LaTeX related syntax in the buffer. 3666 When non-nil, the value should be a list containing any of the 3667 following symbols: 3668 `native' Highlight LaTeX snippets and environments natively. 3669 `latex' Highlight LaTeX snippets and environments. 3670 `script' Highlight subscript and superscript. 3671 `entities' Highlight entities." 3672 :group 'org-appearance 3673 :version "24.4" 3674 :package-version '(Org . "8.0") 3675 :type '(choice 3676 (const :tag "No highlighting" nil) 3677 (set :greedy t :tag "Highlight" 3678 (const :tag "LaTeX snippets and environments (native)" native) 3679 (const :tag "LaTeX snippets and environments" latex) 3680 (const :tag "Subscript and superscript" script) 3681 (const :tag "Entities" entities)))) 3682 3683 (defcustom org-hide-emphasis-markers nil 3684 "Non-nil mean font-lock should hide the emphasis marker characters." 3685 :group 'org-appearance 3686 :type 'boolean 3687 :safe #'booleanp) 3688 3689 (defcustom org-hide-macro-markers nil 3690 "Non-nil mean font-lock should hide the brackets marking macro calls." 3691 :group 'org-appearance 3692 :type 'boolean) 3693 3694 (defcustom org-pretty-entities nil 3695 "Non-nil means show entities as UTF8 characters. 3696 When nil, the \\name form remains in the buffer." 3697 :group 'org-appearance 3698 :version "24.1" 3699 :type 'boolean) 3700 3701 (defcustom org-pretty-entities-include-sub-superscripts t 3702 "Non-nil means, pretty entity display includes formatting sub/superscripts." 3703 :group 'org-appearance 3704 :version "24.1" 3705 :type 'boolean) 3706 3707 (defvar org-emph-re nil 3708 "Regular expression for matching emphasis. 3709 After a match, the match groups contain these elements: 3710 0 The match of the full regular expression, including the characters 3711 before and after the proper match 3712 1 The character before the proper match, or empty at beginning of line 3713 2 The proper match, including the leading and trailing markers 3714 3 The leading marker like * or /, indicating the type of highlighting 3715 4 The text between the emphasis markers, not including the markers 3716 5 The character after the match, empty at the end of a line") 3717 3718 (defvar org-verbatim-re nil 3719 "Regular expression for matching verbatim text.") 3720 3721 (defvar org-emphasis-regexp-components) ; defined just below 3722 (defvar org-emphasis-alist) ; defined just below 3723 (defun org-set-emph-re (var val) 3724 "Set variable and compute the emphasis regular expression." 3725 (set var val) 3726 (when (and (boundp 'org-emphasis-alist) 3727 (boundp 'org-emphasis-regexp-components) 3728 org-emphasis-alist org-emphasis-regexp-components) 3729 (pcase-let* 3730 ((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components) 3731 (body (if (<= nl 0) body 3732 (format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl))) 3733 (template 3734 (format (concat "\\([%s]\\|^\\)" ;before markers 3735 "\\(\\([%%s]\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)" 3736 "\\([%s]\\|$\\)") ;after markers 3737 pre border border body border post))) 3738 (setq org-emph-re (format template "*/_+")) 3739 (setq org-verbatim-re (format template "=~"))))) 3740 3741 ;; This used to be a defcustom (Org <8.0) but allowing the users to 3742 ;; set this option proved cumbersome. See this message/thread: 3743 ;; https://orgmode.org/list/B72CDC2B-72F6-43A8-AC70-E6E6295766EC@gmail.com 3744 (defvar org-emphasis-regexp-components 3745 '("-[:space:]('\"{" "-[:space:].,:!?;'\")}\\[" "[:space:]" "." 1) 3746 "Components used to build the regular expression for emphasis. 3747 This is a list with five entries. Terminology: In an emphasis string 3748 like \" *strong word* \", we call the initial space PREMATCH, the final 3749 space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters 3750 and \"trong wor\" is the body. The different components in this variable 3751 specify what is allowed/forbidden in each part: 3752 3753 pre Chars allowed as prematch. Beginning of line will be allowed too. 3754 post Chars allowed as postmatch. End of line will be allowed too. 3755 border The chars *forbidden* as border characters. 3756 body-regexp A regexp like \".\" to match a body character. Don't use 3757 non-shy groups here, and don't allow newline here. 3758 newline The maximum number of newlines allowed in an emphasis exp. 3759 3760 You need to reload Org or to restart Emacs after setting this.") 3761 3762 (defcustom org-emphasis-alist 3763 '(("*" bold) 3764 ("/" italic) 3765 ("_" underline) 3766 ("=" org-verbatim verbatim) 3767 ("~" org-code verbatim) 3768 ("+" (:strike-through t))) 3769 "Alist of characters and faces to emphasize text. 3770 Text starting and ending with a special character will be emphasized, 3771 for example *bold*, _underlined_ and /italic/. This variable sets the 3772 marker characters and the face to be used by font-lock for highlighting 3773 in Org buffers. 3774 3775 You need to reload Org or to restart Emacs after customizing this." 3776 :group 'org-appearance 3777 :set 'org-set-emph-re 3778 :version "24.4" 3779 :package-version '(Org . "8.0") 3780 :type '(repeat 3781 (list 3782 (string :tag "Marker character") 3783 (choice 3784 (face :tag "Font-lock-face") 3785 (plist :tag "Face property list")) 3786 (option (const verbatim))))) 3787 3788 (defvar org-protecting-blocks '("src" "example" "export") 3789 "Blocks that contain text that is quoted, i.e. not processed as Org syntax. 3790 This is needed for font-lock setup.") 3791 3792 ;;; Functions and variables from their packages 3793 ;; Declared here to avoid compiler warnings 3794 (defvar mark-active) 3795 3796 ;; Various packages 3797 (declare-function calc-eval "calc" (str &optional separator &rest args)) 3798 (declare-function calendar-forward-day "cal-move" (arg)) 3799 (declare-function calendar-goto-date "cal-move" (date)) 3800 (declare-function calendar-goto-today "cal-move" ()) 3801 (declare-function calendar-iso-from-absolute "cal-iso" (date)) 3802 (declare-function calendar-iso-to-absolute "cal-iso" (date)) 3803 (declare-function cdlatex-compute-tables "ext:cdlatex" ()) 3804 (declare-function cdlatex-tab "ext:cdlatex" ()) 3805 (declare-function dired-get-filename 3806 "dired" 3807 (&optional localp no-error-if-not-filep)) 3808 (declare-function iswitchb-read-buffer 3809 "iswitchb" 3810 (prompt &optional 3811 default require-match _predicate start matches-set)) 3812 (declare-function org-agenda-change-all-lines 3813 "org-agenda" 3814 (newhead hdmarker &optional fixface just-this)) 3815 (declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item 3816 "org-agenda" 3817 (&optional end)) 3818 (declare-function org-agenda-copy-local-variable "org-agenda" (var)) 3819 (declare-function org-agenda-format-item 3820 "org-agenda" 3821 (extra txt &optional level category tags dotime 3822 remove-re habitp)) 3823 (declare-function org-agenda-new-marker "org-agenda" (&optional pos)) 3824 (declare-function org-agenda-save-markers-for-cut-and-paste 3825 "org-agenda" 3826 (beg end)) 3827 (declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) 3828 (declare-function org-agenda-skip "org-agenda" ()) 3829 (declare-function org-attach-expand "org-attach" (file)) 3830 (declare-function org-attach-reveal "org-attach" ()) 3831 (declare-function org-attach-reveal-in-emacs "org-attach" ()) 3832 (declare-function org-gnus-follow-link "org-gnus" (&optional group article)) 3833 (declare-function org-indent-mode "org-indent" (&optional arg)) 3834 (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) 3835 (declare-function org-inlinetask-goto-end "org-inlinetask" ()) 3836 (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) 3837 (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) 3838 (declare-function parse-time-string "parse-time" (string)) 3839 3840 (defvar align-mode-rules-list) 3841 (defvar calc-embedded-close-formula) 3842 (defvar calc-embedded-open-formula) 3843 (defvar calc-embedded-open-mode) 3844 (defvar font-lock-unfontify-region-function) 3845 (defvar iswitchb-temp-buflist) 3846 (defvar org-agenda-tags-todo-honor-ignore-options) 3847 (defvar remember-data-file) 3848 (defvar texmathp-why) 3849 3850 (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) 3851 (declare-function org-clock-update-mode-line "org-clock" (&optional refresh)) 3852 (declare-function org-resolve-clocks "org-clock" 3853 (&optional also-non-dangling-p prompt last-valid)) 3854 3855 (defvar org-clock-start-time) 3856 (defvar org-clock-marker (make-marker) 3857 "Marker recording the last clock-in.") 3858 (defvar org-clock-hd-marker (make-marker) 3859 "Marker recording the last clock-in, but the headline position.") 3860 (defvar org-clock-heading "" 3861 "The heading of the current clock entry.") 3862 (defun org-clocking-buffer () 3863 "Return the buffer where the clock is currently running. 3864 Return nil if no clock is running." 3865 (marker-buffer org-clock-marker)) 3866 (defalias 'org-clock-is-active #'org-clocking-buffer) 3867 3868 (defun org-check-running-clock () 3869 "Check if the current buffer contains the running clock. 3870 If yes, offer to stop it and to save the buffer with the changes." 3871 (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) 3872 (y-or-n-p (format "Clock-out in buffer %s before killing it? " 3873 (buffer-name)))) 3874 (org-clock-out) 3875 (when (y-or-n-p "Save changed buffer?") 3876 (save-buffer)))) 3877 3878 (defun org-clocktable-try-shift (dir n) 3879 "Check if this line starts a clock table, if yes, shift the time block." 3880 (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>") 3881 (org-clocktable-shift dir n))) 3882 3883 ;;;###autoload 3884 (defun org-clock-persistence-insinuate () 3885 "Set up hooks for clock persistence." 3886 (require 'org-clock) 3887 (add-hook 'org-mode-hook 'org-clock-load) 3888 (add-hook 'kill-emacs-hook 'org-clock-save)) 3889 3890 (defun org-clock-auto-clockout-insinuate () 3891 "Set up hook for auto clocking out when Emacs is idle. 3892 See `org-clock-auto-clockout-timer'. 3893 3894 This function is meant to be added to the user configuration." 3895 (require 'org-clock) 3896 (add-hook 'org-clock-in-hook #'org-clock-auto-clockout t)) 3897 3898 (defgroup org-archive nil 3899 "Options concerning archiving in Org mode." 3900 :tag "Org Archive" 3901 :group 'org-structure) 3902 3903 (defcustom org-archive-location "%s_archive::" 3904 "The location where subtrees should be archived. 3905 3906 The value of this variable is a string, consisting of two parts, 3907 separated by a double-colon. The first part is a filename and 3908 the second part is a headline. 3909 3910 When the filename is omitted, archiving happens in the same file. 3911 %s in the filename will be replaced by the current file 3912 name (without the directory part). Archiving to a different file 3913 is useful to keep archived entries from contributing to the 3914 Org Agenda. 3915 3916 The archived entries will be filed as subtrees of the specified 3917 headline. When the headline is omitted, the subtrees are simply 3918 filed away at the end of the file, as top-level entries. Also in 3919 the heading you can use %s to represent the file name, this can be 3920 useful when using the same archive for a number of different files. 3921 3922 Here are a few examples: 3923 \"%s_archive::\" 3924 If the current file is Projects.org, archive in file 3925 Projects.org_archive, as top-level trees. This is the default. 3926 3927 \"::* Archived Tasks\" 3928 Archive in the current file, under the top-level headline 3929 \"* Archived Tasks\". 3930 3931 \"~/org/archive.org::\" 3932 Archive in file ~/org/archive.org (absolute path), as top-level trees. 3933 3934 \"~/org/archive.org::* From %s\" 3935 Archive in file ~/org/archive.org (absolute path), under headlines 3936 \"From FILENAME\" where file name is the current file name. 3937 3938 \"~/org/datetree.org::datetree/* Finished Tasks\" 3939 The \"datetree/\" string is special, signifying to archive 3940 items to the datetree. Items are placed in either the CLOSED 3941 date of the item, or the current date if there is no CLOSED date. 3942 The heading will be a subentry to the current date. There doesn't 3943 need to be a heading, but there always needs to be a slash after 3944 datetree. For example, to store archived items directly in the 3945 datetree, use \"~/org/datetree.org::datetree/\". 3946 3947 \"basement::** Finished Tasks\" 3948 Archive in file ./basement (relative path), as level 3 trees 3949 below the level 2 heading \"** Finished Tasks\". 3950 3951 You may define it locally by setting an ARCHIVE property. If 3952 such a property is found in the file or in an entry, and anywhere 3953 up the hierarchy, it will be used. 3954 3955 You can also set it for the whole file using the keyword-syntax: 3956 3957 #+ARCHIVE: basement::** Finished Tasks" 3958 :group 'org-archive 3959 :type 'string) 3960 3961 (defcustom org-agenda-skip-archived-trees t 3962 "Non-nil means the agenda will skip any items located in archived trees. 3963 An archived tree is a tree marked with the tag ARCHIVE. The use of this 3964 variable is no longer recommended, you should leave it at the value t. 3965 Instead, use the key `v' to cycle the archives-mode in the agenda." 3966 :group 'org-archive 3967 :group 'org-agenda-skip 3968 :type 'boolean) 3969 3970 (defcustom org-columns-skip-archived-trees t 3971 "Non-nil means ignore archived trees when creating column view." 3972 :group 'org-archive 3973 :group 'org-properties 3974 :type 'boolean) 3975 3976 (defcustom org-cycle-open-archived-trees nil 3977 "Non-nil means `org-cycle' will open archived trees. 3978 An archived tree is a tree marked with the tag ARCHIVE. 3979 When nil, archived trees will stay folded. You can still open them with 3980 normal outline commands like `show-all', but not with the cycling commands." 3981 :group 'org-archive 3982 :group 'org-cycle 3983 :type 'boolean) 3984 3985 (defcustom org-sparse-tree-open-archived-trees nil 3986 "Non-nil means sparse tree construction shows matches in archived trees. 3987 When nil, matches in these trees are highlighted, but the trees are kept in 3988 collapsed state." 3989 :group 'org-archive 3990 :group 'org-sparse-trees 3991 :type 'boolean) 3992 3993 (defcustom org-sparse-tree-default-date-type nil 3994 "The default date type when building a sparse tree. 3995 When this is nil, a date is a scheduled or a deadline timestamp. 3996 Otherwise, these types are allowed: 3997 3998 all: all timestamps 3999 active: only active timestamps (<...>) 4000 inactive: only inactive timestamps ([...]) 4001 scheduled: only scheduled timestamps 4002 deadline: only deadline timestamps" 4003 :type '(choice (const :tag "Scheduled or deadline" nil) 4004 (const :tag "All timestamps" all) 4005 (const :tag "Only active timestamps" active) 4006 (const :tag "Only inactive timestamps" inactive) 4007 (const :tag "Only scheduled timestamps" scheduled) 4008 (const :tag "Only deadline timestamps" deadline) 4009 (const :tag "Only closed timestamps" closed)) 4010 :version "26.1" 4011 :package-version '(Org . "8.3") 4012 :group 'org-sparse-trees) 4013 4014 (defun org-cycle-hide-archived-subtrees (state) 4015 "Re-hide all archived subtrees after a visibility state change. 4016 STATE should be one of the symbols listed in the docstring of 4017 `org-cycle-hook'." 4018 (when (and (not org-cycle-open-archived-trees) 4019 (not (memq state '(overview folded)))) 4020 (save-excursion 4021 (let* ((globalp (memq state '(contents all))) 4022 (beg (if globalp (point-min) (point))) 4023 (end (if globalp (point-max) (org-end-of-subtree t)))) 4024 (org-hide-archived-subtrees beg end) 4025 (goto-char beg) 4026 (when (looking-at-p (concat ".*:" org-archive-tag ":")) 4027 (message "%s" (substitute-command-keys 4028 "Subtree is archived and stays closed. Use \ 4029 `\\[org-force-cycle-archived]' to cycle it anyway."))))))) 4030 4031 (defun org-force-cycle-archived () 4032 "Cycle subtree even if it is archived." 4033 (interactive) 4034 (setq this-command 'org-cycle) 4035 (let ((org-cycle-open-archived-trees t)) 4036 (call-interactively 'org-cycle))) 4037 4038 (defun org-hide-archived-subtrees (beg end) 4039 "Re-hide all archived subtrees after a visibility state change." 4040 (org-with-wide-buffer 4041 (let ((case-fold-search nil) 4042 (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":"))) 4043 (goto-char beg) 4044 ;; Include headline point is currently on. 4045 (beginning-of-line) 4046 (while (and (< (point) end) (re-search-forward re end t)) 4047 (when (member org-archive-tag (org-get-tags nil t)) 4048 (org-flag-subtree t) 4049 (org-end-of-subtree t)))))) 4050 4051 (defun org-flag-subtree (flag) 4052 (save-excursion 4053 (org-back-to-heading t) 4054 (org-flag-region (line-end-position) 4055 (progn (org-end-of-subtree t) (point)) 4056 flag 4057 'outline))) 4058 4059 (defalias 'org-advertized-archive-subtree 'org-archive-subtree) 4060 4061 ;; Declare Column View Code 4062 4063 (declare-function org-columns-get-format-and-top-level "org-colview" ()) 4064 (declare-function org-columns-compute "org-colview" (property)) 4065 4066 ;; Declare ID code 4067 4068 (declare-function org-id-store-link "org-id") 4069 (declare-function org-id-locations-load "org-id") 4070 (declare-function org-id-locations-save "org-id") 4071 (defvar org-id-track-globally) 4072 4073 ;;; Variables for pre-computed regular expressions, all buffer local 4074 4075 (defvar-local org-todo-regexp nil 4076 "Matches any of the TODO state keywords. 4077 Since TODO keywords are case-sensitive, `case-fold-search' is 4078 expected to be bound to nil when matching against this regexp.") 4079 4080 (defvar-local org-not-done-regexp nil 4081 "Matches any of the TODO state keywords except the last one. 4082 Since TODO keywords are case-sensitive, `case-fold-search' is 4083 expected to be bound to nil when matching against this regexp.") 4084 4085 (defvar-local org-not-done-heading-regexp nil 4086 "Matches a TODO headline that is not done. 4087 Since TODO keywords are case-sensitive, `case-fold-search' is 4088 expected to be bound to nil when matching against this regexp.") 4089 4090 (defvar-local org-todo-line-regexp nil 4091 "Matches a headline and puts TODO state into group 2 if present. 4092 Since TODO keywords are case-sensitive, `case-fold-search' is 4093 expected to be bound to nil when matching against this regexp.") 4094 4095 (defvar-local org-complex-heading-regexp nil 4096 "Matches a headline and puts everything into groups: 4097 4098 group 1: Stars 4099 group 2: The TODO keyword, maybe 4100 group 3: Priority cookie 4101 group 4: True headline 4102 group 5: Tags 4103 4104 Since TODO keywords are case-sensitive, `case-fold-search' is 4105 expected to be bound to nil when matching against this regexp.") 4106 4107 (defvar-local org-complex-heading-regexp-format nil 4108 "Printf format to make regexp to match an exact headline. 4109 This regexp will match the headline of any node which has the 4110 exact headline text that is put into the format, but may have any 4111 TODO state, priority and tags.") 4112 4113 (defvar-local org-todo-line-tags-regexp nil 4114 "Matches a headline and puts TODO state into group 2 if present. 4115 Also put tags into group 4 if tags are present.") 4116 4117 (defconst org-plain-time-of-day-regexp 4118 (concat 4119 "\\(\\<[012]?[0-9]" 4120 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" 4121 "\\(--?" 4122 "\\(\\<[012]?[0-9]" 4123 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" 4124 "\\)?") 4125 "Regular expression to match a plain time or time range. 4126 Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following 4127 groups carry important information: 4128 0 the full match 4129 1 the first time, range or not 4130 8 the second time, if it is a range.") 4131 4132 (defconst org-plain-time-extension-regexp 4133 (concat 4134 "\\(\\<[012]?[0-9]" 4135 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" 4136 "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?") 4137 "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40. 4138 Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following 4139 groups carry important information: 4140 0 the full match 4141 7 hours of duration 4142 9 minutes of duration") 4143 4144 (defconst org-stamp-time-of-day-regexp 4145 (concat 4146 "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)" 4147 "\\([012][0-9]:[0-5][0-9]\\)\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?>" 4148 "\\(--?" 4149 "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") 4150 "Regular expression to match a timestamp time or time range. 4151 After a match, the following groups carry important information: 4152 0 the full match 4153 1 date plus weekday, for back referencing to make sure 4154 both times are on the same day 4155 2 the first time, range or not 4156 4 the second time, if it is a range.") 4157 4158 (defconst org-startup-options 4159 '(("fold" org-startup-folded t) 4160 ("overview" org-startup-folded t) 4161 ("nofold" org-startup-folded nil) 4162 ("showall" org-startup-folded nil) 4163 ("show2levels" org-startup-folded show2levels) 4164 ("show3levels" org-startup-folded show3levels) 4165 ("show4levels" org-startup-folded show4levels) 4166 ("show5levels" org-startup-folded show5levels) 4167 ("showeverything" org-startup-folded showeverything) 4168 ("content" org-startup-folded content) 4169 ("indent" org-startup-indented t) 4170 ("noindent" org-startup-indented nil) 4171 ("num" org-startup-numerated t) 4172 ("nonum" org-startup-numerated nil) 4173 ("hidestars" org-hide-leading-stars t) 4174 ("showstars" org-hide-leading-stars nil) 4175 ("odd" org-odd-levels-only t) 4176 ("oddeven" org-odd-levels-only nil) 4177 ("align" org-startup-align-all-tables t) 4178 ("noalign" org-startup-align-all-tables nil) 4179 ("shrink" org-startup-shrink-all-tables t) 4180 ("inlineimages" org-startup-with-inline-images t) 4181 ("noinlineimages" org-startup-with-inline-images nil) 4182 ("latexpreview" org-startup-with-latex-preview t) 4183 ("nolatexpreview" org-startup-with-latex-preview nil) 4184 ("customtime" org-display-custom-times t) 4185 ("logdone" org-log-done time) 4186 ("lognotedone" org-log-done note) 4187 ("nologdone" org-log-done nil) 4188 ("lognoteclock-out" org-log-note-clock-out t) 4189 ("nolognoteclock-out" org-log-note-clock-out nil) 4190 ("logrepeat" org-log-repeat state) 4191 ("lognoterepeat" org-log-repeat note) 4192 ("logdrawer" org-log-into-drawer t) 4193 ("nologdrawer" org-log-into-drawer nil) 4194 ("logstatesreversed" org-log-states-order-reversed t) 4195 ("nologstatesreversed" org-log-states-order-reversed nil) 4196 ("nologrepeat" org-log-repeat nil) 4197 ("logreschedule" org-log-reschedule time) 4198 ("lognotereschedule" org-log-reschedule note) 4199 ("nologreschedule" org-log-reschedule nil) 4200 ("logredeadline" org-log-redeadline time) 4201 ("lognoteredeadline" org-log-redeadline note) 4202 ("nologredeadline" org-log-redeadline nil) 4203 ("logrefile" org-log-refile time) 4204 ("lognoterefile" org-log-refile note) 4205 ("nologrefile" org-log-refile nil) 4206 ("fninline" org-footnote-define-inline t) 4207 ("nofninline" org-footnote-define-inline nil) 4208 ("fnlocal" org-footnote-section nil) 4209 ("fnauto" org-footnote-auto-label t) 4210 ("fnprompt" org-footnote-auto-label nil) 4211 ("fnconfirm" org-footnote-auto-label confirm) 4212 ("fnplain" org-footnote-auto-label plain) 4213 ("fnadjust" org-footnote-auto-adjust t) 4214 ("nofnadjust" org-footnote-auto-adjust nil) 4215 ("constcgs" constants-unit-system cgs) 4216 ("constSI" constants-unit-system SI) 4217 ("noptag" org-tag-persistent-alist nil) 4218 ("hideblocks" org-hide-block-startup t) 4219 ("nohideblocks" org-hide-block-startup nil) 4220 ("beamer" org-startup-with-beamer-mode t) 4221 ("entitiespretty" org-pretty-entities t) 4222 ("entitiesplain" org-pretty-entities nil)) 4223 "Variable associated with STARTUP options for Org. 4224 Each element is a list of three items: the startup options (as written 4225 in the #+STARTUP line), the corresponding variable, and the value to set 4226 this variable to if the option is found. An optional fourth element PUSH 4227 means to push this value onto the list in the variable.") 4228 4229 (defcustom org-group-tags t 4230 "When non-nil (the default), use group tags. 4231 This can be turned on/off through `org-toggle-tags-groups'." 4232 :group 'org-tags 4233 :group 'org-startup 4234 :type 'boolean) 4235 4236 (defvar org-inhibit-startup nil) ; Dynamically-scoped param. 4237 4238 (defun org-toggle-tags-groups () 4239 "Toggle support for group tags. 4240 Support for group tags is controlled by the option 4241 `org-group-tags', which is non-nil by default." 4242 (interactive) 4243 (setq org-group-tags (not org-group-tags)) 4244 (cond ((and (derived-mode-p 'org-agenda-mode) 4245 org-group-tags) 4246 (org-agenda-redo)) 4247 ((derived-mode-p 'org-mode) 4248 (let ((org-inhibit-startup t)) (org-mode)))) 4249 (message "Groups tags support has been turned %s" 4250 (if org-group-tags "on" "off"))) 4251 4252 (defun org--tag-add-to-alist (alist1 alist2) 4253 "Merge tags from ALIST1 into ALIST2. 4254 4255 Duplicates tags outside a group are removed. Keywords and order 4256 are preserved. 4257 4258 The function assumes ALIST1 and ALIST2 are proper tag alists. 4259 See `org-tag-alist' for their structure." 4260 (cond 4261 ((null alist2) alist1) 4262 ((null alist1) alist2) 4263 (t 4264 (let ((to-add nil) 4265 (group-flag nil)) 4266 (dolist (tag-pair alist1) 4267 (pcase tag-pair 4268 (`(,(or :startgrouptag :startgroup)) 4269 (setq group-flag t) 4270 (push tag-pair to-add)) 4271 (`(,(or :endgrouptag :endgroup)) 4272 (setq group-flag nil) 4273 (push tag-pair to-add)) 4274 (`(,(or :grouptags :newline)) 4275 (push tag-pair to-add)) 4276 (`(,tag . ,_) 4277 ;; Remove duplicates from ALIST1, unless they are in 4278 ;; a group. Indeed, it makes sense to have a tag appear in 4279 ;; multiple groups. 4280 (when (or group-flag (not (assoc tag alist2))) 4281 (push tag-pair to-add))) 4282 (_ (error "Invalid association in tag alist: %S" tag-pair)))) 4283 ;; Preserve order of ALIST1. 4284 (append (nreverse to-add) alist2))))) 4285 4286 (defun org-priority-to-value (s) 4287 "Convert priority string S to its numeric value." 4288 (or (save-match-data 4289 (and (string-match "\\([0-9]+\\)" s) 4290 (string-to-number (match-string 1 s)))) 4291 (string-to-char s))) 4292 4293 (defun org-set-regexps-and-options (&optional tags-only) 4294 "Precompute regular expressions used in the current buffer. 4295 When optional argument TAGS-ONLY is non-nil, only compute tags 4296 related expressions." 4297 (when (derived-mode-p 'org-mode) 4298 (let ((alist (org-collect-keywords 4299 (append '("FILETAGS" "TAGS") 4300 (and (not tags-only) 4301 '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS" 4302 "LINK" "OPTIONS" "PRIORITIES" "PROPERTY" 4303 "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO"))) 4304 '("ARCHIVE" "CATEGORY" "COLUMNS" "PRIORITIES")))) 4305 ;; Startup options. Get this early since it does change 4306 ;; behavior for other options (e.g., tags). 4307 (let ((startup (cl-mapcan (lambda (value) (split-string value)) 4308 (cdr (assoc "STARTUP" alist))))) 4309 (dolist (option startup) 4310 (pcase (assoc-string option org-startup-options t) 4311 (`(,_ ,variable ,value t) 4312 (unless (listp (symbol-value variable)) 4313 (set (make-local-variable variable) nil)) 4314 (add-to-list variable value)) 4315 (`(,_ ,variable ,value . ,_) 4316 (set (make-local-variable variable) value)) 4317 (_ nil)))) 4318 (setq-local org-file-tags 4319 (mapcar #'org-add-prop-inherited 4320 (cl-mapcan (lambda (value) 4321 (cl-mapcan 4322 (lambda (k) (org-split-string k ":")) 4323 (split-string value))) 4324 (cdr (assoc "FILETAGS" alist))))) 4325 (setq org-current-tag-alist 4326 (org--tag-add-to-alist 4327 org-tag-persistent-alist 4328 (let ((tags (cdr (assoc "TAGS" alist)))) 4329 (if tags 4330 (org-tag-string-to-alist 4331 (mapconcat #'identity tags "\n")) 4332 org-tag-alist)))) 4333 (setq org-tag-groups-alist 4334 (org-tag-alist-to-groups org-current-tag-alist)) 4335 (unless tags-only 4336 ;; Properties. 4337 (let ((properties nil)) 4338 (dolist (value (cdr (assoc "PROPERTY" alist))) 4339 (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value) 4340 (setq properties (org--update-property-plist 4341 (match-string-no-properties 1 value) 4342 (match-string-no-properties 2 value) 4343 properties)))) 4344 (setq-local org-keyword-properties properties)) 4345 ;; Archive location. 4346 (let ((archive (cdr (assoc "ARCHIVE" alist)))) 4347 (when archive (setq-local org-archive-location archive))) 4348 ;; Category. 4349 (let ((category (cdr (assoc "CATEGORY" alist)))) 4350 (when category 4351 (setq-local org-category (intern category)) 4352 (setq-local org-keyword-properties 4353 (org--update-property-plist 4354 "CATEGORY" category org-keyword-properties)))) 4355 ;; Columns. 4356 (let ((column (cdr (assoc "COLUMNS" alist)))) 4357 (when column (setq-local org-columns-default-format column))) 4358 ;; Constants. 4359 (let ((store nil)) 4360 (dolist (pair (cl-mapcan #'split-string 4361 (cdr (assoc "CONSTANTS" alist)))) 4362 (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" pair) 4363 (let* ((name (match-string 1 pair)) 4364 (value (match-string 2 pair)) 4365 (old (assoc name store))) 4366 (if old (setcdr old value) 4367 (push (cons name value) store))))) 4368 (setq org-table-formula-constants-local store)) 4369 ;; Link abbreviations. 4370 (let ((links 4371 (delq nil 4372 (mapcar 4373 (lambda (value) 4374 (and (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value) 4375 (cons (match-string-no-properties 1 value) 4376 (match-string-no-properties 2 value)))) 4377 (cdr (assoc "LINK" alist)))))) 4378 (when links (setq org-link-abbrev-alist-local (nreverse links)))) 4379 ;; Priorities. 4380 (let ((value (cdr (assoc "PRIORITIES" alist)))) 4381 (pcase (and value (split-string value)) 4382 (`(,high ,low ,default . ,_) 4383 (setq-local org-priority-highest (org-priority-to-value high)) 4384 (setq-local org-priority-lowest (org-priority-to-value low)) 4385 (setq-local org-priority-default (org-priority-to-value default))))) 4386 ;; Scripts. 4387 (let ((value (cdr (assoc "OPTIONS" alist)))) 4388 (dolist (option value) 4389 (when (string-match "\\^:\\(t\\|nil\\|{}\\)" option) 4390 (setq-local org-use-sub-superscripts 4391 (read (match-string 1 option)))))) 4392 ;; TODO keywords. 4393 (setq-local org-todo-kwd-alist nil) 4394 (setq-local org-todo-key-alist nil) 4395 (setq-local org-todo-key-trigger nil) 4396 (setq-local org-todo-keywords-1 nil) 4397 (setq-local org-done-keywords nil) 4398 (setq-local org-todo-heads nil) 4399 (setq-local org-todo-sets nil) 4400 (setq-local org-todo-log-states nil) 4401 (let ((todo-sequences 4402 (or (append (mapcar (lambda (value) 4403 (cons 'type (split-string value))) 4404 (cdr (assoc "TYP_TODO" alist))) 4405 (mapcar (lambda (value) 4406 (cons 'sequence (split-string value))) 4407 (append (cdr (assoc "TODO" alist)) 4408 (cdr (assoc "SEQ_TODO" alist))))) 4409 (let ((d (default-value 'org-todo-keywords))) 4410 (if (not (stringp (car d))) d 4411 ;; XXX: Backward compatibility code. 4412 (list (cons org-todo-interpretation d))))))) 4413 (dolist (sequence todo-sequences) 4414 (let* ((sequence (or (run-hook-with-args-until-success 4415 'org-todo-setup-filter-hook sequence) 4416 sequence)) 4417 (sequence-type (car sequence)) 4418 (keywords (cdr sequence)) 4419 (sep (member "|" keywords)) 4420 names alist) 4421 (dolist (k (remove "|" keywords)) 4422 (unless (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" 4423 k) 4424 (error "Invalid TODO keyword %s" k)) 4425 (let ((name (match-string 1 k)) 4426 (key (match-string 2 k)) 4427 (log (org-extract-log-state-settings k))) 4428 (push name names) 4429 (push (cons name (and key (string-to-char key))) alist) 4430 (when log (push log org-todo-log-states)))) 4431 (let* ((names (nreverse names)) 4432 (done (if sep (org-remove-keyword-keys (cdr sep)) 4433 (last names))) 4434 (head (car names)) 4435 (tail (list sequence-type head (car done) (org-last done)))) 4436 (add-to-list 'org-todo-heads head 'append) 4437 (push names org-todo-sets) 4438 (setq org-done-keywords (append org-done-keywords done nil)) 4439 (setq org-todo-keywords-1 (append org-todo-keywords-1 names nil)) 4440 (setq org-todo-key-alist 4441 (append org-todo-key-alist 4442 (and alist 4443 (append '((:startgroup)) 4444 (nreverse alist) 4445 '((:endgroup)))))) 4446 (dolist (k names) (push (cons k tail) org-todo-kwd-alist)))))) 4447 (setq org-todo-sets (nreverse org-todo-sets) 4448 org-todo-kwd-alist (nreverse org-todo-kwd-alist) 4449 org-todo-key-trigger (delq nil (mapcar #'cdr org-todo-key-alist)) 4450 org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)) 4451 ;; Compute the regular expressions and other local variables. 4452 ;; Using `org-outline-regexp-bol' would complicate them much, 4453 ;; because of the fixed white space at the end of that string. 4454 (unless org-done-keywords 4455 (setq org-done-keywords 4456 (and org-todo-keywords-1 (last org-todo-keywords-1)))) 4457 (setq org-not-done-keywords 4458 (org-delete-all org-done-keywords 4459 (copy-sequence org-todo-keywords-1)) 4460 org-todo-regexp (regexp-opt org-todo-keywords-1 t) 4461 org-not-done-regexp (regexp-opt org-not-done-keywords t) 4462 org-not-done-heading-regexp 4463 (format org-heading-keyword-regexp-format org-not-done-regexp) 4464 org-todo-line-regexp 4465 (format org-heading-keyword-maybe-regexp-format org-todo-regexp) 4466 org-complex-heading-regexp 4467 (concat "^\\(\\*+\\)" 4468 "\\(?: +" org-todo-regexp "\\)?" 4469 "\\(?: +\\(\\[#.\\]\\)\\)?" 4470 "\\(?: +\\(.*?\\)\\)??" 4471 "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?" 4472 "[ \t]*$") 4473 org-complex-heading-regexp-format 4474 (concat "^\\(\\*+\\)" 4475 "\\(?: +" org-todo-regexp "\\)?" 4476 "\\(?: +\\(\\[#.\\]\\)\\)?" 4477 "\\(?: +" 4478 ;; Stats cookies can be stuck to body. 4479 "\\(?:\\[[0-9%%/]+\\] *\\)*" 4480 "\\(%s\\)" 4481 "\\(?: *\\[[0-9%%/]+\\]\\)*" 4482 "\\)" 4483 "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?" 4484 "[ \t]*$") 4485 org-todo-line-tags-regexp 4486 (concat "^\\(\\*+\\)" 4487 "\\(?: +" org-todo-regexp "\\)?" 4488 "\\(?: +\\(.*?\\)\\)??" 4489 "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?" 4490 "[ \t]*$")) 4491 (org-compute-latex-and-related-regexp))))) 4492 4493 (defun org-collect-keywords (keywords &optional unique directory) 4494 "Return values for KEYWORDS in current buffer, as an alist. 4495 4496 KEYWORDS is a list of strings. Return value is a list of 4497 elements with the pattern: 4498 4499 (NAME . LIST-OF-VALUES) 4500 4501 where NAME is the upcase name of the keyword, and LIST-OF-VALUES 4502 is a list of non-empty values, as strings, in order of appearance 4503 in the buffer. 4504 4505 When KEYWORD appears in UNIQUE list, LIST-OF-VALUE is its first 4506 value, empty or not, appearing in the buffer, as a string. 4507 4508 When KEYWORD appears in DIRECTORIES, each value is a cons cell: 4509 4510 (VALUE . DIRECTORY) 4511 4512 where VALUE is the regular value, and DIRECTORY is the variable 4513 `default-directory' for the buffer containing the keyword. This 4514 is important for values containing relative file names, since the 4515 function follows SETUPFILE keywords, and may change its working 4516 directory." 4517 (let* ((keywords (cons "SETUPFILE" (mapcar #'upcase keywords))) 4518 (unique (mapcar #'upcase unique)) 4519 (alist (org--collect-keywords-1 4520 keywords unique directory 4521 (and buffer-file-name (list buffer-file-name)) 4522 nil))) 4523 ;; Re-order results. 4524 (dolist (entry alist) 4525 (pcase entry 4526 (`(,_ . ,(and value (pred consp))) 4527 (setcdr entry (nreverse value))))) 4528 (nreverse alist))) 4529 4530 (defun org--collect-keywords-1 (keywords unique directory files alist) 4531 (org-with-point-at 1 4532 (let ((case-fold-search t) 4533 (regexp (org-make-options-regexp keywords))) 4534 (while (and keywords (re-search-forward regexp nil t)) 4535 (let ((element (org-element-at-point))) 4536 (when (eq 'keyword (org-element-type element)) 4537 (let ((value (org-element-property :value element))) 4538 (pcase (org-element-property :key element) 4539 ("SETUPFILE" 4540 (when (and (org-string-nw-p value) 4541 (not buffer-read-only)) ;FIXME: bug in Gnus? 4542 (let* ((uri (org-strip-quotes value)) 4543 (uri-is-url (org-url-p uri)) 4544 (uri (if uri-is-url 4545 uri 4546 (expand-file-name uri)))) 4547 (unless (member uri files) 4548 (with-temp-buffer 4549 (unless uri-is-url 4550 (setq default-directory (file-name-directory uri))) 4551 (let ((contents (org-file-contents uri :noerror))) 4552 (when contents 4553 (insert contents) 4554 ;; Fake Org mode: `org-element-at-point' 4555 ;; doesn't need full set-up. 4556 (let ((major-mode 'org-mode)) 4557 (setq alist 4558 (org--collect-keywords-1 4559 keywords unique directory 4560 (cons uri files) 4561 alist)))))))))) 4562 (keyword 4563 (let ((entry (assoc keyword alist)) 4564 (final 4565 (cond ((not (member keyword directory)) value) 4566 (buffer-file-name 4567 (cons value 4568 (file-name-directory buffer-file-name))) 4569 (t (cons value default-directory))))) 4570 (cond ((member keyword unique) 4571 (push (cons keyword final) alist) 4572 (setq keywords (remove keyword keywords)) 4573 (setq regexp (org-make-options-regexp keywords))) 4574 ((null entry) (push (list keyword final) alist)) 4575 (t (push final (cdr entry))))))))))) 4576 alist))) 4577 4578 (defun org-tag-string-to-alist (s) 4579 "Return tag alist associated to string S. 4580 S is a value for TAGS keyword or produced with 4581 `org-tag-alist-to-string'. Return value is an alist suitable for 4582 `org-tag-alist' or `org-tag-persistent-alist'." 4583 (let ((lines (mapcar #'split-string (split-string s "\n" t))) 4584 (tag-re (concat "\\`\\(" org-tag-re "\\|{.+?}\\)" ; regular expression 4585 "\\(?:(\\(.\\))\\)?\\'")) 4586 alist group-flag) 4587 (dolist (tokens lines (cdr (nreverse alist))) 4588 (push '(:newline) alist) 4589 (while tokens 4590 (let ((token (pop tokens))) 4591 (pcase token 4592 ("{" 4593 (push '(:startgroup) alist) 4594 (when (equal (nth 1 tokens) ":") (setq group-flag t))) 4595 ("}" 4596 (push '(:endgroup) alist) 4597 (setq group-flag nil)) 4598 ("[" 4599 (push '(:startgrouptag) alist) 4600 (when (equal (nth 1 tokens) ":") (setq group-flag t))) 4601 ("]" 4602 (push '(:endgrouptag) alist) 4603 (setq group-flag nil)) 4604 (":" 4605 (push '(:grouptags) alist)) 4606 ((guard (string-match tag-re token)) 4607 (let ((tag (match-string 1 token)) 4608 (key (and (match-beginning 2) 4609 (string-to-char (match-string 2 token))))) 4610 ;; Push all tags in groups, no matter if they already 4611 ;; appear somewhere else in the list. 4612 (when (or group-flag (not (assoc tag alist))) 4613 (push (cons tag key) alist)))))))))) 4614 4615 (defun org-tag-alist-to-string (alist &optional skip-key) 4616 "Return tag string associated to ALIST. 4617 4618 ALIST is an alist, as defined in `org-tag-alist' or 4619 `org-tag-persistent-alist', or produced with 4620 `org-tag-string-to-alist'. 4621 4622 Return value is a string suitable as a value for \"TAGS\" 4623 keyword. 4624 4625 When optional argument SKIP-KEY is non-nil, skip selection keys 4626 next to tags." 4627 (mapconcat (lambda (token) 4628 (pcase token 4629 (`(:startgroup) "{") 4630 (`(:endgroup) "}") 4631 (`(:startgrouptag) "[") 4632 (`(:endgrouptag) "]") 4633 (`(:grouptags) ":") 4634 (`(:newline) "\\n") 4635 ((and 4636 (guard (not skip-key)) 4637 `(,(and tag (pred stringp)) . ,(and key (pred characterp)))) 4638 (format "%s(%c)" tag key)) 4639 (`(,(and tag (pred stringp)) . ,_) tag) 4640 (_ (user-error "Invalid tag token: %S" token)))) 4641 alist 4642 " ")) 4643 4644 (defun org-tag-alist-to-groups (alist) 4645 "Return group alist from tag ALIST. 4646 ALIST is an alist, as defined in `org-tag-alist' or 4647 `org-tag-persistent-alist', or produced with 4648 `org-tag-string-to-alist'. Return value is an alist following 4649 the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as 4650 a string, summarizing TAGS, as a list of strings." 4651 (let (groups group-status current-group) 4652 (dolist (token alist (nreverse groups)) 4653 (pcase token 4654 (`(,(or :startgroup :startgrouptag)) (setq group-status t)) 4655 (`(,(or :endgroup :endgrouptag)) 4656 (when (eq group-status 'append) 4657 (push (nreverse current-group) groups)) 4658 (setq group-status nil current-group nil)) 4659 (`(:grouptags) (setq group-status 'append)) 4660 ((and `(,tag . ,_) (guard group-status)) 4661 (if (eq group-status 'append) (push tag current-group) 4662 (setq current-group (list tag)))) 4663 (_ nil))))) 4664 4665 (defvar org--file-cache (make-hash-table :test #'equal) 4666 "Hash table to store contents of files referenced via a URL. 4667 This is the cache of file URLs read using `org-file-contents'.") 4668 4669 (defun org-reset-file-cache () 4670 "Reset the cache of files downloaded by `org-file-contents'." 4671 (clrhash org--file-cache)) 4672 4673 (defun org-file-contents (file &optional noerror nocache) 4674 "Return the contents of FILE, as a string. 4675 4676 FILE can be a file name or URL. 4677 4678 If FILE is a URL, download the contents. If the URL contents are 4679 already cached in the `org--file-cache' hash table, the download step 4680 is skipped. 4681 4682 If NOERROR is non-nil, ignore the error when unable to read the FILE 4683 from file or URL, and return nil. 4684 4685 If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version 4686 is available. This option applies only if FILE is a URL." 4687 (let* ((is-url (org-url-p file)) 4688 (cache (and is-url 4689 (not nocache) 4690 (gethash file org--file-cache)))) 4691 (cond 4692 (cache) 4693 (is-url 4694 (with-current-buffer (url-retrieve-synchronously file) 4695 (goto-char (point-min)) 4696 ;; Move point to after the url-retrieve header. 4697 (search-forward "\n\n" nil :move) 4698 ;; Search for the success code only in the url-retrieve header. 4699 (if (save-excursion 4700 (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror)) 4701 ;; Update the cache `org--file-cache' and return contents. 4702 (puthash file 4703 (buffer-substring-no-properties (point) (point-max)) 4704 org--file-cache) 4705 (funcall (if noerror #'message #'user-error) 4706 "Unable to fetch file from %S" 4707 file) 4708 nil))) 4709 (t 4710 (with-temp-buffer 4711 (condition-case nil 4712 (progn 4713 (insert-file-contents file) 4714 (buffer-string)) 4715 (file-error 4716 (funcall (if noerror #'message #'user-error) 4717 "Unable to read file %S" 4718 file) 4719 nil))))))) 4720 4721 (defun org-extract-log-state-settings (x) 4722 "Extract the log state setting from a TODO keyword string. 4723 This will extract info from a string like \"WAIT(w@/!)\"." 4724 (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) 4725 (let ((kw (match-string 1 x)) 4726 (log1 (and (match-end 3) (match-string 3 x))) 4727 (log2 (and (match-end 4) (match-string 4 x)))) 4728 (and (or log1 log2) 4729 (list kw 4730 (and log1 (if (equal log1 "!") 'time 'note)) 4731 (and log2 (if (equal log2 "!") 'time 'note))))))) 4732 4733 (defun org-remove-keyword-keys (list) 4734 "Remove a pair of parenthesis at the end of each string in LIST." 4735 (mapcar (lambda (x) 4736 (if (string-match "(.*)$" x) 4737 (substring x 0 (match-beginning 0)) 4738 x)) 4739 list)) 4740 4741 (defun org-assign-fast-keys (alist) 4742 "Assign fast keys to a keyword-key alist. 4743 Respect keys that are already there." 4744 (let (new e (alt ?0)) 4745 (while (setq e (pop alist)) 4746 (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) 4747 (cdr e)) ;; Key already assigned. 4748 (push e new) 4749 (let ((clist (string-to-list (downcase (car e)))) 4750 (used (append new alist))) 4751 (when (= (car clist) ?@) 4752 (pop clist)) 4753 (while (and clist (rassoc (car clist) used)) 4754 (pop clist)) 4755 (unless clist 4756 (while (rassoc alt used) 4757 (cl-incf alt))) 4758 (push (cons (car e) (or (car clist) alt)) new)))) 4759 (nreverse new))) 4760 4761 ;;; Some variables used in various places 4762 4763 (defvar org-window-configuration nil 4764 "Used in various places to store a window configuration.") 4765 (defvar org-selected-window nil 4766 "Used in various places to store a window configuration.") 4767 (defvar org-finish-function nil 4768 "Function to be called when `C-c C-c' is used. 4769 This is for getting out of special buffers like capture.") 4770 (defvar org-last-state) 4771 4772 ;; Defined somewhere in this file, but used before definition. 4773 (defvar org-entities) ;; defined in org-entities.el 4774 (defvar org-struct-menu) 4775 (defvar org-org-menu) 4776 (defvar org-tbl-menu) 4777 4778 ;;;; Define the Org mode 4779 4780 (defun org-before-change-function (_beg _end) 4781 "Every change indicates that a table might need an update." 4782 (setq org-table-may-need-update t)) 4783 (defvar org-mode-map) 4784 (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. 4785 (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. 4786 (defvar org-inhibit-logging nil) ; Dynamically-scoped param. 4787 (defvar org-inhibit-blocking nil) ; Dynamically-scoped param. 4788 4789 (defvar bidi-paragraph-direction) 4790 (defvar buffer-face-mode-face) 4791 4792 (require 'outline) 4793 4794 ;; Other stuff we need. 4795 (require 'time-date) 4796 (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) 4797 (when (< emacs-major-version 28) ; preloaded in Emacs 28 4798 (require 'easymenu)) 4799 4800 (require 'org-entities) 4801 (require 'org-faces) 4802 (require 'org-list) 4803 (require 'org-pcomplete) 4804 (require 'org-src) 4805 (require 'org-footnote) 4806 (require 'org-macro) 4807 4808 ;; babel 4809 (require 'ob) 4810 4811 ;;;###autoload 4812 (define-derived-mode org-mode outline-mode "Org" 4813 "Outline-based notes management and organizer, alias 4814 \"Carsten's outline-mode for keeping track of everything.\" 4815 4816 Org mode develops organizational tasks around a NOTES file which 4817 contains information about projects as plain text. Org mode is 4818 implemented on top of Outline mode, which is ideal to keep the content 4819 of large files well structured. It supports ToDo items, deadlines and 4820 time stamps, which magically appear in the diary listing of the Emacs 4821 calendar. Tables are easily created with a built-in table editor. 4822 Plain text URL-like links connect to websites, emails (VM), Usenet 4823 messages (Gnus), BBDB entries, and any files related to the project. 4824 For printing and sharing of notes, an Org file (or a part of it) 4825 can be exported as a structured ASCII or HTML file. 4826 4827 The following commands are available: 4828 4829 \\{org-mode-map}" 4830 (org-load-modules-maybe) 4831 (org-install-agenda-files-menu) 4832 (when org-link-descriptive (add-to-invisibility-spec '(org-link))) 4833 (make-local-variable 'org-link-descriptive) 4834 (add-to-invisibility-spec '(org-hide-block . t)) 4835 (setq-local outline-regexp org-outline-regexp) 4836 (setq-local outline-level 'org-outline-level) 4837 (setq bidi-paragraph-direction 'left-to-right) 4838 (when (and (stringp org-ellipsis) (not (equal "" org-ellipsis))) 4839 (unless org-display-table 4840 (setq org-display-table (make-display-table))) 4841 (set-display-table-slot 4842 org-display-table 4 4843 (vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis)) 4844 org-ellipsis))) 4845 (setq buffer-display-table org-display-table)) 4846 (org-set-regexps-and-options) 4847 (org-set-font-lock-defaults) 4848 (when (and org-tag-faces (not org-tags-special-faces-re)) 4849 ;; tag faces set outside customize.... force initialization. 4850 (org-set-tag-faces 'org-tag-faces org-tag-faces)) 4851 ;; Calc embedded 4852 (setq-local calc-embedded-open-mode "# ") 4853 ;; Modify a few syntax entries 4854 (modify-syntax-entry ?\" "\"") 4855 (modify-syntax-entry ?\\ "_") 4856 (modify-syntax-entry ?~ "_") 4857 (modify-syntax-entry ?< "(>") 4858 (modify-syntax-entry ?> ")<") 4859 (setq-local font-lock-unfontify-region-function 'org-unfontify-region) 4860 ;; Activate before-change-function 4861 (setq-local org-table-may-need-update t) 4862 (add-hook 'before-change-functions 'org-before-change-function nil 'local) 4863 ;; Check for running clock before killing a buffer 4864 (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) 4865 ;; Initialize macros templates. 4866 (org-macro-initialize-templates) 4867 ;; Initialize radio targets. 4868 (org-update-radio-target-regexp) 4869 ;; Indentation. 4870 (setq-local indent-line-function 'org-indent-line) 4871 (setq-local indent-region-function 'org-indent-region) 4872 ;; Filling and auto-filling. 4873 (org-setup-filling) 4874 ;; Comments. 4875 (org-setup-comments-handling) 4876 ;; Initialize cache. 4877 (org-element-cache-reset) 4878 ;; Beginning/end of defun 4879 (setq-local beginning-of-defun-function 'org-backward-element) 4880 (setq-local end-of-defun-function 4881 (lambda () 4882 (if (not (org-at-heading-p)) 4883 (org-forward-element) 4884 (org-forward-element) 4885 (forward-char -1)))) 4886 ;; Next error for sparse trees 4887 (setq-local next-error-function 'org-occur-next-match) 4888 ;; Make commit log messages from Org documents easier. 4889 (setq-local add-log-current-defun-function #'org-add-log-current-headline) 4890 ;; Make sure dependence stuff works reliably, even for users who set it 4891 ;; too late :-( 4892 (if org-enforce-todo-dependencies 4893 (add-hook 'org-blocker-hook 4894 'org-block-todo-from-children-or-siblings-or-parent) 4895 (remove-hook 'org-blocker-hook 4896 'org-block-todo-from-children-or-siblings-or-parent)) 4897 (if org-enforce-todo-checkbox-dependencies 4898 (add-hook 'org-blocker-hook 4899 'org-block-todo-from-checkboxes) 4900 (remove-hook 'org-blocker-hook 4901 'org-block-todo-from-checkboxes)) 4902 4903 ;; Align options lines 4904 (setq-local 4905 align-mode-rules-list 4906 '((org-in-buffer-settings 4907 (regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") 4908 (modes . '(org-mode))))) 4909 4910 ;; Setup the pcomplete hooks 4911 (setq-local pcomplete-command-completion-function #'org-pcomplete-initial) 4912 (setq-local pcomplete-command-name-function #'org-command-at-point) 4913 (setq-local pcomplete-default-completion-function #'ignore) 4914 (setq-local pcomplete-parse-arguments-function #'org-parse-arguments) 4915 (setq-local pcomplete-termination-string "") 4916 (add-hook 'completion-at-point-functions 4917 #'pcomplete-completions-at-point nil t) 4918 (setq-local buffer-face-mode-face 'org-default) 4919 4920 ;; If empty file that did not turn on Org mode automatically, make 4921 ;; it to. 4922 (when (and org-insert-mode-line-in-empty-file 4923 (called-interactively-p 'any) 4924 (= (point-min) (point-max))) 4925 (insert "# -*- mode: org -*-\n\n")) 4926 (unless org-inhibit-startup 4927 (org-unmodified 4928 (when org-startup-with-beamer-mode (org-beamer-mode)) 4929 (when (or org-startup-align-all-tables org-startup-shrink-all-tables) 4930 (org-table-map-tables 4931 (cond ((and org-startup-align-all-tables 4932 org-startup-shrink-all-tables) 4933 (lambda () (org-table-align) (org-table-shrink))) 4934 (org-startup-align-all-tables #'org-table-align) 4935 (t #'org-table-shrink)) 4936 t)) 4937 (when org-startup-with-inline-images (org-display-inline-images)) 4938 (when org-startup-with-latex-preview (org-latex-preview '(16))) 4939 (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility)) 4940 (when org-startup-truncated (setq truncate-lines t)) 4941 (when org-startup-numerated (require 'org-num) (org-num-mode 1)) 4942 (when org-startup-indented (require 'org-indent) (org-indent-mode 1)))) 4943 4944 ;; Add a custom keymap for `visual-line-mode' so that activating 4945 ;; this minor mode does not override Org's keybindings. 4946 ;; FIXME: Probably `visual-line-mode' should take care of this. 4947 (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist))) 4948 (newmap (make-sparse-keymap))) 4949 (set-keymap-parent newmap oldmap) 4950 (define-key newmap [remap move-beginning-of-line] nil) 4951 (define-key newmap [remap move-end-of-line] nil) 4952 (define-key newmap [remap kill-line] nil) 4953 (make-local-variable 'minor-mode-overriding-map-alist) 4954 (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist)) 4955 4956 ;; Activate `org-table-header-line-mode' 4957 (when org-table-header-line-p 4958 (org-table-header-line-mode 1)) 4959 ;; Try to set `org-hide' face correctly. 4960 (let ((foreground (org-find-invisible-foreground))) 4961 (when foreground 4962 (set-face-foreground 'org-hide foreground))) 4963 ;; Set face extension as requested. 4964 (org--set-faces-extend '(org-block-begin-line org-block-end-line) 4965 org-fontify-whole-block-delimiter-line) 4966 (org--set-faces-extend org-level-faces org-fontify-whole-heading-line)) 4967 4968 ;; Update `customize-package-emacs-version-alist' 4969 (add-to-list 'customize-package-emacs-version-alist 4970 '(Org ("8.0" . "24.4") 4971 ("8.1" . "24.4") 4972 ("8.2" . "24.4") 4973 ("8.2.7" . "24.4") 4974 ("8.3" . "26.1") 4975 ("9.0" . "26.1") 4976 ("9.1" . "26.1") 4977 ("9.2" . "27.1") 4978 ("9.3" . "27.1") 4979 ("9.4" . "27.2") 4980 ("9.5" . "28.1"))) 4981 4982 (defvar org-mode-transpose-word-syntax-table 4983 (let ((st (make-syntax-table text-mode-syntax-table))) 4984 (dolist (c org-emphasis-alist st) 4985 (modify-syntax-entry (string-to-char (car c)) "w p" st)))) 4986 4987 (when (fboundp 'abbrev-table-put) 4988 (abbrev-table-put org-mode-abbrev-table 4989 :parents (list text-mode-abbrev-table))) 4990 4991 (defun org-find-invisible-foreground () 4992 (let ((candidates (remove 4993 "unspecified-bg" 4994 (nconc 4995 (list (face-background 'default) 4996 (face-background 'org-default)) 4997 (mapcar 4998 (lambda (alist) 4999 (when (boundp alist) 5000 (cdr (assq 'background-color (symbol-value alist))))) 5001 '(default-frame-alist initial-frame-alist window-system-default-frame-alist)) 5002 (list (face-foreground 'org-hide)))))) 5003 (car (remove nil candidates)))) 5004 5005 (defun org-current-time (&optional rounding-minutes past) 5006 "Current time, possibly rounded to ROUNDING-MINUTES. 5007 When ROUNDING-MINUTES is not an integer, fall back on the car of 5008 `org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure 5009 the rounding returns a past time." 5010 (let ((r (or (and (integerp rounding-minutes) rounding-minutes) 5011 (car org-time-stamp-rounding-minutes))) 5012 (now (current-time))) 5013 (if (< r 1) 5014 now 5015 (let* ((time (decode-time now)) 5016 (res (apply #'encode-time 0 (* r (round (nth 1 time) r)) 5017 (nthcdr 2 time)))) 5018 (if (or (not past) (org-time-less-p res now)) 5019 res 5020 (org-time-subtract res (* r 60))))))) 5021 5022 (defun org-today () 5023 "Return today date, considering `org-extend-today-until'." 5024 (time-to-days 5025 (org-time-since (* 3600 org-extend-today-until)))) 5026 5027 ;;;; Font-Lock stuff, including the activators 5028 5029 (defconst org-match-sexp-depth 3 5030 "Number of stacked braces for sub/superscript matching.") 5031 5032 (defun org-create-multibrace-regexp (left right n) 5033 "Create a regular expression which will match a balanced sexp. 5034 Opening delimiter is LEFT, and closing delimiter is RIGHT, both given 5035 as single character strings. 5036 The regexp returned will match the entire expression including the 5037 delimiters. It will also define a single group which contains the 5038 match except for the outermost delimiters. The maximum depth of 5039 stacked delimiters is N. Escaping delimiters is not possible." 5040 (let* ((nothing (concat "[^" left right "]*?")) 5041 (or "\\|") 5042 (re nothing) 5043 (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) 5044 (while (> n 1) 5045 (setq n (1- n) 5046 re (concat re or next) 5047 next (concat "\\(?:" nothing left next right "\\)+" nothing))) 5048 (concat left "\\(" re "\\)" right))) 5049 5050 (defconst org-match-substring-regexp 5051 (concat 5052 "\\(\\S-\\)\\([_^]\\)\\(" 5053 "\\(?:" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" 5054 "\\|" 5055 "\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" 5056 "\\|" 5057 "\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)") 5058 "The regular expression matching a sub- or superscript.") 5059 5060 (defconst org-match-substring-with-braces-regexp 5061 (concat 5062 "\\(\\S-\\)\\([_^]\\)" 5063 "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)") 5064 "The regular expression matching a sub- or superscript, forcing braces.") 5065 5066 (defvar org-emph-face nil) 5067 5068 (defun org-do-emphasis-faces (limit) 5069 "Run through the buffer and emphasize strings." 5070 (let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)" 5071 (car org-emphasis-regexp-components)))) 5072 (catch :exit 5073 (while (re-search-forward quick-re limit t) 5074 (let* ((marker (match-string 2)) 5075 (verbatim? (member marker '("~" "=")))) 5076 (when (save-excursion 5077 (goto-char (match-beginning 0)) 5078 (and 5079 ;; Do not match table hlines. 5080 (not (and (equal marker "+") 5081 (org-match-line 5082 "[ \t]*\\(|[-+]+|?\\|\\+[-+]+\\+\\)[ \t]*$"))) 5083 ;; Do not match headline stars. Do not consider 5084 ;; stars of a headline as closing marker for bold 5085 ;; markup either. 5086 (not (and (equal marker "*") 5087 (save-excursion 5088 (forward-char) 5089 (skip-chars-backward "*") 5090 (looking-at-p org-outline-regexp-bol)))) 5091 ;; Match full emphasis markup regexp. 5092 (looking-at (if verbatim? org-verbatim-re org-emph-re)) 5093 ;; Do not span over paragraph boundaries. 5094 (not (string-match-p org-element-paragraph-separate 5095 (match-string 2))) 5096 ;; Do not span over cells in table rows. 5097 (not (and (save-match-data (org-match-line "[ \t]*|")) 5098 (string-match-p "|" (match-string 4)))))) 5099 (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist)) 5100 (m (if org-hide-emphasis-markers 4 2))) 5101 (font-lock-prepend-text-property 5102 (match-beginning m) (match-end m) 'face face) 5103 (when verbatim? 5104 (org-remove-flyspell-overlays-in 5105 (match-beginning 0) (match-end 0)) 5106 (remove-text-properties (match-beginning 2) (match-end 2) 5107 '(display t invisible t intangible t))) 5108 (add-text-properties (match-beginning 2) (match-end 2) 5109 '(font-lock-multiline t org-emphasis t)) 5110 (when (and org-hide-emphasis-markers 5111 (not (org-at-comment-p))) 5112 (add-text-properties (match-end 4) (match-beginning 5) 5113 '(invisible t)) 5114 (add-text-properties (match-beginning 3) (match-end 3) 5115 '(invisible t))) 5116 (throw :exit t)))))))) 5117 5118 (defun org-emphasize (&optional char) 5119 "Insert or change an emphasis, i.e. a font like bold or italic. 5120 If there is an active region, change that region to a new emphasis. 5121 If there is no region, just insert the marker characters and position 5122 the cursor between them. 5123 CHAR should be the marker character. If it is a space, it means to 5124 remove the emphasis of the selected region. 5125 If CHAR is not given (for example in an interactive call) it will be 5126 prompted for." 5127 (interactive) 5128 (let ((erc org-emphasis-regexp-components) 5129 (string "") beg end move s) 5130 (if (org-region-active-p) 5131 (setq beg (region-beginning) 5132 end (region-end) 5133 string (buffer-substring beg end)) 5134 (setq move t)) 5135 5136 (unless char 5137 (message "Emphasis marker or tag: [%s]" 5138 (mapconcat #'car org-emphasis-alist "")) 5139 (setq char (read-char-exclusive))) 5140 (if (equal char ?\s) 5141 (setq s "" 5142 move nil) 5143 (unless (assoc (char-to-string char) org-emphasis-alist) 5144 (user-error "No such emphasis marker: \"%c\"" char)) 5145 (setq s (char-to-string char))) 5146 (while (and (> (length string) 1) 5147 (equal (substring string 0 1) (substring string -1)) 5148 (assoc (substring string 0 1) org-emphasis-alist)) 5149 (setq string (substring string 1 -1))) 5150 (setq string (concat s string s)) 5151 (when beg (delete-region beg end)) 5152 (unless (or (bolp) 5153 (string-match (concat "[" (nth 0 erc) "\n]") 5154 (char-to-string (char-before (point))))) 5155 (insert " ")) 5156 (unless (or (eobp) 5157 (string-match (concat "[" (nth 1 erc) "\n]") 5158 (char-to-string (char-after (point))))) 5159 (insert " ") (backward-char 1)) 5160 (insert string) 5161 (and move (backward-char 1)))) 5162 5163 (defconst org-nonsticky-props 5164 '(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link)) 5165 5166 (defsubst org-rear-nonsticky-at (pos) 5167 (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) 5168 5169 (defun org-activate-links (limit) 5170 "Add link properties to links. 5171 This includes angle, plain, and bracket links." 5172 (catch :exit 5173 (while (re-search-forward org-link-any-re limit t) 5174 (let* ((start (match-beginning 0)) 5175 (end (match-end 0)) 5176 (visible-start (or (match-beginning 3) (match-beginning 2))) 5177 (visible-end (or (match-end 3) (match-end 2))) 5178 (style (cond ((eq ?< (char-after start)) 'angle) 5179 ((eq ?\[ (char-after (1+ start))) 'bracket) 5180 (t 'plain)))) 5181 (when (and (memq style org-highlight-links) 5182 ;; Do not span over paragraph boundaries. 5183 (not (string-match-p org-element-paragraph-separate 5184 (match-string 0))) 5185 ;; Do not confuse plain links with tags. 5186 (not (and (eq style 'plain) 5187 (let ((face (get-text-property 5188 (max (1- start) (point-min)) 'face))) 5189 (if (consp face) (memq 'org-tag face) 5190 (eq 'org-tag face)))))) 5191 (let* ((link-object (save-excursion 5192 (goto-char start) 5193 (save-match-data (org-element-link-parser)))) 5194 (link (org-element-property :raw-link link-object)) 5195 (type (org-element-property :type link-object)) 5196 (path (org-element-property :path link-object)) 5197 (face-property (pcase (org-link-get-parameter type :face) 5198 ((and (pred functionp) face) (funcall face path)) 5199 ((and (pred facep) face) face) 5200 ((and (pred consp) face) face) ;anonymous 5201 (_ 'org-link))) 5202 (properties ;for link's visible part 5203 (list 'mouse-face (or (org-link-get-parameter type :mouse-face) 5204 'highlight) 5205 'keymap (or (org-link-get-parameter type :keymap) 5206 org-mouse-map) 5207 'help-echo (pcase (org-link-get-parameter type :help-echo) 5208 ((and (pred stringp) echo) echo) 5209 ((and (pred functionp) echo) echo) 5210 (_ (concat "LINK: " link))) 5211 'htmlize-link (pcase (org-link-get-parameter type 5212 :htmlize-link) 5213 ((and (pred functionp) f) (funcall f)) 5214 (_ `(:uri ,link))) 5215 'font-lock-multiline t))) 5216 (org-remove-flyspell-overlays-in start end) 5217 (org-rear-nonsticky-at end) 5218 (if (not (eq 'bracket style)) 5219 (progn 5220 (add-face-text-property start end face-property) 5221 (add-text-properties start end properties)) 5222 ;; Handle invisible parts in bracket links. 5223 (remove-text-properties start end '(invisible nil)) 5224 (let ((hidden 5225 (append `(invisible 5226 ,(or (org-link-get-parameter type :display) 5227 'org-link)) 5228 properties))) 5229 (add-text-properties start visible-start hidden) 5230 (add-face-text-property start end face-property) 5231 (add-text-properties visible-start visible-end properties) 5232 (add-text-properties visible-end end hidden) 5233 (org-rear-nonsticky-at visible-start) 5234 (org-rear-nonsticky-at visible-end))) 5235 (let ((f (org-link-get-parameter type :activate-func))) 5236 (when (functionp f) 5237 (funcall f start end path (eq style 'bracket)))) 5238 (throw :exit t))))) ;signal success 5239 nil)) 5240 5241 (defun org-activate-code (limit) 5242 (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) 5243 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) 5244 (remove-text-properties (match-beginning 0) (match-end 0) 5245 '(display t invisible t intangible t)) 5246 t)) 5247 5248 (defcustom org-src-fontify-natively t 5249 "When non-nil, fontify code in code blocks. 5250 See also the `org-block' face." 5251 :type 'boolean 5252 :version "26.1" 5253 :package-version '(Org . "8.3") 5254 :group 'org-appearance 5255 :group 'org-babel) 5256 5257 (defcustom org-allow-promoting-top-level-subtree nil 5258 "When non-nil, allow promoting a top level subtree. 5259 The leading star of the top level headline will be replaced 5260 by a #." 5261 :type 'boolean 5262 :version "24.1" 5263 :group 'org-appearance) 5264 5265 (defun org-fontify-meta-lines-and-blocks (limit) 5266 (condition-case nil 5267 (org-fontify-meta-lines-and-blocks-1 limit) 5268 (error (message "Org mode fontification error in %S at %d" 5269 (current-buffer) 5270 (line-number-at-pos))))) 5271 5272 (defun org-fontify-meta-lines-and-blocks-1 (limit) 5273 "Fontify #+ lines and blocks." 5274 (let ((case-fold-search t)) 5275 (when (re-search-forward 5276 (rx bol (group (zero-or-more (any " \t")) "#" 5277 (group (group (or (seq "+" (one-or-more (any "a-zA-Z")) (optional ":")) 5278 (any " \t") 5279 eol)) 5280 (optional (group "_" (group (one-or-more (any "a-zA-Z")))))) 5281 (zero-or-more (any " \t")) 5282 (group (group (zero-or-more (not (any " \t\n")))) 5283 (zero-or-more (any " \t")) 5284 (group (zero-or-more any))))) 5285 limit t) 5286 (let ((beg (match-beginning 0)) 5287 (end-of-beginline (match-end 0)) 5288 ;; Including \n at end of #+begin line will include \n 5289 ;; after the end of block content. 5290 (block-start (match-end 0)) 5291 (block-end nil) 5292 (lang (match-string 7)) ; The language, if it is a source block. 5293 (bol-after-beginline (line-beginning-position 2)) 5294 (dc1 (downcase (match-string 2))) 5295 (dc3 (downcase (match-string 3))) 5296 (whole-blockline org-fontify-whole-block-delimiter-line) 5297 beg-of-endline end-of-endline nl-before-endline quoting block-type) 5298 (cond 5299 ((and (match-end 4) (equal dc3 "+begin")) 5300 ;; Truly a block 5301 (setq block-type (downcase (match-string 5)) 5302 ;; Src, example, export, maybe more. 5303 quoting (member block-type org-protecting-blocks)) 5304 (when (re-search-forward 5305 (rx-to-string `(group bol (or (seq (one-or-more "*") space) 5306 (seq (zero-or-more (any " \t")) 5307 "#+end" 5308 ,(match-string 4) 5309 word-end 5310 (zero-or-more any))))) 5311 ;; We look further than LIMIT on purpose. 5312 nil t) 5313 ;; We do have a matching #+end line. 5314 (setq beg-of-endline (match-beginning 0) 5315 end-of-endline (match-end 0) 5316 nl-before-endline (1- (match-beginning 0))) 5317 (setq block-end (match-beginning 0)) ; Include the final newline. 5318 (when quoting 5319 (org-remove-flyspell-overlays-in bol-after-beginline nl-before-endline) 5320 (remove-text-properties beg end-of-endline 5321 '(display t invisible t intangible t))) 5322 (add-text-properties 5323 beg end-of-endline '(font-lock-fontified t font-lock-multiline t)) 5324 (org-remove-flyspell-overlays-in beg bol-after-beginline) 5325 (org-remove-flyspell-overlays-in nl-before-endline end-of-endline) 5326 (cond 5327 ((and lang (not (string= lang "")) org-src-fontify-natively) 5328 (save-match-data 5329 (org-src-font-lock-fontify-block lang block-start block-end)) 5330 (add-text-properties bol-after-beginline block-end '(src-block t))) 5331 (quoting 5332 (add-text-properties 5333 bol-after-beginline beg-of-endline 5334 (list 'face 5335 (list :inherit 5336 (let ((face-name 5337 (intern (format "org-block-%s" lang)))) 5338 (append (and (facep face-name) (list face-name)) 5339 '(org-block))))))) 5340 ((not org-fontify-quote-and-verse-blocks)) 5341 ((string= block-type "quote") 5342 (add-face-text-property 5343 bol-after-beginline beg-of-endline 'org-quote t)) 5344 ((string= block-type "verse") 5345 (add-face-text-property 5346 bol-after-beginline beg-of-endline 'org-verse t))) 5347 ;; Fontify the #+begin and #+end lines of the blocks 5348 (add-text-properties 5349 beg (if whole-blockline bol-after-beginline end-of-beginline) 5350 '(face org-block-begin-line)) 5351 (unless (eq (char-after beg-of-endline) ?*) 5352 (add-text-properties 5353 beg-of-endline 5354 (if whole-blockline 5355 (let ((beg-of-next-line (1+ end-of-endline))) 5356 (min (point-max) beg-of-next-line)) 5357 (min (point-max) end-of-endline)) 5358 '(face org-block-end-line))) 5359 t)) 5360 ((member dc1 '("+title:" "+subtitle:" "+author:" "+email:" "+date:")) 5361 (org-remove-flyspell-overlays-in 5362 (match-beginning 0) 5363 (if (equal "+title:" dc1) (match-end 2) (match-end 0))) 5364 (add-text-properties 5365 beg (match-end 3) 5366 (if (member (intern (substring dc1 1 -1)) org-hidden-keywords) 5367 '(font-lock-fontified t invisible t) 5368 '(font-lock-fontified t face org-document-info-keyword))) 5369 (add-text-properties 5370 (match-beginning 6) (min (point-max) (1+ (match-end 6))) 5371 (if (string-equal dc1 "+title:") 5372 '(font-lock-fontified t face org-document-title) 5373 '(font-lock-fontified t face org-document-info)))) 5374 ((string-prefix-p "+caption" dc1) 5375 (org-remove-flyspell-overlays-in (match-end 2) (match-end 0)) 5376 (remove-text-properties (match-beginning 0) (match-end 0) 5377 '(display t invisible t intangible t)) 5378 ;; Handle short captions 5379 (save-excursion 5380 (beginning-of-line) 5381 (looking-at (rx (group (zero-or-more (any " \t")) 5382 "#+caption" 5383 (optional "[" (zero-or-more any) "]") 5384 ":") 5385 (zero-or-more (any " \t"))))) 5386 (add-text-properties (line-beginning-position) (match-end 1) 5387 '(font-lock-fontified t face org-meta-line)) 5388 (add-text-properties (match-end 0) (line-end-position) 5389 '(font-lock-fontified t face org-block)) 5390 t) 5391 ((member dc3 '(" " "")) 5392 ;; Just a comment, the plus was not there 5393 (org-remove-flyspell-overlays-in beg (match-end 0)) 5394 (add-text-properties 5395 beg (match-end 0) 5396 '(font-lock-fontified t face font-lock-comment-face))) 5397 (t ;; Just any other in-buffer setting, but not indented 5398 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) 5399 (remove-text-properties (match-beginning 0) (match-end 0) 5400 '(display t invisible t intangible t)) 5401 (add-text-properties beg (match-end 0) 5402 '(font-lock-fontified t face org-meta-line)) 5403 t)))))) 5404 5405 (defun org-fontify-drawers (limit) 5406 "Fontify drawers." 5407 (when (re-search-forward org-drawer-regexp limit t) 5408 (add-text-properties (1- (match-beginning 1)) (1+ (match-end 1)) 5409 '(font-lock-fontified t face org-drawer)) 5410 (org-remove-flyspell-overlays-in 5411 (line-beginning-position) (line-beginning-position 2)) 5412 t)) 5413 5414 (defun org-fontify-macros (limit) 5415 "Fontify macros." 5416 (when (re-search-forward "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)" limit t) 5417 (let ((begin (match-beginning 0)) 5418 (opening-end (match-beginning 1))) 5419 (when (and (re-search-forward "\n[ \t]*\n\\|\\(}}}\\)" limit t) 5420 (match-string 1)) 5421 (let ((end (match-end 1)) 5422 (closing-start (match-beginning 1))) 5423 (add-text-properties 5424 begin end 5425 '(font-lock-multiline t font-lock-fontified t face org-macro)) 5426 (org-remove-flyspell-overlays-in begin end) 5427 (when org-hide-macro-markers 5428 (add-text-properties begin opening-end '(invisible t)) 5429 (add-text-properties closing-start end '(invisible t))) 5430 t))))) 5431 5432 (defun org-fontify-extend-region (beg end _old-len) 5433 (let ((end (if (progn (goto-char end) (looking-at-p "^[*#]")) 5434 (1+ end) end)) 5435 (begin-re "\\(\\\\\\[\\|\\(#\\+begin_\\|\\\\begin{\\)\\S-+\\)") 5436 (end-re "\\(\\\\\\]\\|\\(#\\+end_\\|\\\\end{\\)\\S-+\\)") 5437 (extend 5438 (lambda (r1 r2 dir) 5439 (let ((re (replace-regexp-in-string 5440 "\\(begin\\|end\\)" r1 5441 (replace-regexp-in-string 5442 "[][]" r2 5443 (match-string-no-properties 0))))) 5444 (re-search-forward (regexp-quote re) nil t dir))))) 5445 (goto-char beg) 5446 (back-to-indentation) 5447 (save-match-data 5448 (cond ((looking-at end-re) 5449 (cons (or (funcall extend "begin" "[" -1) beg) end)) 5450 ((looking-at begin-re) 5451 (cons beg (or (funcall extend "end" "]" 1) end))) 5452 (t (cons beg end)))))) 5453 5454 (defun org-activate-footnote-links (limit) 5455 "Add text properties for footnotes." 5456 (let ((fn (org-footnote-next-reference-or-definition limit))) 5457 (when fn 5458 (let* ((beg (nth 1 fn)) 5459 (end (nth 2 fn)) 5460 (label (car fn)) 5461 (referencep (/= (line-beginning-position) beg))) 5462 (when (and referencep (nth 3 fn)) 5463 (save-excursion 5464 (goto-char beg) 5465 (search-forward (or label "fn:")) 5466 (org-remove-flyspell-overlays-in beg (match-end 0)))) 5467 (add-text-properties beg end 5468 (list 'mouse-face 'highlight 5469 'keymap org-mouse-map 5470 'help-echo 5471 (if referencep "Footnote reference" 5472 "Footnote definition") 5473 'font-lock-fontified t 5474 'font-lock-multiline t 5475 'face 'org-footnote)))))) 5476 5477 (defun org-activate-dates (limit) 5478 "Add text properties for dates." 5479 (when (and (re-search-forward org-tsr-regexp-both limit t) 5480 (not (equal (char-before (match-beginning 0)) 91))) 5481 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) 5482 (add-text-properties (match-beginning 0) (match-end 0) 5483 (list 'mouse-face 'highlight 5484 'keymap org-mouse-map)) 5485 (org-rear-nonsticky-at (match-end 0)) 5486 (when org-display-custom-times 5487 ;; If it's a date range, activate custom time for second date. 5488 (when (match-end 3) 5489 (org-display-custom-time (match-beginning 3) (match-end 3))) 5490 (org-display-custom-time (match-beginning 1) (match-end 1))) 5491 t)) 5492 5493 (defun org-activate-target-links (limit) 5494 "Add text properties for target matches." 5495 (when org-target-link-regexp 5496 (let ((case-fold-search t)) 5497 ;; `org-target-link-regexp' matches one character before the 5498 ;; actual target. 5499 (unless (bolp) (forward-char -1)) 5500 (when (re-search-forward org-target-link-regexp limit t) 5501 (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) 5502 (add-text-properties (match-beginning 1) (match-end 1) 5503 (list 'mouse-face 'highlight 5504 'keymap org-mouse-map 5505 'help-echo "Radio target link" 5506 'org-linked-text t)) 5507 (org-rear-nonsticky-at (match-end 1)) 5508 t)))) 5509 5510 (defvar org-latex-and-related-regexp nil 5511 "Regular expression for highlighting LaTeX, entities and sub/superscript.") 5512 5513 (defun org-compute-latex-and-related-regexp () 5514 "Compute regular expression for LaTeX, entities and sub/superscript. 5515 Result depends on variable `org-highlight-latex-and-related'." 5516 (let ((re-sub 5517 (cond ((not (memq 'script org-highlight-latex-and-related)) nil) 5518 ((eq org-use-sub-superscripts '{}) 5519 (list org-match-substring-with-braces-regexp)) 5520 (org-use-sub-superscripts (list org-match-substring-regexp)))) 5521 (re-latex 5522 (when (or (memq 'latex org-highlight-latex-and-related) 5523 (memq 'native org-highlight-latex-and-related)) 5524 (let ((matchers (plist-get org-format-latex-options :matchers))) 5525 (delq nil 5526 (mapcar (lambda (x) 5527 (and (member (car x) matchers) (nth 1 x))) 5528 org-latex-regexps))))) 5529 (re-entities 5530 (when (memq 'entities org-highlight-latex-and-related) 5531 (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\ 5532 \\($\\|{}\\|[^[:alpha:]]\\)")))) 5533 (setq-local org-latex-and-related-regexp 5534 (mapconcat #'identity 5535 (append re-latex re-entities re-sub) 5536 "\\|")))) 5537 5538 (defun org-do-latex-and-related (limit) 5539 "Highlight LaTeX snippets and environments, entities and sub/superscript. 5540 Stop at first highlighted object, if any. Return t if some 5541 highlighting was done, nil otherwise." 5542 (when (org-string-nw-p org-latex-and-related-regexp) 5543 (let ((latex-prefix-re (rx (or "$" "\\(" "\\["))) 5544 (blank-line-re (rx (and "\n" (zero-or-more (or " " "\t")) "\n")))) 5545 (catch 'found 5546 (while (and (< (point) limit) 5547 (re-search-forward org-latex-and-related-regexp nil t)) 5548 (cond 5549 ((>= (match-beginning 0) limit) 5550 (throw 'found nil)) 5551 ((cl-some (lambda (f) 5552 (memq f '(org-code org-verbatim underline 5553 org-special-keyword))) 5554 (save-excursion 5555 (goto-char (1+ (match-beginning 0))) 5556 (face-at-point nil t)))) 5557 ;; Try to limit false positives. In this case, ignore 5558 ;; $$...$$, \(...\), and \[...\] LaTeX constructs if they 5559 ;; contain an empty line. 5560 ((save-excursion 5561 (goto-char (match-beginning 0)) 5562 (and (looking-at-p latex-prefix-re) 5563 (save-match-data 5564 (re-search-forward blank-line-re (1- (match-end 0)) t))))) 5565 (t 5566 (let* ((offset (if (memq (char-after (1+ (match-beginning 0))) 5567 '(?_ ?^)) 5568 1 5569 0)) 5570 (start (+ offset (match-beginning 0))) 5571 (end (match-end 0))) 5572 (if (memq 'native org-highlight-latex-and-related) 5573 (org-src-font-lock-fontify-block "latex" start end) 5574 (font-lock-prepend-text-property start end 5575 'face 'org-latex-and-related)) 5576 (add-text-properties (+ offset (match-beginning 0)) (match-end 0) 5577 '(font-lock-multiline t)) 5578 (throw 'found t))))) 5579 nil)))) 5580 5581 (defun org-restart-font-lock () 5582 "Restart `font-lock-mode', to force refontification." 5583 (when font-lock-mode 5584 (font-lock-mode -1) 5585 (font-lock-mode 1))) 5586 5587 (defun org-activate-tags (limit) 5588 (when (re-search-forward org-tag-line-re limit t) 5589 (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) 5590 (add-text-properties (match-beginning 1) (match-end 1) 5591 (list 'mouse-face 'highlight 5592 'keymap org-mouse-map)) 5593 (org-rear-nonsticky-at (match-end 1)) 5594 t)) 5595 5596 (defun org-outline-level () 5597 "Compute the outline level of the heading at point. 5598 5599 If this is called at a normal headline, the level is the number 5600 of stars. Use `org-reduced-level' to remove the effect of 5601 `org-odd-levels'. Unlike to `org-current-level', this function 5602 takes into consideration inlinetasks." 5603 (org-with-wide-buffer 5604 (end-of-line) 5605 (if (re-search-backward org-outline-regexp-bol nil t) 5606 (1- (- (match-end 0) (match-beginning 0))) 5607 0))) 5608 5609 (defvar org-font-lock-keywords nil) 5610 5611 (defsubst org-re-property (property &optional literal allow-null value) 5612 "Return a regexp matching a PROPERTY line. 5613 5614 When optional argument LITERAL is non-nil, do not quote PROPERTY. 5615 This is useful when PROPERTY is a regexp. When ALLOW-NULL is 5616 non-nil, match properties even without a value. 5617 5618 Match group 3 is set to the value when it exists. If there is no 5619 value and ALLOW-NULL is non-nil, it is set to the empty string. 5620 5621 With optional argument VALUE, match only property lines with 5622 that value; in this case, ALLOW-NULL is ignored. VALUE is quoted 5623 unless LITERAL is non-nil." 5624 (concat 5625 "^\\(?4:[ \t]*\\)" 5626 (format "\\(?1::\\(?2:%s\\):\\)" 5627 (if literal property (regexp-quote property))) 5628 (cond (value 5629 (format "[ \t]+\\(?3:%s\\)\\(?5:[ \t]*\\)$" 5630 (if literal value (regexp-quote value)))) 5631 (allow-null 5632 "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$") 5633 (t 5634 "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$")))) 5635 5636 (defconst org-property-re 5637 (org-re-property "\\S-+" 'literal t) 5638 "Regular expression matching a property line. 5639 There are four matching groups: 5640 1: :PROPKEY: including the leading and trailing colon, 5641 2: PROPKEY without the leading and trailing colon, 5642 3: PROPVAL without leading or trailing spaces, 5643 4: the indentation of the current line, 5644 5: trailing whitespace.") 5645 5646 (defvar org-font-lock-hook nil 5647 "Functions to be called for special font lock stuff.") 5648 5649 (defvar org-font-lock-extra-keywords nil) ;Dynamically scoped. 5650 5651 (defvar org-font-lock-set-keywords-hook nil 5652 "Functions that can manipulate `org-font-lock-extra-keywords'. 5653 This is called after `org-font-lock-extra-keywords' is defined, but before 5654 it is installed to be used by font lock. This can be useful if something 5655 needs to be inserted at a specific position in the font-lock sequence.") 5656 5657 (defun org-font-lock-hook (limit) 5658 "Run `org-font-lock-hook' within LIMIT." 5659 (run-hook-with-args 'org-font-lock-hook limit)) 5660 5661 (defun org-set-font-lock-defaults () 5662 "Set font lock defaults for the current buffer." 5663 (let ((org-font-lock-extra-keywords 5664 (list 5665 ;; Call the hook 5666 '(org-font-lock-hook) 5667 ;; Headlines 5668 `(,(if org-fontify-whole-heading-line 5669 "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)" 5670 "^\\(\\**\\)\\(\\* \\)\\(.*\\)") 5671 (1 (org-get-level-face 1)) 5672 (2 (org-get-level-face 2)) 5673 (3 (org-get-level-face 3))) 5674 ;; Table lines 5675 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 5676 (1 'org-table t)) 5677 ;; Table internals 5678 '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) 5679 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) 5680 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) 5681 '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t)) 5682 ;; Properties 5683 (list org-property-re 5684 '(1 'org-special-keyword t) 5685 '(3 'org-property-value t)) 5686 ;; Drawers 5687 '(org-fontify-drawers) 5688 ;; Link related fontification. 5689 '(org-activate-links) 5690 (when (memq 'tag org-highlight-links) '(org-activate-tags (1 'org-tag prepend))) 5691 (when (memq 'radio org-highlight-links) '(org-activate-target-links (1 'org-link t))) 5692 (when (memq 'date org-highlight-links) '(org-activate-dates (0 'org-date t))) 5693 (when (memq 'footnote org-highlight-links) '(org-activate-footnote-links)) 5694 ;; Targets. 5695 (list org-radio-target-regexp '(0 'org-target t)) 5696 (list org-target-regexp '(0 'org-target t)) 5697 ;; Diary sexps. 5698 '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) 5699 ;; Macro 5700 '(org-fontify-macros) 5701 ;; TODO keyword 5702 (list (format org-heading-keyword-regexp-format 5703 org-todo-regexp) 5704 '(2 (org-get-todo-face 2) prepend)) 5705 ;; TODO 5706 (when org-fontify-todo-headline 5707 (list (format org-heading-keyword-regexp-format 5708 (concat 5709 "\\(?:" 5710 (mapconcat 'regexp-quote org-not-done-keywords "\\|") 5711 "\\)")) 5712 '(2 'org-headline-todo prepend))) 5713 ;; DONE 5714 (when org-fontify-done-headline 5715 (list (format org-heading-keyword-regexp-format 5716 (concat 5717 "\\(?:" 5718 (mapconcat 'regexp-quote org-done-keywords "\\|") 5719 "\\)")) 5720 '(2 'org-headline-done prepend))) 5721 ;; Priorities 5722 '(org-font-lock-add-priority-faces) 5723 ;; Tags 5724 '(org-font-lock-add-tag-faces) 5725 ;; Tags groups 5726 (when (and org-group-tags org-tag-groups-alist) 5727 (list (concat org-outline-regexp-bol ".+\\(:" 5728 (regexp-opt (mapcar 'car org-tag-groups-alist)) 5729 ":\\).*$") 5730 '(1 'org-tag-group prepend))) 5731 ;; Special keywords 5732 (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) 5733 (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) 5734 (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) 5735 (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) 5736 ;; Emphasis 5737 (when org-fontify-emphasized-text '(org-do-emphasis-faces)) 5738 ;; Checkboxes 5739 '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" 5740 1 'org-checkbox prepend) 5741 (when (cdr (assq 'checkbox org-list-automatic-rules)) 5742 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" 5743 (0 (org-get-checkbox-statistics-face) prepend))) 5744 ;; Description list items 5745 '("\\(?:^[ \t]*[-+]\\|^[ \t]+[*]\\)[ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)" 5746 1 'org-list-dt prepend) 5747 ;; Inline export snippets 5748 '("\\(@@\\)\\([a-z-]+:\\).*?\\(@@\\)" 5749 (1 'font-lock-comment-face t) 5750 (2 'org-tag t) 5751 (3 'font-lock-comment-face t)) 5752 ;; ARCHIVEd headings 5753 (list (concat 5754 org-outline-regexp-bol 5755 "\\(.*:" org-archive-tag ":.*\\)") 5756 '(1 'org-archived prepend)) 5757 ;; Specials 5758 '(org-do-latex-and-related) 5759 '(org-fontify-entities) 5760 '(org-raise-scripts) 5761 ;; Code 5762 '(org-activate-code (1 'org-code t)) 5763 ;; COMMENT 5764 (list (format 5765 "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)" 5766 org-todo-regexp 5767 org-comment-string) 5768 '(9 'org-special-keyword t)) 5769 ;; Blocks and meta lines 5770 '(org-fontify-meta-lines-and-blocks) 5771 ;; Citations 5772 '(org-cite-activate)))) 5773 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) 5774 (run-hooks 'org-font-lock-set-keywords-hook) 5775 ;; Now set the full font-lock-keywords 5776 (setq-local org-font-lock-keywords org-font-lock-extra-keywords) 5777 (setq-local font-lock-defaults 5778 '(org-font-lock-keywords t nil nil backward-paragraph)) 5779 (setq-local font-lock-extend-after-change-region-function 5780 #'org-fontify-extend-region) 5781 (kill-local-variable 'font-lock-keywords) 5782 nil)) 5783 5784 (defun org-toggle-pretty-entities () 5785 "Toggle the composition display of entities as UTF8 characters." 5786 (interactive) 5787 (setq-local org-pretty-entities (not org-pretty-entities)) 5788 (org-restart-font-lock) 5789 (if org-pretty-entities 5790 (message "Entities are now displayed as UTF8 characters") 5791 (save-restriction 5792 (widen) 5793 (decompose-region (point-min) (point-max)) 5794 (message "Entities are now displayed as plain text")))) 5795 5796 (defvar-local org-custom-properties-overlays nil 5797 "List of overlays used for custom properties.") 5798 5799 (defun org-toggle-custom-properties-visibility () 5800 "Display or hide properties in `org-custom-properties'." 5801 (interactive) 5802 (if org-custom-properties-overlays 5803 (progn (mapc #'delete-overlay org-custom-properties-overlays) 5804 (setq org-custom-properties-overlays nil)) 5805 (when org-custom-properties 5806 (org-with-wide-buffer 5807 (goto-char (point-min)) 5808 (let ((regexp (org-re-property (regexp-opt org-custom-properties) t t))) 5809 (while (re-search-forward regexp nil t) 5810 (let ((end (cdr (save-match-data (org-get-property-block))))) 5811 (when (and end (< (point) end)) 5812 ;; Hide first custom property in current drawer. 5813 (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) 5814 (overlay-put o 'invisible t) 5815 (overlay-put o 'org-custom-property t) 5816 (push o org-custom-properties-overlays)) 5817 ;; Hide additional custom properties in the same drawer. 5818 (while (re-search-forward regexp end t) 5819 (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) 5820 (overlay-put o 'invisible t) 5821 (overlay-put o 'org-custom-property t) 5822 (push o org-custom-properties-overlays))))) 5823 ;; Each entry is limited to a single property drawer. 5824 (outline-next-heading))))))) 5825 5826 (defun org-fontify-entities (limit) 5827 "Find an entity to fontify." 5828 (let (ee) 5829 (when org-pretty-entities 5830 (catch 'match 5831 ;; "\_ "-family is left out on purpose. Only the first one, 5832 ;; i.e., "\_ ", could be fontified anyway, and it would be 5833 ;; confusing when adding a second white space character. 5834 (while (re-search-forward 5835 "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)" 5836 limit t) 5837 (when (and (not (org-at-comment-p)) 5838 (setq ee (org-entity-get (match-string 1))) 5839 (= (length (nth 6 ee)) 1)) 5840 (let* ((end (if (equal (match-string 2) "{}") 5841 (match-end 2) 5842 (match-end 1)))) 5843 (add-text-properties 5844 (match-beginning 0) end 5845 (list 'font-lock-fontified t)) 5846 (compose-region (match-beginning 0) end 5847 (nth 6 ee) nil) 5848 (backward-char 1) 5849 (throw 'match t)))) 5850 nil)))) 5851 5852 (defun org-fontify-like-in-org-mode (s &optional odd-levels) 5853 "Fontify string S like in Org mode." 5854 (with-temp-buffer 5855 (insert s) 5856 (let ((org-odd-levels-only odd-levels)) 5857 (org-mode) 5858 (org-font-lock-ensure) 5859 (buffer-string)))) 5860 5861 (defun org-get-level-face (n) 5862 "Get the right face for match N in font-lock matching of headlines." 5863 (let* ((org-l0 (- (match-end 2) (match-beginning 1) 1)) 5864 (org-l (if org-odd-levels-only (1+ (/ org-l0 2)) org-l0)) 5865 (org-f (if org-cycle-level-faces 5866 (nth (% (1- org-l) org-n-level-faces) org-level-faces) 5867 (nth (1- (min org-l org-n-level-faces)) org-level-faces)))) 5868 (cond 5869 ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) 5870 ((eq n 2) org-f) 5871 (t (unless org-level-color-stars-only org-f))))) 5872 5873 (defun org-face-from-face-or-color (context inherit face-or-color) 5874 "Create a face list that inherits INHERIT, but sets the foreground color. 5875 When FACE-OR-COLOR is not a string, just return it." 5876 (if (stringp face-or-color) 5877 (list :inherit inherit 5878 (cdr (assoc context org-faces-easy-properties)) 5879 face-or-color) 5880 face-or-color)) 5881 5882 (defun org-get-todo-face (kwd) 5883 "Get the right face for a TODO keyword KWD. 5884 If KWD is a number, get the corresponding match group." 5885 (when (numberp kwd) (setq kwd (match-string kwd))) 5886 (or (org-face-from-face-or-color 5887 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces))) 5888 (and (member kwd org-done-keywords) 'org-done) 5889 'org-todo)) 5890 5891 (defun org-get-priority-face (priority) 5892 "Get the right face for PRIORITY. 5893 PRIORITY is a character." 5894 (or (org-face-from-face-or-color 5895 'priority 'org-priority (cdr (assq priority org-priority-faces))) 5896 'org-priority)) 5897 5898 (defun org-get-tag-face (tag) 5899 "Get the right face for TAG. 5900 If TAG is a number, get the corresponding match group." 5901 (let ((tag (if (wholenump tag) (match-string tag) tag))) 5902 (or (org-face-from-face-or-color 5903 'tag 'org-tag (cdr (assoc tag org-tag-faces))) 5904 'org-tag))) 5905 5906 (defvar org-priority-regexp) ; defined later in the file 5907 5908 (defun org-font-lock-add-priority-faces (limit) 5909 "Add the special priority faces." 5910 (while (re-search-forward (concat "^\\*+" org-priority-regexp) limit t) 5911 (let ((beg (match-beginning 1)) 5912 (end (1+ (match-end 2)))) 5913 (add-face-text-property 5914 beg end 5915 (org-get-priority-face (string-to-char (match-string 2)))) 5916 (add-text-properties 5917 beg end 5918 (list 'font-lock-fontified t))))) 5919 5920 (defun org-font-lock-add-tag-faces (limit) 5921 "Add the special tag faces." 5922 (when (and org-tag-faces org-tags-special-faces-re) 5923 (while (re-search-forward org-tags-special-faces-re limit t) 5924 (add-face-text-property 5925 (match-beginning 1) 5926 (match-end 1) 5927 (org-get-tag-face 1)) 5928 (add-text-properties (match-beginning 1) (match-end 1) 5929 (list 'font-lock-fontified t)) 5930 (backward-char 1)))) 5931 5932 (defun org-unfontify-region (beg end &optional _maybe_loudly) 5933 "Remove fontification and activation overlays from links." 5934 (font-lock-default-unfontify-region beg end) 5935 (let* ((buffer-undo-list t) 5936 (inhibit-read-only t) (inhibit-point-motion-hooks t) 5937 (inhibit-modification-hooks t) 5938 deactivate-mark buffer-file-name buffer-file-truename) 5939 (decompose-region beg end) 5940 (remove-text-properties beg end 5941 '(mouse-face t keymap t org-linked-text t 5942 invisible t intangible t 5943 org-emphasis t)) 5944 (org-remove-font-lock-display-properties beg end))) 5945 5946 (defconst org-script-display '(((raise -0.3) (height 0.7)) 5947 ((raise 0.3) (height 0.7)) 5948 ((raise -0.5)) 5949 ((raise 0.5))) 5950 "Display properties for showing superscripts and subscripts.") 5951 5952 (defun org-remove-font-lock-display-properties (beg end) 5953 "Remove specific display properties that have been added by font lock. 5954 The will remove the raise properties that are used to show superscripts 5955 and subscripts." 5956 (let (next prop) 5957 (while (< beg end) 5958 (setq next (next-single-property-change beg 'display nil end) 5959 prop (get-text-property beg 'display)) 5960 (when (member prop org-script-display) 5961 (put-text-property beg next 'display nil)) 5962 (setq beg next)))) 5963 5964 (defun org-raise-scripts (limit) 5965 "Add raise properties to sub/superscripts." 5966 (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts 5967 (re-search-forward 5968 (if (eq org-use-sub-superscripts t) 5969 org-match-substring-regexp 5970 org-match-substring-with-braces-regexp) 5971 limit t)) 5972 (let* ((pos (point)) table-p comment-p 5973 (mpos (match-beginning 3)) 5974 (emph-p (get-text-property mpos 'org-emphasis)) 5975 (link-p (get-text-property mpos 'mouse-face)) 5976 (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) 5977 (goto-char (point-at-bol)) 5978 (setq table-p (looking-at-p org-table-dataline-regexp) 5979 comment-p (looking-at-p "^[ \t]*#[ +]")) 5980 (goto-char pos) 5981 ;; Handle a_b^c 5982 (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) 5983 (unless (or comment-p emph-p link-p keyw-p) 5984 (put-text-property (match-beginning 3) (match-end 0) 5985 'display 5986 (if (equal (char-after (match-beginning 2)) ?^) 5987 (nth (if table-p 3 1) org-script-display) 5988 (nth (if table-p 2 0) org-script-display))) 5989 (add-text-properties (match-beginning 2) (match-end 2) 5990 (list 'invisible t)) 5991 (when (and (eq (char-after (match-beginning 3)) ?{) 5992 (eq (char-before (match-end 3)) ?})) 5993 (add-text-properties (match-beginning 3) (1+ (match-beginning 3)) 5994 (list 'invisible t)) 5995 (add-text-properties (1- (match-end 3)) (match-end 3) 5996 (list 'invisible t)))) 5997 t))) 5998 5999 (defun org-remove-empty-overlays-at (pos) 6000 "Remove outline overlays that do not contain non-white stuff." 6001 (dolist (o (overlays-at pos)) 6002 (and (eq 'outline (overlay-get o 'invisible)) 6003 (not (string-match-p 6004 "\\S-" (buffer-substring (overlay-start o) 6005 (overlay-end o)))) 6006 (delete-overlay o)))) 6007 6008 (defun org-show-empty-lines-in-parent () 6009 "Move to the parent and re-show empty lines before visible headlines." 6010 (save-excursion 6011 (let ((context (if (org-up-heading-safe) 'children 'overview))) 6012 (org-cycle-show-empty-lines context)))) 6013 6014 (defun org-files-list () 6015 "Return `org-agenda-files' list, plus all open Org files. 6016 This is useful for operations that need to scan all of a user's 6017 open and agenda-wise Org files." 6018 (let ((files (mapcar #'expand-file-name (org-agenda-files)))) 6019 (dolist (buf (buffer-list)) 6020 (with-current-buffer buf 6021 (when (and (derived-mode-p 'org-mode) (buffer-file-name)) 6022 (cl-pushnew (expand-file-name (buffer-file-name)) files 6023 :test #'equal)))) 6024 files)) 6025 6026 (defsubst org-entry-beginning-position () 6027 "Return the beginning position of the current entry." 6028 (save-excursion (org-back-to-heading t) (point))) 6029 6030 (defsubst org-entry-end-position () 6031 "Return the end position of the current entry." 6032 (save-excursion (outline-next-heading) (point))) 6033 6034 (defun org-subtree-end-visible-p () 6035 "Is the end of the current subtree visible?" 6036 (pos-visible-in-window-p 6037 (save-excursion (org-end-of-subtree t) (point)))) 6038 6039 (defun org-first-headline-recenter () 6040 "Move cursor to the first headline and recenter the headline." 6041 (let ((window (get-buffer-window))) 6042 (when window 6043 (goto-char (point-min)) 6044 (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t) 6045 (set-window-start window (line-beginning-position)))))) 6046 6047 6048 ;;; Visibility (headlines, blocks, drawers) 6049 6050 ;;;; Headlines visibility 6051 6052 (defun org-show-entry () 6053 "Show the body directly following its heading. 6054 Show the heading too, if it is currently invisible." 6055 (interactive) 6056 (save-excursion 6057 (org-back-to-heading-or-point-min t) 6058 (org-flag-region 6059 (line-end-position 0) 6060 (save-excursion 6061 (if (re-search-forward 6062 (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) 6063 (match-beginning 1) 6064 (point-max))) 6065 nil 6066 'outline) 6067 (org-cycle-hide-drawers 'children))) 6068 6069 (defun org-hide-entry () 6070 "Hide the body directly following its heading." 6071 (interactive) 6072 (save-excursion 6073 (org-back-to-heading-or-point-min t) 6074 (when (org-at-heading-p) (forward-line)) 6075 (org-flag-region 6076 (line-end-position 0) 6077 (save-excursion 6078 (if (re-search-forward 6079 (concat "[\r\n]" org-outline-regexp) nil t) 6080 (line-end-position 0) 6081 (point-max))) 6082 t 6083 'outline))) 6084 6085 (defun org-show-children (&optional level) 6086 "Show all direct subheadings of this heading. 6087 Prefix arg LEVEL is how many levels below the current level 6088 should be shown. Default is enough to cause the following 6089 heading to appear." 6090 (interactive "p") 6091 (unless (org-before-first-heading-p) 6092 (save-excursion 6093 (org-with-limited-levels (org-back-to-heading t)) 6094 (let* ((current-level (funcall outline-level)) 6095 (max-level (org-get-valid-level 6096 current-level 6097 (if level (prefix-numeric-value level) 1))) 6098 (end (save-excursion (org-end-of-subtree t t))) 6099 (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") 6100 (past-first-child nil) 6101 ;; Make sure to skip inlinetasks. 6102 (re (format regexp-fmt 6103 current-level 6104 (cond 6105 ((not (featurep 'org-inlinetask)) "") 6106 (org-odd-levels-only (- (* 2 org-inlinetask-min-level) 6107 3)) 6108 (t (1- org-inlinetask-min-level)))))) 6109 ;; Display parent heading. 6110 (org-flag-heading nil) 6111 (forward-line) 6112 ;; Display children. First child may be deeper than expected 6113 ;; MAX-LEVEL. Since we want to display it anyway, adjust 6114 ;; MAX-LEVEL accordingly. 6115 (while (re-search-forward re end t) 6116 (unless past-first-child 6117 (setq re (format regexp-fmt 6118 current-level 6119 (max (funcall outline-level) max-level))) 6120 (setq past-first-child t)) 6121 (org-flag-heading nil)))))) 6122 6123 (defun org-show-subtree () 6124 "Show everything after this heading at deeper levels." 6125 (interactive) 6126 (org-flag-region 6127 (point) (save-excursion (org-end-of-subtree t t)) nil 'outline)) 6128 6129 ;;;; Blocks and drawers visibility 6130 6131 (defun org--hide-wrapper-toggle (element category force no-error) 6132 "Toggle visibility for ELEMENT. 6133 6134 ELEMENT is a block or drawer type parsed element. CATEGORY is 6135 either `block' or `drawer'. When FORCE is `off', show the block 6136 or drawer. If it is non-nil, hide it unconditionally. Throw an 6137 error when not at a block or drawer, unless NO-ERROR is non-nil. 6138 6139 Return a non-nil value when toggling is successful." 6140 (let ((type (org-element-type element))) 6141 (cond 6142 ((memq type 6143 (pcase category 6144 (`drawer '(drawer property-drawer)) 6145 (`block '(center-block 6146 comment-block dynamic-block example-block export-block 6147 quote-block special-block src-block verse-block)) 6148 (_ (error "Unknown category: %S" category)))) 6149 (let* ((post (org-element-property :post-affiliated element)) 6150 (start (save-excursion 6151 (goto-char post) 6152 (line-end-position))) 6153 (end (save-excursion 6154 (goto-char (org-element-property :end element)) 6155 (skip-chars-backward " \t\n") 6156 (line-end-position)))) 6157 ;; Do nothing when not before or at the block opening line or 6158 ;; at the block closing line. 6159 (unless (let ((eol (line-end-position))) 6160 (and (> eol start) (/= eol end))) 6161 (let* ((spec (if (eq category 'block) 'org-hide-block 'outline)) 6162 (flag 6163 (cond ((eq force 'off) nil) 6164 (force t) 6165 ((eq spec (get-char-property start 'invisible)) nil) 6166 (t t)))) 6167 (org-flag-region start end flag spec)) 6168 ;; When the block is hidden away, make sure point is left in 6169 ;; a visible part of the buffer. 6170 (when (invisible-p (max (1- (point)) (point-min))) 6171 (goto-char post)) 6172 ;; Signal success. 6173 t))) 6174 (no-error nil) 6175 (t 6176 (user-error (if (eq category 'drawer) 6177 "Not at a drawer" 6178 "Not at a block")))))) 6179 6180 (defun org-hide-block-toggle (&optional force no-error element) 6181 "Toggle the visibility of the current block. 6182 6183 When optional argument FORCE is `off', make block visible. If it 6184 is non-nil, hide it unconditionally. Throw an error when not at 6185 a block, unless NO-ERROR is non-nil. When optional argument 6186 ELEMENT is provided, consider it instead of the current block. 6187 6188 Return a non-nil value when toggling is successful." 6189 (interactive) 6190 (org--hide-wrapper-toggle 6191 (or element (org-element-at-point)) 'block force no-error)) 6192 6193 (defun org-hide-drawer-toggle (&optional force no-error element) 6194 "Toggle the visibility of the current drawer. 6195 6196 When optional argument FORCE is `off', make drawer visible. If 6197 it is non-nil, hide it unconditionally. Throw an error when not 6198 at a drawer, unless NO-ERROR is non-nil. When optional argument 6199 ELEMENT is provided, consider it instead of the current drawer. 6200 6201 Return a non-nil value when toggling is successful." 6202 (interactive) 6203 (org--hide-wrapper-toggle 6204 (or element (org-element-at-point)) 'drawer force no-error)) 6205 6206 (defun org-hide-block-all () 6207 "Fold all blocks in the current buffer." 6208 (interactive) 6209 (org-show-all '(blocks)) 6210 (org-block-map 'org-hide-block-toggle)) 6211 6212 (defun org-hide-drawer-all () 6213 "Fold all drawers in the current buffer." 6214 (let ((begin (point-min)) 6215 (end (point-max))) 6216 (org--hide-drawers begin end))) 6217 6218 (defun org-cycle-hide-drawers (state) 6219 "Re-hide all drawers after a visibility state change. 6220 STATE should be one of the symbols listed in the docstring of 6221 `org-cycle-hook'." 6222 (when (derived-mode-p 'org-mode) 6223 (cond ((not (memq state '(overview folded contents))) 6224 (let* ((global? (eq state 'all)) 6225 (beg (if global? (point-min) (line-beginning-position))) 6226 (end (cond (global? (point-max)) 6227 ((eq state 'children) (org-entry-end-position)) 6228 (t (save-excursion (org-end-of-subtree t t)))))) 6229 (org--hide-drawers beg end))) 6230 ((memq state '(overview contents)) 6231 ;; Hide drawers before first heading. 6232 (let ((beg (point-min)) 6233 (end (save-excursion 6234 (goto-char (point-min)) 6235 (if (org-before-first-heading-p) 6236 (org-entry-end-position) 6237 (point-min))))) 6238 (when (< beg end) 6239 (org--hide-drawers beg end))))))) 6240 6241 (defun org--hide-drawers (begin end) 6242 "Hide all drawers between BEGIN and END." 6243 (save-excursion 6244 (goto-char begin) 6245 (while (re-search-forward org-drawer-regexp end t) 6246 (let* ((pair (get-char-property-and-overlay (line-beginning-position) 6247 'invisible)) 6248 (o (cdr-safe pair))) 6249 (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer 6250 (pcase (get-char-property-and-overlay (point) 'invisible) 6251 (`(outline . ,o) (goto-char (overlay-end o))) ;already folded 6252 (_ 6253 (let* ((drawer (org-element-at-point)) 6254 (type (org-element-type drawer))) 6255 (when (memq type '(drawer property-drawer)) 6256 (org-hide-drawer-toggle t nil drawer) 6257 ;; Make sure to skip drawer entirely or we might flag it 6258 ;; another time when matching its ending line with 6259 ;; `org-drawer-regexp'. 6260 (goto-char (org-element-property :end drawer))))))))))) 6261 6262 ;;;; Visibility cycling 6263 6264 (defvar-local org-cycle-global-status nil) 6265 (put 'org-cycle-global-status 'org-state t) 6266 (defvar-local org-cycle-subtree-status nil) 6267 (put 'org-cycle-subtree-status 'org-state t) 6268 6269 (defun org-show-all (&optional types) 6270 "Show all contents in the visible part of the buffer. 6271 By default, the function expands headings, blocks and drawers. 6272 When optional argument TYPE is a list of symbols among `blocks', 6273 `drawers' and `headings', to only expand one specific type." 6274 (interactive) 6275 (let ((types (or types '(blocks drawers headings)))) 6276 (when (memq 'blocks types) 6277 (org-flag-region (point-min) (point-max) nil 'org-hide-block)) 6278 (cond 6279 ;; Fast path. Since headings and drawers share the same 6280 ;; invisible spec, clear everything in one go. 6281 ((and (memq 'headings types) 6282 (memq 'drawers types)) 6283 (org-flag-region (point-min) (point-max) nil 'outline)) 6284 ((memq 'headings types) 6285 (org-flag-region (point-min) (point-max) nil 'outline) 6286 (org-cycle-hide-drawers 'all)) 6287 ((memq 'drawers types) 6288 (save-excursion 6289 (goto-char (point-min)) 6290 (while (re-search-forward org-drawer-regexp nil t) 6291 (let* ((pair (get-char-property-and-overlay (line-beginning-position) 6292 'invisible)) 6293 (o (cdr-safe pair))) 6294 (if (overlayp o) (goto-char (overlay-end o)) 6295 (pcase (get-char-property-and-overlay (point) 'invisible) 6296 (`(outline . ,o) 6297 (goto-char (overlay-end o)) 6298 (delete-overlay o)) 6299 (_ nil)))))))))) 6300 6301 ;;;###autoload 6302 (defun org-cycle (&optional arg) 6303 "TAB-action and visibility cycling for Org mode. 6304 6305 This is the command invoked in Org mode by the `TAB' key. Its main 6306 purpose is outline visibility cycling, but it also invokes other actions 6307 in special contexts. 6308 6309 When this function is called with a `\\[universal-argument]' prefix, rotate \ 6310 the entire 6311 buffer through 3 states (global cycling) 6312 1. OVERVIEW: Show only top-level headlines. 6313 2. CONTENTS: Show all headlines of all levels, but no body text. 6314 3. SHOW ALL: Show everything. 6315 6316 With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ 6317 switch to the startup visibility, 6318 determined by the variable `org-startup-folded', and by any VISIBILITY 6319 properties in the buffer. 6320 6321 With a `\\[universal-argument] \\[universal-argument] \ 6322 \\[universal-argument]' prefix argument, show the entire buffer, including 6323 any drawers. 6324 6325 When inside a table, re-align the table and move to the next field. 6326 6327 When point is at the beginning of a headline, rotate the subtree started 6328 by this line through 3 different states (local cycling) 6329 1. FOLDED: Only the main headline is shown. 6330 2. CHILDREN: The main headline and the direct children are shown. 6331 From this state, you can move to one of the children 6332 and zoom in further. 6333 3. SUBTREE: Show the entire subtree, including body text. 6334 If there is no subtree, switch directly from CHILDREN to FOLDED. 6335 6336 When point is at the beginning of an empty headline and the variable 6337 `org-cycle-level-after-item/entry-creation' is set, cycle the level 6338 of the headline by demoting and promoting it to likely levels. This 6339 speeds up creation document structure by pressing `TAB' once or several 6340 times right after creating a new headline. 6341 6342 When there is a numeric prefix, go up to a heading with level ARG, do 6343 a `show-subtree' and return to the previous cursor position. If ARG 6344 is negative, go up that many levels. 6345 6346 When point is not at the beginning of a headline, execute the global 6347 binding for `TAB', which is re-indenting the line. See the option 6348 `org-cycle-emulate-tab' for details. 6349 6350 As a special case, if point is at the very beginning of the buffer, if 6351 there is no headline there, and if the variable `org-cycle-global-at-bob' 6352 is non-nil, this function acts as if called with prefix argument \ 6353 \(`\\[universal-argument] TAB', 6354 same as `S-TAB') also when called without prefix argument." 6355 (interactive "P") 6356 (org-load-modules-maybe) 6357 (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) 6358 (and org-cycle-level-after-item/entry-creation 6359 (or (org-cycle-level) 6360 (org-cycle-item-indentation)))) 6361 (let* ((limit-level 6362 (or org-cycle-max-level 6363 (and (boundp 'org-inlinetask-min-level) 6364 org-inlinetask-min-level 6365 (1- org-inlinetask-min-level)))) 6366 (nstars 6367 (and limit-level 6368 (if org-odd-levels-only 6369 (1- (* 2 limit-level)) 6370 limit-level))) 6371 (org-outline-regexp 6372 (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+")))) 6373 (cond 6374 ((equal arg '(16)) 6375 (setq last-command 'dummy) 6376 (org-set-startup-visibility) 6377 (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) 6378 ((equal arg '(64)) 6379 (org-show-all) 6380 (org-unlogged-message "Entire buffer visible, including drawers")) 6381 ((equal arg '(4)) (org-cycle-internal-global)) 6382 ;; Show-subtree, ARG levels up from here. 6383 ((integerp arg) 6384 (save-excursion 6385 (org-back-to-heading) 6386 (outline-up-heading (if (< arg 0) (- arg) 6387 (- (funcall outline-level) arg))) 6388 (org-show-subtree))) 6389 ;; Global cycling at BOB: delegate to `org-cycle-internal-global'. 6390 ((and org-cycle-global-at-bob 6391 (bobp) 6392 (not (looking-at org-outline-regexp))) 6393 (let ((org-cycle-hook 6394 (remq 'org-optimize-window-after-visibility-change 6395 org-cycle-hook))) 6396 (org-cycle-internal-global))) 6397 ;; Try CDLaTeX TAB completion. 6398 ((org-try-cdlatex-tab)) 6399 ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. 6400 ((and (featurep 'org-inlinetask) 6401 (org-inlinetask-at-task-p) 6402 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) 6403 (org-inlinetask-toggle-visibility)) 6404 (t 6405 (let ((pos (point)) 6406 (element (org-element-at-point))) 6407 (cond 6408 ;; Try toggling visibility for block at point. 6409 ((org-hide-block-toggle nil t element)) 6410 ;; Try toggling visibility for drawer at point. 6411 ((org-hide-drawer-toggle nil t element)) 6412 ;; Table: enter it or move to the next field. 6413 ((and (org-match-line "[ \t]*[|+]") 6414 (org-element-lineage element '(table) t)) 6415 (if (and (eq 'table (org-element-type element)) 6416 (eq 'table.el (org-element-property :type element))) 6417 (message (substitute-command-keys "\\<org-mode-map>\ 6418 Use `\\[org-edit-special]' to edit table.el tables")) 6419 (org-table-justify-field-maybe) 6420 (call-interactively #'org-table-next-field))) 6421 ((run-hook-with-args-until-success 6422 'org-tab-after-check-for-table-hook)) 6423 ;; At an item/headline: delegate to `org-cycle-internal-local'. 6424 ((and (or (and org-cycle-include-plain-lists 6425 (let ((item (org-element-lineage element 6426 '(item plain-list) 6427 t))) 6428 (and item 6429 (= (line-beginning-position) 6430 (org-element-property :post-affiliated 6431 item))))) 6432 (org-match-line org-outline-regexp)) 6433 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) 6434 (org-cycle-internal-local)) 6435 ;; From there: TAB emulation and template completion. 6436 (buffer-read-only (org-back-to-heading)) 6437 ((run-hook-with-args-until-success 6438 'org-tab-after-check-for-cycling-hook)) 6439 ((run-hook-with-args-until-success 6440 'org-tab-before-tab-emulation-hook)) 6441 ((and (eq org-cycle-emulate-tab 'exc-hl-bol) 6442 (or (not (bolp)) 6443 (not (looking-at org-outline-regexp)))) 6444 (call-interactively (global-key-binding (kbd "TAB")))) 6445 ((or (eq org-cycle-emulate-tab t) 6446 (and (memq org-cycle-emulate-tab '(white whitestart)) 6447 (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) 6448 (or (and (eq org-cycle-emulate-tab 'white) 6449 (= (match-end 0) (point-at-eol))) 6450 (and (eq org-cycle-emulate-tab 'whitestart) 6451 (>= (match-end 0) pos))))) 6452 (call-interactively (global-key-binding (kbd "TAB")))) 6453 (t 6454 (save-excursion 6455 (org-back-to-heading) 6456 (org-cycle)))))))))) 6457 6458 (defun org-cycle-internal-global () 6459 "Do the global cycling action." 6460 ;; Hack to avoid display of messages for .org attachments in Gnus 6461 (let ((ga (string-match-p "\\*fontification" (buffer-name)))) 6462 (cond 6463 ((and (eq last-command this-command) 6464 (eq org-cycle-global-status 'overview)) 6465 ;; We just created the overview - now do table of contents 6466 ;; This can be slow in very large buffers, so indicate action 6467 (run-hook-with-args 'org-pre-cycle-hook 'contents) 6468 (unless ga (org-unlogged-message "CONTENTS...")) 6469 (org-content) 6470 (unless ga (org-unlogged-message "CONTENTS...done")) 6471 (setq org-cycle-global-status 'contents) 6472 (run-hook-with-args 'org-cycle-hook 'contents)) 6473 6474 ((and (eq last-command this-command) 6475 (eq org-cycle-global-status 'contents)) 6476 ;; We just showed the table of contents - now show everything 6477 (run-hook-with-args 'org-pre-cycle-hook 'all) 6478 (org-show-all '(headings blocks)) 6479 (unless ga (org-unlogged-message "SHOW ALL")) 6480 (setq org-cycle-global-status 'all) 6481 (run-hook-with-args 'org-cycle-hook 'all)) 6482 6483 (t 6484 ;; Default action: go to overview 6485 (run-hook-with-args 'org-pre-cycle-hook 'overview) 6486 (org-overview) 6487 (unless ga (org-unlogged-message "OVERVIEW")) 6488 (setq org-cycle-global-status 'overview) 6489 (run-hook-with-args 'org-cycle-hook 'overview))))) 6490 6491 (defvar org-called-with-limited-levels nil 6492 "Non-nil when `org-with-limited-levels' is currently active.") 6493 6494 (defun org-cycle-internal-local () 6495 "Do the local cycling action." 6496 (let ((goal-column 0) eoh eol eos has-children children-skipped struct) 6497 ;; First, determine end of headline (EOH), end of subtree or item 6498 ;; (EOS), and if item or heading has children (HAS-CHILDREN). 6499 (save-excursion 6500 (if (org-at-item-p) 6501 (progn 6502 (beginning-of-line) 6503 (setq struct (org-list-struct)) 6504 (setq eoh (point-at-eol)) 6505 (setq eos (org-list-get-item-end-before-blank (point) struct)) 6506 (setq has-children (org-list-has-child-p (point) struct))) 6507 (org-back-to-heading) 6508 (setq eoh (save-excursion (outline-end-of-heading) (point))) 6509 (setq eos (save-excursion 6510 (org-end-of-subtree t t) 6511 (unless (eobp) (forward-char -1)) 6512 (point))) 6513 (setq has-children 6514 (or 6515 (save-excursion 6516 (let ((level (funcall outline-level))) 6517 (outline-next-heading) 6518 (and (org-at-heading-p t) 6519 (> (funcall outline-level) level)))) 6520 (and (eq org-cycle-include-plain-lists 'integrate) 6521 (save-excursion 6522 (org-list-search-forward (org-item-beginning-re) eos t)))))) 6523 ;; Determine end invisible part of buffer (EOL) 6524 (beginning-of-line 2) 6525 (while (and (not (eobp)) ;this is like `next-line' 6526 (get-char-property (1- (point)) 'invisible)) 6527 (goto-char (next-single-char-property-change (point) 'invisible)) 6528 (and (eolp) (beginning-of-line 2))) 6529 (setq eol (point))) 6530 ;; Find out what to do next and set `this-command' 6531 (cond 6532 ((= eos eoh) 6533 ;; Nothing is hidden behind this heading 6534 (unless (org-before-first-heading-p) 6535 (run-hook-with-args 'org-pre-cycle-hook 'empty)) 6536 (org-unlogged-message "EMPTY ENTRY") 6537 (setq org-cycle-subtree-status nil) 6538 (save-excursion 6539 (goto-char eos) 6540 (outline-next-heading) 6541 (when (org-invisible-p) (org-flag-heading nil)))) 6542 ((and (or (>= eol eos) 6543 (not (string-match "\\S-" (buffer-substring eol eos)))) 6544 (or has-children 6545 (not (setq children-skipped 6546 org-cycle-skip-children-state-if-no-children)))) 6547 ;; Entire subtree is hidden in one line: children view 6548 (unless (org-before-first-heading-p) 6549 (run-hook-with-args 'org-pre-cycle-hook 'children)) 6550 (if (org-at-item-p) 6551 (org-list-set-item-visibility (point-at-bol) struct 'children) 6552 (org-show-entry) 6553 (org-with-limited-levels (org-show-children)) 6554 (org-show-set-visibility 'tree) 6555 ;; Fold every list in subtree to top-level items. 6556 (when (eq org-cycle-include-plain-lists 'integrate) 6557 (save-excursion 6558 (org-back-to-heading) 6559 (while (org-list-search-forward (org-item-beginning-re) eos t) 6560 (beginning-of-line 1) 6561 (let* ((struct (org-list-struct)) 6562 (prevs (org-list-prevs-alist struct)) 6563 (end (org-list-get-bottom-point struct))) 6564 (dolist (e (org-list-get-all-items (point) struct prevs)) 6565 (org-list-set-item-visibility e struct 'folded)) 6566 (goto-char (if (< end eos) end eos))))))) 6567 (org-unlogged-message "CHILDREN") 6568 (save-excursion 6569 (goto-char eos) 6570 (outline-next-heading) 6571 (when (org-invisible-p) (org-flag-heading nil))) 6572 (setq org-cycle-subtree-status 'children) 6573 (unless (org-before-first-heading-p) 6574 (run-hook-with-args 'org-cycle-hook 'children))) 6575 ((or children-skipped 6576 (and (eq last-command this-command) 6577 (eq org-cycle-subtree-status 'children))) 6578 ;; We just showed the children, or no children are there, 6579 ;; now show everything. 6580 (unless (org-before-first-heading-p) 6581 (run-hook-with-args 'org-pre-cycle-hook 'subtree)) 6582 (org-flag-region eoh eos nil 'outline) 6583 (org-unlogged-message 6584 (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) 6585 (setq org-cycle-subtree-status 'subtree) 6586 (unless (org-before-first-heading-p) 6587 (run-hook-with-args 'org-cycle-hook 'subtree))) 6588 (t 6589 ;; Default action: hide the subtree. 6590 (run-hook-with-args 'org-pre-cycle-hook 'folded) 6591 (org-flag-region eoh eos t 'outline) 6592 (org-unlogged-message "FOLDED") 6593 (setq org-cycle-subtree-status 'folded) 6594 (unless (org-before-first-heading-p) 6595 (run-hook-with-args 'org-cycle-hook 'folded)))))) 6596 6597 ;;;###autoload 6598 (defun org-global-cycle (&optional arg) 6599 "Cycle the global visibility. For details see `org-cycle'. 6600 With `\\[universal-argument]' prefix ARG, switch to startup visibility. 6601 With a numeric prefix, show all headlines up to that level." 6602 (interactive "P") 6603 (cond 6604 ((integerp arg) 6605 (org-content arg) 6606 (setq org-cycle-global-status 'contents)) 6607 ((equal arg '(4)) 6608 (org-set-startup-visibility) 6609 (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) 6610 (t 6611 (org-cycle '(4))))) 6612 6613 (defun org-set-startup-visibility () 6614 "Set the visibility required by startup options and properties." 6615 (cond 6616 ((eq org-startup-folded t) 6617 (org-overview)) 6618 ((eq org-startup-folded 'content) 6619 (org-content)) 6620 ((eq org-startup-folded 'show2levels) 6621 (org-content 2)) 6622 ((eq org-startup-folded 'show3levels) 6623 (org-content 3)) 6624 ((eq org-startup-folded 'show4levels) 6625 (org-content 4)) 6626 ((eq org-startup-folded 'show5levels) 6627 (org-content 5)) 6628 ((or (eq org-startup-folded 'showeverything) 6629 (eq org-startup-folded nil)) 6630 (org-show-all))) 6631 (unless (eq org-startup-folded 'showeverything) 6632 (when org-hide-block-startup (org-hide-block-all)) 6633 (org-set-visibility-according-to-property) 6634 (org-cycle-hide-archived-subtrees 'all) 6635 (org-cycle-hide-drawers 'all) 6636 (org-cycle-show-empty-lines t))) 6637 6638 (defun org-set-visibility-according-to-property () 6639 "Switch subtree visibility according to VISIBILITY property." 6640 (interactive) 6641 (let ((regexp (org-re-property "VISIBILITY"))) 6642 (org-with-point-at 1 6643 (while (re-search-forward regexp nil t) 6644 (let ((state (match-string 3))) 6645 (if (not (org-at-property-p)) (outline-next-heading) 6646 (save-excursion 6647 (org-back-to-heading t) 6648 (org-flag-subtree t) 6649 (org-reveal) 6650 (pcase state 6651 ("folded" 6652 (org-flag-subtree t)) 6653 ("children" 6654 (org-show-hidden-entry) 6655 (org-show-children)) 6656 ("content" 6657 (save-excursion 6658 (save-restriction 6659 (org-narrow-to-subtree) 6660 (org-content)))) 6661 ((or "all" "showall") 6662 (outline-show-subtree)) 6663 (_ nil))) 6664 (org-end-of-subtree))))))) 6665 6666 (defun org-overview () 6667 "Switch to overview mode, showing only top-level headlines." 6668 (interactive) 6669 (org-show-all '(headings drawers)) 6670 (save-excursion 6671 (goto-char (point-min)) 6672 (when (re-search-forward org-outline-regexp-bol nil t) 6673 (let* ((last (line-end-position)) 6674 (level (- (match-end 0) (match-beginning 0) 1)) 6675 (regexp (format "^\\*\\{1,%d\\} " level))) 6676 (while (re-search-forward regexp nil :move) 6677 (org-flag-region last (line-end-position 0) t 'outline) 6678 (setq last (line-end-position)) 6679 (setq level (- (match-end 0) (match-beginning 0) 1)) 6680 (setq regexp (format "^\\*\\{1,%d\\} " level))) 6681 (org-flag-region last (point) t 'outline))))) 6682 6683 (defun org-content (&optional arg) 6684 "Show all headlines in the buffer, like a table of contents. 6685 With numerical argument N, show content up to level N." 6686 (interactive "p") 6687 (org-show-all '(headings drawers)) 6688 (save-excursion 6689 (goto-char (point-max)) 6690 (let ((regexp (if (and (wholenump arg) (> arg 0)) 6691 (format "^\\*\\{1,%d\\} " arg) 6692 "^\\*+ ")) 6693 (last (point))) 6694 (while (re-search-backward regexp nil t) 6695 (org-flag-region (line-end-position) last t 'outline) 6696 (setq last (line-end-position 0)))))) 6697 6698 (defvar org-scroll-position-to-restore nil 6699 "Temporarily store scroll position to restore.") 6700 (defun org-optimize-window-after-visibility-change (state) 6701 "Adjust the window after a change in outline visibility. 6702 This function is the default value of the hook `org-cycle-hook'." 6703 (when (get-buffer-window (current-buffer)) 6704 (let ((repeat (eq last-command this-command))) 6705 (unless repeat 6706 (setq org-scroll-position-to-restore nil)) 6707 (cond 6708 ((eq state 'content) nil) 6709 ((eq state 'all) nil) 6710 ((and org-scroll-position-to-restore repeat 6711 (eq state 'folded)) 6712 (set-window-start nil org-scroll-position-to-restore)) 6713 ((eq state 'folded) nil) 6714 ((eq state 'children) 6715 (setq org-scroll-position-to-restore (window-start)) 6716 (or (org-subtree-end-visible-p) (recenter 1))) 6717 ((eq state 'subtree) 6718 (unless repeat 6719 (setq org-scroll-position-to-restore (window-start))) 6720 (or (org-subtree-end-visible-p) (recenter 1))))))) 6721 6722 (defun org-clean-visibility-after-subtree-move () 6723 "Fix visibility issues after moving a subtree." 6724 ;; First, find a reasonable region to look at: 6725 ;; Start two siblings above, end three below 6726 (let* ((beg (save-excursion 6727 (and (org-get-previous-sibling) 6728 (org-get-previous-sibling)) 6729 (point))) 6730 (end (save-excursion 6731 (and (org-get-next-sibling) 6732 (org-get-next-sibling) 6733 (org-get-next-sibling)) 6734 (if (org-at-heading-p) 6735 (point-at-eol) 6736 (point)))) 6737 (level (looking-at "\\*+")) 6738 (re (when level (concat "^" (regexp-quote (match-string 0)) " ")))) 6739 (save-excursion 6740 (save-restriction 6741 (narrow-to-region beg end) 6742 (when re 6743 ;; Properly fold already folded siblings 6744 (goto-char (point-min)) 6745 (while (re-search-forward re nil t) 6746 (when (and (not (org-invisible-p)) 6747 (org-invisible-p (line-end-position))) 6748 (outline-hide-entry)))) 6749 (org-cycle-hide-drawers 'all) 6750 (org-cycle-show-empty-lines 'overview))))) 6751 6752 (defun org-cycle-show-empty-lines (state) 6753 "Show empty lines above all visible headlines. 6754 The region to be covered depends on STATE when called through 6755 `org-cycle-hook'. Lisp program can use t for STATE to get the 6756 entire buffer covered. Note that an empty line is only shown if there 6757 are at least `org-cycle-separator-lines' empty lines before the headline." 6758 (when (/= org-cycle-separator-lines 0) 6759 (save-excursion 6760 (let* ((n (abs org-cycle-separator-lines)) 6761 (re (cond 6762 ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") 6763 ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") 6764 (t (let ((ns (number-to-string (- n 2)))) 6765 (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" 6766 "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) 6767 beg end) 6768 (cond 6769 ((memq state '(overview contents t)) 6770 (setq beg (point-min) end (point-max))) 6771 ((memq state '(children folded)) 6772 (setq beg (point) 6773 end (progn (org-end-of-subtree t t) 6774 (line-beginning-position 2))))) 6775 (when beg 6776 (goto-char beg) 6777 (while (re-search-forward re end t) 6778 (unless (get-char-property (match-end 1) 'invisible) 6779 (let ((e (match-end 1)) 6780 (b (if (>= org-cycle-separator-lines 0) 6781 (match-beginning 1) 6782 (save-excursion 6783 (goto-char (match-beginning 0)) 6784 (skip-chars-backward " \t\n") 6785 (line-end-position))))) 6786 (org-flag-region b e nil 'outline)))))))) 6787 ;; Never hide empty lines at the end of the file. 6788 (save-excursion 6789 (goto-char (point-max)) 6790 (outline-previous-heading) 6791 (outline-end-of-heading) 6792 (when (and (looking-at "[ \t\n]+") 6793 (= (match-end 0) (point-max))) 6794 (org-flag-region (point) (match-end 0) nil 'outline)))) 6795 6796 ;;;; Reveal point location 6797 6798 (defun org-show-context (&optional key) 6799 "Make sure point and context are visible. 6800 Optional argument KEY, when non-nil, is a symbol. See 6801 `org-show-context-detail' for allowed values and how much is to 6802 be shown." 6803 (org-show-set-visibility 6804 (cond ((symbolp org-show-context-detail) org-show-context-detail) 6805 ((cdr (assq key org-show-context-detail))) 6806 (t (cdr (assq 'default org-show-context-detail)))))) 6807 6808 (defun org-show-set-visibility (detail) 6809 "Set visibility around point according to DETAIL. 6810 DETAIL is either nil, `minimal', `local', `ancestors', 6811 `ancestors-full', `lineage', `tree', `canonical' or t. See 6812 `org-show-context-detail' for more information." 6813 ;; Show current heading and possibly its entry, following headline 6814 ;; or all children. 6815 (if (and (org-at-heading-p) (not (eq detail 'local))) 6816 (org-flag-heading nil) 6817 (org-show-entry) 6818 ;; If point is hidden within a drawer or a block, make sure to 6819 ;; expose it. 6820 (dolist (o (overlays-at (point))) 6821 (when (memq (overlay-get o 'invisible) '(org-hide-block outline)) 6822 (delete-overlay o))) 6823 (unless (org-before-first-heading-p) 6824 (org-with-limited-levels 6825 (cl-case detail 6826 ((tree canonical t) (org-show-children)) 6827 ((nil minimal ancestors ancestors-full)) 6828 (t (save-excursion 6829 (outline-next-heading) 6830 (org-flag-heading nil))))))) 6831 ;; Show whole subtree. 6832 (when (eq detail 'ancestors-full) (org-show-subtree)) 6833 ;; Show all siblings. 6834 (when (eq detail 'lineage) (org-show-siblings)) 6835 ;; Show ancestors, possibly with their children. 6836 (when (memq detail '(ancestors ancestors-full lineage tree canonical t)) 6837 (save-excursion 6838 (while (org-up-heading-safe) 6839 (org-flag-heading nil) 6840 (when (memq detail '(canonical t)) (org-show-entry)) 6841 (when (memq detail '(tree canonical t)) (org-show-children)))))) 6842 6843 (defvar org-reveal-start-hook nil 6844 "Hook run before revealing a location.") 6845 6846 (defun org-reveal (&optional siblings) 6847 "Show current entry, hierarchy above it, and the following headline. 6848 6849 This can be used to show a consistent set of context around 6850 locations exposed with `org-show-context'. 6851 6852 With optional argument SIBLINGS, on each level of the hierarchy all 6853 siblings are shown. This repairs the tree structure to what it would 6854 look like when opened with hierarchical calls to `org-cycle'. 6855 6856 With a \\[universal-argument] \\[universal-argument] prefix, \ 6857 go to the parent and show the entire tree." 6858 (interactive "P") 6859 (run-hooks 'org-reveal-start-hook) 6860 (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical)) 6861 ((equal siblings '(16)) 6862 (save-excursion 6863 (when (org-up-heading-safe) 6864 (org-show-subtree) 6865 (run-hook-with-args 'org-cycle-hook 'subtree)))) 6866 (t (org-show-set-visibility 'lineage)))) 6867 6868 6869 ;;; Indirect buffer display of subtrees 6870 6871 (defvar org-indirect-dedicated-frame nil 6872 "This is the frame being used for indirect tree display.") 6873 (defvar org-last-indirect-buffer nil) 6874 6875 (defun org-tree-to-indirect-buffer (&optional arg) 6876 "Create indirect buffer and narrow it to current subtree. 6877 6878 With a numerical prefix ARG, go up to this level and then take that tree. 6879 If ARG is negative, go up that many levels. 6880 6881 If `org-indirect-buffer-display' is not `new-frame', the command removes the 6882 indirect buffer previously made with this command, to avoid proliferation of 6883 indirect buffers. However, when you call the command with a \ 6884 `\\[universal-argument]' prefix, or 6885 when `org-indirect-buffer-display' is `new-frame', the last buffer is kept 6886 so that you can work with several indirect buffers at the same time. If 6887 `org-indirect-buffer-display' is `dedicated-frame', the \ 6888 `\\[universal-argument]' prefix also 6889 requests that a new frame be made for the new buffer, so that the dedicated 6890 frame is not changed." 6891 (interactive "P") 6892 (let ((cbuf (current-buffer)) 6893 (cwin (selected-window)) 6894 (pos (point)) 6895 beg end level heading ibuf) 6896 (save-excursion 6897 (org-back-to-heading t) 6898 (when (numberp arg) 6899 (setq level (org-outline-level)) 6900 (when (< arg 0) (setq arg (+ level arg))) 6901 (while (> (setq level (org-outline-level)) arg) 6902 (org-up-heading-safe))) 6903 (setq beg (point) 6904 heading (org-get-heading 'no-tags)) 6905 (org-end-of-subtree t t) 6906 (when (org-at-heading-p) (backward-char 1)) 6907 (setq end (point))) 6908 (when (and (buffer-live-p org-last-indirect-buffer) 6909 (not (eq org-indirect-buffer-display 'new-frame)) 6910 (not arg)) 6911 (kill-buffer org-last-indirect-buffer)) 6912 (setq ibuf (org-get-indirect-buffer cbuf heading) 6913 org-last-indirect-buffer ibuf) 6914 (cond 6915 ((or (eq org-indirect-buffer-display 'new-frame) 6916 (and arg (eq org-indirect-buffer-display 'dedicated-frame))) 6917 (select-frame (make-frame)) 6918 (delete-other-windows) 6919 (pop-to-buffer-same-window ibuf) 6920 (org-set-frame-title heading)) 6921 ((eq org-indirect-buffer-display 'dedicated-frame) 6922 (raise-frame 6923 (select-frame (or (and org-indirect-dedicated-frame 6924 (frame-live-p org-indirect-dedicated-frame) 6925 org-indirect-dedicated-frame) 6926 (setq org-indirect-dedicated-frame (make-frame))))) 6927 (delete-other-windows) 6928 (pop-to-buffer-same-window ibuf) 6929 (org-set-frame-title (concat "Indirect: " heading))) 6930 ((eq org-indirect-buffer-display 'current-window) 6931 (pop-to-buffer-same-window ibuf)) 6932 ((eq org-indirect-buffer-display 'other-window) 6933 (pop-to-buffer ibuf)) 6934 (t (error "Invalid value"))) 6935 (narrow-to-region beg end) 6936 (org-show-all '(headings drawers blocks)) 6937 (goto-char pos) 6938 (run-hook-with-args 'org-cycle-hook 'all) 6939 (and (window-live-p cwin) (select-window cwin)))) 6940 6941 (defun org-get-indirect-buffer (&optional buffer heading) 6942 (setq buffer (or buffer (current-buffer))) 6943 (let ((n 1) (base (buffer-name buffer)) bname) 6944 (while (buffer-live-p 6945 (get-buffer 6946 (setq bname 6947 (concat base "-" 6948 (if heading (concat heading "-" (number-to-string n)) 6949 (number-to-string n)))))) 6950 (setq n (1+ n))) 6951 (condition-case nil 6952 (make-indirect-buffer buffer bname 'clone) 6953 (error (make-indirect-buffer buffer bname))))) 6954 6955 (defun org-set-frame-title (title) 6956 "Set the title of the current frame to the string TITLE." 6957 (modify-frame-parameters (selected-frame) (list (cons 'name title)))) 6958 6959 ;;;; Structure editing 6960 6961 ;;; Inserting headlines 6962 6963 (defun org--blank-before-heading-p (&optional parent) 6964 "Non-nil when an empty line should precede a new heading here. 6965 When optional argument PARENT is non-nil, consider parent 6966 headline instead of current one." 6967 (pcase (assq 'heading org-blank-before-new-entry) 6968 (`(heading . auto) 6969 (save-excursion 6970 (org-with-limited-levels 6971 (unless (and (org-before-first-heading-p) 6972 (not (outline-next-heading))) 6973 (org-back-to-heading t) 6974 (when parent (org-up-heading-safe)) 6975 (cond ((not (bobp)) 6976 (org-previous-line-empty-p)) 6977 ((outline-next-heading) 6978 (org-previous-line-empty-p)) 6979 ;; Ignore trailing spaces on last buffer line. 6980 ((progn (skip-chars-backward " \t") (bolp)) 6981 (org-previous-line-empty-p)) 6982 (t nil)))))) 6983 (`(heading . ,value) value) 6984 (_ nil))) 6985 6986 (defun org-insert-heading (&optional arg invisible-ok top) 6987 "Insert a new heading or an item with the same depth at point. 6988 6989 If point is at the beginning of a heading, insert a new heading 6990 or a new headline above the current one. When at the beginning 6991 of a regular line of text, turn it into a heading. 6992 6993 If point is in the middle of a line, split it and create a new 6994 headline with the text in the current line after point (see 6995 `org-M-RET-may-split-line' on how to modify this behavior). As 6996 a special case, on a headline, splitting can only happen on the 6997 title itself. E.g., this excludes breaking stars or tags. 6998 6999 With a `\\[universal-argument]' prefix, set \ 7000 `org-insert-heading-respect-content' to 7001 a non-nil value for the duration of the command. This forces the 7002 insertion of a heading after the current subtree, independently 7003 on the location of point. 7004 7005 With a `\\[universal-argument] \\[universal-argument]' prefix, \ 7006 insert the heading at the end of the tree 7007 above the current heading. For example, if point is within a 7008 2nd-level heading, then it will insert a 2nd-level heading at 7009 the end of the 1st-level parent subtree. 7010 7011 When INVISIBLE-OK is set, stop at invisible headlines when going 7012 back. This is important for non-interactive uses of the 7013 command. 7014 7015 When optional argument TOP is non-nil, insert a level 1 heading, 7016 unconditionally." 7017 (interactive "P") 7018 (let* ((blank? (org--blank-before-heading-p (equal arg '(16)))) 7019 (level (org-current-level)) 7020 (stars (make-string (if (and level (not top)) level 1) ?*))) 7021 (cond 7022 ((or org-insert-heading-respect-content 7023 (member arg '((4) (16))) 7024 (and (not invisible-ok) 7025 (invisible-p (max (1- (point)) (point-min))))) 7026 ;; Position point at the location of insertion. Make sure we 7027 ;; end up on a visible headline if INVISIBLE-OK is nil. 7028 (org-with-limited-levels 7029 (if (not level) (outline-next-heading) ;before first headline 7030 (org-back-to-heading invisible-ok) 7031 (when (equal arg '(16)) (org-up-heading-safe)) 7032 (org-end-of-subtree))) 7033 (unless (bolp) (insert "\n")) 7034 (when (and blank? (save-excursion 7035 (backward-char) 7036 (org-before-first-heading-p))) 7037 (insert "\n") 7038 (backward-char)) 7039 (when (and (not level) (not (eobp)) (not (bobp))) 7040 (when (org-at-heading-p) (insert "\n")) 7041 (backward-char)) 7042 (unless (and blank? (org-previous-line-empty-p)) 7043 (org-N-empty-lines-before-current (if blank? 1 0))) 7044 (insert stars " ") 7045 ;; When INVISIBLE-OK is non-nil, ensure newly created headline 7046 ;; is visible. 7047 (unless invisible-ok 7048 (pcase (get-char-property-and-overlay (point) 'invisible) 7049 (`(outline . ,o) 7050 (move-overlay o (overlay-start o) (line-end-position 0))) 7051 (_ nil)))) 7052 ;; At a headline... 7053 ((org-at-heading-p) 7054 (cond ((bolp) 7055 (when blank? (save-excursion (insert "\n"))) 7056 (save-excursion (insert stars " \n")) 7057 (unless (and blank? (org-previous-line-empty-p)) 7058 (org-N-empty-lines-before-current (if blank? 1 0))) 7059 (end-of-line)) 7060 ((and (org-get-alist-option org-M-RET-may-split-line 'headline) 7061 (org-match-line org-complex-heading-regexp) 7062 (org-pos-in-match-range (point) 4)) 7063 ;; Grab the text that should moved to the new headline. 7064 ;; Preserve tags. 7065 (let ((split (delete-and-extract-region (point) (match-end 4)))) 7066 (if (looking-at "[ \t]*$") (replace-match "") 7067 (org-align-tags)) 7068 (end-of-line) 7069 (when blank? (insert "\n")) 7070 (insert "\n" stars " ") 7071 (when (org-string-nw-p split) (insert split)))) 7072 (t 7073 (end-of-line) 7074 (when blank? (insert "\n")) 7075 (insert "\n" stars " ")))) 7076 ;; On regular text, turn line into a headline or split, if 7077 ;; appropriate. 7078 ((bolp) 7079 (insert stars " ") 7080 (unless (and blank? (org-previous-line-empty-p)) 7081 (org-N-empty-lines-before-current (if blank? 1 0)))) 7082 (t 7083 (unless (org-get-alist-option org-M-RET-may-split-line 'headline) 7084 (end-of-line)) 7085 (insert "\n" stars " ") 7086 (unless (and blank? (org-previous-line-empty-p)) 7087 (org-N-empty-lines-before-current (if blank? 1 0)))))) 7088 (run-hooks 'org-insert-heading-hook)) 7089 7090 (defun org-N-empty-lines-before-current (n) 7091 "Make the number of empty lines before current exactly N. 7092 So this will delete or add empty lines." 7093 (let ((column (current-column))) 7094 (beginning-of-line) 7095 (unless (bobp) 7096 (let ((start (save-excursion 7097 (skip-chars-backward " \r\t\n") 7098 (line-end-position)))) 7099 (delete-region start (line-end-position 0)))) 7100 (insert (make-string n ?\n)) 7101 (move-to-column column))) 7102 7103 (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) 7104 "Return the heading of the current entry, without the stars. 7105 When NO-TAGS is non-nil, don't include tags. 7106 When NO-TODO is non-nil, don't include TODO keywords. 7107 When NO-PRIORITY is non-nil, don't include priority cookie. 7108 When NO-COMMENT is non-nil, don't include COMMENT string. 7109 Return nil before first heading." 7110 (unless (org-before-first-heading-p) 7111 (save-excursion 7112 (org-back-to-heading t) 7113 (let ((case-fold-search nil)) 7114 (looking-at org-complex-heading-regexp) 7115 (let ((todo (and (not no-todo) (match-string 2))) 7116 (priority (and (not no-priority) (match-string 3))) 7117 (headline (pcase (match-string 4) 7118 (`nil "") 7119 ((and (guard no-comment) h) 7120 (replace-regexp-in-string 7121 (eval-when-compile 7122 (format "\\`%s[ \t]+" org-comment-string)) 7123 "" h)) 7124 (h h))) 7125 (tags (and (not no-tags) (match-string 5)))) 7126 (mapconcat #'identity 7127 (delq nil (list todo priority headline tags)) 7128 " ")))))) 7129 7130 (defun org-heading-components () 7131 "Return the components of the current heading. 7132 This is a list with the following elements: 7133 - the level as an integer 7134 - the reduced level, different if `org-odd-levels-only' is set. 7135 - the TODO keyword, or nil 7136 - the priority character, like ?A, or nil if no priority is given 7137 - the headline text itself, or the tags string if no headline text 7138 - the tags string, or nil." 7139 (save-excursion 7140 (org-back-to-heading t) 7141 (when (let (case-fold-search) (looking-at org-complex-heading-regexp)) 7142 (list (length (match-string 1)) 7143 (org-reduced-level (length (match-string 1))) 7144 (match-string-no-properties 2) 7145 (and (match-end 3) (aref (match-string 3) 2)) 7146 (match-string-no-properties 4) 7147 (match-string-no-properties 5))))) 7148 7149 (defun org-get-entry () 7150 "Get the entry text, after heading, entire subtree." 7151 (save-excursion 7152 (org-back-to-heading t) 7153 (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) 7154 7155 (defun org-edit-headline (&optional heading) 7156 "Edit the current headline. 7157 Set it to HEADING when provided." 7158 (interactive) 7159 (org-with-wide-buffer 7160 (org-back-to-heading t) 7161 (let ((case-fold-search nil)) 7162 (when (looking-at org-complex-heading-regexp) 7163 (let* ((old (match-string-no-properties 4)) 7164 (new (save-match-data 7165 (org-trim (or heading (read-string "Edit: " old)))))) 7166 (unless (equal old new) 7167 (if old (replace-match new t t nil 4) 7168 (goto-char (or (match-end 3) (match-end 2) (match-end 1))) 7169 (insert " " new)) 7170 (org-align-tags) 7171 (when (looking-at "[ \t]*$") (replace-match "")))))))) 7172 7173 (defun org-insert-heading-after-current () 7174 "Insert a new heading with same level as current, after current subtree." 7175 (interactive) 7176 (org-back-to-heading) 7177 (org-insert-heading) 7178 (org-move-subtree-down) 7179 (end-of-line 1)) 7180 7181 (defun org-insert-heading-respect-content (&optional invisible-ok) 7182 "Insert heading with `org-insert-heading-respect-content' set to t." 7183 (interactive) 7184 (org-insert-heading '(4) invisible-ok)) 7185 7186 (defun org-insert-todo-heading-respect-content (&optional force-state) 7187 "Insert TODO heading with `org-insert-heading-respect-content' set to t." 7188 (interactive) 7189 (org-insert-todo-heading force-state '(4))) 7190 7191 (defun org-insert-todo-heading (arg &optional force-heading) 7192 "Insert a new heading with the same level and TODO state as current heading. 7193 7194 If the heading has no TODO state, or if the state is DONE, use 7195 the first state (TODO by default). Also with one prefix arg, 7196 force first state. With two prefix args, force inserting at the 7197 end of the parent subtree. 7198 7199 When called at a plain list item, insert a new item with an 7200 unchecked check box." 7201 (interactive "P") 7202 (when (or force-heading (not (org-insert-item 'checkbox))) 7203 (org-insert-heading (or (and (equal arg '(16)) '(16)) 7204 force-heading)) 7205 (save-excursion 7206 (org-forward-heading-same-level -1) 7207 (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))) 7208 (let* ((new-mark-x 7209 (if (or (equal arg '(4)) 7210 (not (match-beginning 2)) 7211 (member (match-string 2) org-done-keywords)) 7212 (car org-todo-keywords-1) 7213 (match-string 2))) 7214 (new-mark 7215 (or 7216 (run-hook-with-args-until-success 7217 'org-todo-get-default-hook new-mark-x nil) 7218 new-mark-x))) 7219 (beginning-of-line 1) 7220 (and (looking-at org-outline-regexp) (goto-char (match-end 0)) 7221 (if org-treat-insert-todo-heading-as-state-change 7222 (org-todo new-mark) 7223 (insert new-mark " ")))) 7224 (when org-provide-todo-statistics 7225 (org-update-parent-todo-statistics)))) 7226 7227 (defun org-insert-subheading (arg) 7228 "Insert a new subheading and demote it. 7229 Works for outline headings and for plain lists alike." 7230 (interactive "P") 7231 (org-insert-heading arg) 7232 (cond 7233 ((org-at-heading-p) (org-do-demote)) 7234 ((org-at-item-p) (org-indent-item)))) 7235 7236 (defun org-insert-todo-subheading (arg) 7237 "Insert a new subheading with TODO keyword or checkbox and demote it. 7238 Works for outline headings and for plain lists alike." 7239 (interactive "P") 7240 (org-insert-todo-heading arg) 7241 (cond 7242 ((org-at-heading-p) (org-do-demote)) 7243 ((org-at-item-p) (org-indent-item)))) 7244 7245 ;;; Promotion and Demotion 7246 7247 (defvar org-after-demote-entry-hook nil 7248 "Hook run after an entry has been demoted. 7249 The cursor will be at the beginning of the entry. 7250 When a subtree is being demoted, the hook will be called for each node.") 7251 7252 (defvar org-after-promote-entry-hook nil 7253 "Hook run after an entry has been promoted. 7254 The cursor will be at the beginning of the entry. 7255 When a subtree is being promoted, the hook will be called for each node.") 7256 7257 (defun org-promote-subtree () 7258 "Promote the entire subtree. 7259 See also `org-promote'." 7260 (interactive) 7261 (save-excursion 7262 (org-with-limited-levels (org-map-tree 'org-promote))) 7263 (org-fix-position-after-promote)) 7264 7265 (defun org-demote-subtree () 7266 "Demote the entire subtree. 7267 See `org-demote' and `org-promote'." 7268 (interactive) 7269 (save-excursion 7270 (org-with-limited-levels (org-map-tree 'org-demote))) 7271 (org-fix-position-after-promote)) 7272 7273 (defun org-do-promote () 7274 "Promote the current heading higher up the tree. 7275 If the region is active in `transient-mark-mode', promote all 7276 headings in the region." 7277 (interactive) 7278 (save-excursion 7279 (if (org-region-active-p) 7280 (org-map-region 'org-promote (region-beginning) (region-end)) 7281 (org-promote))) 7282 (org-fix-position-after-promote)) 7283 7284 (defun org-do-demote () 7285 "Demote the current heading lower down the tree. 7286 If the region is active in `transient-mark-mode', demote all 7287 headings in the region." 7288 (interactive) 7289 (save-excursion 7290 (if (org-region-active-p) 7291 (org-map-region 'org-demote (region-beginning) (region-end)) 7292 (org-demote))) 7293 (org-fix-position-after-promote)) 7294 7295 (defun org-fix-position-after-promote () 7296 "Fix cursor position and indentation after demoting/promoting." 7297 (let ((pos (point))) 7298 (when (save-excursion 7299 (beginning-of-line) 7300 (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) 7301 (or (eq pos (match-end 1)) (eq pos (match-end 2)))) 7302 (cond ((eobp) (insert " ")) 7303 ((eolp) (insert " ")) 7304 ((equal (char-after) ?\s) (forward-char 1)))))) 7305 7306 (defun org-current-level () 7307 "Return the level of the current entry, or nil if before the first headline. 7308 The level is the number of stars at the beginning of the 7309 headline. Use `org-reduced-level' to remove the effect of 7310 `org-odd-levels'. Unlike to `org-outline-level', this function 7311 ignores inlinetasks." 7312 (let ((level (org-with-limited-levels (org-outline-level)))) 7313 (and (> level 0) level))) 7314 7315 (defun org-get-previous-line-level () 7316 "Return the outline depth of the last headline before the current line. 7317 Returns 0 for the first headline in the buffer, and nil if before the 7318 first headline." 7319 (and (org-current-level) 7320 (or (and (/= (line-beginning-position) (point-min)) 7321 (save-excursion (beginning-of-line 0) (org-current-level))) 7322 0))) 7323 7324 (defun org-reduced-level (l) 7325 "Compute the effective level of a heading. 7326 This takes into account the setting of `org-odd-levels-only'." 7327 (cond 7328 ((zerop l) 0) 7329 (org-odd-levels-only (1+ (floor (/ l 2)))) 7330 (t l))) 7331 7332 (defun org-level-increment () 7333 "Return the number of stars that will be added or removed at a 7334 time to headlines when structure editing, based on the value of 7335 `org-odd-levels-only'." 7336 (if org-odd-levels-only 2 1)) 7337 7338 (defun org-get-valid-level (level &optional change) 7339 "Rectify a level change under the influence of `org-odd-levels-only'. 7340 LEVEL is a current level, CHANGE is by how much the level should 7341 be modified. Even if CHANGE is nil, LEVEL may be returned 7342 modified because even level numbers will become the next higher 7343 odd number. Returns values greater than 0." 7344 (if org-odd-levels-only 7345 (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) 7346 ((> change 0) (1+ (* 2 (/ (+ (1- level) (* 2 change)) 2)))) 7347 ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) 7348 (max 1 (+ level (or change 0))))) 7349 7350 (defun org-promote () 7351 "Promote the current heading higher up the tree." 7352 (org-with-wide-buffer 7353 (org-back-to-heading t) 7354 (let* ((after-change-functions (remq 'flyspell-after-change-function 7355 after-change-functions)) 7356 (level (save-match-data (funcall outline-level))) 7357 (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) 7358 (diff (abs (- level (length up-head) -1)))) 7359 (cond 7360 ((and (= level 1) org-allow-promoting-top-level-subtree) 7361 (replace-match "# " nil t)) 7362 ((= level 1) 7363 (user-error "Cannot promote to level 0. UNDO to recover if necessary")) 7364 (t (replace-match up-head nil t))) 7365 (unless (= level 1) 7366 (when org-auto-align-tags (org-align-tags)) 7367 (when org-adapt-indentation (org-fixup-indentation (- diff)))) 7368 (run-hooks 'org-after-promote-entry-hook)))) 7369 7370 (defun org-demote () 7371 "Demote the current heading lower down the tree." 7372 (org-with-wide-buffer 7373 (org-back-to-heading t) 7374 (let* ((after-change-functions (remq 'flyspell-after-change-function 7375 after-change-functions)) 7376 (level (save-match-data (funcall outline-level))) 7377 (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) 7378 (diff (abs (- level (length down-head) -1)))) 7379 (replace-match down-head nil t) 7380 (when org-auto-align-tags (org-align-tags)) 7381 (when org-adapt-indentation (org-fixup-indentation diff)) 7382 (run-hooks 'org-after-demote-entry-hook)))) 7383 7384 (defun org-cycle-level () 7385 "Cycle the level of an empty headline through possible states. 7386 This goes first to child, then to parent, level, then up the hierarchy. 7387 After top level, it switches back to sibling level." 7388 (interactive) 7389 (let ((org-adapt-indentation nil)) 7390 (when (org-point-at-end-of-empty-headline) 7391 (setq this-command 'org-cycle-level) ; Only needed for caching 7392 (let ((cur-level (org-current-level)) 7393 (prev-level (org-get-previous-line-level))) 7394 (cond 7395 ;; If first headline in file, promote to top-level. 7396 ((= prev-level 0) 7397 (cl-loop repeat (/ (- cur-level 1) (org-level-increment)) 7398 do (org-do-promote))) 7399 ;; If same level as prev, demote one. 7400 ((= prev-level cur-level) 7401 (org-do-demote)) 7402 ;; If parent is top-level, promote to top level if not already. 7403 ((= prev-level 1) 7404 (cl-loop repeat (/ (- cur-level 1) (org-level-increment)) 7405 do (org-do-promote))) 7406 ;; If top-level, return to prev-level. 7407 ((= cur-level 1) 7408 (cl-loop repeat (/ (- prev-level 1) (org-level-increment)) 7409 do (org-do-demote))) 7410 ;; If less than prev-level, promote one. 7411 ((< cur-level prev-level) 7412 (org-do-promote)) 7413 ;; If deeper than prev-level, promote until higher than 7414 ;; prev-level. 7415 ((> cur-level prev-level) 7416 (cl-loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment))) 7417 do (org-do-promote)))) 7418 t)))) 7419 7420 (defun org-map-tree (fun) 7421 "Call FUN for every heading underneath the current one." 7422 (org-back-to-heading t) 7423 (let ((level (funcall outline-level))) 7424 (save-excursion 7425 (funcall fun) 7426 (while (and (progn 7427 (outline-next-heading) 7428 (> (funcall outline-level) level)) 7429 (not (eobp))) 7430 (funcall fun))))) 7431 7432 (defun org-map-region (fun beg end) 7433 "Call FUN for every heading between BEG and END." 7434 (let ((org-ignore-region t)) 7435 (save-excursion 7436 (setq end (copy-marker end)) 7437 (goto-char beg) 7438 (when (and (re-search-forward org-outline-regexp-bol nil t) 7439 (< (point) end)) 7440 (funcall fun)) 7441 (while (and (progn 7442 (outline-next-heading) 7443 (< (point) end)) 7444 (not (eobp))) 7445 (funcall fun))))) 7446 7447 (defun org-fixup-indentation (diff) 7448 "Change the indentation in the current entry by DIFF. 7449 7450 DIFF is an integer. Indentation is done according to the 7451 following rules: 7452 7453 - Planning information and property drawers are always indented 7454 according to the new level of the headline; 7455 7456 - Footnote definitions and their contents are ignored; 7457 7458 - Inlinetasks' boundaries are not shifted; 7459 7460 - Empty lines are ignored; 7461 7462 - Other lines' indentation are shifted by DIFF columns, unless 7463 it would introduce a structural change in the document, in 7464 which case no shifting is done at all. 7465 7466 Assume point is at a heading or an inlinetask beginning." 7467 (org-with-wide-buffer 7468 (narrow-to-region (line-beginning-position) 7469 (save-excursion 7470 (if (org-with-limited-levels (org-at-heading-p)) 7471 (org-with-limited-levels (outline-next-heading)) 7472 (org-inlinetask-goto-end)) 7473 (point))) 7474 (forward-line) 7475 ;; Indent properly planning info and property drawer. 7476 (when (looking-at-p org-planning-line-re) 7477 (org-indent-line) 7478 (forward-line)) 7479 (when (looking-at org-property-drawer-re) 7480 (goto-char (match-end 0)) 7481 (forward-line) 7482 (org-indent-region (match-beginning 0) (match-end 0))) 7483 (when (looking-at org-logbook-drawer-re) 7484 (let ((end-marker (move-marker (make-marker) (match-end 0))) 7485 (col (+ (current-indentation) diff))) 7486 (when (wholenump col) 7487 (while (< (point) end-marker) 7488 (if (natnump diff) 7489 (insert (make-string diff 32)) 7490 (delete-char (abs diff))) 7491 (forward-line))))) 7492 (catch 'no-shift 7493 (when (or (zerop diff) (not (eq org-adapt-indentation t))) 7494 (throw 'no-shift nil)) 7495 ;; If DIFF is negative, first check if a shift is possible at all 7496 ;; (e.g., it doesn't break structure). This can only happen if 7497 ;; some contents are not properly indented. 7498 (let ((case-fold-search t)) 7499 (when (< diff 0) 7500 (let ((diff (- diff)) 7501 (forbidden-re (concat org-outline-regexp 7502 "\\|" 7503 (substring org-footnote-definition-re 1)))) 7504 (save-excursion 7505 (while (not (eobp)) 7506 (cond 7507 ((looking-at-p "[ \t]*$") (forward-line)) 7508 ((and (looking-at-p org-footnote-definition-re) 7509 (let ((e (org-element-at-point))) 7510 (and (eq (org-element-type e) 'footnote-definition) 7511 (goto-char (org-element-property :end e)))))) 7512 ((looking-at-p org-outline-regexp) (forward-line)) 7513 ;; Give up if shifting would move before column 0 or 7514 ;; if it would introduce a headline or a footnote 7515 ;; definition. 7516 (t 7517 (skip-chars-forward " \t") 7518 (let ((ind (current-column))) 7519 (when (or (< ind diff) 7520 (and (= ind diff) (looking-at-p forbidden-re))) 7521 (throw 'no-shift nil))) 7522 ;; Ignore contents of example blocks and source 7523 ;; blocks if their indentation is meant to be 7524 ;; preserved. Jump to block's closing line. 7525 (beginning-of-line) 7526 (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") 7527 (let ((e (org-element-at-point))) 7528 (and (memq (org-element-type e) 7529 '(example-block src-block)) 7530 (or org-src-preserve-indentation 7531 (org-element-property :preserve-indent e)) 7532 (goto-char (org-element-property :end e)) 7533 (progn (skip-chars-backward " \r\t\n") 7534 (beginning-of-line) 7535 t)))) 7536 (forward-line)))))))) 7537 ;; Shift lines but footnote definitions, inlinetasks boundaries 7538 ;; by DIFF. Also skip contents of source or example blocks 7539 ;; when indentation is meant to be preserved. 7540 (while (not (eobp)) 7541 (cond 7542 ((and (looking-at-p org-footnote-definition-re) 7543 (let ((e (org-element-at-point))) 7544 (and (eq (org-element-type e) 'footnote-definition) 7545 (goto-char (org-element-property :end e)))))) 7546 ((looking-at-p org-outline-regexp) (forward-line)) 7547 ((looking-at-p "[ \t]*$") (forward-line)) 7548 (t 7549 (indent-line-to (+ (current-indentation) diff)) 7550 (beginning-of-line) 7551 (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") 7552 (let ((e (org-element-at-point))) 7553 (and (memq (org-element-type e) 7554 '(example-block src-block)) 7555 (or org-src-preserve-indentation 7556 (org-element-property :preserve-indent e)) 7557 (goto-char (org-element-property :end e)) 7558 (progn (skip-chars-backward " \r\t\n") 7559 (beginning-of-line) 7560 t)))) 7561 (forward-line))))))))) 7562 7563 (defun org-convert-to-odd-levels () 7564 "Convert an Org file with all levels allowed to one with odd levels. 7565 This will leave level 1 alone, convert level 2 to level 3, level 3 to 7566 level 5 etc." 7567 (interactive) 7568 (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") 7569 (let ((outline-level 'org-outline-level) 7570 (org-odd-levels-only nil) n) 7571 (save-excursion 7572 (goto-char (point-min)) 7573 (while (re-search-forward "^\\*\\*+ " nil t) 7574 (setq n (- (length (match-string 0)) 2)) 7575 (while (>= (setq n (1- n)) 0) 7576 (org-demote)) 7577 (end-of-line 1)))))) 7578 7579 (defun org-convert-to-oddeven-levels () 7580 "Convert an Org file with only odd levels to one with odd/even levels. 7581 This promotes level 3 to level 2, level 5 to level 3 etc. If the 7582 file contains a section with an even level, conversion would 7583 destroy the structure of the file. An error is signaled in this 7584 case." 7585 (interactive) 7586 (goto-char (point-min)) 7587 ;; First check if there are no even levels 7588 (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) 7589 (org-show-set-visibility 'canonical) 7590 (error "Not all levels are odd in this file. Conversion not possible")) 7591 (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") 7592 (let ((outline-regexp org-outline-regexp) 7593 (outline-level 'org-outline-level) 7594 (org-odd-levels-only nil) n) 7595 (save-excursion 7596 (goto-char (point-min)) 7597 (while (re-search-forward "^\\*\\*+ " nil t) 7598 (setq n (/ (1- (length (match-string 0))) 2)) 7599 (while (>= (setq n (1- n)) 0) 7600 (org-promote)) 7601 (end-of-line 1)))))) 7602 7603 (defun org-tr-level (n) 7604 "Make N odd if required." 7605 (if org-odd-levels-only (1+ (/ n 2)) n)) 7606 7607 ;;; Vertical tree motion, cutting and pasting of subtrees 7608 7609 (defun org-move-subtree-up (&optional arg) 7610 "Move the current subtree up past ARG headlines of the same level." 7611 (interactive "p") 7612 (org-move-subtree-down (- (prefix-numeric-value arg)))) 7613 7614 (defun org-move-subtree-down (&optional arg) 7615 "Move the current subtree down past ARG headlines of the same level." 7616 (interactive "p") 7617 (setq arg (prefix-numeric-value arg)) 7618 (org-preserve-local-variables 7619 (let ((movfunc (if (> arg 0) 'org-get-next-sibling 7620 'org-get-previous-sibling)) 7621 (ins-point (make-marker)) 7622 (cnt (abs arg)) 7623 (col (current-column)) 7624 beg end txt folded) 7625 ;; Select the tree 7626 (org-back-to-heading) 7627 (setq beg (point)) 7628 (save-match-data 7629 (save-excursion (outline-end-of-heading) 7630 (setq folded (org-invisible-p))) 7631 (progn (org-end-of-subtree nil t) 7632 (unless (eobp) (backward-char)))) 7633 (outline-next-heading) 7634 (setq end (point)) 7635 (goto-char beg) 7636 ;; Find insertion point, with error handling 7637 (while (> cnt 0) 7638 (unless (and (funcall movfunc) (looking-at org-outline-regexp)) 7639 (goto-char beg) 7640 (user-error "Cannot move past superior level or buffer limit")) 7641 (setq cnt (1- cnt))) 7642 (when (> arg 0) 7643 ;; Moving forward - still need to move over subtree 7644 (org-end-of-subtree t t) 7645 (save-excursion 7646 (org-back-over-empty-lines) 7647 (or (bolp) (newline)))) 7648 (move-marker ins-point (point)) 7649 (setq txt (buffer-substring beg end)) 7650 (org-save-markers-in-region beg end) 7651 (delete-region beg end) 7652 (org-remove-empty-overlays-at beg) 7653 (unless (= beg (point-min)) (org-flag-region (1- beg) beg nil 'outline)) 7654 (unless (bobp) (org-flag-region (1- (point)) (point) nil 'outline)) 7655 (and (not (bolp)) (looking-at "\n") (forward-char 1)) 7656 (let ((bbb (point))) 7657 (insert-before-markers txt) 7658 (org-reinstall-markers-in-region bbb) 7659 (move-marker ins-point bbb)) 7660 (or (bolp) (insert "\n")) 7661 (goto-char ins-point) 7662 (org-skip-whitespace) 7663 (move-marker ins-point nil) 7664 (if folded 7665 (org-flag-subtree t) 7666 (org-show-entry) 7667 (org-show-children)) 7668 (org-clean-visibility-after-subtree-move) 7669 ;; move back to the initial column we were at 7670 (move-to-column col)))) 7671 7672 (defvar org-subtree-clip "" 7673 "Clipboard for cut and paste of subtrees. 7674 This is actually only a copy of the kill, because we use the normal kill 7675 ring. We need it to check if the kill was created by `org-copy-subtree'.") 7676 7677 (defvar org-subtree-clip-folded nil 7678 "Was the last copied subtree folded? 7679 This is used to fold the tree back after pasting.") 7680 7681 (defun org-cut-subtree (&optional n) 7682 "Cut the current subtree into the clipboard. 7683 With prefix arg N, cut this many sequential subtrees. 7684 This is a short-hand for marking the subtree and then cutting it." 7685 (interactive "p") 7686 (org-copy-subtree n 'cut)) 7687 7688 (defun org-copy-subtree (&optional n cut force-store-markers nosubtrees) 7689 "Copy the current subtree into the clipboard. 7690 With prefix arg N, copy this many sequential subtrees. 7691 This is a short-hand for marking the subtree and then copying it. 7692 If CUT is non-nil, actually cut the subtree. 7693 If FORCE-STORE-MARKERS is non-nil, store the relative locations 7694 of some markers in the region, even if CUT is non-nil. This is 7695 useful if the caller implements cut-and-paste as copy-then-paste-then-cut." 7696 (interactive "p") 7697 (org-preserve-local-variables 7698 (let (beg end folded (beg0 (point))) 7699 (if (called-interactively-p 'any) 7700 (org-back-to-heading nil) ; take what looks like a subtree 7701 (org-back-to-heading t)) ; take what is really there 7702 (setq beg (point)) 7703 (skip-chars-forward " \t\r\n") 7704 (save-match-data 7705 (if nosubtrees 7706 (outline-next-heading) 7707 (save-excursion (outline-end-of-heading) 7708 (setq folded (org-invisible-p))) 7709 (ignore-errors (org-forward-heading-same-level (1- n) t)) 7710 (org-end-of-subtree t t))) 7711 ;; Include the end of an inlinetask 7712 (when (and (featurep 'org-inlinetask) 7713 (looking-at-p (concat (org-inlinetask-outline-regexp) 7714 "END[ \t]*$"))) 7715 (end-of-line)) 7716 (setq end (point)) 7717 (goto-char beg0) 7718 (when (> end beg) 7719 (setq org-subtree-clip-folded folded) 7720 (when (or cut force-store-markers) 7721 (org-save-markers-in-region beg end)) 7722 (if cut (kill-region beg end) (copy-region-as-kill beg end)) 7723 (setq org-subtree-clip (current-kill 0)) 7724 (message "%s: Subtree(s) with %d characters" 7725 (if cut "Cut" "Copied") 7726 (length org-subtree-clip)))))) 7727 7728 (defun org-paste-subtree (&optional level tree for-yank remove) 7729 "Paste the clipboard as a subtree, with modification of headline level. 7730 7731 The entire subtree is promoted or demoted in order to match a new headline 7732 level. 7733 7734 If the cursor is at the beginning of a headline, the same level as 7735 that headline is used to paste the tree. 7736 7737 If not, the new level is derived from the *visible* headings 7738 before and after the insertion point, and taken to be the inferior headline 7739 level of the two. So if the previous visible heading is level 3 and the 7740 next is level 4 (or vice versa), level 4 will be used for insertion. 7741 This makes sure that the subtree remains an independent subtree and does 7742 not swallow low level entries. 7743 7744 You can also force a different level, either by using a numeric prefix 7745 argument, or by inserting the heading marker by hand. For example, if the 7746 cursor is after \"*****\", then the tree will be shifted to level 5. 7747 7748 If optional TREE is given, use this text instead of the kill ring. 7749 7750 When FOR-YANK is set, this is called by `org-yank'. In this case, do not 7751 move back over whitespace before inserting, and move point to the end of 7752 the inserted text when done. 7753 7754 When REMOVE is non-nil, remove the subtree from the clipboard." 7755 (interactive "P") 7756 (setq tree (or tree (and kill-ring (current-kill 0)))) 7757 (unless (org-kill-is-subtree-p tree) 7758 (user-error 7759 (substitute-command-keys 7760 "The kill is not a (set of) tree(s). Use `\\[yank]' to yank anyway"))) 7761 (org-with-limited-levels 7762 (let* ((visp (not (org-invisible-p))) 7763 (txt tree) 7764 (old-level (if (string-match org-outline-regexp-bol txt) 7765 (- (match-end 0) (match-beginning 0) 1) 7766 -1)) 7767 (force-level 7768 (cond 7769 (level (prefix-numeric-value level)) 7770 ;; When point is after the stars in an otherwise empty 7771 ;; headline, use the number of stars as the forced level. 7772 ((and (org-match-line "^\\*+[ \t]*$") 7773 (not (eq ?* (char-after)))) 7774 (org-outline-level)) 7775 ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) 7776 (previous-level 7777 (save-excursion 7778 (org-previous-visible-heading 1) 7779 (if (org-at-heading-p) (org-outline-level) 1))) 7780 (next-level 7781 (save-excursion 7782 (if (org-at-heading-p) (org-outline-level) 7783 (org-next-visible-heading 1) 7784 (if (org-at-heading-p) (org-outline-level) 1)))) 7785 (new-level (or force-level (max previous-level next-level))) 7786 (shift (if (or (= old-level -1) 7787 (= new-level -1) 7788 (= old-level new-level)) 7789 0 7790 (- new-level old-level))) 7791 (delta (if (> shift 0) -1 1)) 7792 (func (if (> shift 0) #'org-demote #'org-promote)) 7793 (org-odd-levels-only nil) 7794 beg end newend) 7795 ;; Remove the forced level indicator. 7796 (when (and force-level (not level)) 7797 (delete-region (line-beginning-position) (point))) 7798 ;; Paste before the next visible heading or at end of buffer, 7799 ;; unless point is at the beginning of a headline. 7800 (unless (and (bolp) (org-at-heading-p)) 7801 (org-next-visible-heading 1) 7802 (unless (bolp) (insert "\n"))) 7803 (setq beg (point)) 7804 (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) 7805 (insert-before-markers txt) 7806 (unless (string-suffix-p "\n" txt) (insert "\n")) 7807 (setq newend (point)) 7808 (org-reinstall-markers-in-region beg) 7809 (setq end (point)) 7810 (goto-char beg) 7811 (skip-chars-forward " \t\n\r") 7812 (setq beg (point)) 7813 (when (and (org-invisible-p) visp) 7814 (save-excursion (outline-show-heading))) 7815 ;; Shift if necessary. 7816 (unless (= shift 0) 7817 (save-restriction 7818 (narrow-to-region beg end) 7819 (while (not (= shift 0)) 7820 (org-map-region func (point-min) (point-max)) 7821 (setq shift (+ delta shift))) 7822 (goto-char (point-min)) 7823 (setq newend (point-max)))) 7824 (when (or for-yank (called-interactively-p 'interactive)) 7825 (message "Clipboard pasted as level %d subtree" new-level)) 7826 (when (and (not for-yank) ; in this case, org-yank will decide about folding 7827 kill-ring 7828 (equal org-subtree-clip (current-kill 0)) 7829 org-subtree-clip-folded) 7830 ;; The tree was folded before it was killed/copied 7831 (org-flag-subtree t)) 7832 (when for-yank (goto-char newend)) 7833 (when remove (pop kill-ring))))) 7834 7835 (defun org-kill-is-subtree-p (&optional txt) 7836 "Check if the current kill is an outline subtree, or a set of trees. 7837 Returns nil if kill does not start with a headline, or if the first 7838 headline level is not the largest headline level in the tree. 7839 So this will actually accept several entries of equal levels as well, 7840 which is OK for `org-paste-subtree'. 7841 If optional TXT is given, check this string instead of the current kill." 7842 (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) 7843 (re (org-get-limited-outline-regexp)) 7844 (^re (concat "^" re)) 7845 (start-level (and kill 7846 (string-match 7847 (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)") 7848 kill) 7849 (- (match-end 2) (match-beginning 2) 1))) 7850 (start (1+ (or (match-beginning 2) -1)))) 7851 (if (not start-level) 7852 (progn 7853 nil) ;; does not even start with a heading 7854 (catch 'exit 7855 (while (setq start (string-match ^re kill (1+ start))) 7856 (when (< (- (match-end 0) (match-beginning 0) 1) start-level) 7857 (throw 'exit nil))) 7858 t)))) 7859 7860 (defvar org-markers-to-move nil 7861 "Markers that should be moved with a cut-and-paste operation. 7862 Those markers are stored together with their positions relative to 7863 the start of the region.") 7864 7865 (defun org-save-markers-in-region (beg end) 7866 "Check markers in region. 7867 If these markers are between BEG and END, record their position relative 7868 to BEG, so that after moving the block of text, we can put the markers back 7869 into place. 7870 This function gets called just before an entry or tree gets cut from the 7871 buffer. After re-insertion, `org-reinstall-markers-in-region' must be 7872 called immediately, to move the markers with the entries." 7873 (setq org-markers-to-move nil) 7874 (when (featurep 'org-clock) 7875 (org-clock-save-markers-for-cut-and-paste beg end)) 7876 (when (featurep 'org-agenda) 7877 (org-agenda-save-markers-for-cut-and-paste beg end))) 7878 7879 (defun org-check-and-save-marker (marker beg end) 7880 "Check if MARKER is between BEG and END. 7881 If yes, remember the marker and the distance to BEG." 7882 (when (and (marker-buffer marker) 7883 (or (equal (marker-buffer marker) (current-buffer)) 7884 (equal (marker-buffer marker) (buffer-base-buffer (current-buffer)))) 7885 (>= marker beg) (< marker end)) 7886 (push (cons marker (- marker beg)) org-markers-to-move))) 7887 7888 (defun org-reinstall-markers-in-region (beg) 7889 "Move all remembered markers to their position relative to BEG." 7890 (dolist (x org-markers-to-move) 7891 (move-marker (car x) (+ beg (cdr x)))) 7892 (setq org-markers-to-move nil)) 7893 7894 (defun org-narrow-to-subtree () 7895 "Narrow buffer to the current subtree." 7896 (interactive) 7897 (save-excursion 7898 (save-match-data 7899 (org-with-limited-levels 7900 (narrow-to-region 7901 (progn (org-back-to-heading t) (point)) 7902 (progn (org-end-of-subtree t t) 7903 (when (and (org-at-heading-p) (not (eobp))) (backward-char 1)) 7904 (point))))))) 7905 7906 (defun org-toggle-narrow-to-subtree () 7907 "Narrow to the subtree at point or widen a narrowed buffer." 7908 (interactive) 7909 (if (buffer-narrowed-p) 7910 (progn (widen) (message "Buffer widen")) 7911 (org-narrow-to-subtree) 7912 (message "Buffer narrowed to current subtree"))) 7913 7914 (defun org-narrow-to-block () 7915 "Narrow buffer to the current block." 7916 (interactive) 7917 (let* ((case-fold-search t) 7918 (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*" 7919 "^[ \t]*#\\+end_.*"))) 7920 (if blockp 7921 (narrow-to-region (car blockp) (cdr blockp)) 7922 (user-error "Not in a block")))) 7923 7924 (defun org-clone-subtree-with-time-shift (n &optional shift) 7925 "Clone the task (subtree) at point N times. 7926 The clones will be inserted as siblings. 7927 7928 In interactive use, the user will be prompted for the number of 7929 clones to be produced. If the entry has a timestamp, the user 7930 will also be prompted for a time shift, which may be a repeater 7931 as used in time stamps, for example `+3d'. To disable this, 7932 you can call the function with a universal prefix argument. 7933 7934 When a valid repeater is given and the entry contains any time 7935 stamps, the clones will become a sequence in time, with time 7936 stamps in the subtree shifted for each clone produced. If SHIFT 7937 is nil or the empty string, time stamps will be left alone. The 7938 ID property of the original subtree is removed. 7939 7940 In each clone, all the CLOCK entries will be removed. This 7941 prevents Org from considering that the clocked times overlap. 7942 7943 If the original subtree did contain time stamps with a repeater, 7944 the following will happen: 7945 - the repeater will be removed in each clone 7946 - an additional clone will be produced, with the current, unshifted 7947 date(s) in the entry. 7948 - the original entry will be placed *after* all the clones, with 7949 repeater intact. 7950 - the start days in the repeater in the original entry will be shifted 7951 to past the last clone. 7952 In this way you can spell out a number of instances of a repeating task, 7953 and still retain the repeater to cover future instances of the task. 7954 7955 As described above, N+1 clones are produced when the original 7956 subtree has a repeater. Setting N to 0, then, can be used to 7957 remove the repeater from a subtree and create a shifted clone 7958 with the original repeater." 7959 (interactive "nNumber of clones to produce: ") 7960 (unless (wholenump n) (user-error "Invalid number of replications %s" n)) 7961 (when (org-before-first-heading-p) (user-error "No subtree to clone")) 7962 (let* ((beg (save-excursion (org-back-to-heading t) (point))) 7963 (end-of-tree (save-excursion (org-end-of-subtree t t) (point))) 7964 (shift 7965 (or shift 7966 (if (and (not (equal current-prefix-arg '(4))) 7967 (save-excursion 7968 (goto-char beg) 7969 (re-search-forward org-ts-regexp-both end-of-tree t))) 7970 (read-from-minibuffer 7971 "Date shift per clone (e.g. +1w, empty to copy unchanged): ") 7972 ""))) ;No time shift 7973 (doshift 7974 (and (org-string-nw-p shift) 7975 (or (string-match "\\`[ \t]*\\([+-]?[0-9]+\\)\\([hdwmy]\\)[ \t]*\\'" 7976 shift) 7977 (user-error "Invalid shift specification %s" shift))))) 7978 (goto-char end-of-tree) 7979 (unless (bolp) (insert "\n")) 7980 (let* ((end (point)) 7981 (template (buffer-substring beg end)) 7982 (shift-n (and doshift (string-to-number (match-string 1 shift)))) 7983 (shift-what (pcase (and doshift (match-string 2 shift)) 7984 (`nil nil) 7985 ("h" 'hour) 7986 ("d" 'day) 7987 ("w" (setq shift-n (* 7 shift-n)) 'day) 7988 ("m" 'month) 7989 ("y" 'year) 7990 (_ (error "Unsupported time unit")))) 7991 (nmin 1) 7992 (nmax n) 7993 (n-no-remove -1) 7994 (org-id-overriding-file-name (buffer-file-name (buffer-base-buffer))) 7995 (idprop (org-entry-get beg "ID"))) 7996 (when (and doshift 7997 (string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" 7998 template)) 7999 (delete-region beg end) 8000 (setq end beg) 8001 (setq nmin 0) 8002 (setq nmax (1+ nmax)) 8003 (setq n-no-remove nmax)) 8004 (goto-char end) 8005 (cl-loop for n from nmin to nmax do 8006 (insert 8007 ;; Prepare clone. 8008 (with-temp-buffer 8009 (insert template) 8010 (org-mode) 8011 (goto-char (point-min)) 8012 (org-show-subtree) 8013 (and idprop (if org-clone-delete-id 8014 (org-entry-delete nil "ID") 8015 (org-id-get-create t))) 8016 (unless (= n 0) 8017 (while (re-search-forward org-clock-line-re nil t) 8018 (delete-region (line-beginning-position) 8019 (line-beginning-position 2))) 8020 (goto-char (point-min)) 8021 (while (re-search-forward org-drawer-regexp nil t) 8022 (org-remove-empty-drawer-at (point)))) 8023 (goto-char (point-min)) 8024 (when doshift 8025 (while (re-search-forward org-ts-regexp-both nil t) 8026 (org-timestamp-change (* n shift-n) shift-what)) 8027 (unless (= n n-no-remove) 8028 (goto-char (point-min)) 8029 (while (re-search-forward org-ts-regexp nil t) 8030 (save-excursion 8031 (goto-char (match-beginning 0)) 8032 (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") 8033 (delete-region (match-beginning 1) (match-end 1))))))) 8034 (buffer-string))))) 8035 (goto-char beg))) 8036 8037 ;;; Outline path 8038 8039 (defvar org-outline-path-cache nil 8040 "Alist between buffer positions and outline paths. 8041 It value is an alist (POSITION . PATH) where POSITION is the 8042 buffer position at the beginning of an entry and PATH is a list 8043 of strings describing the outline path for that entry, in reverse 8044 order.") 8045 8046 (defun org--get-outline-path-1 (&optional use-cache) 8047 "Return outline path to current headline. 8048 8049 Outline path is a list of strings, in reverse order. When 8050 optional argument USE-CACHE is non-nil, make use of a cache. See 8051 `org-get-outline-path' for details. 8052 8053 Assume buffer is widened and point is on a headline." 8054 (or (and use-cache (cdr (assq (point) org-outline-path-cache))) 8055 (let ((p (point)) 8056 (heading (let ((case-fold-search nil)) 8057 (looking-at org-complex-heading-regexp) 8058 (if (not (match-end 4)) "" 8059 ;; Remove statistics cookies. 8060 (org-trim 8061 (org-link-display-format 8062 (replace-regexp-in-string 8063 "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" 8064 (match-string-no-properties 4)))))))) 8065 (if (org-up-heading-safe) 8066 (let ((path (cons heading (org--get-outline-path-1 use-cache)))) 8067 (when use-cache 8068 (push (cons p path) org-outline-path-cache)) 8069 path) 8070 ;; This is a new root node. Since we assume we are moving 8071 ;; forward, we can drop previous cache so as to limit number 8072 ;; of associations there. 8073 (let ((path (list heading))) 8074 (when use-cache (setq org-outline-path-cache (list (cons p path)))) 8075 path))))) 8076 8077 (defun org-get-outline-path (&optional with-self use-cache) 8078 "Return the outline path to the current entry. 8079 8080 An outline path is a list of ancestors for current headline, as 8081 a list of strings. Statistics cookies are removed and links are 8082 replaced with their description, if any, or their path otherwise. 8083 8084 When optional argument WITH-SELF is non-nil, the path also 8085 includes the current headline. 8086 8087 When optional argument USE-CACHE is non-nil, cache outline paths 8088 between calls to this function so as to avoid backtracking. This 8089 argument is useful when planning to find more than one outline 8090 path in the same document. In that case, there are two 8091 conditions to satisfy: 8092 - `org-outline-path-cache' is set to nil before starting the 8093 process; 8094 - outline paths are computed by increasing buffer positions." 8095 (org-with-wide-buffer 8096 (and (or (and with-self (org-back-to-heading t)) 8097 (org-up-heading-safe)) 8098 (reverse (org--get-outline-path-1 use-cache))))) 8099 8100 (defun org-format-outline-path (path &optional width prefix separator) 8101 "Format the outline path PATH for display. 8102 WIDTH is the maximum number of characters that is available. 8103 PREFIX is a prefix to be included in the returned string, 8104 such as the file name. 8105 SEPARATOR is inserted between the different parts of the path, 8106 the default is \"/\"." 8107 (setq width (or width 79)) 8108 (setq path (delq nil path)) 8109 (unless (> width 0) 8110 (user-error "Argument `width' must be positive")) 8111 (setq separator (or separator "/")) 8112 (let* ((org-odd-levels-only nil) 8113 (fpath (concat 8114 prefix (and prefix path separator) 8115 (mapconcat 8116 (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) 8117 (cl-loop for head in path 8118 for n from 0 8119 collect (org-add-props 8120 head nil 'face 8121 (nth (% n org-n-level-faces) org-level-faces))) 8122 separator)))) 8123 (when (> (length fpath) width) 8124 (if (< width 7) 8125 ;; It's unlikely that `width' will be this small, but don't 8126 ;; waste characters by adding ".." if it is. 8127 (setq fpath (substring fpath 0 width)) 8128 (setf (substring fpath (- width 2)) ".."))) 8129 fpath)) 8130 8131 (defun org-display-outline-path (&optional file current separator just-return-string) 8132 "Display the current outline path in the echo area. 8133 8134 If FILE is non-nil, prepend the output with the file name. 8135 If CURRENT is non-nil, append the current heading to the output. 8136 SEPARATOR is passed through to `org-format-outline-path'. It separates 8137 the different parts of the path and defaults to \"/\". 8138 If JUST-RETURN-STRING is non-nil, return a string, don't display a message." 8139 (interactive "P") 8140 (let* (case-fold-search 8141 (bfn (buffer-file-name (buffer-base-buffer))) 8142 (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) 8143 res) 8144 (when current (setq path (append path 8145 (save-excursion 8146 (org-back-to-heading t) 8147 (when (looking-at org-complex-heading-regexp) 8148 (list (match-string 4))))))) 8149 (setq res 8150 (org-format-outline-path 8151 path 8152 (1- (frame-width)) 8153 (and file bfn (concat (file-name-nondirectory bfn) separator)) 8154 separator)) 8155 (add-face-text-property 0 (length res) 8156 `(:height ,(face-attribute 'default :height)) 8157 nil res) 8158 (if just-return-string 8159 res 8160 (org-unlogged-message "%s" res)))) 8161 8162 ;;; Outline Sorting 8163 8164 (defun org-sort (&optional with-case) 8165 "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'. 8166 Optional argument WITH-CASE means sort case-sensitively." 8167 (interactive "P") 8168 (org-call-with-arg 8169 (cond ((org-at-table-p) #'org-table-sort-lines) 8170 ((org-at-item-p) #'org-sort-list) 8171 (t #'org-sort-entries)) 8172 with-case)) 8173 8174 (defun org-sort-remove-invisible (s) 8175 "Remove emphasis markers and any invisible property from string S. 8176 Assume S may contain only objects." 8177 ;; org-element-interpret-data clears any text property, including 8178 ;; invisible part. 8179 (org-element-interpret-data 8180 (let ((tree (org-element-parse-secondary-string 8181 s (org-element-restriction 'paragraph)))) 8182 (org-element-map tree '(bold code italic link strike-through underline verbatim) 8183 (lambda (o) 8184 (pcase (org-element-type o) 8185 ;; Terminal object. Replace it with its value. 8186 ((or `code `verbatim) 8187 (let ((new (org-element-property :value o))) 8188 (org-element-insert-before new o) 8189 (org-element-put-property 8190 new :post-blank (org-element-property :post-blank o)))) 8191 ;; Non-terminal objects. Splice contents. 8192 (type 8193 (let ((contents 8194 (or (org-element-contents o) 8195 (and (eq type 'link) 8196 (list (org-element-property :raw-link o))))) 8197 (c nil)) 8198 (while contents 8199 (setq c (pop contents)) 8200 (org-element-insert-before c o)) 8201 (org-element-put-property 8202 c :post-blank (org-element-property :post-blank o))))) 8203 (org-element-extract-element o))) 8204 ;; Return modified tree. 8205 tree))) 8206 8207 (defvar org-after-sorting-entries-or-items-hook nil 8208 "Hook that is run after a bunch of entries or items have been sorted. 8209 When children are sorted, the cursor is in the parent line when this 8210 hook gets called. When a region or a plain list is sorted, the cursor 8211 will be in the first entry of the sorted region/list.") 8212 8213 (defun org-sort-entries 8214 (&optional with-case sorting-type getkey-func compare-func property 8215 interactive?) 8216 "Sort entries on a certain level of an outline tree. 8217 If there is an active region, the entries in the region are sorted. 8218 Else, if the cursor is before the first entry, sort the top-level items. 8219 Else, the children of the entry at point are sorted. 8220 8221 Sorting can be alphabetically, numerically, by date/time as given by 8222 a time stamp, by a property, by priority order, or by a custom function. 8223 8224 The command prompts for the sorting type unless it has been given to the 8225 function through the SORTING-TYPE argument, which needs to be a character, 8226 \(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F ?k ?K). Here is 8227 the precise meaning of each character: 8228 8229 a Alphabetically, ignoring the TODO keyword and the priority, if any. 8230 c By creation time, which is assumed to be the first inactive time stamp 8231 at the beginning of a line. 8232 d By deadline date/time. 8233 k By clocking time. 8234 n Numerically, by converting the beginning of the entry/item to a number. 8235 o By order of TODO keywords. 8236 p By priority according to the cookie. 8237 r By the value of a property. 8238 s By scheduled date/time. 8239 t By date/time, either the first active time stamp in the entry, or, if 8240 none exist, by the first inactive one. 8241 8242 Capital letters will reverse the sort order. 8243 8244 If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be 8245 called with point at the beginning of the record. It must return a 8246 value that is compatible with COMPARE-FUNC, the function used to 8247 compare entries. 8248 8249 Comparing entries ignores case by default. However, with an optional argument 8250 WITH-CASE, the sorting considers case as well. 8251 8252 Sorting is done against the visible part of the headlines, it ignores hidden 8253 links. 8254 8255 When sorting is done, call `org-after-sorting-entries-or-items-hook'. 8256 8257 A non-nil value for INTERACTIVE? is used to signal that this 8258 function is being called interactively." 8259 (interactive (list current-prefix-arg nil nil nil nil t)) 8260 (let ((case-func (if with-case 'identity 'downcase)) 8261 start beg end stars re re2 8262 txt what tmp) 8263 ;; Find beginning and end of region to sort 8264 (cond 8265 ((org-region-active-p) 8266 ;; we will sort the region 8267 (setq end (region-end) 8268 what "region") 8269 (goto-char (region-beginning)) 8270 (unless (org-at-heading-p) (outline-next-heading)) 8271 (setq start (point))) 8272 ((or (org-at-heading-p) 8273 (ignore-errors (progn (org-back-to-heading) t))) 8274 ;; we will sort the children of the current headline 8275 (org-back-to-heading) 8276 (setq start (point) 8277 end (progn (org-end-of-subtree t t) 8278 (or (bolp) (insert "\n")) 8279 (when (>= (org-back-over-empty-lines) 1) 8280 (forward-line 1)) 8281 (point)) 8282 what "children") 8283 (goto-char start) 8284 (outline-show-subtree) 8285 (outline-next-heading)) 8286 (t 8287 ;; we will sort the top-level entries in this file 8288 (goto-char (point-min)) 8289 (or (org-at-heading-p) (outline-next-heading)) 8290 (setq start (point)) 8291 (goto-char (point-max)) 8292 (beginning-of-line 1) 8293 (when (looking-at ".*?\\S-") 8294 ;; File ends in a non-white line 8295 (end-of-line 1) 8296 (insert "\n")) 8297 (setq end (point-max)) 8298 (setq what "top-level") 8299 (goto-char start) 8300 (org-show-all '(headings drawers blocks)))) 8301 8302 (setq beg (point)) 8303 (when (>= beg end) (goto-char start) (user-error "Nothing to sort")) 8304 8305 (looking-at "\\(\\*+\\)") 8306 (setq stars (match-string 1) 8307 re (concat "^" (regexp-quote stars) " +") 8308 re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]") 8309 txt (buffer-substring beg end)) 8310 (unless (equal (substring txt -1) "\n") (setq txt (concat txt "\n"))) 8311 (when (and (not (equal stars "*")) (string-match re2 txt)) 8312 (user-error "Region to sort contains a level above the first entry")) 8313 8314 (unless sorting-type 8315 (message 8316 "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc 8317 [t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing 8318 A/N/P/R/O/F/T/S/D/C/K means reversed:" 8319 what) 8320 (setq sorting-type (read-char-exclusive))) 8321 8322 (unless getkey-func 8323 (and (= (downcase sorting-type) ?f) 8324 (setq getkey-func 8325 (or (and interactive? 8326 (org-read-function 8327 "Function for extracting keys: ")) 8328 (error "Missing key extractor"))))) 8329 8330 (and (= (downcase sorting-type) ?r) 8331 (not property) 8332 (setq property 8333 (completing-read "Property: " 8334 (mapcar #'list (org-buffer-property-keys t)) 8335 nil t))) 8336 8337 (when (member sorting-type '(?k ?K)) (org-clock-sum)) 8338 (message "Sorting entries...") 8339 8340 (save-restriction 8341 (narrow-to-region start end) 8342 (let ((restore-clock? 8343 ;; The clock marker is lost when using `sort-subr'; mark 8344 ;; the clock with temporary `:org-clock-marker-backup' 8345 ;; text property. 8346 (when (and (eq (org-clocking-buffer) (current-buffer)) 8347 (<= start (marker-position org-clock-marker)) 8348 (>= end (marker-position org-clock-marker))) 8349 (with-silent-modifications 8350 (put-text-property (1- org-clock-marker) org-clock-marker 8351 :org-clock-marker-backup t)) 8352 t)) 8353 (dcst (downcase sorting-type)) 8354 (case-fold-search nil) 8355 (now (current-time))) 8356 (org-preserve-local-variables 8357 (sort-subr 8358 (/= dcst sorting-type) 8359 ;; This function moves to the beginning character of the 8360 ;; "record" to be sorted. 8361 (lambda nil 8362 (if (re-search-forward re nil t) 8363 (goto-char (match-beginning 0)) 8364 (goto-char (point-max)))) 8365 ;; This function moves to the last character of the "record" being 8366 ;; sorted. 8367 (lambda nil 8368 (save-match-data 8369 (condition-case nil 8370 (outline-forward-same-level 1) 8371 (error 8372 (goto-char (point-max)))))) 8373 ;; This function returns the value that gets sorted against. 8374 (lambda () 8375 (cond 8376 ((= dcst ?n) 8377 (string-to-number 8378 (org-sort-remove-invisible (org-get-heading t t t t)))) 8379 ((= dcst ?a) 8380 (funcall case-func 8381 (org-sort-remove-invisible (org-get-heading t t t t)))) 8382 ((= dcst ?k) 8383 (or (get-text-property (point) :org-clock-minutes) 0)) 8384 ((= dcst ?t) 8385 (let ((end (save-excursion (outline-next-heading) (point)))) 8386 (if (or (re-search-forward org-ts-regexp end t) 8387 (re-search-forward org-ts-regexp-both end t)) 8388 (org-time-string-to-seconds (match-string 0)) 8389 (float-time now)))) 8390 ((= dcst ?c) 8391 (let ((end (save-excursion (outline-next-heading) (point)))) 8392 (if (re-search-forward 8393 (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") 8394 end t) 8395 (org-time-string-to-seconds (match-string 0)) 8396 (float-time now)))) 8397 ((= dcst ?s) 8398 (let ((end (save-excursion (outline-next-heading) (point)))) 8399 (if (re-search-forward org-scheduled-time-regexp end t) 8400 (org-time-string-to-seconds (match-string 1)) 8401 (float-time now)))) 8402 ((= dcst ?d) 8403 (let ((end (save-excursion (outline-next-heading) (point)))) 8404 (if (re-search-forward org-deadline-time-regexp end t) 8405 (org-time-string-to-seconds (match-string 1)) 8406 (float-time now)))) 8407 ((= dcst ?p) 8408 (if (re-search-forward org-priority-regexp (point-at-eol) t) 8409 (string-to-char (match-string 2)) 8410 org-priority-default)) 8411 ((= dcst ?r) 8412 (or (org-entry-get nil property) "")) 8413 ((= dcst ?o) 8414 (when (looking-at org-complex-heading-regexp) 8415 (let* ((m (match-string 2)) 8416 (s (if (member m org-done-keywords) '- '+))) 8417 (- 99 (funcall s (length (member m org-todo-keywords-1))))))) 8418 ((= dcst ?f) 8419 (if getkey-func 8420 (progn 8421 (setq tmp (funcall getkey-func)) 8422 (when (stringp tmp) (setq tmp (funcall case-func tmp))) 8423 tmp) 8424 (error "Invalid key function `%s'" getkey-func))) 8425 (t (error "Invalid sorting type `%c'" sorting-type)))) 8426 nil 8427 (cond 8428 ((= dcst ?a) 'org-string-collate-lessp) 8429 ((= dcst ?f) 8430 (or compare-func 8431 (and interactive? 8432 (org-read-function 8433 (concat "Function for comparing keys " 8434 "(empty for default `sort-subr' predicate): ") 8435 'allow-empty)))) 8436 ((member dcst '(?p ?t ?s ?d ?c ?k)) '<)))) 8437 (org-cycle-hide-drawers 'all) 8438 (when restore-clock? 8439 (move-marker org-clock-marker 8440 (1+ (next-single-property-change 8441 start :org-clock-marker-backup))) 8442 (remove-text-properties (1- org-clock-marker) org-clock-marker 8443 '(:org-clock-marker-backup t))))) 8444 (run-hooks 'org-after-sorting-entries-or-items-hook) 8445 (message "Sorting entries...done"))) 8446 8447 (defun org-contextualize-keys (alist contexts) 8448 "Return valid elements in ALIST depending on CONTEXTS. 8449 8450 `org-agenda-custom-commands' or `org-capture-templates' are the 8451 values used for ALIST, and `org-agenda-custom-commands-contexts' 8452 or `org-capture-templates-contexts' are the associated contexts 8453 definitions." 8454 (let ((contexts 8455 ;; normalize contexts 8456 (mapcar 8457 (lambda(c) (cond ((listp (cadr c)) 8458 (list (car c) (car c) (nth 1 c))) 8459 ((string= "" (cadr c)) 8460 (list (car c) (car c) (nth 2 c))) 8461 (t c))) 8462 contexts)) 8463 (a alist) r s) 8464 ;; loop over all commands or templates 8465 (dolist (c a) 8466 (let (vrules repl) 8467 (cond 8468 ((not (assoc (car c) contexts)) 8469 (push c r)) 8470 ((and (assoc (car c) contexts) 8471 (setq vrules (org-contextualize-validate-key 8472 (car c) contexts))) 8473 (mapc (lambda (vr) 8474 (unless (equal (car vr) (cadr vr)) 8475 (setq repl vr))) 8476 vrules) 8477 (if (not repl) (push c r) 8478 (push (cadr repl) s) 8479 (push 8480 (cons (car c) 8481 (cdr (or (assoc (cadr repl) alist) 8482 (error "Undefined key `%s' as contextual replacement for `%s'" 8483 (cadr repl) (car c))))) 8484 r)))))) 8485 ;; Return limited ALIST, possibly with keys modified, and deduplicated 8486 (delq 8487 nil 8488 (delete-dups 8489 (mapcar (lambda (x) 8490 (let ((tpl (car x))) 8491 (unless (delq 8492 nil 8493 (mapcar (lambda (y) 8494 (equal y tpl)) 8495 s)) 8496 x))) 8497 (reverse r)))))) 8498 8499 (defun org-contextualize-validate-key (key contexts) 8500 "Check CONTEXTS for agenda or capture KEY." 8501 (let (res) 8502 (dolist (r contexts) 8503 (dolist (rr (car (last r))) 8504 (when 8505 (and (equal key (car r)) 8506 (if (functionp rr) (funcall rr) 8507 (or (and (eq (car rr) 'in-file) 8508 (buffer-file-name) 8509 (string-match (cdr rr) (buffer-file-name))) 8510 (and (eq (car rr) 'in-mode) 8511 (string-match (cdr rr) (symbol-name major-mode))) 8512 (and (eq (car rr) 'in-buffer) 8513 (string-match (cdr rr) (buffer-name))) 8514 (when (and (eq (car rr) 'not-in-file) 8515 (buffer-file-name)) 8516 (not (string-match (cdr rr) (buffer-file-name)))) 8517 (when (eq (car rr) 'not-in-mode) 8518 (not (string-match (cdr rr) (symbol-name major-mode)))) 8519 (when (eq (car rr) 'not-in-buffer) 8520 (not (string-match (cdr rr) (buffer-name))))))) 8521 (push r res)))) 8522 (delete-dups (delq nil res)))) 8523 8524 ;; Defined to provide a value for defcustom, since there is no 8525 ;; string-collate-greaterp in Emacs. 8526 (defun org-string-collate-greaterp (s1 s2) 8527 "Return non-nil if S1 is greater than S2 in collation order." 8528 (not (org-string-collate-lessp s1 s2))) 8529 8530 ;;;###autoload 8531 (defun org-run-like-in-org-mode (cmd) 8532 "Run a command, pretending that the current buffer is in Org mode. 8533 This will temporarily bind local variables that are typically bound in 8534 Org mode to the values they have in Org mode, and then interactively 8535 call CMD." 8536 (org-load-modules-maybe) 8537 (let (binds) 8538 (dolist (var (org-get-local-variables)) 8539 (when (or (not (boundp (car var))) 8540 (eq (symbol-value (car var)) 8541 (default-value (car var)))) 8542 (push (list (car var) `(quote ,(cadr var))) binds))) 8543 (eval `(let ,binds 8544 (call-interactively (quote ,cmd)))))) 8545 8546 (defun org-get-category (&optional pos force-refresh) 8547 "Get the category applying to position POS." 8548 (save-match-data 8549 (when force-refresh (org-refresh-category-properties)) 8550 (let ((pos (or pos (point)))) 8551 (or (get-text-property pos 'org-category) 8552 (progn (org-refresh-category-properties) 8553 (get-text-property pos 'org-category)))))) 8554 8555 ;;; Refresh properties 8556 8557 (defun org-refresh-properties (dprop tprop) 8558 "Refresh buffer text properties. 8559 DPROP is the drawer property and TPROP is either the 8560 corresponding text property to set, or an alist with each element 8561 being a text property (as a symbol) and a function to apply to 8562 the value of the drawer property." 8563 (let* ((case-fold-search t) 8564 (inhibit-read-only t) 8565 (inherit? (org-property-inherit-p dprop)) 8566 (property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t)) 8567 (global-or-keyword (and inherit? 8568 (org--property-global-or-keyword-value dprop nil)))) 8569 (with-silent-modifications 8570 (org-with-point-at 1 8571 ;; Set global and keyword based values to the whole buffer. 8572 (when global-or-keyword 8573 (put-text-property (point-min) (point-max) tprop global-or-keyword)) 8574 ;; Set values based on property-drawers throughout the document. 8575 (while (re-search-forward property-re nil t) 8576 (when (org-at-property-p) 8577 (org-refresh-property tprop (org-entry-get (point) dprop) inherit?)) 8578 (outline-next-heading)))))) 8579 8580 (defun org-refresh-property (tprop p &optional inherit) 8581 "Refresh the buffer text property TPROP from the drawer property P. 8582 8583 The refresh happens only for the current entry, or the whole 8584 sub-tree if optional argument INHERIT is non-nil. 8585 8586 If point is before first headline, the function applies to the 8587 part before the first headline. In that particular case, when 8588 optional argument INHERIT is non-nil, it refreshes properties for 8589 the whole buffer." 8590 (save-excursion 8591 (org-back-to-heading-or-point-min t) 8592 (let ((start (point)) 8593 (end (save-excursion 8594 (cond ((and inherit (org-before-first-heading-p)) 8595 (point-max)) 8596 (inherit 8597 (org-end-of-subtree t t)) 8598 ((outline-next-heading)) 8599 ((point-max)))))) 8600 (if (symbolp tprop) 8601 ;; TPROP is a text property symbol. 8602 (put-text-property start end tprop p) 8603 ;; TPROP is an alist with (property . function) elements. 8604 (pcase-dolist (`(,prop . ,f) tprop) 8605 (put-text-property start end prop (funcall f p))))))) 8606 8607 (defun org-refresh-category-properties () 8608 "Refresh category text properties in the buffer." 8609 (let ((case-fold-search t) 8610 (inhibit-read-only t) 8611 (default-category 8612 (cond ((null org-category) 8613 (if buffer-file-name 8614 (file-name-sans-extension 8615 (file-name-nondirectory buffer-file-name)) 8616 "???")) 8617 ((symbolp org-category) (symbol-name org-category)) 8618 (t org-category)))) 8619 (with-silent-modifications 8620 (org-with-wide-buffer 8621 ;; Set buffer-wide property from keyword. Search last #+CATEGORY 8622 ;; keyword. If none is found, fall-back to `org-category' or 8623 ;; buffer file name, or set it by the document property drawer. 8624 (put-text-property 8625 (point-min) (point-max) 8626 'org-category 8627 (catch 'buffer-category 8628 (goto-char (point-max)) 8629 (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t) 8630 (let ((element (org-element-at-point))) 8631 (when (eq (org-element-type element) 'keyword) 8632 (throw 'buffer-category 8633 (org-element-property :value element))))) 8634 default-category)) 8635 ;; Set categories from the document property drawer or 8636 ;; property drawers in the outline. If category is found in 8637 ;; the property drawer for the whole buffer that value 8638 ;; overrides the keyword-based value set above. 8639 (goto-char (point-min)) 8640 (let ((regexp (org-re-property "CATEGORY"))) 8641 (while (re-search-forward regexp nil t) 8642 (let ((value (match-string-no-properties 3))) 8643 (when (org-at-property-p) 8644 (put-text-property 8645 (save-excursion (org-back-to-heading-or-point-min t)) 8646 (save-excursion (if (org-before-first-heading-p) 8647 (point-max) 8648 (org-end-of-subtree t t))) 8649 'org-category 8650 value))))))))) 8651 8652 (defun org-refresh-stats-properties () 8653 "Refresh stats text properties in the buffer." 8654 (with-silent-modifications 8655 (org-with-point-at 1 8656 (let ((regexp (concat org-outline-regexp-bol 8657 ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]"))) 8658 (while (re-search-forward regexp nil t) 8659 (let* ((numerator (string-to-number (match-string 1))) 8660 (denominator (and (match-end 2) 8661 (string-to-number (match-string 2)))) 8662 (stats (cond ((not denominator) numerator) ;percent 8663 ((= denominator 0) 0) 8664 (t (/ (* numerator 100) denominator))))) 8665 (put-text-property (point) (progn (org-end-of-subtree t t) (point)) 8666 'org-stats stats))))))) 8667 8668 (defun org-refresh-effort-properties () 8669 "Refresh effort properties." 8670 (org-refresh-properties 8671 org-effort-property 8672 '((effort . identity) 8673 (effort-minutes . org-duration-to-minutes)))) 8674 8675 (defun org-find-file-at-mouse (ev) 8676 "Open file link or URL at mouse." 8677 (interactive "e") 8678 (mouse-set-point ev) 8679 (org-open-at-point 'in-emacs)) 8680 8681 (defun org-open-at-mouse (ev) 8682 "Open file link or URL at mouse. 8683 See the docstring of `org-open-file' for details." 8684 (interactive "e") 8685 (mouse-set-point ev) 8686 (when (eq major-mode 'org-agenda-mode) 8687 (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) 8688 (org-open-at-point)) 8689 8690 (defvar org-window-config-before-follow-link nil 8691 "The window configuration before following a link. 8692 This is saved in case the need arises to restore it.") 8693 8694 (defun org--file-default-apps () 8695 "Return the default applications for this operating system." 8696 (pcase system-type 8697 (`darwin org-file-apps-macos) 8698 (`windows-nt org-file-apps-windowsnt) 8699 (_ org-file-apps-gnu))) 8700 8701 (defun org--file-apps-entry-dlink-p (entry) 8702 "Non-nil if ENTRY should be matched against the link by `org-open-file'. 8703 8704 It assumes that is the case when the entry uses a regular 8705 expression which has at least one grouping construct and the 8706 action is either a Lisp form or a command string containing 8707 \"%1\", i.e., using at least one subexpression match as 8708 a parameter." 8709 (pcase entry 8710 (`(,selector . ,action) 8711 (and (stringp selector) 8712 (> (regexp-opt-depth selector) 0) 8713 (or (and (stringp action) 8714 (string-match "%[0-9]" action)) 8715 (consp action)))) 8716 (_ nil))) 8717 8718 (defun org--file-apps-regexp-alist (list &optional add-auto-mode) 8719 "Convert extensions to regular expressions in the cars of LIST. 8720 8721 Also, weed out any non-string entries, because the return value 8722 is used only for regexp matching. 8723 8724 When ADD-AUTO-MODE is non-nil, make all matches in `auto-mode-alist' 8725 point to the symbol `emacs', indicating that the file should be 8726 opened in Emacs." 8727 (append 8728 (delq nil 8729 (mapcar (lambda (x) 8730 (unless (not (stringp (car x))) 8731 (if (string-match "\\W" (car x)) 8732 x 8733 (cons (concat "\\." (car x) "\\'") (cdr x))))) 8734 list)) 8735 (when add-auto-mode 8736 (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) 8737 8738 ;;;###autoload 8739 (defun org-open-file (path &optional in-emacs line search) 8740 "Open the file at PATH. 8741 First, this expands any special file name abbreviations. Then the 8742 configuration variable `org-file-apps' is checked if it contains an 8743 entry for this file type, and if yes, the corresponding command is launched. 8744 8745 If no application is found, Emacs simply visits the file. 8746 8747 With optional prefix argument IN-EMACS, Emacs will visit the file. 8748 With a double \\[universal-argument] \\[universal-argument] \ 8749 prefix arg, Org tries to avoid opening in Emacs 8750 and to use an external application to visit the file. 8751 8752 Optional LINE specifies a line to go to, optional SEARCH a string 8753 to search for. If LINE or SEARCH is given, the file will be 8754 opened in Emacs, unless an entry from `org-file-apps' that makes 8755 use of groups in a regexp matches. 8756 8757 If you want to change the way frames are used when following a 8758 link, please customize `org-link-frame-setup'. 8759 8760 If the file does not exist, throw an error." 8761 (let* ((file (if (equal path "") buffer-file-name 8762 (substitute-in-file-name (expand-file-name path)))) 8763 (file-apps (append org-file-apps (org--file-default-apps))) 8764 (apps (cl-remove-if #'org--file-apps-entry-dlink-p file-apps)) 8765 (apps-dlink (cl-remove-if-not #'org--file-apps-entry-dlink-p 8766 file-apps)) 8767 (remp (and (assq 'remote apps) (file-remote-p file))) 8768 (dirp (unless remp (file-directory-p file))) 8769 (file (if (and dirp org-open-directory-means-index-dot-org) 8770 (concat (file-name-as-directory file) "index.org") 8771 file)) 8772 (a-m-a-p (assq 'auto-mode apps)) 8773 (dfile (downcase file)) 8774 ;; Reconstruct the original link from the PATH, LINE and 8775 ;; SEARCH args. 8776 (link (cond (line (concat file "::" (number-to-string line))) 8777 (search (concat file "::" search)) 8778 (t file))) 8779 (dlink (downcase link)) 8780 (ext 8781 (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile) 8782 (match-string 1 dfile))) 8783 (save-position-maybe 8784 (let ((old-buffer (current-buffer)) 8785 (old-pos (point)) 8786 (old-mode major-mode)) 8787 (lambda () 8788 (and (derived-mode-p 'org-mode) 8789 (eq old-mode 'org-mode) 8790 (or (not (eq old-buffer (current-buffer))) 8791 (not (eq old-pos (point)))) 8792 (org-mark-ring-push old-pos old-buffer))))) 8793 cmd link-match-data) 8794 (cond 8795 ((member in-emacs '((16) system)) 8796 (setq cmd (cdr (assq 'system apps)))) 8797 (in-emacs (setq cmd 'emacs)) 8798 (t 8799 (setq cmd (or (and remp (cdr (assq 'remote apps))) 8800 (and dirp (cdr (assq 'directory apps))) 8801 ;; First, try matching against apps-dlink if we 8802 ;; get a match here, store the match data for 8803 ;; later. 8804 (let ((match (assoc-default dlink apps-dlink 8805 'string-match))) 8806 (if match 8807 (progn (setq link-match-data (match-data)) 8808 match) 8809 (progn (setq in-emacs (or in-emacs line search)) 8810 nil))) ; if we have no match in apps-dlink, 8811 ; always open the file in emacs if line or search 8812 ; is given (for backwards compatibility) 8813 (assoc-default dfile 8814 (org--file-apps-regexp-alist apps a-m-a-p) 8815 'string-match) 8816 (cdr (assoc ext apps)) 8817 (cdr (assq t apps)))))) 8818 (when (eq cmd 'system) 8819 (setq cmd (cdr (assq 'system apps)))) 8820 (when (eq cmd 'default) 8821 (setq cmd (cdr (assoc t apps)))) 8822 (when (eq cmd 'mailcap) 8823 (require 'mailcap) 8824 (mailcap-parse-mailcaps) 8825 (let* ((mime-type (mailcap-extension-to-mime (or ext ""))) 8826 (command (mailcap-mime-info mime-type))) 8827 (if (stringp command) 8828 (setq cmd command) 8829 (setq cmd 'emacs)))) 8830 (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files 8831 (not (file-exists-p file)) 8832 (not org-open-non-existing-files)) 8833 (user-error "No such file: %s" file)) 8834 (cond 8835 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) 8836 ;; Remove quotes around the file name - we'll use shell-quote-argument. 8837 (while (string-match "['\"]%s['\"]" cmd) 8838 (setq cmd (replace-match "%s" t t cmd))) 8839 (setq cmd (replace-regexp-in-string 8840 "%s" 8841 (shell-quote-argument (convert-standard-filename file)) 8842 cmd 8843 nil t)) 8844 8845 ;; Replace "%1", "%2" etc. in command with group matches from regex 8846 (save-match-data 8847 (let ((match-index 1) 8848 (number-of-groups (- (/ (length link-match-data) 2) 1))) 8849 (set-match-data link-match-data) 8850 (while (<= match-index number-of-groups) 8851 (let ((regex (concat "%" (number-to-string match-index))) 8852 (replace-with (match-string match-index dlink))) 8853 (while (string-match regex cmd) 8854 (setq cmd (replace-match replace-with t t cmd)))) 8855 (setq match-index (+ match-index 1))))) 8856 8857 (save-window-excursion 8858 (message "Running %s...done" cmd) 8859 ;; Handlers such as "gio open" and kde-open5 start viewer in background 8860 ;; and exit immediately. Use pipe connection type instead of pty to 8861 ;; avoid killing children processes with SIGHUP when temporary terminal 8862 ;; session is finished. 8863 ;; 8864 ;; TODO: Once minimum Emacs version is 25.1 or above, consider using 8865 ;; the `make-process' invocation from 5db61eb0f929 to get more helpful 8866 ;; error messages. 8867 (let ((process-connection-type nil)) 8868 (start-process-shell-command cmd nil cmd)) 8869 (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))) 8870 ((or (stringp cmd) 8871 (eq cmd 'emacs)) 8872 (funcall (cdr (assq 'file org-link-frame-setup)) file) 8873 (widen) 8874 (cond (line (org-goto-line line) 8875 (when (derived-mode-p 'org-mode) (org-reveal))) 8876 (search (condition-case err 8877 (org-link-search search) 8878 ;; Save position before error-ing out so user 8879 ;; can easily move back to the original buffer. 8880 (error (funcall save-position-maybe) 8881 (error (nth 1 err))))))) 8882 ((functionp cmd) 8883 (save-match-data 8884 (set-match-data link-match-data) 8885 (condition-case nil 8886 (funcall cmd file link) 8887 ;; FIXME: Remove this check when most default installations 8888 ;; of Emacs have at least Org 9.0. 8889 ((debug wrong-number-of-arguments wrong-type-argument 8890 invalid-function) 8891 (user-error "Please see Org News for version 9.0 about \ 8892 `org-file-apps'--Lisp error: %S" cmd))))) 8893 ((consp cmd) 8894 ;; FIXME: Remove this check when most default installations of 8895 ;; Emacs have at least Org 9.0. Heads-up instead of silently 8896 ;; fall back to `org-link-frame-setup' for an old usage of 8897 ;; `org-file-apps' with sexp instead of a function for `cmd'. 8898 (user-error "Please see Org News for version 9.0 about \ 8899 `org-file-apps'--Error: Deprecated usage of %S" cmd)) 8900 (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) 8901 (funcall save-position-maybe))) 8902 8903 ;;;###autoload 8904 (defun org-open-at-point-global () 8905 "Follow a link or a time-stamp like Org mode does. 8906 Also follow links and emails as seen by `thing-at-point'. 8907 This command can be called in any mode to follow an external 8908 link or a time-stamp that has Org mode syntax. Its behavior 8909 is undefined when called on internal links like fuzzy links. 8910 Raise a user error when there is nothing to follow." 8911 (interactive) 8912 (let ((tap-url (thing-at-point 'url)) 8913 (tap-email (thing-at-point 'email))) 8914 (cond ((org-in-regexp org-link-any-re) 8915 (org-link-open-from-string (match-string-no-properties 0))) 8916 ((or (org-in-regexp org-ts-regexp-both nil t) 8917 (org-in-regexp org-tsr-regexp-both nil t)) 8918 (org-follow-timestamp-link)) 8919 (tap-url (org-link-open-from-string tap-url)) 8920 (tap-email (org-link-open-from-string 8921 (concat "mailto:" tap-email))) 8922 (t (user-error "No link found"))))) 8923 8924 (defvar org-open-at-point-functions nil 8925 "Hook that is run when following a link at point. 8926 8927 Functions in this hook must return t if they identify and follow 8928 a link at point. If they don't find anything interesting at point, 8929 they must return nil.") 8930 8931 (defun org-open-at-point (&optional arg) 8932 "Open link, timestamp, footnote or tags at point. 8933 8934 When point is on a link, follow it. Normally, files will be 8935 opened by an appropriate application. If the optional prefix 8936 argument ARG is non-nil, Emacs will visit the file. With 8937 a double prefix argument, try to open outside of Emacs, in the 8938 application the system uses for this file type. 8939 8940 When point is on a timestamp, open the agenda at the day 8941 specified. 8942 8943 When point is a footnote definition, move to the first reference 8944 found. If it is on a reference, move to the associated 8945 definition. 8946 8947 When point is on a headline, display a list of every link in the 8948 entry, so it is possible to pick one, or all, of them. If point 8949 is on a tag, call `org-tags-view' instead. 8950 8951 On top of syntactically correct links, this function also tries 8952 to open links and time-stamps in comments, node properties, and 8953 keywords if point is on something looking like a timestamp or 8954 a link." 8955 (interactive "P") 8956 (org-load-modules-maybe) 8957 (setq org-window-config-before-follow-link (current-window-configuration)) 8958 (org-remove-occur-highlights nil nil t) 8959 (unless (run-hook-with-args-until-success 'org-open-at-point-functions) 8960 (let* ((context 8961 ;; Only consider supported types, even if they are not the 8962 ;; closest one. 8963 (org-element-lineage 8964 (org-element-context) 8965 '(citation citation-reference clock comment comment-block 8966 footnote-definition footnote-reference headline 8967 inline-src-block inlinetask keyword link node-property 8968 planning src-block timestamp) 8969 t)) 8970 (type (org-element-type context)) 8971 (value (org-element-property :value context))) 8972 (cond 8973 ((not type) (user-error "No link found")) 8974 ;; No valid link at point. For convenience, look if something 8975 ;; looks like a link under point in some specific places. 8976 ((memq type '(comment comment-block node-property keyword)) 8977 (call-interactively #'org-open-at-point-global)) 8978 ;; On a headline or an inlinetask, but not on a timestamp, 8979 ;; a link, a footnote reference or a citation. 8980 ((memq type '(headline inlinetask)) 8981 (org-match-line org-complex-heading-regexp) 8982 (let ((tags-beg (match-beginning 5)) 8983 (tags-end (match-end 5))) 8984 (if (and tags-beg (>= (point) tags-beg) (< (point) tags-end)) 8985 ;; On tags. 8986 (org-tags-view 8987 arg 8988 (save-excursion 8989 (let* ((beg-tag (or (search-backward ":" tags-beg 'at-limit) (point))) 8990 (end-tag (search-forward ":" tags-end nil 2))) 8991 (buffer-substring (1+ beg-tag) (1- end-tag))))) 8992 ;; Not on tags. 8993 (pcase (org-offer-links-in-entry (current-buffer) (point) arg) 8994 (`(nil . ,_) 8995 (require 'org-attach) 8996 (when (org-attach-dir) 8997 (message "Opening attachment") 8998 (if (equal arg '(4)) 8999 (org-attach-reveal-in-emacs) 9000 (org-attach-reveal)))) 9001 (`(,links . ,links-end) 9002 (dolist (link (if (stringp links) (list links) links)) 9003 (search-forward link nil links-end) 9004 (goto-char (match-beginning 0)) 9005 (org-open-at-point arg))))))) 9006 ;; On a footnote reference or at definition's label. 9007 ((or (eq type 'footnote-reference) 9008 (and (eq type 'footnote-definition) 9009 (save-excursion 9010 ;; Do not validate action when point is on the 9011 ;; spaces right after the footnote label, in order 9012 ;; to be on par with behavior on links. 9013 (skip-chars-forward " \t") 9014 (let ((begin 9015 (org-element-property :contents-begin context))) 9016 (if begin (< (point) begin) 9017 (= (org-element-property :post-affiliated context) 9018 (line-beginning-position))))))) 9019 (org-footnote-action)) 9020 ;; On a planning line. Check if we are really on a timestamp. 9021 ((and (eq type 'planning) 9022 (org-in-regexp org-ts-regexp-both nil t)) 9023 (org-follow-timestamp-link)) 9024 ;; On a clock line, make sure point is on the timestamp 9025 ;; before opening it. 9026 ((and (eq type 'clock) 9027 value 9028 (>= (point) (org-element-property :begin value)) 9029 (<= (point) (org-element-property :end value))) 9030 (org-follow-timestamp-link)) 9031 ((eq type 'src-block) (org-babel-open-src-block-result)) 9032 ;; Do nothing on white spaces after an object. 9033 ((>= (point) 9034 (save-excursion 9035 (goto-char (org-element-property :end context)) 9036 (skip-chars-backward " \t") 9037 (point))) 9038 (user-error "No link found")) 9039 ((eq type 'inline-src-block) (org-babel-open-src-block-result)) 9040 ((eq type 'timestamp) (org-follow-timestamp-link)) 9041 ((eq type 'link) (org-link-open context arg)) 9042 ((memq type '(citation citation-reference)) (org-cite-follow context arg)) 9043 (t (user-error "No link found"))))) 9044 (run-hook-with-args 'org-follow-link-hook)) 9045 9046 ;;;###autoload 9047 (defun org-offer-links-in-entry (buffer marker &optional nth zero) 9048 "Offer links in the current entry and return the selected link. 9049 If there is only one link, return it. 9050 If NTH is an integer, return the NTH link found. 9051 If ZERO is a string, check also this string for a link, and if 9052 there is one, return it." 9053 (with-current-buffer buffer 9054 (org-with-wide-buffer 9055 (goto-char marker) 9056 (let ((cnt ?0) 9057 have-zero end links link c) 9058 (when (and (stringp zero) (string-match org-link-bracket-re zero)) 9059 (push (match-string 0 zero) links) 9060 (setq cnt (1- cnt) have-zero t)) 9061 (save-excursion 9062 (org-back-to-heading t) 9063 (setq end (save-excursion (outline-next-heading) (point))) 9064 (while (re-search-forward org-link-any-re end t) 9065 (push (match-string 0) links)) 9066 (setq links (org-uniquify (reverse links)))) 9067 (cond 9068 ((null links) 9069 (message "No links")) 9070 ((equal (length links) 1) 9071 (setq link (car links))) 9072 ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) 9073 (setq link (nth (if have-zero nth (1- nth)) links))) 9074 (t ; we have to select a link 9075 (save-excursion 9076 (save-window-excursion 9077 (delete-other-windows) 9078 (with-output-to-temp-buffer "*Select Link*" 9079 (dolist (l links) 9080 (cond 9081 ((not (string-match org-link-bracket-re l)) 9082 (princ (format "[%c] %s\n" (cl-incf cnt) 9083 (org-unbracket-string "<" ">" l)))) 9084 ((match-end 2) 9085 (princ (format "[%c] %s (%s)\n" (cl-incf cnt) 9086 (match-string 2 l) (match-string 1 l)))) 9087 (t (princ (format "[%c] %s\n" (cl-incf cnt) 9088 (match-string 1 l))))))) 9089 (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) 9090 (message "Select link to open, RET to open all:") 9091 (setq c (read-char-exclusive)) 9092 (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) 9093 (when (equal c ?q) (user-error "Abort")) 9094 (if (equal c ?\C-m) 9095 (setq link links) 9096 (setq nth (- c ?0)) 9097 (when have-zero (setq nth (1+ nth))) 9098 (unless (and (integerp nth) (>= (length links) nth)) 9099 (user-error "Invalid link selection")) 9100 (setq link (nth (1- nth) links))))) 9101 (cons link end))))) 9102 9103 ;;; File search 9104 9105 (defun org-do-occur (regexp &optional cleanup) 9106 "Call the Emacs command `occur'. 9107 If CLEANUP is non-nil, remove the printout of the regular expression 9108 in the *Occur* buffer. This is useful if the regex is long and not useful 9109 to read." 9110 (occur regexp) 9111 (when cleanup 9112 (let ((cwin (selected-window)) win beg end) 9113 (when (setq win (get-buffer-window "*Occur*")) 9114 (select-window win)) 9115 (goto-char (point-min)) 9116 (when (re-search-forward "match[a-z]+" nil t) 9117 (setq beg (match-end 0)) 9118 (when (re-search-forward "^[ \t]*[0-9]+" nil t) 9119 (setq end (1- (match-beginning 0))))) 9120 (and beg end (let ((inhibit-read-only t)) (delete-region beg end))) 9121 (goto-char (point-min)) 9122 (select-window cwin)))) 9123 9124 9125 ;;; The Mark Ring 9126 9127 (defvar org-mark-ring nil 9128 "Mark ring for positions before jumps in Org mode.") 9129 9130 (defvar org-mark-ring-last-goto nil 9131 "Last position in the mark ring used to go back.") 9132 9133 ;; Fill and close the ring 9134 (setq org-mark-ring nil) 9135 (setq org-mark-ring-last-goto nil) ;in case file is reloaded 9136 9137 (dotimes (_ org-mark-ring-length) (push (make-marker) org-mark-ring)) 9138 (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring) 9139 org-mark-ring) 9140 9141 (defun org-mark-ring-push (&optional pos buffer) 9142 "Put the current position into the mark ring and rotate it. 9143 Also push position into the Emacs mark ring. If optional 9144 argument POS and BUFFER are not nil, mark this location instead." 9145 (interactive) 9146 (let ((pos (or pos (point))) 9147 (buffer (or buffer (current-buffer)))) 9148 (with-current-buffer buffer 9149 (org-with-point-at pos (push-mark nil t))) 9150 (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring)) 9151 (move-marker (car org-mark-ring) pos buffer)) 9152 (message 9153 (substitute-command-keys 9154 "Position saved to mark ring, go back with `\\[org-mark-ring-goto]'."))) 9155 9156 (defun org-mark-ring-goto (&optional n) 9157 "Jump to the previous position in the mark ring. 9158 With prefix arg N, jump back that many stored positions. When 9159 called several times in succession, walk through the entire ring. 9160 Org mode commands jumping to a different position in the current file, 9161 or to another Org file, automatically push the old position onto the ring." 9162 (interactive "p") 9163 (let (p m) 9164 (if (eq last-command this-command) 9165 (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring))) 9166 (setq p org-mark-ring)) 9167 (setq org-mark-ring-last-goto p) 9168 (setq m (car p)) 9169 (pop-to-buffer-same-window (marker-buffer m)) 9170 (goto-char m) 9171 (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) 9172 9173 ;;; Following specific links 9174 9175 (defvar org-agenda-buffer-tmp-name) 9176 (defvar org-agenda-start-on-weekday) 9177 (defvar org-agenda-buffer-name) 9178 (defun org-follow-timestamp-link () 9179 "Open an agenda view for the time-stamp date/range at point." 9180 ;; Avoid changing the global value. 9181 (let ((org-agenda-buffer-name org-agenda-buffer-name)) 9182 (cond 9183 ((org-at-date-range-p t) 9184 (let ((org-agenda-start-on-weekday) 9185 (t1 (match-string 1)) 9186 (t2 (match-string 2)) tt1 tt2) 9187 (setq tt1 (time-to-days (org-time-string-to-time t1)) 9188 tt2 (time-to-days (org-time-string-to-time t2))) 9189 (let ((org-agenda-buffer-tmp-name 9190 (format "*Org Agenda(a:%s)" 9191 (concat (substring t1 0 10) "--" (substring t2 0 10))))) 9192 (org-agenda-list nil tt1 (1+ (- tt2 tt1)))))) 9193 ((org-at-timestamp-p 'lax) 9194 (let ((org-agenda-buffer-tmp-name 9195 (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10)))) 9196 (org-agenda-list nil (time-to-days (org-time-string-to-time 9197 (substring (match-string 1) 0 10))) 9198 1))) 9199 (t (error "This should not happen"))))) 9200 9201 9202 ;;; Following file links 9203 (declare-function mailcap-parse-mailcaps "mailcap" (&optional path force)) 9204 (declare-function mailcap-extension-to-mime "mailcap" (extn)) 9205 (declare-function mailcap-mime-info 9206 "mailcap" (string &optional request no-decode)) 9207 (defvar org-wait nil) 9208 9209 ;;;; Refiling 9210 9211 (defun org-get-org-file () 9212 "Read a filename, with default directory `org-directory'." 9213 (let ((default (or org-default-notes-file remember-data-file))) 9214 (read-file-name (format "File name [%s]: " default) 9215 (file-name-as-directory org-directory) 9216 default))) 9217 9218 (defun org-notes-order-reversed-p () 9219 "Check if the current file should receive notes in reversed order." 9220 (cond 9221 ((not org-reverse-note-order) nil) 9222 ((eq t org-reverse-note-order) t) 9223 ((not (listp org-reverse-note-order)) nil) 9224 (t (catch 'exit 9225 (dolist (entry org-reverse-note-order) 9226 (when (string-match (car entry) buffer-file-name) 9227 (throw 'exit (cdr entry)))))))) 9228 9229 (defvar org-agenda-new-buffers nil 9230 "Buffers created to visit agenda files.") 9231 9232 (declare-function org-string-nw-p "org-macs" (s)) 9233 ;;;; Dynamic blocks 9234 9235 (defun org-find-dblock (name) 9236 "Find the first dynamic block with name NAME in the buffer. 9237 If not found, stay at current position and return nil." 9238 (let ((case-fold-search t) pos) 9239 (save-excursion 9240 (goto-char (point-min)) 9241 (setq pos (and (re-search-forward 9242 (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t) 9243 (match-beginning 0)))) 9244 (when pos (goto-char pos)) 9245 pos)) 9246 9247 (defun org-create-dblock (plist) 9248 "Create a dynamic block section, with parameters taken from PLIST. 9249 PLIST must contain a :name entry which is used as the name of the block." 9250 (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol))) 9251 (end-of-line 1) 9252 (newline)) 9253 (let ((col (current-column)) 9254 (name (plist-get plist :name))) 9255 (insert "#+BEGIN: " name) 9256 (while plist 9257 (if (eq (car plist) :name) 9258 (setq plist (cddr plist)) 9259 (insert " " (prin1-to-string (pop plist))))) 9260 (insert "\n\n" (make-string col ?\ ) "#+END:\n") 9261 (beginning-of-line -2))) 9262 9263 (defun org-prepare-dblock () 9264 "Prepare dynamic block for refresh. 9265 This empties the block, puts the cursor at the insert position and returns 9266 the property list including an extra property :name with the block name." 9267 (unless (looking-at org-dblock-start-re) 9268 (user-error "Not at a dynamic block")) 9269 (let* ((begdel (1+ (match-end 0))) 9270 (name (org-no-properties (match-string 1))) 9271 (params (append (list :name name) 9272 (read (concat "(" (match-string 3) ")"))))) 9273 (save-excursion 9274 (beginning-of-line 1) 9275 (skip-chars-forward " \t") 9276 (setq params (plist-put params :indentation-column (current-column)))) 9277 (unless (re-search-forward org-dblock-end-re nil t) 9278 (error "Dynamic block not terminated")) 9279 (setq params 9280 (append params 9281 (list :content (buffer-substring 9282 begdel (match-beginning 0))))) 9283 (delete-region begdel (match-beginning 0)) 9284 (goto-char begdel) 9285 (open-line 1) 9286 params)) 9287 9288 (defun org-map-dblocks (&optional command) 9289 "Apply COMMAND to all dynamic blocks in the current buffer. 9290 If COMMAND is not given, use `org-update-dblock'." 9291 (let ((cmd (or command 'org-update-dblock))) 9292 (save-excursion 9293 (goto-char (point-min)) 9294 (while (re-search-forward org-dblock-start-re nil t) 9295 (goto-char (match-beginning 0)) 9296 (save-excursion 9297 (condition-case nil 9298 (funcall cmd) 9299 (error (message "Error during update of dynamic block")))) 9300 (unless (re-search-forward org-dblock-end-re nil t) 9301 (error "Dynamic block not terminated")))))) 9302 9303 (defvar org-dynamic-block-alist nil 9304 "Alist defining all the Org dynamic blocks. 9305 9306 The key is the dynamic block type name, as a string. The value 9307 is the function used to insert the dynamic block. 9308 9309 Use `org-dynamic-block-define' to populate it.") 9310 9311 (defun org-dynamic-block-function (type) 9312 "Return function associated to a given dynamic block type. 9313 TYPE is the dynamic block type, as a string." 9314 (cdr (assoc type org-dynamic-block-alist))) 9315 9316 (defun org-dynamic-block-types () 9317 "List all defined dynamic block types." 9318 (mapcar #'car org-dynamic-block-alist)) 9319 9320 (defun org-dynamic-block-define (type func) 9321 "Define dynamic block TYPE with FUNC. 9322 TYPE is a string. FUNC is the function creating the dynamic 9323 block of such type." 9324 (pcase (assoc type org-dynamic-block-alist) 9325 (`nil (push (cons type func) org-dynamic-block-alist)) 9326 (def (setcdr def func)))) 9327 9328 (defun org-dynamic-block-insert-dblock (type &optional interactive-p) 9329 "Insert a dynamic block of type TYPE. 9330 When used interactively, select the dynamic block types among 9331 defined types, per `org-dynamic-block-define'. If INTERACTIVE-P 9332 is non-nil, call the dynamic block function interactively." 9333 (interactive (list (completing-read "Dynamic block: " 9334 (org-dynamic-block-types)) 9335 t)) 9336 (pcase (org-dynamic-block-function type) 9337 (`nil (error "No such dynamic block: %S" type)) 9338 ((and f (pred functionp)) 9339 (if interactive-p (call-interactively f) (funcall f))) 9340 (_ (error "Invalid function for dynamic block %S" type)))) 9341 9342 (defun org-dblock-update (&optional arg) 9343 "User command for updating dynamic blocks. 9344 Update the dynamic block at point. With prefix ARG, update all dynamic 9345 blocks in the buffer." 9346 (interactive "P") 9347 (if arg 9348 (org-update-all-dblocks) 9349 (or (looking-at org-dblock-start-re) 9350 (org-beginning-of-dblock)) 9351 (org-update-dblock))) 9352 9353 (defun org-update-dblock () 9354 "Update the dynamic block at point. 9355 This means to empty the block, parse for parameters and then call 9356 the correct writing function." 9357 (interactive) 9358 (save-excursion 9359 (let* ((win (selected-window)) 9360 (pos (point)) 9361 (line (org-current-line)) 9362 (params (org-prepare-dblock)) 9363 (name (plist-get params :name)) 9364 (indent (plist-get params :indentation-column)) 9365 (cmd (intern (concat "org-dblock-write:" name)))) 9366 (message "Updating dynamic block `%s' at line %d..." name line) 9367 (funcall cmd params) 9368 (message "Updating dynamic block `%s' at line %d...done" name line) 9369 (goto-char pos) 9370 (when (and indent (> indent 0)) 9371 (setq indent (make-string indent ?\ )) 9372 (save-excursion 9373 (select-window win) 9374 (org-beginning-of-dblock) 9375 (forward-line 1) 9376 (while (not (looking-at org-dblock-end-re)) 9377 (insert indent) 9378 (beginning-of-line 2)) 9379 (when (looking-at org-dblock-end-re) 9380 (and (looking-at "[ \t]+") 9381 (replace-match "")) 9382 (insert indent))))))) 9383 9384 (defun org-beginning-of-dblock () 9385 "Find the beginning of the dynamic block at point. 9386 Error if there is no such block at point." 9387 (let ((pos (point)) 9388 beg) 9389 (end-of-line 1) 9390 (if (and (re-search-backward org-dblock-start-re nil t) 9391 (setq beg (match-beginning 0)) 9392 (re-search-forward org-dblock-end-re nil t) 9393 (> (match-end 0) pos)) 9394 (goto-char beg) 9395 (goto-char pos) 9396 (error "Not in a dynamic block")))) 9397 9398 (defun org-update-all-dblocks () 9399 "Update all dynamic blocks in the buffer. 9400 This function can be used in a hook." 9401 (interactive) 9402 (when (derived-mode-p 'org-mode) 9403 (org-map-dblocks 'org-update-dblock))) 9404 9405 9406 ;;;; Completion 9407 9408 (declare-function org-export-backend-options "ox" (cl-x) t) 9409 (defun org-get-export-keywords () 9410 "Return a list of all currently understood export keywords. 9411 Export keywords include options, block names, attributes and 9412 keywords relative to each registered export back-end." 9413 (let (keywords) 9414 (dolist (backend 9415 (bound-and-true-p org-export-registered-backends) 9416 (delq nil keywords)) 9417 ;; Back-end name (for keywords, like #+LATEX:) 9418 (push (upcase (symbol-name (org-export-backend-name backend))) keywords) 9419 (dolist (option-entry (org-export-backend-options backend)) 9420 ;; Back-end options. 9421 (push (nth 1 option-entry) keywords))))) 9422 9423 (defconst org-options-keywords 9424 '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:" 9425 "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:" 9426 "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:" 9427 "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:" 9428 "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:")) 9429 9430 (defcustom org-structure-template-alist 9431 '(("a" . "export ascii") 9432 ("c" . "center") 9433 ("C" . "comment") 9434 ("e" . "example") 9435 ("E" . "export") 9436 ("h" . "export html") 9437 ("l" . "export latex") 9438 ("q" . "quote") 9439 ("s" . "src") 9440 ("v" . "verse")) 9441 "An alist of keys and block types. 9442 `org-insert-structure-template' will display a menu with this 9443 list of templates to choose from. The block type is inserted, 9444 with \"#+BEGIN_\" and \"#+END_\" added automatically. 9445 9446 The menu keys are defined by the car of each entry in this alist. 9447 If two entries have the keys \"a\" and \"aa\" respectively, the 9448 former will be inserted by typing \"a TAB/RET/SPC\" and the 9449 latter will be inserted by typing \"aa\". If an entry with the 9450 key \"aab\" is later added, it can be inserted by typing \"ab\". 9451 9452 If loaded, Org Tempo also uses `org-structure-template-alist'. A 9453 block can be inserted by pressing TAB after the string \"<KEY\"." 9454 :group 'org-edit-structure 9455 :type '(repeat 9456 (cons (string :tag "Key") 9457 (string :tag "Template"))) 9458 :package-version '(Org . "9.2")) 9459 9460 (defun org--check-org-structure-template-alist (&optional checklist) 9461 "Check whether `org-structure-template-alist' is set up correctly. 9462 In particular, check if the Org 9.2 format is used as opposed to 9463 previous format." 9464 (let ((elm (cl-remove-if-not (lambda (x) (listp (cdr x))) 9465 (or (eval checklist) 9466 org-structure-template-alist)))) 9467 (when elm 9468 (org-display-warning 9469 (format " 9470 Please update the entries of `%s'. 9471 9472 In Org 9.2 the format was changed from something like 9473 9474 (\"s\" \"#+BEGIN_SRC ?\\n#+END_SRC\") 9475 9476 to something like 9477 9478 (\"s\" . \"src\") 9479 9480 Please refer to the documentation of `org-structure-template-alist'. 9481 9482 The following entries must be updated: 9483 9484 %s" 9485 (or checklist 'org-structure-template-alist) 9486 (pp-to-string elm)))))) 9487 9488 (defun org--insert-structure-template-mks () 9489 "Present `org-structure-template-alist' with `org-mks'. 9490 9491 Menus are added if keys require more than one keystroke. Tabs 9492 are added to single key entries when more than one stroke is 9493 needed. Keys longer than two characters are reduced to two 9494 characters." 9495 (org--check-org-structure-template-alist) 9496 (let* (case-fold-search 9497 (templates (append org-structure-template-alist 9498 '(("\t" . "Press TAB, RET or SPC to write block name")))) 9499 (keys (mapcar #'car templates)) 9500 (start-letters 9501 (delete-dups (mapcar (lambda (key) (substring key 0 1)) keys))) 9502 ;; Sort each element of `org-structure-template-alist' into 9503 ;; sublists according to the first letter. 9504 (superlist 9505 (mapcar (lambda (letter) 9506 (list letter 9507 (cl-remove-if-not 9508 (apply-partially #'string-match-p (concat "^" letter)) 9509 templates :key #'car))) 9510 start-letters))) 9511 (org-mks 9512 (apply #'append 9513 ;; Make an `org-mks' table. If only one element is 9514 ;; present in a sublist, make it part of the top-menu, 9515 ;; otherwise make a submenu according to the starting 9516 ;; letter and populate it. 9517 (mapcar (lambda (sublist) 9518 (if (eq 1 (length (cadr sublist))) 9519 (mapcar (lambda (elm) 9520 (list (substring (car elm) 0 1) 9521 (cdr elm) "")) 9522 (cadr sublist)) 9523 ;; Create submenu. 9524 (let* ((topkey (car sublist)) 9525 (elms (cadr sublist)) 9526 (keys (mapcar #'car elms)) 9527 (long (> (length elms) 3))) 9528 (append 9529 (list 9530 ;; Make a description of the submenu. 9531 (list topkey 9532 (concat 9533 (mapconcat #'cdr 9534 (cl-subseq elms 0 (if long 3 (length elms))) 9535 ", ") 9536 (when long ", ...")))) 9537 ;; List of entries in submenu. 9538 (cl-mapcar #'list 9539 (org--insert-structure-template-unique-keys keys) 9540 (mapcar #'cdr elms) 9541 (make-list (length elms) "")))))) 9542 superlist)) 9543 "Select a key\n============" 9544 "Key: "))) 9545 9546 (defun org--insert-structure-template-unique-keys (keys) 9547 "Make a list of unique, two characters long elements from KEYS. 9548 9549 Elements of length one have a tab appended. Elements of length 9550 two are kept as is. Longer elements are truncated to length two. 9551 9552 If an element cannot be made unique, an error is raised." 9553 (let ((ordered-keys (cl-sort (copy-sequence keys) #'< :key #'length)) 9554 menu-keys) 9555 (dolist (key ordered-keys) 9556 (let ((potential-key 9557 (cl-case (length key) 9558 (1 (concat key "\t")) 9559 (2 key) 9560 (otherwise 9561 (cl-find-if-not (lambda (k) (assoc k menu-keys)) 9562 (mapcar (apply-partially #'concat (substring key 0 1)) 9563 (split-string (substring key 1) "" t))))))) 9564 (if (or (not potential-key) (assoc potential-key menu-keys)) 9565 (user-error "Could not make unique key for `%s'" key) 9566 (push (cons potential-key key) menu-keys)))) 9567 (mapcar #'car 9568 (cl-sort menu-keys #'< 9569 :key (lambda (elm) (cl-position (cdr elm) keys)))))) 9570 9571 (defun org-insert-structure-template (type) 9572 "Insert a block structure of the type #+begin_foo/#+end_foo. 9573 Select a block from `org-structure-template-alist' then type 9574 either RET, TAB or SPC to write the block type. With an active 9575 region, wrap the region in the block. Otherwise, insert an empty 9576 block." 9577 (interactive 9578 (list (pcase (org--insert-structure-template-mks) 9579 (`("\t" . ,_) (read-string "Structure type: ")) 9580 (`(,_ ,choice . ,_) choice)))) 9581 (let* ((region? (use-region-p)) 9582 (region-start (and region? (region-beginning))) 9583 (region-end (and region? (copy-marker (region-end)))) 9584 (extended? (string-match-p "\\`\\(src\\|export\\)\\'" type)) 9585 (verbatim? (string-match-p 9586 (concat "\\`" (regexp-opt '("example" "export" "src"))) 9587 type))) 9588 (when region? (goto-char region-start)) 9589 (let ((column (current-indentation))) 9590 (if (save-excursion (skip-chars-backward " \t") (bolp)) 9591 (beginning-of-line) 9592 (insert "\n")) 9593 (save-excursion 9594 (indent-to column) 9595 (insert (format "#+begin_%s%s\n" type (if extended? " " ""))) 9596 (when region? 9597 (when verbatim? (org-escape-code-in-region (point) region-end)) 9598 (goto-char region-end) 9599 ;; Ignore empty lines at the end of the region. 9600 (skip-chars-backward " \r\t\n") 9601 (end-of-line)) 9602 (unless (bolp) (insert "\n")) 9603 (indent-to column) 9604 (insert (format "#+end_%s" (car (split-string type)))) 9605 (if (looking-at "[ \t]*$") (replace-match "") 9606 (insert "\n")) 9607 (when (and (eobp) (not (bolp))) (insert "\n"))) 9608 (if extended? (end-of-line) 9609 (forward-line) 9610 (skip-chars-forward " \t"))))) 9611 9612 9613 ;;;; TODO, DEADLINE, Comments 9614 9615 (defun org-toggle-comment () 9616 "Change the COMMENT state of an entry." 9617 (interactive) 9618 (save-excursion 9619 (org-back-to-heading) 9620 (let ((case-fold-search nil)) 9621 (looking-at org-complex-heading-regexp)) 9622 (goto-char (or (match-end 3) (match-end 2) (match-end 1))) 9623 (skip-chars-forward " \t") 9624 (unless (memq (char-before) '(?\s ?\t)) (insert " ")) 9625 (if (org-in-commented-heading-p t) 9626 (delete-region (point) 9627 (progn (search-forward " " (line-end-position) 'move) 9628 (skip-chars-forward " \t") 9629 (point))) 9630 (insert org-comment-string) 9631 (unless (eolp) (insert " "))))) 9632 9633 (defvar org-last-todo-state-is-todo nil 9634 "This is non-nil when the last TODO state change led to a TODO state. 9635 If the last change removed the TODO tag or switched to DONE, then 9636 this is nil.") 9637 9638 (defvar org-todo-setup-filter-hook nil 9639 "Hook for functions that pre-filter todo specs. 9640 Each function takes a todo spec and returns either nil or the spec 9641 transformed into canonical form." ) 9642 9643 (defvar org-todo-get-default-hook nil 9644 "Hook for functions that get a default item for todo. 9645 Each function takes arguments (NEW-MARK OLD-MARK) and returns either 9646 nil or a string to be used for the todo mark." ) 9647 9648 (defvar org-agenda-headline-snapshot-before-repeat) 9649 9650 (defun org-current-effective-time () 9651 "Return current time adjusted for `org-extend-today-until' variable." 9652 (let* ((ct (org-current-time)) 9653 (dct (decode-time ct)) 9654 (ct1 9655 (cond 9656 (org-use-last-clock-out-time-as-effective-time 9657 (or (org-clock-get-last-clock-out-time) ct)) 9658 ((and org-use-effective-time (< (nth 2 dct) org-extend-today-until)) 9659 (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))) 9660 (t ct)))) 9661 ct1)) 9662 9663 (defun org-todo-yesterday (&optional arg) 9664 "Like `org-todo' but the time of change will be 23:59 of yesterday." 9665 (interactive "P") 9666 (if (eq major-mode 'org-agenda-mode) 9667 (apply 'org-agenda-todo-yesterday arg) 9668 (let* ((org-use-effective-time t) 9669 (hour (nth 2 (decode-time (org-current-time)))) 9670 (org-extend-today-until (1+ hour))) 9671 (org-todo arg)))) 9672 9673 (defvar org-block-entry-blocking "" 9674 "First entry preventing the TODO state change.") 9675 9676 (defun org-cancel-repeater () 9677 "Cancel a repeater by setting its numeric value to zero." 9678 (interactive) 9679 (save-excursion 9680 (org-back-to-heading t) 9681 (let ((bound1 (point)) 9682 (bound0 (save-excursion (outline-next-heading) (point)))) 9683 (when (and (re-search-forward 9684 (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" 9685 org-deadline-time-regexp "\\)\\|\\(" 9686 org-ts-regexp "\\)") 9687 bound0 t) 9688 (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]" 9689 bound1 t)) 9690 (replace-match "0" t nil nil 1))))) 9691 9692 (defvar org-state) 9693 (defvar org-blocked-by-checkboxes) 9694 (defun org-todo (&optional arg) 9695 "Change the TODO state of an item. 9696 9697 The state of an item is given by a keyword at the start of the heading, 9698 like 9699 *** TODO Write paper 9700 *** DONE Call mom 9701 9702 The different keywords are specified in the variable `org-todo-keywords'. 9703 By default the available states are \"TODO\" and \"DONE\". So, for this 9704 example: when the item starts with TODO, it is changed to DONE. 9705 When it starts with DONE, the DONE is removed. And when neither TODO nor 9706 DONE are present, add TODO at the beginning of the heading. 9707 You can set up single-character keys to fast-select the new state. See the 9708 `org-todo-keywords' and `org-use-fast-todo-selection' for details. 9709 9710 With `\\[universal-argument]' prefix ARG, force logging the state change \ 9711 and take a 9712 logging note. 9713 With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \ 9714 next set of TODO \ 9715 keywords (nextset). 9716 Another way to achieve this is `S-C-<right>'. 9717 With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ 9718 prefix, circumvent any state blocking. 9719 With numeric prefix arg, switch to the Nth state. 9720 9721 With a numeric prefix arg of 0, inhibit note taking for the change. 9722 With a numeric prefix arg of -1, cancel repeater to allow marking as DONE. 9723 9724 When called through ELisp, arg is also interpreted in the following way: 9725 `none' -> empty state 9726 \"\" -> switch to empty state 9727 `done' -> switch to DONE 9728 `nextset' -> switch to the next set of keywords 9729 `previousset' -> switch to the previous set of keywords 9730 \"WAITING\" -> switch to the specified keyword, but only if it 9731 really is a member of `org-todo-keywords'." 9732 (interactive "P") 9733 (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) 9734 (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) 9735 'region-start-level 'region)) 9736 org-loop-over-headlines-in-active-region) 9737 (org-map-entries 9738 (lambda () (org-todo arg)) 9739 nil cl 9740 (when (org-invisible-p) (org-end-of-subtree nil t)))) 9741 (when (equal arg '(16)) (setq arg 'nextset)) 9742 (when (equal arg -1) (org-cancel-repeater) (setq arg nil)) 9743 (let ((org-blocker-hook org-blocker-hook) 9744 commentp 9745 case-fold-search) 9746 (when (equal arg '(64)) 9747 (setq arg nil org-blocker-hook nil)) 9748 (when (and org-blocker-hook 9749 (or org-inhibit-blocking 9750 (org-entry-get nil "NOBLOCKING"))) 9751 (setq org-blocker-hook nil)) 9752 (save-excursion 9753 (catch 'exit 9754 (org-back-to-heading t) 9755 (when (org-in-commented-heading-p t) 9756 (org-toggle-comment) 9757 (setq commentp t)) 9758 (when (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) 9759 (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)")) 9760 (looking-at "\\(?: *\\|[ \t]*$\\)")) 9761 (let* ((match-data (match-data)) 9762 (startpos (copy-marker (line-beginning-position))) 9763 (force-log (and (equal arg '(4)) (prog1 t (setq arg nil)))) 9764 (logging (save-match-data (org-entry-get nil "LOGGING" t t))) 9765 (org-log-done org-log-done) 9766 (org-log-repeat org-log-repeat) 9767 (org-todo-log-states org-todo-log-states) 9768 (org-inhibit-logging 9769 (if (equal arg 0) 9770 (progn (setq arg nil) 'note) org-inhibit-logging)) 9771 (this (match-string 1)) 9772 (hl-pos (match-beginning 0)) 9773 (head (org-get-todo-sequence-head this)) 9774 (ass (assoc head org-todo-kwd-alist)) 9775 (interpret (nth 1 ass)) 9776 (done-word (nth 3 ass)) 9777 (final-done-word (nth 4 ass)) 9778 (org-last-state (or this "")) 9779 (completion-ignore-case t) 9780 (member (member this org-todo-keywords-1)) 9781 (tail (cdr member)) 9782 (org-state (cond 9783 ((eq arg 'right) 9784 ;; Next state 9785 (if this 9786 (if tail (car tail) nil) 9787 (car org-todo-keywords-1))) 9788 ((eq arg 'left) 9789 ;; Previous state 9790 (unless (equal member org-todo-keywords-1) 9791 (if this 9792 (nth (- (length org-todo-keywords-1) 9793 (length tail) 2) 9794 org-todo-keywords-1) 9795 (org-last org-todo-keywords-1)))) 9796 (arg 9797 ;; User or caller requests a specific state. 9798 (cond 9799 ((equal arg "") nil) 9800 ((eq arg 'none) nil) 9801 ((eq arg 'done) (or done-word (car org-done-keywords))) 9802 ((eq arg 'nextset) 9803 (or (car (cdr (member head org-todo-heads))) 9804 (car org-todo-heads))) 9805 ((eq arg 'previousset) 9806 (let ((org-todo-heads (reverse org-todo-heads))) 9807 (or (car (cdr (member head org-todo-heads))) 9808 (car org-todo-heads)))) 9809 ((car (member arg org-todo-keywords-1))) 9810 ((stringp arg) 9811 (user-error "State `%s' not valid in this file" arg)) 9812 ((nth (1- (prefix-numeric-value arg)) 9813 org-todo-keywords-1)))) 9814 ((and org-todo-key-trigger org-use-fast-todo-selection) 9815 ;; Use fast selection. 9816 (org-fast-todo-selection this)) 9817 ((null member) (or head (car org-todo-keywords-1))) 9818 ((equal this final-done-word) nil) ;-> make empty 9819 ((null tail) nil) ;-> first entry 9820 ((memq interpret '(type priority)) 9821 (if (eq this-command last-command) 9822 (car tail) 9823 (if (> (length tail) 0) 9824 (or done-word (car org-done-keywords)) 9825 nil))) 9826 (t 9827 (car tail)))) 9828 (org-state (or 9829 (run-hook-with-args-until-success 9830 'org-todo-get-default-hook org-state org-last-state) 9831 org-state)) 9832 (next (if (org-string-nw-p org-state) (concat " " org-state " ") " ")) 9833 (change-plist (list :type 'todo-state-change :from this :to org-state 9834 :position startpos)) 9835 dolog now-done-p) 9836 (when org-blocker-hook 9837 (let (org-blocked-by-checkboxes block-reason) 9838 (setq org-last-todo-state-is-todo 9839 (not (member this org-done-keywords))) 9840 (unless (save-excursion 9841 (save-match-data 9842 (org-with-wide-buffer 9843 (run-hook-with-args-until-failure 9844 'org-blocker-hook change-plist)))) 9845 (setq block-reason (if org-blocked-by-checkboxes 9846 "contained checkboxes" 9847 (format "\"%s\"" org-block-entry-blocking))) 9848 (if (called-interactively-p 'interactive) 9849 (user-error "TODO state change from %s to %s blocked (by %s)" 9850 this org-state block-reason) 9851 ;; Fail silently. 9852 (message "TODO state change from %s to %s blocked (by %s)" 9853 this org-state block-reason) 9854 (throw 'exit nil))))) 9855 (store-match-data match-data) 9856 (replace-match next t t) 9857 (cond ((and org-state (equal this org-state)) 9858 (message "TODO state was already %s" (org-trim next))) 9859 ((not (pos-visible-in-window-p hl-pos)) 9860 (message "TODO state changed to %s" (org-trim next)))) 9861 (unless head 9862 (setq head (org-get-todo-sequence-head org-state) 9863 ass (assoc head org-todo-kwd-alist) 9864 interpret (nth 1 ass) 9865 done-word (nth 3 ass) 9866 final-done-word (nth 4 ass))) 9867 (when (memq arg '(nextset previousset)) 9868 (message "Keyword-Set %d/%d: %s" 9869 (- (length org-todo-sets) -1 9870 (length (memq (assoc org-state org-todo-sets) org-todo-sets))) 9871 (length org-todo-sets) 9872 (mapconcat 'identity (assoc org-state org-todo-sets) " "))) 9873 (setq org-last-todo-state-is-todo 9874 (not (member org-state org-done-keywords))) 9875 (setq now-done-p (and (member org-state org-done-keywords) 9876 (not (member this org-done-keywords)))) 9877 (and logging (org-local-logging logging)) 9878 (when (or (and (or org-todo-log-states org-log-done) 9879 (not (eq org-inhibit-logging t)) 9880 (not (memq arg '(nextset previousset)))) 9881 force-log) 9882 ;; We need to look at recording a time and note. 9883 (setq dolog (or (if force-log 'note) 9884 (nth 1 (assoc org-state org-todo-log-states)) 9885 (nth 2 (assoc this org-todo-log-states)))) 9886 (when (and (eq dolog 'note) (eq org-inhibit-logging 'note)) 9887 (setq dolog 'time)) 9888 (when (or (and (not org-state) (not org-closed-keep-when-no-todo)) 9889 (and org-state 9890 (member org-state org-not-done-keywords) 9891 (not (member this org-not-done-keywords)))) 9892 ;; This is now a todo state and was not one before 9893 ;; If there was a CLOSED time stamp, get rid of it. 9894 (org-add-planning-info nil nil 'closed)) 9895 (when (and now-done-p org-log-done) 9896 ;; It is now done, and it was not done before. 9897 (org-add-planning-info 'closed (org-current-effective-time)) 9898 (when (and (not dolog) (eq 'note org-log-done)) 9899 (org-add-log-setup 'done org-state this 'note))) 9900 (when (and org-state dolog) 9901 ;; This is a non-nil state, and we need to log it. 9902 (org-add-log-setup 'state org-state this dolog))) 9903 ;; Fixup tag positioning. 9904 (org-todo-trigger-tag-changes org-state) 9905 (when org-auto-align-tags (org-align-tags)) 9906 (when org-provide-todo-statistics 9907 (org-update-parent-todo-statistics)) 9908 (when (bound-and-true-p org-clock-out-when-done) 9909 (org-clock-out-if-current)) 9910 (run-hooks 'org-after-todo-state-change-hook) 9911 (when (and arg (not (member org-state org-done-keywords))) 9912 (setq head (org-get-todo-sequence-head org-state))) 9913 (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) 9914 ;; Do we need to trigger a repeat? 9915 (when now-done-p 9916 (when (boundp 'org-agenda-headline-snapshot-before-repeat) 9917 ;; This is for the agenda, take a snapshot of the headline. 9918 (save-match-data 9919 (setq org-agenda-headline-snapshot-before-repeat 9920 (org-get-heading)))) 9921 (org-auto-repeat-maybe org-state)) 9922 ;; Fixup cursor location if close to the keyword. 9923 (when (and (outline-on-heading-p) 9924 (not (bolp)) 9925 (save-excursion (beginning-of-line 1) 9926 (looking-at org-todo-line-regexp)) 9927 (< (point) (+ 2 (or (match-end 2) (match-end 1))))) 9928 (goto-char (or (match-end 2) (match-end 1))) 9929 (and (looking-at " ") 9930 (not (looking-at " *:")) 9931 (just-one-space))) 9932 (when org-trigger-hook 9933 (save-excursion 9934 (run-hook-with-args 'org-trigger-hook change-plist))) 9935 (when commentp (org-toggle-comment)))))))) 9936 9937 (defun org-block-todo-from-children-or-siblings-or-parent (change-plist) 9938 "Block turning an entry into a TODO, using the hierarchy. 9939 This checks whether the current task should be blocked from state 9940 changes. Such blocking occurs when: 9941 9942 1. The task has children which are not all in a completed state. 9943 9944 2. A task has a parent with the property :ORDERED:, and there 9945 are siblings prior to the current task with incomplete 9946 status. 9947 9948 3. The parent of the task is blocked because it has siblings that should 9949 be done first, or is child of a block grandparent TODO entry." 9950 9951 (if (not org-enforce-todo-dependencies) 9952 t ; if locally turned off don't block 9953 (catch 'dont-block 9954 ;; If this is not a todo state change, or if this entry is already DONE, 9955 ;; do not block 9956 (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) 9957 (member (plist-get change-plist :from) 9958 (cons 'done org-done-keywords)) 9959 (member (plist-get change-plist :to) 9960 (cons 'todo org-not-done-keywords)) 9961 (not (plist-get change-plist :to))) 9962 (throw 'dont-block t)) 9963 ;; If this task has children, and any are undone, it's blocked 9964 (save-excursion 9965 (org-back-to-heading t) 9966 (let ((this-level (funcall outline-level))) 9967 (outline-next-heading) 9968 (let ((child-level (funcall outline-level))) 9969 (while (and (not (eobp)) 9970 (> child-level this-level)) 9971 ;; this todo has children, check whether they are all 9972 ;; completed 9973 (when (and (not (org-entry-is-done-p)) 9974 (org-entry-is-todo-p)) 9975 (setq org-block-entry-blocking (org-get-heading)) 9976 (throw 'dont-block nil)) 9977 (outline-next-heading) 9978 (setq child-level (funcall outline-level)))))) 9979 ;; Otherwise, if the task's parent has the :ORDERED: property, and 9980 ;; any previous siblings are undone, it's blocked 9981 (save-excursion 9982 (org-back-to-heading t) 9983 (let* ((pos (point)) 9984 (parent-pos (and (org-up-heading-safe) (point))) 9985 (case-fold-search nil)) 9986 (unless parent-pos (throw 'dont-block t)) ; no parent 9987 (when (and (org-not-nil (org-entry-get (point) "ORDERED")) 9988 (forward-line 1) 9989 (re-search-forward org-not-done-heading-regexp pos t)) 9990 (setq org-block-entry-blocking (match-string 0)) 9991 (throw 'dont-block nil)) ; block, there is an older sibling not done. 9992 ;; Search further up the hierarchy, to see if an ancestor is blocked 9993 (while t 9994 (goto-char parent-pos) 9995 (unless (looking-at org-not-done-heading-regexp) 9996 (throw 'dont-block t)) ; do not block, parent is not a TODO 9997 (setq pos (point)) 9998 (setq parent-pos (and (org-up-heading-safe) (point))) 9999 (unless parent-pos (throw 'dont-block t)) ; no parent 10000 (when (and (org-not-nil (org-entry-get (point) "ORDERED")) 10001 (forward-line 1) 10002 (re-search-forward org-not-done-heading-regexp pos t) 10003 (setq org-block-entry-blocking (org-get-heading))) 10004 (throw 'dont-block nil)))))))) ; block, older sibling not done. 10005 10006 (defcustom org-track-ordered-property-with-tag nil 10007 "Should the ORDERED property also be shown as a tag? 10008 The ORDERED property decides if an entry should require subtasks to be 10009 completed in sequence. Since a property is not very visible, setting 10010 this option means that toggling the ORDERED property with the command 10011 `org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is 10012 not relevant for the behavior, but it makes things more visible. 10013 10014 Note that toggling the tag with tags commands will not change the property 10015 and therefore not influence behavior! 10016 10017 This can be t, meaning the tag ORDERED should be used. It can also be a 10018 string to select a different tag for this task." 10019 :group 'org-todo 10020 :type '(choice 10021 (const :tag "No tracking" nil) 10022 (const :tag "Track with ORDERED tag" t) 10023 (string :tag "Use other tag"))) 10024 10025 (defun org-toggle-ordered-property () 10026 "Toggle the ORDERED property of the current entry. 10027 For better visibility, you can track the value of this property with a tag. 10028 See variable `org-track-ordered-property-with-tag'." 10029 (interactive) 10030 (let* ((t1 org-track-ordered-property-with-tag) 10031 (tag (and t1 (if (stringp t1) t1 "ORDERED")))) 10032 (save-excursion 10033 (org-back-to-heading) 10034 (if (org-entry-get nil "ORDERED") 10035 (progn 10036 (org-delete-property "ORDERED") 10037 (and tag (org-toggle-tag tag 'off)) 10038 (message "Subtasks can be completed in arbitrary order")) 10039 (org-entry-put nil "ORDERED" "t") 10040 (and tag (org-toggle-tag tag 'on)) 10041 (message "Subtasks must be completed in sequence"))))) 10042 10043 (defun org-block-todo-from-checkboxes (change-plist) 10044 "Block turning an entry into a TODO, using checkboxes. 10045 This checks whether the current task should be blocked from state 10046 changes because there are unchecked boxes in this entry." 10047 (if (not org-enforce-todo-checkbox-dependencies) 10048 t ; if locally turned off don't block 10049 (catch 'dont-block 10050 ;; If this is not a todo state change, or if this entry is already DONE, 10051 ;; do not block 10052 (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) 10053 (member (plist-get change-plist :from) 10054 (cons 'done org-done-keywords)) 10055 (member (plist-get change-plist :to) 10056 (cons 'todo org-not-done-keywords)) 10057 (not (plist-get change-plist :to))) 10058 (throw 'dont-block t)) 10059 ;; If this task has checkboxes that are not checked, it's blocked 10060 (save-excursion 10061 (org-back-to-heading t) 10062 (let ((beg (point)) end) 10063 (outline-next-heading) 10064 (setq end (point)) 10065 (goto-char beg) 10066 (when (org-list-search-forward 10067 (concat (org-item-beginning-re) 10068 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" 10069 "\\[[- ]\\]") 10070 end t) 10071 (when (boundp 'org-blocked-by-checkboxes) 10072 (setq org-blocked-by-checkboxes t)) 10073 (throw 'dont-block nil)))) 10074 t))) ; do not block 10075 10076 (defun org-entry-blocked-p () 10077 "Non-nil if entry at point is blocked." 10078 (and (not (org-entry-get nil "NOBLOCKING")) 10079 (member (org-entry-get nil "TODO") org-not-done-keywords) 10080 (not (run-hook-with-args-until-failure 10081 'org-blocker-hook 10082 (list :type 'todo-state-change 10083 :position (point) 10084 :from 'todo 10085 :to 'done))))) 10086 10087 (defun org-update-statistics-cookies (all) 10088 "Update the statistics cookie, either from TODO or from checkboxes. 10089 This should be called with the cursor in a line with a statistics 10090 cookie. When called with a \\[universal-argument] prefix, update 10091 all statistics cookies in the buffer." 10092 (interactive "P") 10093 (if all 10094 (progn 10095 (org-update-checkbox-count 'all) 10096 (org-map-region 'org-update-parent-todo-statistics 10097 (point-min) (point-max))) 10098 (if (not (org-at-heading-p)) 10099 (org-update-checkbox-count) 10100 (let ((pos (point-marker)) 10101 end l1 l2) 10102 (ignore-errors (org-back-to-heading t)) 10103 (if (not (org-at-heading-p)) 10104 (org-update-checkbox-count) 10105 (setq l1 (org-outline-level)) 10106 (setq end 10107 (save-excursion 10108 (outline-next-heading) 10109 (when (org-at-heading-p) (setq l2 (org-outline-level))) 10110 (point))) 10111 (if (and (save-excursion 10112 (re-search-forward 10113 "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t)) 10114 (not (save-excursion 10115 (re-search-forward 10116 ":COOKIE_DATA:.*\\<todo\\>" end t)))) 10117 (org-update-checkbox-count) 10118 (if (and l2 (> l2 l1)) 10119 (progn 10120 (goto-char end) 10121 (org-update-parent-todo-statistics)) 10122 (goto-char pos) 10123 (beginning-of-line 1) 10124 (while (re-search-forward 10125 "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)" 10126 (point-at-eol) t) 10127 (replace-match (if (match-end 2) "[100%]" "[0/0]") t t))))) 10128 (goto-char pos) 10129 (move-marker pos nil))))) 10130 10131 (defvar org-entry-property-inherited-from) ;; defined below 10132 (defun org-update-parent-todo-statistics () 10133 "Update any statistics cookie in the parent of the current headline. 10134 When `org-hierarchical-todo-statistics' is nil, statistics will cover 10135 the entire subtree and this will travel up the hierarchy and update 10136 statistics everywhere." 10137 (let* ((prop (save-excursion 10138 (org-up-heading-safe) 10139 (org-entry-get nil "COOKIE_DATA" 'inherit))) 10140 (recursive (or (not org-hierarchical-todo-statistics) 10141 (and prop (string-match "\\<recursive\\>" prop)))) 10142 (lim (or (and prop (marker-position org-entry-property-inherited-from)) 10143 0)) 10144 (first t) 10145 (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") 10146 level ltoggle l1 new ndel 10147 (cnt-all 0) (cnt-done 0) is-percent kwd 10148 checkbox-beg cookie-present) 10149 (catch 'exit 10150 (save-excursion 10151 (beginning-of-line 1) 10152 (setq ltoggle (funcall outline-level)) 10153 ;; Three situations are to consider: 10154 10155 ;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up 10156 ;; to the top-level ancestor on the headline; 10157 10158 ;; 2. If parent has "recursive" property, repeat up to the 10159 ;; headline setting that property, taking inheritance into 10160 ;; account; 10161 10162 ;; 3. Else, move up to direct parent and proceed only once. 10163 (while (and (setq level (org-up-heading-safe)) 10164 (or recursive first) 10165 (>= (point) lim)) 10166 (setq first nil cookie-present nil) 10167 (unless (and level 10168 (not (string-match 10169 "\\<checkbox\\>" 10170 (downcase (or (org-entry-get nil "COOKIE_DATA") 10171 ""))))) 10172 (throw 'exit nil)) 10173 (while (re-search-forward box-re (point-at-eol) t) 10174 (setq cnt-all 0 cnt-done 0 cookie-present t) 10175 (setq is-percent (match-end 2) checkbox-beg (match-beginning 0)) 10176 (save-match-data 10177 (unless (outline-next-heading) (throw 'exit nil)) 10178 (while (and (looking-at org-complex-heading-regexp) 10179 (> (setq l1 (length (match-string 1))) level)) 10180 (setq kwd (and (or recursive (= l1 ltoggle)) 10181 (match-string 2))) 10182 (if (or (eq org-provide-todo-statistics 'all-headlines) 10183 (and (eq org-provide-todo-statistics t) 10184 (or (member kwd org-done-keywords))) 10185 (and (listp org-provide-todo-statistics) 10186 (stringp (car org-provide-todo-statistics)) 10187 (or (member kwd org-provide-todo-statistics) 10188 (member kwd org-done-keywords))) 10189 (and (listp org-provide-todo-statistics) 10190 (listp (car org-provide-todo-statistics)) 10191 (or (member kwd (car org-provide-todo-statistics)) 10192 (and (member kwd org-done-keywords) 10193 (member kwd (cadr org-provide-todo-statistics)))))) 10194 (setq cnt-all (1+ cnt-all)) 10195 (and (eq org-provide-todo-statistics t) 10196 kwd 10197 (setq cnt-all (1+ cnt-all)))) 10198 (when (or (and (member org-provide-todo-statistics '(t all-headlines)) 10199 (member kwd org-done-keywords)) 10200 (and (listp org-provide-todo-statistics) 10201 (listp (car org-provide-todo-statistics)) 10202 (member kwd org-done-keywords) 10203 (member kwd (cadr org-provide-todo-statistics))) 10204 (and (listp org-provide-todo-statistics) 10205 (stringp (car org-provide-todo-statistics)) 10206 (member kwd org-done-keywords))) 10207 (setq cnt-done (1+ cnt-done))) 10208 (outline-next-heading))) 10209 (setq new 10210 (if is-percent 10211 (format "[%d%%]" (floor (* 100.0 cnt-done) 10212 (max 1 cnt-all))) 10213 (format "[%d/%d]" cnt-done cnt-all)) 10214 ndel (- (match-end 0) checkbox-beg)) 10215 (goto-char checkbox-beg) 10216 (insert new) 10217 (delete-region (point) (+ (point) ndel)) 10218 (when org-auto-align-tags (org-fix-tags-on-the-fly))) 10219 (when cookie-present 10220 (run-hook-with-args 'org-after-todo-statistics-hook 10221 cnt-done (- cnt-all cnt-done)))))) 10222 (run-hooks 'org-todo-statistics-hook))) 10223 10224 (defvar org-after-todo-statistics-hook nil 10225 "Hook that is called after a TODO statistics cookie has been updated. 10226 Each function is called with two arguments: the number of not-done entries 10227 and the number of done entries. 10228 10229 For example, the following function, when added to this hook, will switch 10230 an entry to DONE when all children are done, and back to TODO when new 10231 entries are set to a TODO status. Note that this hook is only called 10232 when there is a statistics cookie in the headline! 10233 10234 (defun org-summary-todo (n-done n-not-done) 10235 \"Switch entry to DONE when all subentries are done, to TODO otherwise.\" 10236 (let (org-log-done org-log-states) ; turn off logging 10237 (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))") 10238 10239 (defvar org-todo-statistics-hook nil 10240 "Hook that is run whenever Org thinks TODO statistics should be updated. 10241 This hook runs even if there is no statistics cookie present, in which case 10242 `org-after-todo-statistics-hook' would not run.") 10243 10244 (defun org-todo-trigger-tag-changes (state) 10245 "Apply the changes defined in `org-todo-state-tags-triggers'." 10246 (let ((l org-todo-state-tags-triggers) 10247 changes) 10248 (when (or (not state) (equal state "")) 10249 (setq changes (append changes (cdr (assoc "" l))))) 10250 (when (and (stringp state) (> (length state) 0)) 10251 (setq changes (append changes (cdr (assoc state l))))) 10252 (when (member state org-not-done-keywords) 10253 (setq changes (append changes (cdr (assq 'todo l))))) 10254 (when (member state org-done-keywords) 10255 (setq changes (append changes (cdr (assq 'done l))))) 10256 (dolist (c changes) 10257 (org-toggle-tag (car c) (if (cdr c) 'on 'off))))) 10258 10259 (defun org-local-logging (value) 10260 "Get logging settings from a property VALUE." 10261 ;; Directly set the variables, they are already local. 10262 (setq org-log-done nil 10263 org-log-repeat nil 10264 org-todo-log-states nil) 10265 (dolist (w (split-string value)) 10266 (let (a) 10267 (cond 10268 ((setq a (assoc w org-startup-options)) 10269 (and (member (nth 1 a) '(org-log-done org-log-repeat)) 10270 (set (nth 1 a) (nth 2 a)))) 10271 ((setq a (org-extract-log-state-settings w)) 10272 (and (member (car a) org-todo-keywords-1) 10273 (push a org-todo-log-states))))))) 10274 10275 (defun org-get-todo-sequence-head (kwd) 10276 "Return the head of the TODO sequence to which KWD belongs. 10277 If KWD is not set, check if there is a text property remembering the 10278 right sequence." 10279 (let (p) 10280 (cond 10281 ((not kwd) 10282 (or (get-text-property (point-at-bol) 'org-todo-head) 10283 (progn 10284 (setq p (next-single-property-change (point-at-bol) 'org-todo-head 10285 nil (point-at-eol))) 10286 (get-text-property p 'org-todo-head)))) 10287 ((not (member kwd org-todo-keywords-1)) 10288 (car org-todo-keywords-1)) 10289 (t (nth 2 (assoc kwd org-todo-kwd-alist)))))) 10290 10291 (defun org-fast-todo-selection (&optional current-state) 10292 "Fast TODO keyword selection with single keys. 10293 Returns the new TODO keyword, or nil if no state change should occur. 10294 When CURRENT-STATE is given and selection letters are not unique globally, 10295 prefer a state in the current sequence over on in another sequence." 10296 (let* ((fulltable org-todo-key-alist) 10297 (head (org-get-todo-sequence-head current-state)) 10298 (done-keywords org-done-keywords) ;; needed for the faces. 10299 (maxlen (apply 'max (mapcar 10300 (lambda (x) 10301 (if (stringp (car x)) (string-width (car x)) 0)) 10302 fulltable))) 10303 (expert (equal org-use-fast-todo-selection 'expert)) 10304 (prompt "") 10305 (fwidth (+ maxlen 3 1 3)) 10306 (ncol (/ (- (window-width) 4) fwidth)) 10307 tg cnt e c tbl subtable 10308 groups ingroup in-current-sequence) 10309 (save-excursion 10310 (save-window-excursion 10311 (if expert 10312 (set-buffer (get-buffer-create " *Org todo*")) 10313 (delete-other-windows) 10314 (set-window-buffer (split-window-vertically) (get-buffer-create " *Org todo*")) 10315 (org-switch-to-buffer-other-window " *Org todo*")) 10316 (erase-buffer) 10317 (setq-local org-done-keywords done-keywords) 10318 (setq tbl fulltable cnt 0) 10319 (while (setq e (pop tbl)) 10320 (cond 10321 ((equal e '(:startgroup)) 10322 (push '() groups) (setq ingroup t) 10323 (unless (= cnt 0) 10324 (setq cnt 0) 10325 (insert "\n")) 10326 (setq prompt (concat prompt "{")) 10327 (insert "{ ")) 10328 ((equal e '(:endgroup)) 10329 (setq ingroup nil cnt 0 in-current-sequence nil) 10330 (setq prompt (concat prompt "}")) 10331 (insert "}\n")) 10332 ((equal e '(:newline)) 10333 (unless (= cnt 0) 10334 (setq cnt 0) 10335 (insert "\n") 10336 (setq e (car tbl)) 10337 (while (equal (car tbl) '(:newline)) 10338 (insert "\n") 10339 (setq tbl (cdr tbl))))) 10340 (t 10341 (setq tg (car e) c (cdr e)) 10342 (if (equal tg head) (setq in-current-sequence t)) 10343 (when ingroup (push tg (car groups))) 10344 (when in-current-sequence (push e subtable)) 10345 (setq tg (org-add-props tg nil 'face 10346 (org-get-todo-face tg))) 10347 (when (and (= cnt 0) (not ingroup)) (insert " ")) 10348 (setq prompt (concat prompt "[" (char-to-string c) "] " tg " ")) 10349 (insert "[" c "] " tg (make-string 10350 (- fwidth 4 (length tg)) ?\ )) 10351 (when (and (= (setq cnt (1+ cnt)) ncol) 10352 ;; Avoid lines with just a closing delimiter. 10353 (not (equal (car tbl) '(:endgroup)))) 10354 (insert "\n") 10355 (when ingroup (insert " ")) 10356 (setq cnt 0))))) 10357 (insert "\n") 10358 (goto-char (point-min)) 10359 (unless expert (org-fit-window-to-buffer)) 10360 (message (concat "[a-z..]:Set [SPC]:clear" 10361 (if expert (concat "\n" prompt) ""))) 10362 (setq c (let ((inhibit-quit t)) (read-char-exclusive))) 10363 (setq subtable (nreverse subtable)) 10364 (cond 10365 ((or (= c ?\C-g) 10366 (and (= c ?q) (not (rassoc c fulltable)))) 10367 (setq quit-flag t)) 10368 ((= c ?\ ) nil) 10369 ((setq e (or (rassoc c subtable) (rassoc c fulltable)) 10370 tg (car e)) 10371 tg) 10372 (t (setq quit-flag t))))))) 10373 10374 (defun org-entry-is-todo-p () 10375 (member (org-get-todo-state) org-not-done-keywords)) 10376 10377 (defun org-entry-is-done-p () 10378 (member (org-get-todo-state) org-done-keywords)) 10379 10380 (defun org-get-todo-state () 10381 "Return the TODO keyword of the current subtree." 10382 (save-excursion 10383 (org-back-to-heading t) 10384 (and (let ((case-fold-search nil)) 10385 (looking-at org-todo-line-regexp)) 10386 (match-end 2) 10387 (match-string 2)))) 10388 10389 (defun org-at-date-range-p (&optional inactive-ok) 10390 "Non-nil if point is inside a date range. 10391 10392 When optional argument INACTIVE-OK is non-nil, also consider 10393 inactive time ranges. 10394 10395 When this function returns a non-nil value, match data is set 10396 according to `org-tr-regexp-both' or `org-tr-regexp', depending 10397 on INACTIVE-OK." 10398 (interactive) 10399 (save-excursion 10400 (catch 'exit 10401 (let ((pos (point))) 10402 (skip-chars-backward "^[<\r\n") 10403 (skip-chars-backward "<[") 10404 (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) 10405 (>= (match-end 0) pos) 10406 (throw 'exit t)) 10407 (skip-chars-backward "^<[\r\n") 10408 (skip-chars-backward "<[") 10409 (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) 10410 (>= (match-end 0) pos) 10411 (throw 'exit t))) 10412 nil))) 10413 10414 (defun org-get-repeat (&optional timestamp) 10415 "Check if there is a time-stamp with repeater in this entry. 10416 10417 Return the repeater, as a string, or nil. Also return nil when 10418 this function is called before first heading. 10419 10420 When optional argument TIMESTAMP is a string, extract the 10421 repeater from there instead." 10422 (save-match-data 10423 (cond 10424 (timestamp 10425 (and (string-match org-repeat-re timestamp) 10426 (match-string-no-properties 1 timestamp))) 10427 ((org-before-first-heading-p) nil) 10428 (t 10429 (save-excursion 10430 (org-back-to-heading t) 10431 (let ((end (org-entry-end-position))) 10432 (catch :repeat 10433 (while (re-search-forward org-repeat-re end t) 10434 (when (save-match-data (org-at-timestamp-p 'agenda)) 10435 (throw :repeat (match-string-no-properties 1))))))))))) 10436 10437 (defvar org-last-changed-timestamp) 10438 (defvar org-last-inserted-timestamp) 10439 (defvar org-log-post-message) 10440 (defvar org-log-note-purpose) 10441 (defvar org-log-note-how nil) 10442 (defvar org-log-note-extra) 10443 (defvar org-log-setup nil) 10444 (defun org-auto-repeat-maybe (done-word) 10445 "Check if the current headline contains a repeated time-stamp. 10446 10447 If yes, set TODO state back to what it was and change the base date 10448 of repeating deadline/scheduled time stamps to new date. 10449 10450 This function is run automatically after each state change to a DONE state." 10451 (let* ((repeat (org-get-repeat)) 10452 (aa (assoc org-last-state org-todo-kwd-alist)) 10453 (interpret (nth 1 aa)) 10454 (head (nth 2 aa)) 10455 (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) 10456 (msg "Entry repeats: ") 10457 (org-log-done nil) 10458 (org-todo-log-states nil) 10459 (end (copy-marker (org-entry-end-position)))) 10460 (when (and repeat (not (= 0 (string-to-number (substring repeat 1))))) 10461 (when (eq org-log-repeat t) (setq org-log-repeat 'state)) 10462 (let ((to-state 10463 (or (org-entry-get nil "REPEAT_TO_STATE" 'selective) 10464 (and (stringp org-todo-repeat-to-state) 10465 org-todo-repeat-to-state) 10466 (and org-todo-repeat-to-state org-last-state)))) 10467 (org-todo (cond ((and to-state (member to-state org-todo-keywords-1)) 10468 to-state) 10469 ((eq interpret 'type) org-last-state) 10470 (head) 10471 (t 'none)))) 10472 (org-back-to-heading t) 10473 (org-add-planning-info nil nil 'closed) 10474 ;; When `org-log-repeat' is non-nil or entry contains 10475 ;; a clock, set LAST_REPEAT property. 10476 (when (or org-log-repeat 10477 (catch :clock 10478 (save-excursion 10479 (while (re-search-forward org-clock-line-re end t) 10480 (when (org-at-clock-log-p) (throw :clock t)))))) 10481 (org-entry-put nil "LAST_REPEAT" (format-time-string 10482 (org-time-stamp-format t t)))) 10483 (when org-log-repeat 10484 (if org-log-setup 10485 ;; We are already setup for some record. 10486 (when (eq org-log-repeat 'note) 10487 ;; Make sure we take a note, not only a time stamp. 10488 (setq org-log-note-how 'note)) 10489 ;; Set up for taking a record. 10490 (org-add-log-setup 'state 10491 (or done-word (car org-done-keywords)) 10492 org-last-state 10493 org-log-repeat))) 10494 ;; Time-stamps without a repeater are usually skipped. However, 10495 ;; a SCHEDULED time-stamp without one is removed, as they are no 10496 ;; longer relevant. 10497 (save-excursion 10498 (let ((scheduled (org-entry-get (point) "SCHEDULED"))) 10499 (when (and scheduled (not (string-match-p org-repeat-re scheduled))) 10500 (org-remove-timestamp-with-keyword org-scheduled-string)))) 10501 ;; Update every time-stamp with a repeater in the entry. 10502 (let ((planning-re (regexp-opt 10503 (list org-scheduled-string org-deadline-string)))) 10504 (while (re-search-forward org-repeat-re end t) 10505 (let* ((ts (match-string 0)) 10506 (type (if (not (org-at-planning-p)) "Plain:" 10507 (save-excursion 10508 (re-search-backward 10509 planning-re (line-beginning-position) t) 10510 (match-string 0))))) 10511 (when (and (org-at-timestamp-p 'agenda) 10512 (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)) 10513 (let ((n (string-to-number (match-string 2 ts))) 10514 (what (match-string 3 ts))) 10515 (when (equal what "w") (setq n (* n 7) what "d")) 10516 (when (and (equal what "h") 10517 (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" 10518 ts))) 10519 (user-error 10520 "Cannot repeat in %d hour(s) because no hour has been set" 10521 n)) 10522 ;; Preparation, see if we need to modify the start 10523 ;; date for the change. 10524 (when (match-end 1) 10525 (let ((time (save-match-data (org-time-string-to-time ts))) 10526 (repeater-type (match-string 1 ts))) 10527 (cond 10528 ((equal "." repeater-type) 10529 ;; Shift starting date to today, or now if 10530 ;; repeater is by hours. 10531 (if (equal what "h") 10532 (org-timestamp-change 10533 (floor (- (org-time-stamp-to-now ts t)) 60) 'minute) 10534 (org-timestamp-change 10535 (- (org-today) (time-to-days time)) 'day))) 10536 ((equal "+" repeater-type) 10537 (let ((nshiftmax 10) 10538 (nshift 0)) 10539 (while (or (= nshift 0) 10540 (not (org-time-less-p nil time))) 10541 (when (= nshiftmax (cl-incf nshift)) 10542 (or (y-or-n-p 10543 (format "%d repeater intervals were not \ 10544 enough to shift date past today. Continue? " 10545 nshift)) 10546 (user-error "Abort"))) 10547 (org-timestamp-change n (cdr (assoc what whata))) 10548 (org-in-regexp org-ts-regexp3) 10549 (setq ts (match-string 1)) 10550 (setq time 10551 (save-match-data 10552 (org-time-string-to-time ts))))) 10553 (org-timestamp-change (- n) (cdr (assoc what whata))) 10554 ;; Rematch, so that we have everything in place 10555 ;; for the real shift. 10556 (org-in-regexp org-ts-regexp3) 10557 (setq ts (match-string 1)) 10558 (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" 10559 ts))))) 10560 (save-excursion 10561 (org-timestamp-change n (cdr (assoc what whata)) nil t)) 10562 (setq msg 10563 (concat msg type " " org-last-changed-timestamp " "))))))) 10564 (run-hooks 'org-todo-repeat-hook) 10565 (setq org-log-post-message msg) 10566 (message msg)))) 10567 10568 (defun org-show-todo-tree (arg) 10569 "Make a compact tree which shows all headlines marked with TODO. 10570 The tree will show the lines where the regexp matches, and all higher 10571 headlines above the match. 10572 With a `\\[universal-argument]' prefix, prompt for a regexp to match. 10573 With a numeric prefix N, construct a sparse tree for the Nth element 10574 of `org-todo-keywords-1'." 10575 (interactive "P") 10576 (let ((case-fold-search nil) 10577 (kwd-re 10578 (cond ((null arg) (concat org-not-done-regexp "\\s-")) 10579 ((equal arg '(4)) 10580 (let ((kwd 10581 (completing-read "Keyword (or KWD1|KWD2|...): " 10582 (mapcar #'list org-todo-keywords-1)))) 10583 (concat "\\(" 10584 (mapconcat 'identity (org-split-string kwd "|") "\\|") 10585 "\\)\\>"))) 10586 ((<= (prefix-numeric-value arg) (length org-todo-keywords-1)) 10587 (regexp-quote (nth (1- (prefix-numeric-value arg)) 10588 org-todo-keywords-1))) 10589 (t (user-error "Invalid prefix argument: %s" arg))))) 10590 (message "%d TODO entries found" 10591 (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) 10592 10593 (defun org--deadline-or-schedule (arg type time) 10594 "Insert DEADLINE or SCHEDULE information in current entry. 10595 TYPE is either `deadline' or `scheduled'. See `org-deadline' or 10596 `org-schedule' for information about ARG and TIME arguments." 10597 (let* ((deadline? (eq type 'deadline)) 10598 (keyword (if deadline? org-deadline-string org-scheduled-string)) 10599 (log (if deadline? org-log-redeadline org-log-reschedule)) 10600 (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) 10601 (old-date-time (and old-date (org-time-string-to-time old-date))) 10602 ;; Save repeater cookie from either TIME or current scheduled 10603 ;; time stamp. We are going to insert it back at the end of 10604 ;; the process. 10605 (repeater (or (and (org-string-nw-p time) 10606 ;; We use `org-repeat-re' because we need 10607 ;; to tell the difference between a real 10608 ;; repeater and a time delta, e.g. "+2d". 10609 (string-match org-repeat-re time) 10610 (match-string 1 time)) 10611 (and (org-string-nw-p old-date) 10612 (string-match "\\([.+-]+[0-9]+[hdwmy]\ 10613 \\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)" 10614 old-date) 10615 (match-string 1 old-date))))) 10616 (pcase arg 10617 (`(4) 10618 (if (not old-date) 10619 (message (if deadline? "Entry had no deadline to remove" 10620 "Entry was not scheduled")) 10621 (when (and old-date log) 10622 (org-add-log-setup (if deadline? 'deldeadline 'delschedule) 10623 nil old-date log)) 10624 (org-remove-timestamp-with-keyword keyword) 10625 (message (if deadline? "Entry no longer has a deadline." 10626 "Entry is no longer scheduled.")))) 10627 (`(16) 10628 (save-excursion 10629 (org-back-to-heading t) 10630 (let ((regexp (if deadline? org-deadline-time-regexp 10631 org-scheduled-time-regexp))) 10632 (if (not (re-search-forward regexp (line-end-position 2) t)) 10633 (user-error (if deadline? "No deadline information to update" 10634 "No scheduled information to update")) 10635 (let* ((rpl0 (match-string 1)) 10636 (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) 10637 (msg (if deadline? "Warn starting from" "Delay until"))) 10638 (replace-match 10639 (concat keyword 10640 " <" rpl 10641 (format " -%dd" 10642 (abs (- (time-to-days 10643 (save-match-data 10644 (org-read-date 10645 nil t nil msg old-date-time))) 10646 (time-to-days old-date-time)))) 10647 ">") t t)))))) 10648 (_ 10649 (org-add-planning-info type time 'closed) 10650 (when (and old-date 10651 log 10652 (not (equal old-date org-last-inserted-timestamp))) 10653 (org-add-log-setup (if deadline? 'redeadline 'reschedule) 10654 org-last-inserted-timestamp 10655 old-date 10656 log)) 10657 (when repeater 10658 (save-excursion 10659 (org-back-to-heading t) 10660 (when (re-search-forward 10661 (concat keyword " " org-last-inserted-timestamp) 10662 (line-end-position 2) 10663 t) 10664 (goto-char (1- (match-end 0))) 10665 (insert " " repeater) 10666 (setq org-last-inserted-timestamp 10667 (concat (substring org-last-inserted-timestamp 0 -1) 10668 " " repeater 10669 (substring org-last-inserted-timestamp -1)))))) 10670 (message (if deadline? "Deadline on %s" "Scheduled to %s") 10671 org-last-inserted-timestamp))))) 10672 10673 (defun org-deadline (arg &optional time) 10674 "Insert a \"DEADLINE:\" string with a timestamp to make a deadline. 10675 10676 When called interactively, this command pops up the Emacs calendar to let 10677 the user select a date. 10678 10679 With one universal prefix argument, remove any deadline from the item. 10680 With two universal prefix arguments, prompt for a warning delay. 10681 With argument TIME, set the deadline at the corresponding date. TIME 10682 can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." 10683 (interactive "P") 10684 (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) 10685 (org-map-entries 10686 (lambda () (org--deadline-or-schedule arg 'deadline time)) 10687 nil 10688 (if (eq org-loop-over-headlines-in-active-region 'start-level) 10689 'region-start-level 10690 'region) 10691 (lambda () (when (org-invisible-p) (org-end-of-subtree nil t)))) 10692 (org--deadline-or-schedule arg 'deadline time))) 10693 10694 (defun org-schedule (arg &optional time) 10695 "Insert a \"SCHEDULED:\" string with a timestamp to schedule an item. 10696 10697 When called interactively, this command pops up the Emacs calendar to let 10698 the user select a date. 10699 10700 With one universal prefix argument, remove any scheduling date from the item. 10701 With two universal prefix arguments, prompt for a delay cookie. 10702 With argument TIME, scheduled at the corresponding date. TIME can 10703 either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." 10704 (interactive "P") 10705 (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) 10706 (org-map-entries 10707 (lambda () (org--deadline-or-schedule arg 'scheduled time)) 10708 nil 10709 (if (eq org-loop-over-headlines-in-active-region 'start-level) 10710 'region-start-level 10711 'region) 10712 (lambda () (when (org-invisible-p) (org-end-of-subtree nil t)))) 10713 (org--deadline-or-schedule arg 'scheduled time))) 10714 10715 (defun org-get-scheduled-time (pom &optional inherit) 10716 "Get the scheduled time as a time tuple, of a format suitable 10717 for calling org-schedule with, or if there is no scheduling, 10718 returns nil." 10719 (let ((time (org-entry-get pom "SCHEDULED" inherit))) 10720 (when time 10721 (org-time-string-to-time time)))) 10722 10723 (defun org-get-deadline-time (pom &optional inherit) 10724 "Get the deadline as a time tuple, of a format suitable for 10725 calling org-deadline with, or if there is no scheduling, returns 10726 nil." 10727 (let ((time (org-entry-get pom "DEADLINE" inherit))) 10728 (when time 10729 (org-time-string-to-time time)))) 10730 10731 (defun org-remove-timestamp-with-keyword (keyword) 10732 "Remove all time stamps with KEYWORD in the current entry." 10733 (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*")) 10734 beg) 10735 (save-excursion 10736 (org-back-to-heading t) 10737 (setq beg (point)) 10738 (outline-next-heading) 10739 (while (re-search-backward re beg t) 10740 (replace-match "") 10741 (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) 10742 (equal (char-before) ?\ )) 10743 (backward-delete-char 1) 10744 (when (string-match "^[ \t]*$" (buffer-substring 10745 (point-at-bol) (point-at-eol))) 10746 (delete-region (point-at-bol) 10747 (min (point-max) (1+ (point-at-eol)))))))))) 10748 10749 (defvar org-time-was-given) ; dynamically scoped parameter 10750 (defvar org-end-time-was-given) ; dynamically scoped parameter 10751 10752 (defun org-at-planning-p () 10753 "Non-nil when point is on a planning info line." 10754 ;; This is as accurate and faster than `org-element-at-point' since 10755 ;; planning info location is fixed in the section. 10756 (org-with-wide-buffer 10757 (beginning-of-line) 10758 (and (looking-at-p org-planning-line-re) 10759 (eq (point) 10760 (ignore-errors 10761 (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p)) 10762 (org-back-to-heading t) 10763 (org-with-limited-levels (org-back-to-heading t))) 10764 (line-beginning-position 2)))))) 10765 10766 (defun org-add-planning-info (what &optional time &rest remove) 10767 "Insert new timestamp with keyword in the planning line. 10768 WHAT indicates what kind of time stamp to add. It is a symbol 10769 among `closed', `deadline', `scheduled' and nil. TIME indicates 10770 the time to use. If none is given, the user is prompted for 10771 a date. REMOVE indicates what kind of entries to remove. An old 10772 WHAT entry will also be removed." 10773 (let (org-time-was-given org-end-time-was-given default-time default-input) 10774 (when (and (memq what '(scheduled deadline)) 10775 (or (not time) 10776 (and (stringp time) 10777 (string-match "^[-+]+[0-9]" time)))) 10778 ;; Try to get a default date/time from existing timestamp 10779 (save-excursion 10780 (org-back-to-heading t) 10781 (let ((end (save-excursion (outline-next-heading) (point))) ts) 10782 (when (re-search-forward (if (eq what 'scheduled) 10783 org-scheduled-time-regexp 10784 org-deadline-time-regexp) 10785 end t) 10786 (setq ts (match-string 1) 10787 default-time (org-time-string-to-time ts) 10788 default-input (and ts (org-get-compact-tod ts))))))) 10789 (when what 10790 (setq time 10791 (if (stringp time) 10792 ;; This is a string (relative or absolute), set 10793 ;; proper date. 10794 (apply #'encode-time 10795 (org-read-date-analyze 10796 time default-time (decode-time default-time))) 10797 ;; If necessary, get the time from the user 10798 (or time (org-read-date nil 'to-time nil 10799 (cl-case what 10800 (deadline "DEADLINE") 10801 (scheduled "SCHEDULED") 10802 (otherwise nil)) 10803 default-time default-input))))) 10804 (org-with-wide-buffer 10805 (org-back-to-heading t) 10806 (let ((planning? (save-excursion 10807 (forward-line) 10808 (looking-at-p org-planning-line-re)))) 10809 (cond 10810 (planning? 10811 (forward-line) 10812 ;; Move to current indentation. 10813 (skip-chars-forward " \t") 10814 ;; Check if we have to remove something. 10815 (dolist (type (if what (cons what remove) remove)) 10816 (save-excursion 10817 (when (re-search-forward 10818 (cl-case type 10819 (closed org-closed-time-regexp) 10820 (deadline org-deadline-time-regexp) 10821 (scheduled org-scheduled-time-regexp) 10822 (otherwise (error "Invalid planning type: %s" type))) 10823 (line-end-position) 10824 t) 10825 ;; Delete until next keyword or end of line. 10826 (delete-region 10827 (match-beginning 0) 10828 (if (re-search-forward org-keyword-time-not-clock-regexp 10829 (line-end-position) 10830 t) 10831 (match-beginning 0) 10832 (line-end-position)))))) 10833 ;; If there is nothing more to add and no more keyword is 10834 ;; left, remove the line completely. 10835 (if (and (looking-at-p "[ \t]*$") (not what)) 10836 (delete-region (line-end-position 0) 10837 (line-end-position)) 10838 ;; If we removed last keyword, do not leave trailing white 10839 ;; space at the end of line. 10840 (let ((p (point))) 10841 (save-excursion 10842 (end-of-line) 10843 (unless (= (skip-chars-backward " \t" p) 0) 10844 (delete-region (point) (line-end-position))))))) 10845 (what 10846 (end-of-line) 10847 (insert "\n") 10848 (when org-adapt-indentation 10849 (indent-to-column (1+ (org-outline-level))))) 10850 (t nil))) 10851 (when what 10852 ;; Insert planning keyword. 10853 (insert (cl-case what 10854 (closed org-closed-string) 10855 (deadline org-deadline-string) 10856 (scheduled org-scheduled-string) 10857 (otherwise (error "Invalid planning type: %s" what))) 10858 " ") 10859 ;; Insert associated timestamp. 10860 (let ((ts (org-insert-time-stamp 10861 time 10862 (or org-time-was-given 10863 (and (eq what 'closed) org-log-done-with-time)) 10864 (eq what 'closed) 10865 nil nil (list org-end-time-was-given)))) 10866 (unless (eolp) (insert " ")) 10867 ts))))) 10868 10869 (defvar org-log-note-marker (make-marker) 10870 "Marker pointing at the entry where the note is to be inserted.") 10871 (defvar org-log-note-purpose nil) 10872 (defvar org-log-note-state nil) 10873 (defvar org-log-note-previous-state nil) 10874 (defvar org-log-note-extra nil) 10875 (defvar org-log-note-window-configuration nil) 10876 (defvar org-log-note-return-to (make-marker)) 10877 (defvar org-log-note-effective-time nil 10878 "Remembered current time. 10879 So that dynamically scoped `org-extend-today-until' affects 10880 timestamps in state change log.") 10881 10882 (defvar org-log-post-message nil 10883 "Message to be displayed after a log note has been stored. 10884 The auto-repeater uses this.") 10885 10886 (defun org-add-note () 10887 "Add a note to the current entry. 10888 This is done in the same way as adding a state change note." 10889 (interactive) 10890 (org-add-log-setup 'note)) 10891 10892 (defun org-log-beginning (&optional create) 10893 "Return expected start of log notes in current entry. 10894 When optional argument CREATE is non-nil, the function creates 10895 a drawer to store notes, if necessary. Returned position ignores 10896 narrowing." 10897 (org-with-wide-buffer 10898 (let ((drawer (org-log-into-drawer))) 10899 (cond 10900 (drawer 10901 (org-end-of-meta-data) 10902 (let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")) 10903 (end (if (org-at-heading-p) (point) 10904 (save-excursion (outline-next-heading) (point)))) 10905 (case-fold-search t)) 10906 (catch 'exit 10907 ;; Try to find existing drawer. 10908 (while (re-search-forward regexp end t) 10909 (let ((element (org-element-at-point))) 10910 (when (eq (org-element-type element) 'drawer) 10911 (let ((cend (org-element-property :contents-end element))) 10912 (when (and (not org-log-states-order-reversed) cend) 10913 (goto-char cend))) 10914 (throw 'exit nil)))) 10915 ;; No drawer found. Create one, if permitted. 10916 (when create 10917 (unless (bolp) (insert "\n")) 10918 (let ((beg (point))) 10919 (insert ":" drawer ":\n:END:\n") 10920 (org-indent-region beg (point)) 10921 (org-flag-region (line-end-position -1) 10922 (1- (point)) t 'outline)) 10923 (end-of-line -1))))) 10924 (t 10925 (org-end-of-meta-data org-log-state-notes-insert-after-drawers) 10926 (skip-chars-forward " \t\n") 10927 (beginning-of-line) 10928 (unless org-log-states-order-reversed 10929 (org-skip-over-state-notes) 10930 (skip-chars-backward " \t\n") 10931 (forward-line))))) 10932 (if (bolp) (point) (line-beginning-position 2)))) 10933 10934 (defun org-add-log-setup (&optional purpose state prev-state how extra) 10935 "Set up the post command hook to take a note. 10936 If this is about to TODO state change, the new state is expected in STATE. 10937 HOW is an indicator what kind of note should be created. 10938 EXTRA is additional text that will be inserted into the notes buffer." 10939 (move-marker org-log-note-marker (point)) 10940 (setq org-log-note-purpose purpose 10941 org-log-note-state state 10942 org-log-note-previous-state prev-state 10943 org-log-note-how how 10944 org-log-note-extra extra 10945 org-log-note-effective-time (org-current-effective-time) 10946 org-log-setup t) 10947 (add-hook 'post-command-hook 'org-add-log-note 'append)) 10948 10949 (defun org-skip-over-state-notes () 10950 "Skip past the list of State notes in an entry." 10951 (when (ignore-errors (goto-char (org-in-item-p))) 10952 (let* ((struct (org-list-struct)) 10953 (prevs (org-list-prevs-alist struct)) 10954 (regexp 10955 (concat "[ \t]*- +" 10956 (replace-regexp-in-string 10957 " +" " +" 10958 (org-replace-escapes 10959 (regexp-quote (cdr (assq 'state org-log-note-headings))) 10960 `(("%d" . ,org-ts-regexp-inactive) 10961 ("%D" . ,org-ts-regexp) 10962 ("%s" . "\\(?:\"\\S-+\"\\)?") 10963 ("%S" . "\\(?:\"\\S-+\"\\)?") 10964 ("%t" . ,org-ts-regexp-inactive) 10965 ("%T" . ,org-ts-regexp) 10966 ("%u" . ".*?") 10967 ("%U" . ".*?"))))))) 10968 (while (looking-at-p regexp) 10969 (goto-char (or (org-list-get-next-item (point) struct prevs) 10970 (org-list-get-item-end (point) struct))))))) 10971 10972 (defun org-add-log-note (&optional _purpose) 10973 "Pop up a window for taking a note, and add this note later." 10974 (remove-hook 'post-command-hook 'org-add-log-note) 10975 (setq org-log-setup nil) 10976 (setq org-log-note-window-configuration (current-window-configuration)) 10977 (delete-other-windows) 10978 (move-marker org-log-note-return-to (point)) 10979 (pop-to-buffer-same-window (marker-buffer org-log-note-marker)) 10980 (goto-char org-log-note-marker) 10981 (org-switch-to-buffer-other-window "*Org Note*") 10982 (erase-buffer) 10983 (if (memq org-log-note-how '(time state)) 10984 (org-store-log-note) 10985 (let ((org-inhibit-startup t)) (org-mode)) 10986 (insert (format "# Insert note for %s. 10987 # Finish with C-c C-c, or cancel with C-c C-k.\n\n" 10988 (cl-case org-log-note-purpose 10989 (clock-out "stopped clock") 10990 (done "closed todo item") 10991 (reschedule "rescheduling") 10992 (delschedule "no longer scheduled") 10993 (redeadline "changing deadline") 10994 (deldeadline "removing deadline") 10995 (refile "refiling") 10996 (note "this entry") 10997 (state 10998 (format "state change from \"%s\" to \"%s\"" 10999 (or org-log-note-previous-state "") 11000 (or org-log-note-state ""))) 11001 (t (error "This should not happen"))))) 11002 (when org-log-note-extra (insert org-log-note-extra)) 11003 (setq-local org-finish-function 'org-store-log-note) 11004 (run-hooks 'org-log-buffer-setup-hook))) 11005 11006 (defvar org-note-abort nil) ; dynamically scoped 11007 (defun org-store-log-note () 11008 "Finish taking a log note, and insert it to where it belongs." 11009 (let ((txt (prog1 (buffer-string) 11010 (kill-buffer))) 11011 (note (cdr (assq org-log-note-purpose org-log-note-headings))) 11012 lines) 11013 (while (string-match "\\`# .*\n[ \t\n]*" txt) 11014 (setq txt (replace-match "" t t txt))) 11015 (when (string-match "\\s-+\\'" txt) 11016 (setq txt (replace-match "" t t txt))) 11017 (setq lines (and (not (equal "" txt)) (org-split-string txt "\n"))) 11018 (when (org-string-nw-p note) 11019 (setq note 11020 (org-replace-escapes 11021 note 11022 (list (cons "%u" (user-login-name)) 11023 (cons "%U" user-full-name) 11024 (cons "%t" (format-time-string 11025 (org-time-stamp-format 'long 'inactive) 11026 org-log-note-effective-time)) 11027 (cons "%T" (format-time-string 11028 (org-time-stamp-format 'long nil) 11029 org-log-note-effective-time)) 11030 (cons "%d" (format-time-string 11031 (org-time-stamp-format nil 'inactive) 11032 org-log-note-effective-time)) 11033 (cons "%D" (format-time-string 11034 (org-time-stamp-format nil nil) 11035 org-log-note-effective-time)) 11036 (cons "%s" (cond 11037 ((not org-log-note-state) "") 11038 ((string-match-p org-ts-regexp 11039 org-log-note-state) 11040 (format "\"[%s]\"" 11041 (substring org-log-note-state 1 -1))) 11042 (t (format "\"%s\"" org-log-note-state)))) 11043 (cons "%S" 11044 (cond 11045 ((not org-log-note-previous-state) "") 11046 ((string-match-p org-ts-regexp 11047 org-log-note-previous-state) 11048 (format "\"[%s]\"" 11049 (substring 11050 org-log-note-previous-state 1 -1))) 11051 (t (format "\"%s\"" 11052 org-log-note-previous-state))))))) 11053 (when lines (setq note (concat note " \\\\"))) 11054 (push note lines)) 11055 (when (and lines (not org-note-abort)) 11056 (with-current-buffer (marker-buffer org-log-note-marker) 11057 (org-with-wide-buffer 11058 ;; Find location for the new note. 11059 (goto-char org-log-note-marker) 11060 (set-marker org-log-note-marker nil) 11061 ;; Note associated to a clock is to be located right after 11062 ;; the clock. Do not move point. 11063 (unless (eq org-log-note-purpose 'clock-out) 11064 (goto-char (org-log-beginning t))) 11065 ;; Make sure point is at the beginning of an empty line. 11066 (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) 11067 ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) 11068 ;; In an existing list, add a new item at the top level. 11069 ;; Otherwise, indent line like a regular one. 11070 (let ((itemp (org-in-item-p))) 11071 (if itemp 11072 (indent-line-to 11073 (let ((struct (save-excursion 11074 (goto-char itemp) (org-list-struct)))) 11075 (org-list-get-ind (org-list-get-top-point struct) struct))) 11076 (org-indent-line))) 11077 (insert (org-list-bullet-string "-") (pop lines)) 11078 (let ((ind (org-list-item-body-column (line-beginning-position)))) 11079 (dolist (line lines) 11080 (insert "\n") 11081 (indent-line-to ind) 11082 (insert line))) 11083 (message "Note stored") 11084 (org-back-to-heading t))))) 11085 ;; Don't add undo information when called from `org-agenda-todo'. 11086 (set-window-configuration org-log-note-window-configuration) 11087 (with-current-buffer (marker-buffer org-log-note-return-to) 11088 (goto-char org-log-note-return-to)) 11089 (move-marker org-log-note-return-to nil) 11090 (when org-log-post-message (message "%s" org-log-post-message))) 11091 11092 (defun org-remove-empty-drawer-at (pos) 11093 "Remove an empty drawer at position POS. 11094 POS may also be a marker." 11095 (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) 11096 (org-with-wide-buffer 11097 (goto-char pos) 11098 (let ((drawer (org-element-at-point))) 11099 (when (and (memq (org-element-type drawer) '(drawer property-drawer)) 11100 (not (org-element-property :contents-begin drawer))) 11101 (delete-region (org-element-property :begin drawer) 11102 (progn (goto-char (org-element-property :end drawer)) 11103 (skip-chars-backward " \r\t\n") 11104 (forward-line) 11105 (point)))))))) 11106 11107 (defvar org-ts-type nil) 11108 (defun org-sparse-tree (&optional arg type) 11109 "Create a sparse tree, prompt for the details. 11110 This command can create sparse trees. You first need to select the type 11111 of match used to create the tree: 11112 11113 t Show all TODO entries. 11114 T Show entries with a specific TODO keyword. 11115 m Show entries selected by a tags/property match. 11116 p Enter a property name and its value (both with completion on existing 11117 names/values) and show entries with that property. 11118 r Show entries matching a regular expression (`/' can be used as well). 11119 b Show deadlines and scheduled items before a date. 11120 a Show deadlines and scheduled items after a date. 11121 d Show deadlines due within `org-deadline-warning-days'. 11122 D Show deadlines and scheduled items between a date range." 11123 (interactive "P") 11124 (setq type (or type org-sparse-tree-default-date-type)) 11125 (setq org-ts-type type) 11126 (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty 11127 [d]eadlines [b]efore-date [a]fter-date [D]ates range 11128 [c]ycle through date types: %s" 11129 (cl-case type 11130 (all "all timestamps") 11131 (scheduled "only scheduled") 11132 (deadline "only deadline") 11133 (active "only active timestamps") 11134 (inactive "only inactive timestamps") 11135 (closed "with a closed time-stamp") 11136 (otherwise "scheduled/deadline"))) 11137 (let ((answer (read-char-exclusive))) 11138 (cl-case answer 11139 (?c 11140 (org-sparse-tree 11141 arg 11142 (cadr 11143 (memq type '(nil all scheduled deadline active inactive closed))))) 11144 (?d (call-interactively 'org-check-deadlines)) 11145 (?b (call-interactively 'org-check-before-date)) 11146 (?a (call-interactively 'org-check-after-date)) 11147 (?D (call-interactively 'org-check-dates-range)) 11148 (?t (call-interactively 'org-show-todo-tree)) 11149 (?T (org-show-todo-tree '(4))) 11150 (?m (call-interactively 'org-match-sparse-tree)) 11151 ((?p ?P) 11152 (let* ((kwd (completing-read 11153 "Property: " (mapcar #'list (org-buffer-property-keys)))) 11154 (value (completing-read 11155 "Value: " (mapcar #'list (org-property-values kwd))))) 11156 (unless (string-match "\\`{.*}\\'" value) 11157 (setq value (concat "\"" value "\""))) 11158 (org-match-sparse-tree arg (concat kwd "=" value)))) 11159 ((?r ?R ?/) (call-interactively 'org-occur)) 11160 (otherwise (user-error "No such sparse tree command \"%c\"" answer))))) 11161 11162 (defvar-local org-occur-highlights nil 11163 "List of overlays used for occur matches.") 11164 (defvar-local org-occur-parameters nil 11165 "Parameters of the active org-occur calls. 11166 This is a list, each call to org-occur pushes as cons cell, 11167 containing the regular expression and the callback, onto the list. 11168 The list can contain several entries if `org-occur' has been called 11169 several time with the KEEP-PREVIOUS argument. Otherwise, this list 11170 will only contain one set of parameters. When the highlights are 11171 removed (for example with `C-c C-c', or with the next edit (depending 11172 on `org-remove-highlights-with-change'), this variable is emptied 11173 as well.") 11174 11175 (defun org-occur (regexp &optional keep-previous callback) 11176 "Make a compact tree showing all matches of REGEXP. 11177 11178 The tree will show the lines where the regexp matches, and any other context 11179 defined in `org-show-context-detail', which see. 11180 11181 When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing 11182 done by a previous call to `org-occur' will be kept, to allow stacking of 11183 calls to this command. 11184 11185 Optional argument CALLBACK can be a function of no argument. In this case, 11186 it is called with point at the end of the match, match data being set 11187 accordingly. Current match is shown only if the return value is non-nil. 11188 The function must neither move point nor alter narrowing." 11189 (interactive "sRegexp: \nP") 11190 (when (equal regexp "") 11191 (user-error "Regexp cannot be empty")) 11192 (unless keep-previous 11193 (org-remove-occur-highlights nil nil t)) 11194 (push (cons regexp callback) org-occur-parameters) 11195 (let ((cnt 0)) 11196 (save-excursion 11197 (goto-char (point-min)) 11198 (when (or (not keep-previous) ; do not want to keep 11199 (not org-occur-highlights)) ; no previous matches 11200 ;; hide everything 11201 (org-overview)) 11202 (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart) 11203 (isearch-no-upper-case-p regexp t) 11204 org-occur-case-fold-search))) 11205 (while (re-search-forward regexp nil t) 11206 (when (or (not callback) 11207 (save-match-data (funcall callback))) 11208 (setq cnt (1+ cnt)) 11209 (when org-highlight-sparse-tree-matches 11210 (org-highlight-new-match (match-beginning 0) (match-end 0))) 11211 (org-show-context 'occur-tree))))) 11212 (when org-remove-highlights-with-change 11213 (add-hook 'before-change-functions 'org-remove-occur-highlights 11214 nil 'local)) 11215 (unless org-sparse-tree-open-archived-trees 11216 (org-hide-archived-subtrees (point-min) (point-max))) 11217 (run-hooks 'org-occur-hook) 11218 (when (called-interactively-p 'interactive) 11219 (message "%d match(es) for regexp %s" cnt regexp)) 11220 cnt)) 11221 11222 (defun org-occur-next-match (&optional n _reset) 11223 "Function for `next-error-function' to find sparse tree matches. 11224 N is the number of matches to move, when negative move backwards. 11225 This function always goes back to the starting point when no 11226 match is found." 11227 (let* ((limit (if (< n 0) (point-min) (point-max))) 11228 (search-func (if (< n 0) 11229 'previous-single-char-property-change 11230 'next-single-char-property-change)) 11231 (n (abs n)) 11232 (pos (point)) 11233 p1) 11234 (catch 'exit 11235 (while (setq p1 (funcall search-func (point) 'org-type)) 11236 (when (equal p1 limit) 11237 (goto-char pos) 11238 (user-error "No more matches")) 11239 (when (equal (get-char-property p1 'org-type) 'org-occur) 11240 (setq n (1- n)) 11241 (when (= n 0) 11242 (goto-char p1) 11243 (throw 'exit (point)))) 11244 (goto-char p1)) 11245 (goto-char p1) 11246 (user-error "No more matches")))) 11247 11248 (defun org-highlight-new-match (beg end) 11249 "Highlight from BEG to END and mark the highlight is an occur headline." 11250 (let ((ov (make-overlay beg end))) 11251 (overlay-put ov 'face 'secondary-selection) 11252 (overlay-put ov 'org-type 'org-occur) 11253 (push ov org-occur-highlights))) 11254 11255 (defun org-remove-occur-highlights (&optional _beg _end noremove) 11256 "Remove the occur highlights from the buffer. 11257 BEG and END are ignored. If NOREMOVE is nil, remove this function 11258 from the `before-change-functions' in the current buffer." 11259 (interactive) 11260 (unless org-inhibit-highlight-removal 11261 (mapc #'delete-overlay org-occur-highlights) 11262 (setq org-occur-highlights nil) 11263 (setq org-occur-parameters nil) 11264 (unless noremove 11265 (remove-hook 'before-change-functions 11266 'org-remove-occur-highlights 'local)))) 11267 11268 ;;;; Priorities 11269 11270 (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]+\\)\\] ?\\)" 11271 "Regular expression matching the priority indicator. 11272 A priority indicator can be e.g. [#A] or [#1]. 11273 This regular expression matches these groups: 11274 0 : the whole match, e.g. \"TODO [#A] Hack\" 11275 1 : the priority cookie, e.g. \"[#A]\" 11276 2 : the value of the priority cookie, e.g. \"A\".") 11277 11278 (defun org-priority-up () 11279 "Increase the priority of the current item." 11280 (interactive) 11281 (org-priority 'up)) 11282 11283 (defun org-priority-down () 11284 "Decrease the priority of the current item." 11285 (interactive) 11286 (org-priority 'down)) 11287 11288 (defun org-priority (&optional action show) 11289 "Change the priority of an item. 11290 11291 When called interactively with a `\\[universal-argument]' prefix, 11292 show the priority in the minibuffer instead of changing it. 11293 11294 When called programmatically, ACTION can be `set', `up', `down', 11295 or a character." 11296 (interactive "P") 11297 (when show 11298 ;; Deprecation warning inserted for Org 9.2; once enough time has 11299 ;; passed the SHOW argument should be removed. 11300 (warn "`org-priority' called with deprecated SHOW argument")) 11301 (if (equal action '(4)) 11302 (org-priority-show) 11303 (unless org-priority-enable-commands 11304 (user-error "Priority commands are disabled")) 11305 (setq action (or action 'set)) 11306 (let ((nump (< org-priority-lowest 65)) 11307 current new news have remove) 11308 (save-excursion 11309 (org-back-to-heading t) 11310 (when (looking-at org-priority-regexp) 11311 (let ((ms (match-string 2))) 11312 (setq current (org-priority-to-value ms) 11313 have t))) 11314 (cond 11315 ((eq action 'remove) 11316 (setq remove t new ?\ )) 11317 ((or (eq action 'set) 11318 (integerp action)) 11319 (if (not (eq action 'set)) 11320 (setq new action) 11321 (setq 11322 new 11323 (if nump 11324 (let ((msg (format "Priority %s-%s, SPC to remove: " 11325 (number-to-string org-priority-highest) 11326 (number-to-string org-priority-lowest)))) 11327 (if (< 9 org-priority-lowest) 11328 (string-to-number (read-string msg)) 11329 (message msg) 11330 (string-to-number (char-to-string (read-char-exclusive))))) 11331 (progn (message "Priority %c-%c, SPC to remove: " 11332 org-priority-highest org-priority-lowest) 11333 (save-match-data 11334 (setq new (read-char-exclusive))))))) 11335 (when (and (= (upcase org-priority-highest) org-priority-highest) 11336 (= (upcase org-priority-lowest) org-priority-lowest)) 11337 (setq new (upcase new))) 11338 (cond ((equal new ?\s) (setq remove t)) 11339 ((or (< (upcase new) org-priority-highest) (> (upcase new) org-priority-lowest)) 11340 (user-error 11341 (if nump 11342 "Priority must be between `%s' and `%s'" 11343 "Priority must be between `%c' and `%c'") 11344 org-priority-highest org-priority-lowest)))) 11345 ((eq action 'up) 11346 (setq new (if have 11347 (1- current) ; normal cycling 11348 ;; last priority was empty 11349 (if (eq last-command this-command) 11350 org-priority-lowest ; wrap around empty to lowest 11351 ;; default 11352 (if org-priority-start-cycle-with-default 11353 org-priority-default 11354 (1- org-priority-default)))))) 11355 ((eq action 'down) 11356 (setq new (if have 11357 (1+ current) ; normal cycling 11358 ;; last priority was empty 11359 (if (eq last-command this-command) 11360 org-priority-highest ; wrap around empty to highest 11361 ;; default 11362 (if org-priority-start-cycle-with-default 11363 org-priority-default 11364 (1+ org-priority-default)))))) 11365 (t (user-error "Invalid action"))) 11366 (when (or (< (upcase new) org-priority-highest) 11367 (> (upcase new) org-priority-lowest)) 11368 (if (and (memq action '(up down)) 11369 (not have) (not (eq last-command this-command))) 11370 ;; `new' is from default priority 11371 (error 11372 "The default can not be set, see `org-priority-default' why") 11373 ;; normal cycling: `new' is beyond highest/lowest priority 11374 ;; and is wrapped around to the empty priority 11375 (setq remove t))) 11376 ;; Numerical priorities are limited to 64, beyond that number, 11377 ;; assume the priority cookie is a character. 11378 (setq news (if (> new 64) (format "%c" new) (format "%s" new))) 11379 (if have 11380 (if remove 11381 (replace-match "" t t nil 1) 11382 (replace-match news t t nil 2)) 11383 (if remove 11384 (user-error "No priority cookie found in line") 11385 (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) 11386 (if (match-end 2) 11387 (progn 11388 (goto-char (match-end 2)) 11389 (insert " [#" news "]")) 11390 (goto-char (match-beginning 3)) 11391 (insert "[#" news "] ")))) 11392 (org-align-tags)) 11393 (if remove 11394 (message "Priority removed") 11395 (message "Priority of current item set to %s" news))))) 11396 11397 (defalias 'org-show-priority 'org-priority-show) 11398 (defun org-priority-show () 11399 "Show the priority of the current item. 11400 This priority is composed of the main priority given with the [#A] cookies, 11401 and by additional input from the age of a schedules or deadline entry." 11402 (interactive) 11403 (let ((pri (if (eq major-mode 'org-agenda-mode) 11404 (org-get-at-bol 'priority) 11405 (save-excursion 11406 (save-match-data 11407 (beginning-of-line) 11408 (and (looking-at org-heading-regexp) 11409 (org-get-priority (match-string 0)))))))) 11410 (message "Priority is %d" (if pri pri -1000)))) 11411 11412 (defun org-get-priority (s) 11413 "Find priority cookie and return priority. 11414 S is a string against which you can match `org-priority-regexp'. 11415 If `org-priority-get-priority-function' is set to a custom 11416 function, use it. Otherwise process S and output the priority 11417 value, an integer." 11418 (save-match-data 11419 (if (functionp org-priority-get-priority-function) 11420 (funcall org-priority-get-priority-function s) 11421 (if (not (string-match org-priority-regexp s)) 11422 (* 1000 (- org-priority-lowest org-priority-default)) 11423 (* 1000 (- org-priority-lowest 11424 (org-priority-to-value (match-string 2 s)))))))) 11425 11426 ;;;; Tags 11427 11428 (defvar org-agenda-archives-mode) 11429 (defvar org-map-continue-from nil 11430 "Position from where mapping should continue. 11431 Can be set by the action argument to `org-scan-tags' and `org-map-entries'.") 11432 11433 (defvar org-scanner-tags nil 11434 "The current tag list while the tags scanner is running.") 11435 11436 (defvar org-trust-scanner-tags nil 11437 "Should `org-get-tags' use the tags for the scanner. 11438 This is for internal dynamical scoping only. 11439 When this is non-nil, the function `org-get-tags' will return the value 11440 of `org-scanner-tags' instead of building the list by itself. This 11441 can lead to large speed-ups when the tags scanner is used in a file with 11442 many entries, and when the list of tags is retrieved, for example to 11443 obtain a list of properties. Building the tags list for each entry in such 11444 a file becomes an N^2 operation - but with this variable set, it scales 11445 as N.") 11446 11447 (defvar org--matcher-tags-todo-only nil) 11448 11449 (defun org-scan-tags (action matcher todo-only &optional start-level) 11450 "Scan headline tags with inheritance and produce output ACTION. 11451 11452 ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, 11453 or `agenda' to produce an entry list for an agenda view. It can also be 11454 a Lisp form or a function that should be called at each matched headline, in 11455 this case the return value is a list of all return values from these calls. 11456 11457 MATCHER is a function accepting three arguments, returning 11458 a non-nil value whenever a given set of tags qualifies a headline 11459 for inclusion. See `org-make-tags-matcher' for more information. 11460 As a special case, it can also be set to t (respectively nil) in 11461 order to match all (respectively none) headline. 11462 11463 When TODO-ONLY is non-nil, only lines with a TODO keyword are 11464 included in the output. 11465 11466 START-LEVEL can be a string with asterisks, reducing the scope to 11467 headlines matching this string." 11468 (require 'org-agenda) 11469 (let* ((re (concat "^" 11470 (if start-level 11471 ;; Get the correct level to match 11472 (concat "\\*\\{" (number-to-string start-level) "\\} ") 11473 org-outline-regexp) 11474 " *\\(" (regexp-opt org-todo-keywords-1 'words) "\\)?" 11475 " *\\(.*?\\)\\([ \t]:\\(?:" org-tag-re ":\\)+\\)?[ \t]*$")) 11476 (props (list 'face 'default 11477 'done-face 'org-agenda-done 11478 'undone-face 'default 11479 'mouse-face 'highlight 11480 'org-not-done-regexp org-not-done-regexp 11481 'org-todo-regexp org-todo-regexp 11482 'org-complex-heading-regexp org-complex-heading-regexp 11483 'help-echo 11484 (format "mouse-2 or RET jump to Org file %S" 11485 (abbreviate-file-name 11486 (or (buffer-file-name (buffer-base-buffer)) 11487 (buffer-name (buffer-base-buffer))))))) 11488 (org-map-continue-from nil) 11489 lspos tags tags-list 11490 (tags-alist (list (cons 0 org-file-tags))) 11491 (llast 0) rtn rtn1 level category i txt 11492 todo marker entry priority 11493 ts-date ts-date-type ts-date-pair) 11494 (unless (or (member action '(agenda sparse-tree)) (functionp action)) 11495 (setq action (list 'lambda nil action))) 11496 (save-excursion 11497 (goto-char (point-min)) 11498 (when (eq action 'sparse-tree) 11499 (org-overview) 11500 (org-remove-occur-highlights)) 11501 (while (let (case-fold-search) 11502 (re-search-forward re nil t)) 11503 (setq org-map-continue-from nil) 11504 (catch :skip 11505 ;; Ignore closing parts of inline tasks. 11506 (when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p)) 11507 (throw :skip t)) 11508 (setq todo (and (match-end 1) (match-string-no-properties 1))) 11509 (setq tags (and (match-end 4) (org-trim (match-string-no-properties 4)))) 11510 (goto-char (setq lspos (match-beginning 0))) 11511 (setq level (org-reduced-level (org-outline-level)) 11512 category (org-get-category)) 11513 (when (eq action 'agenda) 11514 (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) 11515 ts-date (car ts-date-pair) 11516 ts-date-type (cdr ts-date-pair))) 11517 (setq i llast llast level) 11518 ;; remove tag lists from same and sublevels 11519 (while (>= i level) 11520 (when (setq entry (assoc i tags-alist)) 11521 (setq tags-alist (delete entry tags-alist))) 11522 (setq i (1- i))) 11523 ;; add the next tags 11524 (when tags 11525 (setq tags (org-split-string tags ":") 11526 tags-alist 11527 (cons (cons level tags) tags-alist))) 11528 ;; compile tags for current headline 11529 (setq tags-list 11530 (if org-use-tag-inheritance 11531 (apply 'append (mapcar 'cdr (reverse tags-alist))) 11532 tags) 11533 org-scanner-tags tags-list) 11534 (when org-use-tag-inheritance 11535 (setcdr (car tags-alist) 11536 (mapcar (lambda (x) 11537 (setq x (copy-sequence x)) 11538 (org-add-prop-inherited x)) 11539 (cdar tags-alist)))) 11540 (when (and tags org-use-tag-inheritance 11541 (or (not (eq t org-use-tag-inheritance)) 11542 org-tags-exclude-from-inheritance)) 11543 ;; Selective inheritance, remove uninherited ones. 11544 (setcdr (car tags-alist) 11545 (org-remove-uninherited-tags (cdar tags-alist)))) 11546 (when (and 11547 11548 ;; eval matcher only when the todo condition is OK 11549 (and (or (not todo-only) (member todo org-todo-keywords-1)) 11550 (if (functionp matcher) 11551 (let ((case-fold-search t) (org-trust-scanner-tags t)) 11552 (funcall matcher todo tags-list level)) 11553 matcher)) 11554 11555 ;; Call the skipper, but return t if it does not 11556 ;; skip, so that the `and' form continues evaluating. 11557 (progn 11558 (unless (eq action 'sparse-tree) (org-agenda-skip)) 11559 t) 11560 11561 ;; Check if timestamps are deselecting this entry 11562 (or (not todo-only) 11563 (and (member todo org-todo-keywords-1) 11564 (or (not org-agenda-tags-todo-honor-ignore-options) 11565 (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))) 11566 11567 ;; select this headline 11568 (cond 11569 ((eq action 'sparse-tree) 11570 (and org-highlight-sparse-tree-matches 11571 (org-get-heading) (match-end 0) 11572 (org-highlight-new-match 11573 (match-beginning 1) (match-end 1))) 11574 (org-show-context 'tags-tree)) 11575 ((eq action 'agenda) 11576 (setq txt (org-agenda-format-item 11577 "" 11578 (concat 11579 (if (eq org-tags-match-list-sublevels 'indented) 11580 (make-string (1- level) ?.) "") 11581 (org-get-heading)) 11582 (make-string level ?\s) 11583 category 11584 tags-list) 11585 priority (org-get-priority txt)) 11586 (goto-char lspos) 11587 (setq marker (org-agenda-new-marker)) 11588 (org-add-props txt props 11589 'org-marker marker 'org-hd-marker marker 'org-category category 11590 'todo-state todo 11591 'ts-date ts-date 11592 'priority priority 11593 'type (concat "tagsmatch" ts-date-type)) 11594 (push txt rtn)) 11595 ((functionp action) 11596 (setq org-map-continue-from nil) 11597 (save-excursion 11598 (setq rtn1 (funcall action)) 11599 (push rtn1 rtn))) 11600 (t (user-error "Invalid action"))) 11601 11602 ;; if we are to skip sublevels, jump to end of subtree 11603 (unless org-tags-match-list-sublevels 11604 (org-end-of-subtree t) 11605 (backward-char 1)))) 11606 ;; Get the correct position from where to continue 11607 (if org-map-continue-from 11608 (goto-char org-map-continue-from) 11609 (and (= (point) lspos) (end-of-line 1))))) 11610 (when (and (eq action 'sparse-tree) 11611 (not org-sparse-tree-open-archived-trees)) 11612 (org-hide-archived-subtrees (point-min) (point-max))) 11613 (nreverse rtn))) 11614 11615 (defun org-remove-uninherited-tags (tags) 11616 "Remove all tags that are not inherited from the list TAGS." 11617 (cond 11618 ((eq org-use-tag-inheritance t) 11619 (if org-tags-exclude-from-inheritance 11620 (org-delete-all org-tags-exclude-from-inheritance tags) 11621 tags)) 11622 ((not org-use-tag-inheritance) nil) 11623 ((stringp org-use-tag-inheritance) 11624 (delq nil (mapcar 11625 (lambda (x) 11626 (if (and (string-match org-use-tag-inheritance x) 11627 (not (member x org-tags-exclude-from-inheritance))) 11628 x nil)) 11629 tags))) 11630 ((listp org-use-tag-inheritance) 11631 (delq nil (mapcar 11632 (lambda (x) 11633 (if (member x org-use-tag-inheritance) x nil)) 11634 tags))))) 11635 11636 (defun org-match-sparse-tree (&optional todo-only match) 11637 "Create a sparse tree according to tags string MATCH. 11638 11639 MATCH is a string with match syntax. It can contain a selection 11640 of tags (\"+work+urgent-boss\"), properties (\"LEVEL>3\"), and 11641 TODO keywords (\"TODO=\\\"WAITING\\\"\") or a combination of 11642 those. See the manual for details. 11643 11644 If optional argument TODO-ONLY is non-nil, only select lines that 11645 are also TODO tasks." 11646 (interactive "P") 11647 (org-agenda-prepare-buffers (list (current-buffer))) 11648 (let ((org--matcher-tags-todo-only todo-only)) 11649 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match t)) 11650 org--matcher-tags-todo-only))) 11651 11652 (defalias 'org-tags-sparse-tree 'org-match-sparse-tree) 11653 11654 (defvar org-cached-props nil) 11655 (defun org-cached-entry-get (pom property) 11656 (if (or (eq t org-use-property-inheritance) 11657 (and (stringp org-use-property-inheritance) 11658 (let ((case-fold-search t)) 11659 (string-match-p org-use-property-inheritance property))) 11660 (and (listp org-use-property-inheritance) 11661 (member-ignore-case property org-use-property-inheritance))) 11662 ;; Caching is not possible, check it directly. 11663 (org-entry-get pom property 'inherit) 11664 ;; Get all properties, so we can do complicated checks easily. 11665 (cdr (assoc-string property 11666 (or org-cached-props 11667 (setq org-cached-props (org-entry-properties pom))) 11668 t)))) 11669 11670 (defun org-global-tags-completion-table (&optional files) 11671 "Return the list of all tags in all agenda buffer/files. 11672 Optional FILES argument is a list of files which can be used 11673 instead of the agenda files." 11674 (save-excursion 11675 (org-uniquify 11676 (delq nil 11677 (apply #'append 11678 (mapcar 11679 (lambda (file) 11680 (set-buffer (find-file-noselect file)) 11681 (org--tag-add-to-alist 11682 (org-get-buffer-tags) 11683 (mapcar (lambda (x) 11684 (and (stringp (car-safe x)) 11685 (list (car-safe x)))) 11686 org-current-tag-alist))) 11687 (if (car-safe files) files 11688 (org-agenda-files)))))))) 11689 11690 (defun org-make-tags-matcher (match &optional only-local-tags) 11691 "Create the TAGS/TODO matcher form for the selection string MATCH. 11692 11693 Returns a cons of the selection string MATCH and a function 11694 implementing the matcher. 11695 11696 The matcher is to be called at an Org entry, with point on the 11697 headline, and returns non-nil if the entry matches the selection 11698 string MATCH. It must be called with three arguments: the TODO 11699 keyword at the entry (or nil if none), the list of all tags at 11700 the entry including inherited ones and the reduced level of the 11701 headline. Additionally, the category of the entry, if any, must 11702 be specified as the text property `org-category' on the headline. 11703 11704 This function sets the variable `org--matcher-tags-todo-only' to 11705 a non-nil value if the matcher restricts matching to TODO 11706 entries, otherwise it is not touched. 11707 11708 When ONLY-LOCAL-TAGS is non-nil, ignore the global tag completion 11709 table, only get buffer tags. 11710 11711 See also `org-scan-tags'." 11712 (unless match 11713 ;; Get a new match request, with completion against the global 11714 ;; tags table and the local tags in current buffer. 11715 (let ((org-last-tags-completion-table 11716 (org--tag-add-to-alist 11717 (org-get-buffer-tags) 11718 (unless only-local-tags 11719 (org-global-tags-completion-table))))) 11720 (setq match 11721 (completing-read 11722 "Match: " 11723 'org-tags-completion-function nil nil nil 'org-tags-history)))) 11724 11725 (let ((match0 match) 11726 (re (concat 11727 "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)" 11728 "\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)" 11729 "\\([<>=]\\{1,2\\}\\)" 11730 "\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)" 11731 "\\|" org-tag-re "\\)")) 11732 (start 0) 11733 tagsmatch todomatch tagsmatcher todomatcher) 11734 11735 ;; Expand group tags. 11736 (setq match (org-tags-expand match)) 11737 11738 ;; Check if there is a TODO part of this match, which would be the 11739 ;; part after a "/". To make sure that this slash is not part of 11740 ;; a property value to be matched against, we also check that 11741 ;; there is no / after that slash. First, find the last slash. 11742 (let ((s 0)) 11743 (while (string-match "/+" match s) 11744 (setq start (match-beginning 0)) 11745 (setq s (match-end 0)))) 11746 (if (and (string-match "/+" match start) 11747 (not (string-match-p "\"" match start))) 11748 ;; Match contains also a TODO-matching request. 11749 (progn 11750 (setq tagsmatch (substring match 0 (match-beginning 0))) 11751 (setq todomatch (substring match (match-end 0))) 11752 (when (string-prefix-p "!" todomatch) 11753 (setq org--matcher-tags-todo-only t) 11754 (setq todomatch (substring todomatch 1))) 11755 (when (string-match "\\`\\s-*\\'" todomatch) 11756 (setq todomatch nil))) 11757 ;; Only matching tags. 11758 (setq tagsmatch match) 11759 (setq todomatch nil)) 11760 11761 ;; Make the tags matcher. 11762 (when (org-string-nw-p tagsmatch) 11763 (let ((orlist nil) 11764 (orterms (org-split-string tagsmatch "|")) 11765 term) 11766 (while (setq term (pop orterms)) 11767 (while (and (equal (substring term -1) "\\") orterms) 11768 (setq term (concat term "|" (pop orterms)))) ;repair bad split. 11769 (while (string-match re term) 11770 (let* ((rest (substring term (match-end 0))) 11771 (minus (and (match-end 1) 11772 (equal (match-string 1 term) "-"))) 11773 (tag (save-match-data 11774 (replace-regexp-in-string 11775 "\\\\-" "-" (match-string 2 term)))) 11776 (regexp (eq (string-to-char tag) ?{)) 11777 (levelp (match-end 4)) 11778 (propp (match-end 5)) 11779 (mm 11780 (cond 11781 (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list)) 11782 (levelp 11783 `(,(org-op-to-function (match-string 3 term)) 11784 level 11785 ,(string-to-number (match-string 4 term)))) 11786 (propp 11787 (let* ((gv (pcase (upcase (match-string 5 term)) 11788 ("CATEGORY" 11789 '(get-text-property (point) 'org-category)) 11790 ("TODO" 'todo) 11791 (p `(org-cached-entry-get nil ,p)))) 11792 (pv (match-string 7 term)) 11793 (regexp (eq (string-to-char pv) ?{)) 11794 (strp (eq (string-to-char pv) ?\")) 11795 (timep (string-match-p "^\"[[<].*[]>]\"$" pv)) 11796 (po (org-op-to-function (match-string 6 term) 11797 (if timep 'time strp)))) 11798 (setq pv (if (or regexp strp) (substring pv 1 -1) pv)) 11799 (when timep (setq pv (org-matcher-time pv))) 11800 (cond ((and regexp (eq po '/=)) 11801 `(not (string-match ,pv (or ,gv "")))) 11802 (regexp `(string-match ,pv (or ,gv ""))) 11803 (strp `(,po (or ,gv "") ,pv)) 11804 (t 11805 `(,po 11806 (string-to-number (or ,gv "")) 11807 ,(string-to-number pv)))))) 11808 (t `(member ,tag tags-list))))) 11809 (push (if minus `(not ,mm) mm) tagsmatcher) 11810 (setq term rest))) 11811 (push `(and ,@tagsmatcher) orlist) 11812 (setq tagsmatcher nil)) 11813 (setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist))))) 11814 11815 ;; Make the TODO matcher. 11816 (when (org-string-nw-p todomatch) 11817 (let ((orlist nil)) 11818 (dolist (term (org-split-string todomatch "|")) 11819 (while (string-match re term) 11820 (let* ((minus (and (match-end 1) 11821 (equal (match-string 1 term) "-"))) 11822 (kwd (match-string 2 term)) 11823 (regexp (eq (string-to-char kwd) ?{)) 11824 (mm (if regexp `(string-match ,(substring kwd 1 -1) todo) 11825 `(equal todo ,kwd)))) 11826 (push (if minus `(not ,mm) mm) todomatcher)) 11827 (setq term (substring term (match-end 0)))) 11828 (push (if (> (length todomatcher) 1) 11829 (cons 'and todomatcher) 11830 (car todomatcher)) 11831 orlist) 11832 (setq todomatcher nil)) 11833 (setq todomatcher (cons 'or orlist)))) 11834 11835 ;; Return the string and function of the matcher. If no 11836 ;; tags-specific or todo-specific matcher exists, match 11837 ;; everything. 11838 (let ((matcher (if (and tagsmatcher todomatcher) 11839 `(and ,tagsmatcher ,todomatcher) 11840 (or tagsmatcher todomatcher t)))) 11841 (when org--matcher-tags-todo-only 11842 (setq matcher `(and (member todo org-not-done-keywords) ,matcher))) 11843 (cons match0 `(lambda (todo tags-list level) ,matcher))))) 11844 11845 (defun org--tags-expand-group (group tag-groups expanded) 11846 "Recursively expand all tags in GROUP, according to TAG-GROUPS. 11847 TAG-GROUPS is the list of groups used for expansion. EXPANDED is 11848 an accumulator used in recursive calls." 11849 (dolist (tag group) 11850 (unless (member tag expanded) 11851 (let ((group (assoc tag tag-groups))) 11852 (push tag expanded) 11853 (when group 11854 (setq expanded 11855 (org--tags-expand-group (cdr group) tag-groups expanded)))))) 11856 expanded) 11857 11858 (defun org-tags-expand (match &optional single-as-list) 11859 "Expand group tags in MATCH. 11860 11861 This replaces every group tag in MATCH with a regexp tag search. 11862 For example, a group tag \"Work\" defined as { Work : Lab Conf } 11863 will be replaced like this: 11864 11865 Work => {\\<\\(?:Work\\|Lab\\|Conf\\)\\>} 11866 +Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>} 11867 -Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>} 11868 11869 Replacing by a regexp preserves the structure of the match. 11870 E.g., this expansion 11871 11872 Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home 11873 11874 will match anything tagged with \"Lab\" and \"Home\", or tagged 11875 with \"Conf\" and \"Home\" or tagged with \"Work\" and \"Home\". 11876 11877 A group tag in MATCH can contain regular expressions of its own. 11878 For example, a group tag \"Proj\" defined as { Proj : {P@.+} } 11879 will be replaced like this: 11880 11881 Proj => {\\<\\(?:Proj\\)\\>\\|P@.+} 11882 11883 When the optional argument SINGLE-AS-LIST is non-nil, MATCH is 11884 assumed to be a single group tag, and the function will return 11885 the list of tags in this group." 11886 (unless (org-string-nw-p match) (error "Invalid match tag: %S" match)) 11887 (let ((tag-groups 11888 (or org-tag-groups-alist-for-agenda org-tag-groups-alist))) 11889 (cond 11890 (single-as-list (org--tags-expand-group (list match) tag-groups nil)) 11891 (org-group-tags 11892 (let* ((case-fold-search t) 11893 (tag-syntax org-mode-syntax-table) 11894 (group-keys (mapcar #'car tag-groups)) 11895 (key-regexp (concat "\\([+-]?\\)" (regexp-opt group-keys 'words))) 11896 (return-match match)) 11897 ;; Mark regexp-expressions in the match-expression so that we 11898 ;; do not replace them later on. 11899 (let ((s 0)) 11900 (while (string-match "{.+?}" return-match s) 11901 (setq s (match-end 0)) 11902 (add-text-properties 11903 (match-beginning 0) (match-end 0) '(regexp t) return-match))) 11904 ;; @ and _ are allowed as word-components in tags. 11905 (modify-syntax-entry ?@ "w" tag-syntax) 11906 (modify-syntax-entry ?_ "w" tag-syntax) 11907 ;; For each tag token found in MATCH, compute a regexp and it 11908 (with-syntax-table tag-syntax 11909 (replace-regexp-in-string 11910 key-regexp 11911 (lambda (m) 11912 (if (get-text-property (match-beginning 2) 'regexp m) 11913 m ;regexp tag: ignore 11914 (let* ((operator (match-string 1 m)) 11915 (tag-token (let ((tag (match-string 2 m))) 11916 (list tag))) 11917 regexp-tags regular-tags) 11918 ;; Partition tags between regexp and regular tags. 11919 ;; Remove curly bracket syntax from regexp tags. 11920 (dolist (tag (org--tags-expand-group tag-token tag-groups nil)) 11921 (save-match-data 11922 (if (string-match "{\\(.+?\\)}" tag) 11923 (push (match-string 1 tag) regexp-tags) 11924 (push tag regular-tags)))) 11925 ;; Replace tag token by the appropriate regexp. 11926 ;; Regular tags need to be regexp-quoted, whereas 11927 ;; regexp-tags are inserted as-is. 11928 (let ((regular (regexp-opt regular-tags)) 11929 (regexp (mapconcat #'identity regexp-tags "\\|"))) 11930 (concat operator 11931 (cond 11932 ((null regular-tags) (format "{%s}" regexp)) 11933 ((null regexp-tags) (format "{\\<%s\\>}" regular)) 11934 (t (format "{\\<%s\\>\\|%s}" regular regexp)))))))) 11935 return-match 11936 t t)))) 11937 (t match)))) 11938 11939 (defun org-op-to-function (op &optional stringp) 11940 "Turn an operator into the appropriate function." 11941 (setq op 11942 (cond 11943 ((equal op "<" ) '(< org-string< org-time<)) 11944 ((equal op ">" ) '(> org-string> org-time>)) 11945 ((member op '("<=" "=<")) '(<= org-string<= org-time<=)) 11946 ((member op '(">=" "=>")) '(>= org-string>= org-time>=)) 11947 ((member op '("=" "==")) '(= string= org-time=)) 11948 ((member op '("<>" "!=")) '(/= org-string<> org-time<>)))) 11949 (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op)) 11950 11951 (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param 11952 (defvar org-tags-overlay (make-overlay 1 1)) 11953 (delete-overlay org-tags-overlay) 11954 11955 (defun org-add-prop-inherited (s) 11956 (add-text-properties 0 (length s) '(inherited t) s) 11957 s) 11958 11959 (defun org-toggle-tag (tag &optional onoff) 11960 "Toggle the tag TAG for the current line. 11961 If ONOFF is `on' or `off', don't toggle but set to this state." 11962 (save-excursion 11963 (org-back-to-heading t) 11964 (let ((current 11965 ;; Reverse the tags list so any new tag is appended to the 11966 ;; current list of tags. 11967 (nreverse (org-get-tags nil t))) 11968 res) 11969 (pcase onoff 11970 (`off (setq current (delete tag current))) 11971 ((or `on (guard (not (member tag current)))) 11972 (setq res t) 11973 (cl-pushnew tag current :test #'equal)) 11974 (_ (setq current (delete tag current)))) 11975 (org-set-tags (nreverse current)) 11976 res))) 11977 11978 (defun org--align-tags-here (to-col) 11979 "Align tags on the current headline to TO-COL. 11980 Assume point is on a headline. Preserve point when aligning 11981 tags." 11982 (when (org-match-line org-tag-line-re) 11983 (let* ((tags-start (match-beginning 1)) 11984 (blank-start (save-excursion 11985 (goto-char tags-start) 11986 (skip-chars-backward " \t") 11987 (point))) 11988 (new (max (if (>= to-col 0) to-col 11989 (- (abs to-col) (string-width (match-string 1)))) 11990 ;; Introduce at least one space after the heading 11991 ;; or the stars. 11992 (save-excursion 11993 (goto-char blank-start) 11994 (1+ (current-column))))) 11995 (current 11996 (save-excursion (goto-char tags-start) (current-column))) 11997 (origin (point-marker)) 11998 (column (current-column)) 11999 (in-blank? (and (> origin blank-start) (<= origin tags-start)))) 12000 (when (/= new current) 12001 (delete-region blank-start tags-start) 12002 (goto-char blank-start) 12003 (let ((indent-tabs-mode nil)) (indent-to new)) 12004 ;; Try to move back to original position. If point was in the 12005 ;; blanks before the tags, ORIGIN marker is of no use because 12006 ;; it now points to BLANK-START. Use COLUMN instead. 12007 (if in-blank? (org-move-to-column column) (goto-char origin)))))) 12008 12009 (defun org-set-tags-command (&optional arg) 12010 "Set the tags for the current visible entry. 12011 12012 When called with `\\[universal-argument]' prefix argument ARG, \ 12013 realign all tags 12014 in the current buffer. 12015 12016 When called with `\\[universal-argument] \\[universal-argument]' prefix argument, \ 12017 unconditionally do not 12018 offer the fast tag selection interface. 12019 12020 If a region is active, set tags in the region according to the 12021 setting of `org-loop-over-headlines-in-active-region'. 12022 12023 This function is for interactive use only; 12024 in Lisp code use `org-set-tags' instead." 12025 (interactive "P") 12026 (let ((org-use-fast-tag-selection 12027 (unless (equal '(16) arg) org-use-fast-tag-selection))) 12028 (cond 12029 ((equal '(4) arg) (org-align-tags t)) 12030 ((and (org-region-active-p) org-loop-over-headlines-in-active-region) 12031 (let (org-loop-over-headlines-in-active-region) ; hint: infinite recursion. 12032 (org-map-entries 12033 #'org-set-tags-command 12034 nil 12035 (if (eq org-loop-over-headlines-in-active-region 'start-level) 12036 'region-start-level 12037 'region) 12038 (lambda () (when (org-invisible-p) (org-end-of-subtree nil t)))))) 12039 (t 12040 (save-excursion 12041 (org-back-to-heading) 12042 (let* ((all-tags (org-get-tags)) 12043 (table (setq org-last-tags-completion-table 12044 (org--tag-add-to-alist 12045 (and org-complete-tags-always-offer-all-agenda-tags 12046 (org-global-tags-completion-table 12047 (org-agenda-files))) 12048 (or org-current-tag-alist (org-get-buffer-tags))))) 12049 (current-tags 12050 (cl-remove-if (lambda (tag) (get-text-property 0 'inherited tag)) 12051 all-tags)) 12052 (inherited-tags 12053 (cl-remove-if-not (lambda (tag) (get-text-property 0 'inherited tag)) 12054 all-tags)) 12055 (tags 12056 (replace-regexp-in-string 12057 ;; Ignore all forbidden characters in tags. 12058 "[^[:alnum:]_@#%]+" ":" 12059 (if (or (eq t org-use-fast-tag-selection) 12060 (and org-use-fast-tag-selection 12061 (delq nil (mapcar #'cdr table)))) 12062 (org-fast-tag-selection 12063 current-tags 12064 inherited-tags 12065 table 12066 (and org-fast-tag-selection-include-todo org-todo-key-alist)) 12067 (let ((org-add-colon-after-tag-completion (< 1 (length table))) 12068 (crm-separator "[ \t]*:[ \t]*")) 12069 (mapconcat #'identity 12070 (completing-read-multiple 12071 "Tags: " 12072 org-last-tags-completion-table 12073 nil nil (org-make-tag-string current-tags) 12074 'org-tags-history) 12075 ":")))))) 12076 (org-set-tags tags))))) 12077 ;; `save-excursion' may not replace the point at the right 12078 ;; position. 12079 (when (and (save-excursion (skip-chars-backward "*") (bolp)) 12080 (looking-at-p " ")) 12081 (forward-char)))) 12082 12083 (defun org-align-tags (&optional all) 12084 "Align tags in current entry. 12085 When optional argument ALL is non-nil, align all tags in the 12086 visible part of the buffer." 12087 (let ((get-indent-column 12088 (lambda () 12089 (let ((offset (if (bound-and-true-p org-indent-mode) 12090 (* (1- org-indent-indentation-per-level) 12091 (1- (org-current-level))) 12092 0))) 12093 (+ org-tags-column 12094 (if (> org-tags-column 0) (- offset) offset)))))) 12095 (if (and (not all) (org-at-heading-p)) 12096 (org--align-tags-here (funcall get-indent-column)) 12097 (save-excursion 12098 (if all 12099 (progn 12100 (goto-char (point-min)) 12101 (while (re-search-forward org-tag-line-re nil t) 12102 (org--align-tags-here (funcall get-indent-column)))) 12103 (org-back-to-heading t) 12104 (org--align-tags-here (funcall get-indent-column))))))) 12105 12106 (defun org-set-tags (tags) 12107 "Set the tags of the current entry to TAGS, replacing current tags. 12108 12109 TAGS may be a tags string like \":aa:bb:cc:\", or a list of tags. 12110 If TAGS is nil or the empty string, all tags are removed. 12111 12112 This function assumes point is on a headline." 12113 (org-with-wide-buffer 12114 (let ((tags (pcase tags 12115 ((pred listp) tags) 12116 ((pred stringp) (split-string (org-trim tags) ":" t)) 12117 (_ (error "Invalid tag specification: %S" tags)))) 12118 (old-tags (org-get-tags nil t)) 12119 (tags-change? nil)) 12120 (when (functionp org-tags-sort-function) 12121 (setq tags (sort tags org-tags-sort-function))) 12122 (setq tags-change? (not (equal tags old-tags))) 12123 (when tags-change? 12124 ;; Delete previous tags and any trailing white space. 12125 (goto-char (if (org-match-line org-tag-line-re) (match-beginning 1) 12126 (line-end-position))) 12127 (skip-chars-backward " \t") 12128 (delete-region (point) (line-end-position)) 12129 ;; Deleting white spaces may break an otherwise empty headline. 12130 ;; Re-introduce one space in this case. 12131 (unless (org-at-heading-p) (insert " ")) 12132 (when tags 12133 (save-excursion (insert " " (org-make-tag-string tags))) 12134 ;; When text is being inserted on an invisible region 12135 ;; boundary, it can be inadvertently sucked into 12136 ;; invisibility. 12137 (unless (org-invisible-p (line-beginning-position)) 12138 (org-flag-region (point) (line-end-position) nil 'outline)))) 12139 ;; Align tags, if any. 12140 (when tags (org-align-tags)) 12141 (when tags-change? (run-hooks 'org-after-tags-change-hook))))) 12142 12143 (defun org-change-tag-in-region (beg end tag off) 12144 "Add or remove TAG for each entry in the region. 12145 This works in the agenda, and also in an Org buffer." 12146 (interactive 12147 (list (region-beginning) (region-end) 12148 (let ((org-last-tags-completion-table 12149 (if (derived-mode-p 'org-mode) 12150 (org--tag-add-to-alist 12151 (org-get-buffer-tags) 12152 (org-global-tags-completion-table)) 12153 (org-global-tags-completion-table)))) 12154 (completing-read 12155 "Tag: " org-last-tags-completion-table nil nil nil 12156 'org-tags-history)) 12157 (progn 12158 (message "[s]et or [r]emove? ") 12159 (equal (read-char-exclusive) ?r)))) 12160 (when (fboundp 'deactivate-mark) (deactivate-mark)) 12161 (let ((agendap (equal major-mode 'org-agenda-mode)) 12162 l1 l2 m buf pos newhead (cnt 0)) 12163 (goto-char end) 12164 (setq l2 (1- (org-current-line))) 12165 (goto-char beg) 12166 (setq l1 (org-current-line)) 12167 (cl-loop for l from l1 to l2 do 12168 (org-goto-line l) 12169 (setq m (get-text-property (point) 'org-hd-marker)) 12170 (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) 12171 (and agendap m)) 12172 (setq buf (if agendap (marker-buffer m) (current-buffer)) 12173 pos (if agendap m (point))) 12174 (with-current-buffer buf 12175 (save-excursion 12176 (save-restriction 12177 (goto-char pos) 12178 (setq cnt (1+ cnt)) 12179 (org-toggle-tag tag (if off 'off 'on)) 12180 (setq newhead (org-get-heading))))) 12181 (and agendap (org-agenda-change-all-lines newhead m)))) 12182 (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) 12183 12184 (defun org-tags-completion-function (string _predicate &optional flag) 12185 "Complete tag STRING. 12186 FLAG specifies the type of completion operation to perform. This 12187 function is passed as a collection function to `completing-read', 12188 which see." 12189 (let ((completion-ignore-case nil) ;tags are case-sensitive 12190 (confirm (lambda (x) (stringp (car x)))) 12191 (prefix "")) 12192 (when (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) 12193 (setq prefix (match-string 1 string)) 12194 (setq string (match-string 2 string))) 12195 (pcase flag 12196 (`t (all-completions string org-last-tags-completion-table confirm)) 12197 (`lambda (assoc string org-last-tags-completion-table)) ;exact match? 12198 (`nil 12199 (pcase (try-completion string org-last-tags-completion-table confirm) 12200 ((and completion (pred stringp)) 12201 (concat prefix 12202 completion 12203 (if (and org-add-colon-after-tag-completion 12204 (assoc completion org-last-tags-completion-table)) 12205 ":" 12206 ""))) 12207 (completion completion))) 12208 (_ nil)))) 12209 12210 (defun org-fast-tag-insert (kwd tags face &optional end) 12211 "Insert KWD, and the TAGS, the latter with face FACE. 12212 Also insert END." 12213 (insert (format "%-12s" (concat kwd ":")) 12214 (org-add-props (mapconcat 'identity tags " ") nil 'face face) 12215 (or end ""))) 12216 12217 (defun org-fast-tag-show-exit (flag) 12218 (save-excursion 12219 (org-goto-line 3) 12220 (when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) 12221 (replace-match "")) 12222 (when flag 12223 (end-of-line 1) 12224 (org-move-to-column (- (window-width) 19) t) 12225 (insert (org-add-props " Next change exits" nil 'face 'org-warning))))) 12226 12227 (defun org-set-current-tags-overlay (current prefix) 12228 "Add an overlay to CURRENT tag with PREFIX." 12229 (let ((s (org-make-tag-string current))) 12230 (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) 12231 (org-overlay-display org-tags-overlay (concat prefix s)))) 12232 12233 (defvar org-last-tag-selection-key nil) 12234 (defun org-fast-tag-selection (current inherited table &optional todo-table) 12235 "Fast tag selection with single keys. 12236 CURRENT is the current list of tags in the headline, INHERITED is the 12237 list of inherited tags, and TABLE is an alist of tags and corresponding keys, 12238 possibly with grouping information. TODO-TABLE is a similar table with 12239 TODO keywords, should these have keys assigned to them. 12240 If the keys are nil, a-z are automatically assigned. 12241 Returns the new tags string, or nil to not change the current settings." 12242 (let* ((fulltable (append table todo-table)) 12243 (maxlen (if (null fulltable) 0 12244 (apply #'max 12245 (mapcar (lambda (x) 12246 (if (stringp (car x)) (string-width (car x)) 12247 0)) 12248 fulltable)))) 12249 (buf (current-buffer)) 12250 (expert (eq org-fast-tag-selection-single-key 'expert)) 12251 (tab-tags nil) 12252 (fwidth (+ maxlen 3 1 3)) 12253 (ncol (/ (- (window-width) 4) fwidth)) 12254 (i-face 'org-done) 12255 (c-face 'org-todo) 12256 tg cnt e c char c1 c2 ntable tbl rtn 12257 ov-start ov-end ov-prefix 12258 (exit-after-next org-fast-tag-selection-single-key) 12259 (done-keywords org-done-keywords) 12260 groups ingroup intaggroup) 12261 (save-excursion 12262 (beginning-of-line) 12263 (if (looking-at org-tag-line-re) 12264 (setq ov-start (match-beginning 1) 12265 ov-end (match-end 1) 12266 ov-prefix "") 12267 (setq ov-start (1- (point-at-eol)) 12268 ov-end (1+ ov-start)) 12269 (skip-chars-forward "^\n\r") 12270 (setq ov-prefix 12271 (concat 12272 (buffer-substring (1- (point)) (point)) 12273 (if (> (current-column) org-tags-column) 12274 " " 12275 (make-string (- org-tags-column (current-column)) ?\ )))))) 12276 (move-overlay org-tags-overlay ov-start ov-end) 12277 (save-excursion 12278 (save-window-excursion 12279 (if expert 12280 (set-buffer (get-buffer-create " *Org tags*")) 12281 (delete-other-windows) 12282 (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*")) 12283 (org-switch-to-buffer-other-window " *Org tags*")) 12284 (erase-buffer) 12285 (setq-local org-done-keywords done-keywords) 12286 (org-fast-tag-insert "Inherited" inherited i-face "\n") 12287 (org-fast-tag-insert "Current" current c-face "\n\n") 12288 (org-fast-tag-show-exit exit-after-next) 12289 (org-set-current-tags-overlay current ov-prefix) 12290 (setq tbl fulltable char ?a cnt 0) 12291 (while (setq e (pop tbl)) 12292 (cond 12293 ((eq (car e) :startgroup) 12294 (push '() groups) (setq ingroup t) 12295 (unless (zerop cnt) 12296 (setq cnt 0) 12297 (insert "\n")) 12298 (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ ")) 12299 ((eq (car e) :endgroup) 12300 (setq ingroup nil cnt 0) 12301 (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n")) 12302 ((eq (car e) :startgrouptag) 12303 (setq intaggroup t) 12304 (unless (zerop cnt) 12305 (setq cnt 0) 12306 (insert "\n")) 12307 (insert "[ ")) 12308 ((eq (car e) :endgrouptag) 12309 (setq intaggroup nil cnt 0) 12310 (insert "]\n")) 12311 ((equal e '(:newline)) 12312 (unless (zerop cnt) 12313 (setq cnt 0) 12314 (insert "\n") 12315 (setq e (car tbl)) 12316 (while (equal (car tbl) '(:newline)) 12317 (insert "\n") 12318 (setq tbl (cdr tbl))))) 12319 ((equal e '(:grouptags)) (insert " : ")) 12320 (t 12321 (setq tg (copy-sequence (car e)) c2 nil) 12322 (if (cdr e) 12323 (setq c (cdr e)) 12324 ;; automatically assign a character. 12325 (setq c1 (string-to-char 12326 (downcase (substring 12327 tg (if (= (string-to-char tg) ?@) 1 0))))) 12328 (if (or (rassoc c1 ntable) (rassoc c1 table)) 12329 (while (or (rassoc char ntable) (rassoc char table)) 12330 (setq char (1+ char))) 12331 (setq c2 c1)) 12332 (setq c (or c2 char))) 12333 (when ingroup (push tg (car groups))) 12334 (setq tg (org-add-props tg nil 'face 12335 (cond 12336 ((not (assoc tg table)) 12337 (org-get-todo-face tg)) 12338 ((member tg current) c-face) 12339 ((member tg inherited) i-face)))) 12340 (when (equal (caar tbl) :grouptags) 12341 (org-add-props tg nil 'face 'org-tag-group)) 12342 (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " ")) 12343 (insert "[" c "] " tg (make-string 12344 (- fwidth 4 (length tg)) ?\ )) 12345 (push (cons tg c) ntable) 12346 (when (= (cl-incf cnt) ncol) 12347 (unless (memq (caar tbl) '(:endgroup :endgrouptag)) 12348 (insert "\n") 12349 (when (or ingroup intaggroup) (insert " "))) 12350 (setq cnt 0))))) 12351 (setq ntable (nreverse ntable)) 12352 (insert "\n") 12353 (goto-char (point-min)) 12354 (unless expert (org-fit-window-to-buffer)) 12355 (setq rtn 12356 (catch 'exit 12357 (while t 12358 (message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s" 12359 (if (not groups) "no " "") 12360 (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) 12361 (setq c (let ((inhibit-quit t)) (read-char-exclusive))) 12362 (setq org-last-tag-selection-key c) 12363 (cond 12364 ((= c ?\r) (throw 'exit t)) 12365 ((= c ?!) 12366 (setq groups (not groups)) 12367 (goto-char (point-min)) 12368 (while (re-search-forward "[{}]" nil t) (replace-match " "))) 12369 ((= c ?\C-c) 12370 (if (not expert) 12371 (org-fast-tag-show-exit 12372 (setq exit-after-next (not exit-after-next))) 12373 (setq expert nil) 12374 (delete-other-windows) 12375 (set-window-buffer (split-window-vertically) " *Org tags*") 12376 (org-switch-to-buffer-other-window " *Org tags*") 12377 (org-fit-window-to-buffer))) 12378 ((or (= c ?\C-g) 12379 (and (= c ?q) (not (rassoc c ntable)))) 12380 (delete-overlay org-tags-overlay) 12381 (setq quit-flag t)) 12382 ((= c ?\ ) 12383 (setq current nil) 12384 (when exit-after-next (setq exit-after-next 'now))) 12385 ((= c ?\t) 12386 (condition-case nil 12387 (unless tab-tags 12388 (setq tab-tags 12389 (delq nil 12390 (mapcar (lambda (x) 12391 (let ((item (car-safe x))) 12392 (and (stringp item) 12393 (list item)))) 12394 (org--tag-add-to-alist 12395 (with-current-buffer buf 12396 (org-get-buffer-tags)) 12397 table)))))) 12398 (setq tg (completing-read "Tag: " tab-tags)) 12399 (when (string-match "\\S-" tg) 12400 (cl-pushnew (list tg) tab-tags :test #'equal) 12401 (if (member tg current) 12402 (setq current (delete tg current)) 12403 (push tg current))) 12404 (when exit-after-next (setq exit-after-next 'now))) 12405 ((setq e (rassoc c todo-table) tg (car e)) 12406 (with-current-buffer buf 12407 (save-excursion (org-todo tg))) 12408 (when exit-after-next (setq exit-after-next 'now))) 12409 ((setq e (rassoc c ntable) tg (car e)) 12410 (if (member tg current) 12411 (setq current (delete tg current)) 12412 (cl-loop for g in groups do 12413 (when (member tg g) 12414 (dolist (x g) (setq current (delete x current))))) 12415 (push tg current)) 12416 (when exit-after-next (setq exit-after-next 'now)))) 12417 12418 ;; Create a sorted list 12419 (setq current 12420 (sort current 12421 (lambda (a b) 12422 (assoc b (cdr (memq (assoc a ntable) ntable)))))) 12423 (when (eq exit-after-next 'now) (throw 'exit t)) 12424 (goto-char (point-min)) 12425 (beginning-of-line 2) 12426 (delete-region (point) (point-at-eol)) 12427 (org-fast-tag-insert "Current" current c-face) 12428 (org-set-current-tags-overlay current ov-prefix) 12429 (let ((tag-re (concat "\\[.\\] \\(" org-tag-re "\\)"))) 12430 (while (re-search-forward tag-re nil t) 12431 (let ((tag (match-string 1))) 12432 (add-text-properties 12433 (match-beginning 1) (match-end 1) 12434 (list 'face 12435 (cond 12436 ((member tag current) c-face) 12437 ((member tag inherited) i-face) 12438 (t (get-text-property (match-beginning 1) ' 12439 face)))))))) 12440 (goto-char (point-min))))) 12441 (delete-overlay org-tags-overlay) 12442 (if rtn 12443 (mapconcat 'identity current ":") 12444 nil))))) 12445 12446 (defun org-make-tag-string (tags) 12447 "Return string associated to TAGS. 12448 TAGS is a list of strings." 12449 (if (null tags) "" 12450 (format ":%s:" (mapconcat #'identity tags ":")))) 12451 12452 (defun org--get-local-tags () 12453 "Return list of tags for the current headline. 12454 Assume point is at the beginning of the headline." 12455 (and (looking-at org-tag-line-re) 12456 (split-string (match-string-no-properties 2) ":" t))) 12457 12458 (defun org-get-tags (&optional pos local) 12459 "Get the list of tags specified in the current headline. 12460 12461 When argument POS is non-nil, retrieve tags for headline at POS. 12462 12463 According to `org-use-tag-inheritance', tags may be inherited 12464 from parent headlines, and from the whole document, through 12465 `org-file-tags'. In this case, the returned list of tags 12466 contains tags in this order: file tags, tags inherited from 12467 parent headlines, local tags. If a tag appears multiple times, 12468 only the most local tag is returned. 12469 12470 However, when optional argument LOCAL is non-nil, only return 12471 tags specified at the headline. 12472 12473 Inherited tags have the `inherited' text property." 12474 (if (and org-trust-scanner-tags 12475 (or (not pos) (eq pos (point))) 12476 (not local)) 12477 org-scanner-tags 12478 (org-with-point-at (or pos (point)) 12479 (unless (org-before-first-heading-p) 12480 (org-back-to-heading t) 12481 (let ((ltags (org--get-local-tags)) itags) 12482 (if (or local (not org-use-tag-inheritance)) ltags 12483 (while (org-up-heading-safe) 12484 (setq itags (nconc (mapcar #'org-add-prop-inherited 12485 (org--get-local-tags)) 12486 itags))) 12487 (setq itags (append org-file-tags itags)) 12488 (nreverse 12489 (delete-dups 12490 (nreverse (nconc (org-remove-uninherited-tags itags) ltags)))))))))) 12491 12492 (defun org-get-buffer-tags () 12493 "Get a table of all tags used in the buffer, for completion." 12494 (org-with-point-at 1 12495 (let (tags) 12496 (while (re-search-forward org-tag-line-re nil t) 12497 (setq tags (nconc (split-string (match-string-no-properties 2) ":") 12498 tags))) 12499 (mapcar #'list (delete-dups (append org-file-tags tags)))))) 12500 12501 ;;;; The mapping API 12502 12503 (defvar org-agenda-skip-comment-trees) 12504 (defvar org-agenda-skip-function) 12505 (defun org-map-entries (func &optional match scope &rest skip) 12506 "Call FUNC at each headline selected by MATCH in SCOPE. 12507 12508 FUNC is a function or a Lisp form. The function will be called without 12509 arguments, with the cursor positioned at the beginning of the headline. 12510 The return values of all calls to the function will be collected and 12511 returned as a list. 12512 12513 The call to FUNC will be wrapped into a `save-excursion' form, so FUNC 12514 does not need to preserve point. After evaluation, the cursor will be 12515 moved to the end of the line (presumably of the headline of the 12516 processed entry) and search continues from there. Under some 12517 circumstances, this may not produce the wanted results. For example, 12518 if you have removed (e.g. archived) the current (sub)tree it could 12519 mean that the next entry will be skipped entirely. In such cases, you 12520 can specify the position from where search should continue by making 12521 FUNC set the variable `org-map-continue-from' to the desired buffer 12522 position. 12523 12524 MATCH is a tags/property/todo match as it is used in the agenda tags view. 12525 Only headlines that are matched by this query will be considered during 12526 the iteration. When MATCH is nil or t, all headlines will be 12527 visited by the iteration. 12528 12529 SCOPE determines the scope of this command. It can be any of: 12530 12531 nil The current buffer, respecting the restriction if any 12532 tree The subtree started with the entry at point 12533 region The entries within the active region, if any 12534 region-start-level 12535 The entries within the active region, but only those at 12536 the same level than the first one. 12537 file The current buffer, without restriction 12538 file-with-archives 12539 The current buffer, and any archives associated with it 12540 agenda All agenda files 12541 agenda-with-archives 12542 All agenda files with any archive files associated with them 12543 \(file1 file2 ...) 12544 If this is a list, all files in the list will be scanned 12545 12546 The remaining args are treated as settings for the skipping facilities of 12547 the scanner. The following items can be given here: 12548 12549 archive skip trees with the archive tag 12550 comment skip trees with the COMMENT keyword 12551 function or Emacs Lisp form: 12552 will be used as value for `org-agenda-skip-function', so 12553 whenever the function returns a position, FUNC will not be 12554 called for that entry and search will continue from the 12555 position returned 12556 12557 If your function needs to retrieve the tags including inherited tags 12558 at the *current* entry, you can use the value of the variable 12559 `org-scanner-tags' which will be much faster than getting the value 12560 with `org-get-tags'. If your function gets properties with 12561 `org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags' 12562 to t around the call to `org-entry-properties' to get the same speedup. 12563 Note that if your function moves around to retrieve tags and properties at 12564 a *different* entry, you cannot use these techniques." 12565 (unless (and (or (eq scope 'region) (eq scope 'region-start-level)) 12566 (not (org-region-active-p))) 12567 (let* ((org-agenda-archives-mode nil) ; just to make sure 12568 (org-agenda-skip-archived-trees (memq 'archive skip)) 12569 (org-agenda-skip-comment-trees (memq 'comment skip)) 12570 (org-agenda-skip-function 12571 (car (org-delete-all '(comment archive) skip))) 12572 (org-tags-match-list-sublevels t) 12573 (start-level (eq scope 'region-start-level)) 12574 matcher res 12575 org-todo-keywords-for-agenda 12576 org-done-keywords-for-agenda 12577 org-todo-keyword-alist-for-agenda 12578 org-tag-alist-for-agenda 12579 org--matcher-tags-todo-only) 12580 12581 (cond 12582 ((eq match t) (setq matcher t)) 12583 ((eq match nil) (setq matcher t)) 12584 (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t)))) 12585 12586 (save-excursion 12587 (save-restriction 12588 (cond ((eq scope 'tree) 12589 (org-back-to-heading t) 12590 (org-narrow-to-subtree) 12591 (setq scope nil)) 12592 ((and (or (eq scope 'region) (eq scope 'region-start-level)) 12593 (org-region-active-p)) 12594 ;; If needed, set start-level to a string like "2" 12595 (when start-level 12596 (save-excursion 12597 (goto-char (region-beginning)) 12598 (unless (org-at-heading-p) (outline-next-heading)) 12599 (setq start-level (org-current-level)))) 12600 (narrow-to-region (region-beginning) 12601 (save-excursion 12602 (goto-char (region-end)) 12603 (unless (and (bolp) (org-at-heading-p)) 12604 (outline-next-heading)) 12605 (point))) 12606 (setq scope nil))) 12607 12608 (if (not scope) 12609 (progn 12610 (org-agenda-prepare-buffers 12611 (and buffer-file-name (list buffer-file-name))) 12612 (setq res 12613 (org-scan-tags 12614 func matcher org--matcher-tags-todo-only start-level))) 12615 ;; Get the right scope 12616 (cond 12617 ((and scope (listp scope) (symbolp (car scope))) 12618 (setq scope (eval scope))) 12619 ((eq scope 'agenda) 12620 (setq scope (org-agenda-files t))) 12621 ((eq scope 'agenda-with-archives) 12622 (setq scope (org-agenda-files t)) 12623 (setq scope (org-add-archive-files scope))) 12624 ((eq scope 'file) 12625 (setq scope (and buffer-file-name (list buffer-file-name)))) 12626 ((eq scope 'file-with-archives) 12627 (setq scope (org-add-archive-files (list (buffer-file-name)))))) 12628 (org-agenda-prepare-buffers scope) 12629 (dolist (file scope) 12630 (with-current-buffer (org-find-base-buffer-visiting file) 12631 (org-with-wide-buffer 12632 (goto-char (point-min)) 12633 (setq res 12634 (append 12635 res 12636 (org-scan-tags 12637 func matcher org--matcher-tags-todo-only))))))))) 12638 res))) 12639 12640 ;;; Properties API 12641 12642 (defconst org-special-properties 12643 '("ALLTAGS" "BLOCKED" "CLOCKSUM" "CLOCKSUM_T" "CLOSED" "DEADLINE" "FILE" 12644 "ITEM" "PRIORITY" "SCHEDULED" "TAGS" "TIMESTAMP" "TIMESTAMP_IA" "TODO") 12645 "The special properties valid in Org mode. 12646 These are properties that are not defined in the property drawer, 12647 but in some other way.") 12648 12649 (defconst org-default-properties 12650 '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID" 12651 "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" 12652 "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" 12653 "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME" 12654 "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "UNNUMBERED" 12655 "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE" 12656 "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS") 12657 "Some properties that are used by Org mode for various purposes. 12658 Being in this list makes sure that they are offered for completion.") 12659 12660 (defun org--valid-property-p (property) 12661 "Non-nil when string PROPERTY is a valid property name." 12662 (not 12663 (or (equal property "") 12664 (string-match-p "\\s-" property)))) 12665 12666 (defun org--update-property-plist (key val props) 12667 "Associate KEY to VAL in alist PROPS. 12668 Modifications are made by side-effect. Return new alist." 12669 (let* ((appending (string= (substring key -1) "+")) 12670 (key (if appending (substring key 0 -1) key)) 12671 (old (assoc-string key props t))) 12672 (if (not old) (cons (cons key val) props) 12673 (setcdr old (if appending (concat (cdr old) " " val) val)) 12674 props))) 12675 12676 (defun org-get-property-block (&optional beg force) 12677 "Return the (beg . end) range of the body of the property drawer. 12678 BEG is the beginning of the current subtree or the beginning of 12679 the document if before the first headline. If it is not given, 12680 it will be found. If the drawer does not exist, create it if 12681 FORCE is non-nil, or return nil." 12682 (org-with-wide-buffer 12683 (let ((beg (cond (beg (goto-char beg)) 12684 ((or (not (featurep 'org-inlinetask)) 12685 (org-inlinetask-in-task-p)) 12686 (org-back-to-heading-or-point-min t) (point)) 12687 (t (org-with-limited-levels 12688 (org-back-to-heading-or-point-min t)) 12689 (point))))) 12690 ;; Move point to its position according to its positional rules. 12691 (cond ((org-before-first-heading-p) 12692 (while (and (org-at-comment-p) (bolp)) (forward-line))) 12693 (t (forward-line) 12694 (when (looking-at-p org-planning-line-re) (forward-line)))) 12695 (cond ((looking-at org-property-drawer-re) 12696 (forward-line) 12697 (cons (point) (progn (goto-char (match-end 0)) 12698 (line-beginning-position)))) 12699 (force 12700 (goto-char beg) 12701 (org-insert-property-drawer) 12702 (let ((pos (save-excursion (re-search-forward org-property-drawer-re) 12703 (line-beginning-position)))) 12704 (cons pos pos))))))) 12705 12706 (defun org-at-property-drawer-p () 12707 "Non-nil when point is at the first line of a property drawer." 12708 (org-with-wide-buffer 12709 (beginning-of-line) 12710 (and (looking-at org-property-drawer-re) 12711 (or (bobp) 12712 (progn 12713 (forward-line -1) 12714 (cond ((org-at-heading-p)) 12715 ((looking-at org-planning-line-re) 12716 (forward-line -1) 12717 (org-at-heading-p)) 12718 ((looking-at org-comment-regexp) 12719 (forward-line -1) 12720 (while (and (not (bobp)) (looking-at org-comment-regexp)) 12721 (forward-line -1)) 12722 (looking-at org-comment-regexp)) 12723 (t nil))))))) 12724 12725 (defun org-at-property-p () 12726 "Non-nil when point is inside a property drawer. 12727 See `org-property-re' for match data, if applicable." 12728 (save-excursion 12729 (beginning-of-line) 12730 (and (looking-at org-property-re) 12731 (let ((property-drawer (save-match-data (org-get-property-block)))) 12732 (and property-drawer 12733 (>= (point) (car property-drawer)) 12734 (< (point) (cdr property-drawer))))))) 12735 12736 (defun org-property-action () 12737 "Do an action on properties." 12738 (interactive) 12739 (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") 12740 (let ((c (read-char-exclusive))) 12741 (cl-case c 12742 (?s (call-interactively #'org-set-property)) 12743 (?d (call-interactively #'org-delete-property)) 12744 (?D (call-interactively #'org-delete-property-globally)) 12745 (?c (call-interactively #'org-compute-property-at-point)) 12746 (otherwise (user-error "No such property action %c" c))))) 12747 12748 (defun org-inc-effort () 12749 "Increment the value of the effort property in the current entry." 12750 (interactive) 12751 (org-set-effort t)) 12752 12753 (defvar org-clock-effort) ; Defined in org-clock.el. 12754 (defvar org-clock-current-task) ; Defined in org-clock.el. 12755 (defun org-set-effort (&optional increment value) 12756 "Set the effort property of the current entry. 12757 If INCREMENT is non-nil, set the property to the next allowed 12758 value. Otherwise, if optional argument VALUE is provided, use 12759 it. Eventually, prompt for the new value if none of the previous 12760 variables is set." 12761 (interactive "P") 12762 (let* ((allowed (org-property-get-allowed-values nil org-effort-property t)) 12763 (current (org-entry-get nil org-effort-property)) 12764 (value 12765 (cond 12766 (increment 12767 (unless allowed (user-error "Allowed effort values are not set")) 12768 (or (cl-caadr (member (list current) allowed)) 12769 (user-error "Unknown value %S among allowed values" current))) 12770 (value 12771 (if (stringp value) value 12772 (error "Invalid effort value: %S" value))) 12773 (t 12774 (let ((must-match 12775 (and allowed 12776 (not (get-text-property 0 'org-unrestricted 12777 (caar allowed)))))) 12778 (completing-read "Effort: " allowed nil must-match)))))) 12779 ;; Test whether the value can be interpreted as a duration before 12780 ;; inserting it in the buffer: 12781 (org-duration-to-minutes value) 12782 ;; Maybe update the effort value: 12783 (unless (equal current value) 12784 (org-entry-put nil org-effort-property value)) 12785 (org-refresh-property '((effort . identity) 12786 (effort-minutes . org-duration-to-minutes)) 12787 value) 12788 (when (equal (org-get-heading t t t t) 12789 (bound-and-true-p org-clock-current-task)) 12790 (setq org-clock-effort value) 12791 (org-clock-update-mode-line)) 12792 (message "%s is now %s" org-effort-property value))) 12793 12794 (defun org-entry-properties (&optional pom which) 12795 "Get all properties of the current entry. 12796 12797 When POM is a buffer position, get all properties from the entry 12798 there instead. 12799 12800 This includes the TODO keyword, the tags, time strings for 12801 deadline, scheduled, and clocking, and any additional properties 12802 defined in the entry. 12803 12804 If WHICH is nil or `all', get all properties. If WHICH is 12805 `special' or `standard', only get that subclass. If WHICH is 12806 a string, only get that property. 12807 12808 Return value is an alist. Keys are properties, as upcased 12809 strings." 12810 (org-with-point-at pom 12811 (when (and (derived-mode-p 'org-mode) 12812 (org-back-to-heading-or-point-min t)) 12813 (catch 'exit 12814 (let* ((beg (point)) 12815 (specific (and (stringp which) (upcase which))) 12816 (which (cond ((not specific) which) 12817 ((member specific org-special-properties) 'special) 12818 (t 'standard))) 12819 props) 12820 ;; Get the special properties, like TODO and TAGS. 12821 (when (memq which '(nil all special)) 12822 (when (or (not specific) (string= specific "CLOCKSUM")) 12823 (let ((clocksum (get-text-property (point) :org-clock-minutes))) 12824 (when clocksum 12825 (push (cons "CLOCKSUM" (org-duration-from-minutes clocksum)) 12826 props))) 12827 (when specific (throw 'exit props))) 12828 (when (or (not specific) (string= specific "CLOCKSUM_T")) 12829 (let ((clocksumt (get-text-property (point) 12830 :org-clock-minutes-today))) 12831 (when clocksumt 12832 (push (cons "CLOCKSUM_T" 12833 (org-duration-from-minutes clocksumt)) 12834 props))) 12835 (when specific (throw 'exit props))) 12836 (when (or (not specific) (string= specific "ITEM")) 12837 (let ((case-fold-search nil)) 12838 (when (looking-at org-complex-heading-regexp) 12839 (push (cons "ITEM" 12840 (let ((title (match-string-no-properties 4))) 12841 (if (org-string-nw-p title) 12842 (org-remove-tabs title) 12843 ""))) 12844 props))) 12845 (when specific (throw 'exit props))) 12846 (when (or (not specific) (string= specific "TODO")) 12847 (let ((case-fold-search nil)) 12848 (when (and (looking-at org-todo-line-regexp) (match-end 2)) 12849 (push (cons "TODO" (match-string-no-properties 2)) props))) 12850 (when specific (throw 'exit props))) 12851 (when (or (not specific) (string= specific "PRIORITY")) 12852 (push (cons "PRIORITY" 12853 (if (looking-at org-priority-regexp) 12854 (match-string-no-properties 2) 12855 (char-to-string org-priority-default))) 12856 props) 12857 (when specific (throw 'exit props))) 12858 (when (or (not specific) (string= specific "FILE")) 12859 (push (cons "FILE" (buffer-file-name (buffer-base-buffer))) 12860 props) 12861 (when specific (throw 'exit props))) 12862 (when (or (not specific) (string= specific "TAGS")) 12863 (let ((tags (org-get-tags nil t))) 12864 (when tags 12865 (push (cons "TAGS" (org-make-tag-string tags)) 12866 props))) 12867 (when specific (throw 'exit props))) 12868 (when (or (not specific) (string= specific "ALLTAGS")) 12869 (let ((tags (org-get-tags))) 12870 (when tags 12871 (push (cons "ALLTAGS" (org-make-tag-string tags)) 12872 props))) 12873 (when specific (throw 'exit props))) 12874 (when (or (not specific) (string= specific "BLOCKED")) 12875 (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props) 12876 (when specific (throw 'exit props))) 12877 (when (or (not specific) 12878 (member specific '("CLOSED" "DEADLINE" "SCHEDULED"))) 12879 (forward-line) 12880 (when (looking-at-p org-planning-line-re) 12881 (end-of-line) 12882 (let ((bol (line-beginning-position)) 12883 ;; Backward compatibility: time keywords used to 12884 ;; be configurable (before 8.3). Make sure we 12885 ;; get the correct keyword. 12886 (key-assoc `(("CLOSED" . ,org-closed-string) 12887 ("DEADLINE" . ,org-deadline-string) 12888 ("SCHEDULED" . ,org-scheduled-string)))) 12889 (dolist (pair (if specific (list (assoc specific key-assoc)) 12890 key-assoc)) 12891 (save-excursion 12892 (when (search-backward (cdr pair) bol t) 12893 (goto-char (match-end 0)) 12894 (skip-chars-forward " \t") 12895 (and (looking-at org-ts-regexp-both) 12896 (push (cons (car pair) 12897 (match-string-no-properties 0)) 12898 props))))))) 12899 (when specific (throw 'exit props))) 12900 (when (or (not specific) 12901 (member specific '("TIMESTAMP" "TIMESTAMP_IA"))) 12902 (let ((find-ts 12903 (lambda (end ts) 12904 ;; Fix next time-stamp before END. TS is the 12905 ;; list of time-stamps found so far. 12906 (let ((ts ts) 12907 (regexp (cond 12908 ((string= specific "TIMESTAMP") 12909 org-ts-regexp) 12910 ((string= specific "TIMESTAMP_IA") 12911 org-ts-regexp-inactive) 12912 ((assoc "TIMESTAMP_IA" ts) 12913 org-ts-regexp) 12914 ((assoc "TIMESTAMP" ts) 12915 org-ts-regexp-inactive) 12916 (t org-ts-regexp-both)))) 12917 (catch 'next 12918 (while (re-search-forward regexp end t) 12919 (backward-char) 12920 (let ((object (org-element-context))) 12921 ;; Accept to match timestamps in node 12922 ;; properties, too. 12923 (when (memq (org-element-type object) 12924 '(node-property timestamp)) 12925 (let ((type 12926 (org-element-property :type object))) 12927 (cond 12928 ((and (memq type '(active active-range)) 12929 (not (equal specific "TIMESTAMP_IA"))) 12930 (unless (assoc "TIMESTAMP" ts) 12931 (push (cons "TIMESTAMP" 12932 (org-element-property 12933 :raw-value object)) 12934 ts) 12935 (when specific (throw 'exit ts)))) 12936 ((and (memq type '(inactive inactive-range)) 12937 (not (string= specific "TIMESTAMP"))) 12938 (unless (assoc "TIMESTAMP_IA" ts) 12939 (push (cons "TIMESTAMP_IA" 12940 (org-element-property 12941 :raw-value object)) 12942 ts) 12943 (when specific (throw 'exit ts)))))) 12944 ;; Both timestamp types are found, 12945 ;; move to next part. 12946 (when (= (length ts) 2) (throw 'next ts))))) 12947 ts))))) 12948 (goto-char beg) 12949 ;; First look for timestamps within headline. 12950 (let ((ts (funcall find-ts (line-end-position) nil))) 12951 (if (= (length ts) 2) (setq props (nconc ts props)) 12952 ;; Then find timestamps in the section, skipping 12953 ;; planning line. 12954 (let ((end (save-excursion (outline-next-heading)))) 12955 (forward-line) 12956 (when (looking-at-p org-planning-line-re) (forward-line)) 12957 (setq props (nconc (funcall find-ts end ts) props)))))))) 12958 ;; Get the standard properties, like :PROP:. 12959 (when (memq which '(nil all standard)) 12960 ;; If we are looking after a specific property, delegate 12961 ;; to `org-entry-get', which is faster. However, make an 12962 ;; exception for "CATEGORY", since it can be also set 12963 ;; through keywords (i.e. #+CATEGORY). 12964 (if (and specific (not (equal specific "CATEGORY"))) 12965 (let ((value (org-entry-get beg specific nil t))) 12966 (throw 'exit (and value (list (cons specific value))))) 12967 (let ((range (org-get-property-block beg))) 12968 (when range 12969 (let ((end (cdr range)) seen-base) 12970 (goto-char (car range)) 12971 ;; Unlike to `org--update-property-plist', we 12972 ;; handle the case where base values is found 12973 ;; after its extension. We also forbid standard 12974 ;; properties to be named as special properties. 12975 (while (re-search-forward org-property-re end t) 12976 (let* ((key (upcase (match-string-no-properties 2))) 12977 (extendp (string-match-p "\\+\\'" key)) 12978 (key-base (if extendp (substring key 0 -1) key)) 12979 (value (match-string-no-properties 3))) 12980 (cond 12981 ((member-ignore-case key-base org-special-properties)) 12982 (extendp 12983 (setq props 12984 (org--update-property-plist key value props))) 12985 ((member key seen-base)) 12986 (t (push key seen-base) 12987 (let ((p (assoc-string key props t))) 12988 (if p (setcdr p (concat value " " (cdr p))) 12989 (push (cons key value) props)))))))))))) 12990 (unless (assoc "CATEGORY" props) 12991 (push (cons "CATEGORY" (org-get-category beg)) props) 12992 (when (string= specific "CATEGORY") (throw 'exit props))) 12993 ;; Return value. 12994 props))))) 12995 12996 (defun org--property-local-values (property literal-nil) 12997 "Return value for PROPERTY in current entry. 12998 Value is a list whose car is the base value for PROPERTY and cdr 12999 a list of accumulated values. Return nil if neither is found in 13000 the entry. Also return nil when PROPERTY is set to \"nil\", 13001 unless LITERAL-NIL is non-nil." 13002 (let ((range (org-get-property-block))) 13003 (when range 13004 (goto-char (car range)) 13005 (let* ((case-fold-search t) 13006 (end (cdr range)) 13007 (value 13008 ;; Base value. 13009 (save-excursion 13010 (let ((v (and (re-search-forward 13011 (org-re-property property nil t) end t) 13012 (match-string-no-properties 3)))) 13013 (list (if literal-nil v (org-not-nil v))))))) 13014 ;; Find additional values. 13015 (let* ((property+ (org-re-property (concat property "+") nil t))) 13016 (while (re-search-forward property+ end t) 13017 (push (match-string-no-properties 3) value))) 13018 ;; Return final values. 13019 (and (not (equal value '(nil))) (nreverse value)))))) 13020 13021 (defun org--property-global-or-keyword-value (property literal-nil) 13022 "Return value for PROPERTY as defined by global properties or by keyword. 13023 Return value is a string. Return nil if property is not set 13024 globally or by keyword. Also return nil when PROPERTY is set to 13025 \"nil\", unless LITERAL-NIL is non-nil." 13026 (let ((global 13027 (cdr (or (assoc-string property org-keyword-properties t) 13028 (assoc-string property org-global-properties t) 13029 (assoc-string property org-global-properties-fixed t))))) 13030 (if literal-nil global (org-not-nil global)))) 13031 13032 (defun org-entry-get (pom property &optional inherit literal-nil) 13033 "Get value of PROPERTY for entry or content at point-or-marker POM. 13034 13035 If INHERIT is non-nil and the entry does not have the property, 13036 then also check higher levels of the hierarchy. If INHERIT is 13037 the symbol `selective', use inheritance only if the setting in 13038 `org-use-property-inheritance' selects PROPERTY for inheritance. 13039 13040 If the property is present but empty, the return value is the 13041 empty string. If the property is not present at all, nil is 13042 returned. In any other case, return the value as a string. 13043 Search is case-insensitive. 13044 13045 If LITERAL-NIL is set, return the string value \"nil\" as 13046 a string, do not interpret it as the list atom nil. This is used 13047 for inheritance when a \"nil\" value can supersede a non-nil 13048 value higher up the hierarchy." 13049 (org-with-point-at pom 13050 (cond 13051 ((member-ignore-case property (cons "CATEGORY" org-special-properties)) 13052 ;; We need a special property. Use `org-entry-properties' to 13053 ;; retrieve it, but specify the wanted property. 13054 (cdr (assoc-string property (org-entry-properties nil property)))) 13055 ((and inherit 13056 (or (not (eq inherit 'selective)) (org-property-inherit-p property))) 13057 (org-entry-get-with-inheritance property literal-nil)) 13058 (t 13059 (let* ((local (org--property-local-values property literal-nil)) 13060 (value (and local (mapconcat #'identity (delq nil local) " ")))) 13061 (if literal-nil value (org-not-nil value))))))) 13062 13063 (defun org-property-or-variable-value (var &optional inherit) 13064 "Check if there is a property fixing the value of VAR. 13065 If yes, return this value. If not, return the current value of the variable." 13066 (let ((prop (org-entry-get nil (symbol-name var) inherit))) 13067 (if (and prop (stringp prop) (string-match "\\S-" prop)) 13068 (read prop) 13069 (symbol-value var)))) 13070 13071 (defun org-entry-delete (pom property) 13072 "Delete PROPERTY from entry at point-or-marker POM. 13073 Accumulated properties, i.e. PROPERTY+, are also removed. Return 13074 non-nil when a property was removed." 13075 (org-with-point-at pom 13076 (pcase (org-get-property-block) 13077 (`(,begin . ,origin) 13078 (let* ((end (copy-marker origin)) 13079 (re (org-re-property 13080 (concat (regexp-quote property) "\\+?") t t))) 13081 (goto-char begin) 13082 (while (re-search-forward re end t) 13083 (delete-region (match-beginning 0) (line-beginning-position 2))) 13084 ;; If drawer is empty, remove it altogether. 13085 (when (= begin end) 13086 (delete-region (line-beginning-position 0) 13087 (line-beginning-position 2))) 13088 ;; Return non-nil if some property was removed. 13089 (prog1 (/= end origin) (set-marker end nil)))) 13090 (_ nil)))) 13091 13092 ;; Multi-values properties are properties that contain multiple values 13093 ;; These values are assumed to be single words, separated by whitespace. 13094 (defun org-entry-add-to-multivalued-property (pom property value) 13095 "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM." 13096 (let* ((old (org-entry-get pom property)) 13097 (values (and old (split-string old)))) 13098 (setq value (org-entry-protect-space value)) 13099 (unless (member value values) 13100 (setq values (append values (list value))) 13101 (org-entry-put pom property (mapconcat #'identity values " "))))) 13102 13103 (defun org-entry-remove-from-multivalued-property (pom property value) 13104 "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM." 13105 (let* ((old (org-entry-get pom property)) 13106 (values (and old (split-string old)))) 13107 (setq value (org-entry-protect-space value)) 13108 (when (member value values) 13109 (setq values (delete value values)) 13110 (org-entry-put pom property (mapconcat #'identity values " "))))) 13111 13112 (defun org-entry-member-in-multivalued-property (pom property value) 13113 "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?" 13114 (let* ((old (org-entry-get pom property)) 13115 (values (and old (split-string old)))) 13116 (setq value (org-entry-protect-space value)) 13117 (member value values))) 13118 13119 (defun org-entry-get-multivalued-property (pom property) 13120 "Return a list of values in a multivalued property." 13121 (let* ((value (org-entry-get pom property)) 13122 (values (and value (split-string value)))) 13123 (mapcar #'org-entry-restore-space values))) 13124 13125 (defun org-entry-put-multivalued-property (pom property &rest values) 13126 "Set multivalued PROPERTY at point-or-marker POM to VALUES. 13127 VALUES should be a list of strings. Spaces will be protected." 13128 (org-entry-put pom property (mapconcat #'org-entry-protect-space values " ")) 13129 (let* ((value (org-entry-get pom property)) 13130 (values (and value (split-string value)))) 13131 (mapcar #'org-entry-restore-space values))) 13132 13133 (defun org-entry-protect-space (s) 13134 "Protect spaces and newline in string S." 13135 (while (string-match " " s) 13136 (setq s (replace-match "%20" t t s))) 13137 (while (string-match "\n" s) 13138 (setq s (replace-match "%0A" t t s))) 13139 s) 13140 13141 (defun org-entry-restore-space (s) 13142 "Restore spaces and newline in string S." 13143 (while (string-match "%20" s) 13144 (setq s (replace-match " " t t s))) 13145 (while (string-match "%0A" s) 13146 (setq s (replace-match "\n" t t s))) 13147 s) 13148 13149 (defvar org-entry-property-inherited-from (make-marker) 13150 "Marker pointing to the entry from where a property was inherited. 13151 Each call to `org-entry-get-with-inheritance' will set this marker to the 13152 location of the entry where the inheritance search matched. If there was 13153 no match, the marker will point nowhere. 13154 Note that also `org-entry-get' calls this function, if the INHERIT flag 13155 is set.") 13156 13157 (defun org-entry-get-with-inheritance (property &optional literal-nil) 13158 "Get PROPERTY of entry or content at point, search higher levels if needed. 13159 The search will stop at the first ancestor which has the property defined. 13160 If the value found is \"nil\", return nil to show that the property 13161 should be considered as undefined (this is the meaning of nil here). 13162 However, if LITERAL-NIL is set, return the string value \"nil\" instead." 13163 (move-marker org-entry-property-inherited-from nil) 13164 (org-with-wide-buffer 13165 (let (value) 13166 (catch 'exit 13167 (while t 13168 (let ((v (org--property-local-values property literal-nil))) 13169 (when v 13170 (setq value 13171 (concat (mapconcat #'identity (delq nil v) " ") 13172 (and value " ") 13173 value))) 13174 (cond 13175 ((car v) 13176 (org-back-to-heading-or-point-min t) 13177 (move-marker org-entry-property-inherited-from (point)) 13178 (throw 'exit nil)) 13179 ((org-up-heading-or-point-min)) 13180 (t 13181 (let ((global (org--property-global-or-keyword-value property literal-nil))) 13182 (cond ((not global)) 13183 (value (setq value (concat global " " value))) 13184 (t (setq value global)))) 13185 (throw 'exit nil)))))) 13186 (if literal-nil value (org-not-nil value))))) 13187 13188 (defvar org-property-changed-functions nil 13189 "Hook called when the value of a property has changed. 13190 Each hook function should accept two arguments, the name of the property 13191 and the new value.") 13192 13193 (defun org-entry-put (pom property value) 13194 "Set PROPERTY to VALUE for entry at point-or-marker POM. 13195 13196 If the value is nil, it is converted to the empty string. If it 13197 is not a string, an error is raised. Also raise an error on 13198 invalid property names. 13199 13200 PROPERTY can be any regular property (see 13201 `org-special-properties'). It can also be \"TODO\", 13202 \"PRIORITY\", \"SCHEDULED\" and \"DEADLINE\". 13203 13204 For the last two properties, VALUE may have any of the special 13205 values \"earlier\" and \"later\". The function then increases or 13206 decreases scheduled or deadline date by one day." 13207 (cond ((null value) (setq value "")) 13208 ((not (stringp value)) (error "Properties values should be strings")) 13209 ((not (org--valid-property-p property)) 13210 (user-error "Invalid property name: \"%s\"" property))) 13211 (org-no-read-only 13212 (org-with-point-at pom 13213 (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p)) 13214 (org-back-to-heading-or-point-min t) 13215 (org-with-limited-levels (org-back-to-heading-or-point-min t))) 13216 (let ((beg (point))) 13217 (cond 13218 ((equal property "TODO") 13219 (cond ((not (org-string-nw-p value)) (setq value 'none)) 13220 ((not (member value org-todo-keywords-1)) 13221 (user-error "\"%s\" is not a valid TODO state" value))) 13222 (org-todo value) 13223 (org-align-tags)) 13224 ((equal property "PRIORITY") 13225 (org-priority (if (org-string-nw-p value) (string-to-char value) ?\s)) 13226 (org-align-tags)) 13227 ((equal property "SCHEDULED") 13228 (forward-line) 13229 (if (and (looking-at-p org-planning-line-re) 13230 (re-search-forward 13231 org-scheduled-time-regexp (line-end-position) t)) 13232 (cond ((string= value "earlier") (org-timestamp-change -1 'day)) 13233 ((string= value "later") (org-timestamp-change 1 'day)) 13234 ((string= value "") (org-schedule '(4))) 13235 (t (org-schedule nil value))) 13236 (if (member value '("earlier" "later" "")) 13237 (call-interactively #'org-schedule) 13238 (org-schedule nil value)))) 13239 ((equal property "DEADLINE") 13240 (forward-line) 13241 (if (and (looking-at-p org-planning-line-re) 13242 (re-search-forward 13243 org-deadline-time-regexp (line-end-position) t)) 13244 (cond ((string= value "earlier") (org-timestamp-change -1 'day)) 13245 ((string= value "later") (org-timestamp-change 1 'day)) 13246 ((string= value "") (org-deadline '(4))) 13247 (t (org-deadline nil value))) 13248 (if (member value '("earlier" "later" "")) 13249 (call-interactively #'org-deadline) 13250 (org-deadline nil value)))) 13251 ((member property org-special-properties) 13252 (error "The %s property cannot be set with `org-entry-put'" property)) 13253 (t 13254 (let* ((range (org-get-property-block beg 'force)) 13255 (end (cdr range)) 13256 (case-fold-search t)) 13257 (goto-char (car range)) 13258 (if (re-search-forward (org-re-property property nil t) end t) 13259 (progn (delete-region (match-beginning 0) (match-end 0)) 13260 (goto-char (match-beginning 0))) 13261 (goto-char end) 13262 (insert "\n") 13263 (backward-char)) 13264 (insert ":" property ":") 13265 (when value (insert " " value)) 13266 (org-indent-line))))) 13267 (run-hook-with-args 'org-property-changed-functions property value)))) 13268 13269 (defun org-buffer-property-keys (&optional specials defaults columns) 13270 "Get all property keys in the current buffer. 13271 13272 When SPECIALS is non-nil, also list the special properties that 13273 reflect things like tags and TODO state. 13274 13275 When DEFAULTS is non-nil, also include properties that has 13276 special meaning internally: ARCHIVE, CATEGORY, SUMMARY, 13277 DESCRIPTION, LOCATION, and LOGGING and others. 13278 13279 When COLUMNS in non-nil, also include property names given in 13280 COLUMN formats in the current buffer." 13281 (let ((case-fold-search t) 13282 (props (append 13283 (and specials org-special-properties) 13284 (and defaults (cons org-effort-property org-default-properties)) 13285 ;; Get property names from #+PROPERTY keywords as well 13286 (mapcar (lambda (s) 13287 (nth 0 (split-string s))) 13288 (cdar (org-collect-keywords '("PROPERTY"))))))) 13289 (org-with-wide-buffer 13290 (goto-char (point-min)) 13291 (while (re-search-forward org-property-start-re nil t) 13292 (catch :skip 13293 (let ((range (org-get-property-block))) 13294 (unless range (throw :skip nil)) 13295 (goto-char (car range)) 13296 (let ((begin (car range)) 13297 (end (cdr range))) 13298 ;; Make sure that found property block is not located 13299 ;; before current point, as it would generate an infloop. 13300 ;; It can happen, for example, in the following 13301 ;; situation: 13302 ;; 13303 ;; * Headline 13304 ;; :PROPERTIES: 13305 ;; ... 13306 ;; :END: 13307 ;; *************** Inlinetask 13308 ;; #+BEGIN_EXAMPLE 13309 ;; :PROPERTIES: 13310 ;; #+END_EXAMPLE 13311 ;; 13312 (if (< begin (point)) (throw :skip nil) (goto-char begin)) 13313 (while (< (point) end) 13314 (let ((p (progn (looking-at org-property-re) 13315 (match-string-no-properties 2)))) 13316 ;; Only add true property name, not extension symbol. 13317 (push (if (not (string-match-p "\\+\\'" p)) p 13318 (substring p 0 -1)) 13319 props)) 13320 (forward-line)))) 13321 (outline-next-heading))) 13322 (when columns 13323 (goto-char (point-min)) 13324 (while (re-search-forward "^[ \t]*\\(?:#\\+\\|:\\)COLUMNS:" nil t) 13325 (let ((element (org-element-at-point))) 13326 (when (memq (org-element-type element) '(keyword node-property)) 13327 (let ((value (org-element-property :value element)) 13328 (start 0)) 13329 (while (string-match "%[0-9]*\\([[:alnum:]_-]+\\)\\(([^)]+)\\)?\ 13330 \\(?:{[^}]+}\\)?" 13331 value start) 13332 (setq start (match-end 0)) 13333 (let ((p (match-string-no-properties 1 value))) 13334 (unless (member-ignore-case p org-special-properties) 13335 (push p props)))))))))) 13336 (sort (delete-dups 13337 (append props 13338 ;; for each xxx_ALL property, make sure the bare 13339 ;; xxx property is also included 13340 (delq nil (mapcar (lambda (p) 13341 (and (string-match-p "._ALL\\'" p) 13342 (substring p 0 -4))) 13343 props)))) 13344 (lambda (a b) (string< (upcase a) (upcase b)))))) 13345 13346 (defun org-property-values (key) 13347 "List all non-nil values of property KEY in current buffer." 13348 (org-with-wide-buffer 13349 (goto-char (point-min)) 13350 (let ((case-fold-search t) 13351 (re (org-re-property key)) 13352 values) 13353 (while (re-search-forward re nil t) 13354 (push (org-entry-get (point) key) values)) 13355 (delete-dups values)))) 13356 13357 (defun org-insert-property-drawer () 13358 "Insert a property drawer into the current entry. 13359 Do nothing if the drawer already exists. The newly created 13360 drawer is immediately hidden." 13361 (org-with-wide-buffer 13362 ;; Set point to the position where the drawer should be inserted. 13363 (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p)) 13364 (org-back-to-heading-or-point-min t) 13365 (org-with-limited-levels (org-back-to-heading-or-point-min t))) 13366 (if (org-before-first-heading-p) 13367 (while (and (org-at-comment-p) (bolp)) (forward-line)) 13368 (progn 13369 (forward-line) 13370 (when (looking-at-p org-planning-line-re) (forward-line)))) 13371 (unless (looking-at-p org-property-drawer-re) 13372 ;; Make sure we start editing a line from current entry, not from 13373 ;; next one. It prevents extending text properties or overlays 13374 ;; belonging to the latter. 13375 (when (and (bolp) (> (point) (point-min))) (backward-char)) 13376 (let ((begin (if (bobp) (point) (1+ (point)))) 13377 (inhibit-read-only t)) 13378 (unless (bobp) (insert "\n")) 13379 (insert ":PROPERTIES:\n:END:") 13380 (org-flag-region (line-end-position 0) (point) t 'outline) 13381 (when (or (eobp) (= begin (point-min))) (insert "\n")) 13382 (org-indent-region begin (point)))))) 13383 13384 (defun org-insert-drawer (&optional arg drawer) 13385 "Insert a drawer at point. 13386 13387 When optional argument ARG is non-nil, insert a property drawer. 13388 13389 Optional argument DRAWER, when non-nil, is a string representing 13390 drawer's name. Otherwise, the user is prompted for a name. 13391 13392 If a region is active, insert the drawer around that region 13393 instead. 13394 13395 Point is left between drawer's boundaries." 13396 (interactive "P") 13397 (let* ((drawer (if arg "PROPERTIES" 13398 (or drawer (read-from-minibuffer "Drawer: "))))) 13399 (cond 13400 ;; With C-u, fall back on `org-insert-property-drawer' 13401 (arg (org-insert-property-drawer)) 13402 ;; Check validity of suggested drawer's name. 13403 ((not (string-match-p org-drawer-regexp (format ":%s:" drawer))) 13404 (user-error "Invalid drawer name")) 13405 ;; With an active region, insert a drawer at point. 13406 ((not (org-region-active-p)) 13407 (progn 13408 (unless (bolp) (insert "\n")) 13409 (insert (format ":%s:\n\n:END:\n" drawer)) 13410 (forward-line -2))) 13411 ;; Otherwise, insert the drawer at point 13412 (t 13413 (let ((rbeg (region-beginning)) 13414 (rend (copy-marker (region-end)))) 13415 (unwind-protect 13416 (progn 13417 (goto-char rbeg) 13418 (beginning-of-line) 13419 (when (save-excursion 13420 (re-search-forward org-outline-regexp-bol rend t)) 13421 (user-error "Drawers cannot contain headlines")) 13422 ;; Position point at the beginning of the first 13423 ;; non-blank line in region. Insert drawer's opening 13424 ;; there, then indent it. 13425 (org-skip-whitespace) 13426 (beginning-of-line) 13427 (insert ":" drawer ":\n") 13428 (forward-line -1) 13429 (indent-for-tab-command) 13430 ;; Move point to the beginning of the first blank line 13431 ;; after the last non-blank line in region. Insert 13432 ;; drawer's closing, then indent it. 13433 (goto-char rend) 13434 (skip-chars-backward " \r\t\n") 13435 (insert "\n:END:") 13436 (deactivate-mark t) 13437 (indent-for-tab-command) 13438 (unless (eolp) (insert "\n"))) 13439 ;; Clear marker, whatever the outcome of insertion is. 13440 (set-marker rend nil))))))) 13441 13442 (defvar org-property-set-functions-alist nil 13443 "Property set function alist. 13444 Each entry should have the following format: 13445 13446 (PROPERTY . READ-FUNCTION) 13447 13448 The read function will be called with the same argument as 13449 `org-completing-read'.") 13450 13451 (defun org-set-property-function (property) 13452 "Get the function that should be used to set PROPERTY. 13453 This is computed according to `org-property-set-functions-alist'." 13454 (or (cdr (assoc property org-property-set-functions-alist)) 13455 'org-completing-read)) 13456 13457 (defun org-read-property-value (property &optional pom default) 13458 "Read value for PROPERTY, as a string. 13459 When optional argument POM is non-nil, completion uses additional 13460 information, i.e., allowed or existing values at point or marker 13461 POM. 13462 Optional argument DEFAULT provides a default value for PROPERTY." 13463 (let* ((completion-ignore-case t) 13464 (allowed 13465 (or (org-property-get-allowed-values nil property 'table) 13466 (and pom (org-property-get-allowed-values pom property 'table)))) 13467 (current (org-entry-get nil property)) 13468 (prompt (format "%s value%s: " 13469 property 13470 (if (org-string-nw-p current) 13471 (format " [%s]" current) 13472 ""))) 13473 (set-function (org-set-property-function property))) 13474 (org-trim 13475 (if allowed 13476 (funcall set-function 13477 prompt allowed nil 13478 (not (get-text-property 0 'org-unrestricted (caar allowed))) 13479 default nil default) 13480 (let ((all (mapcar #'list 13481 (append (org-property-values property) 13482 (and pom 13483 (org-with-point-at pom 13484 (org-property-values property))))))) 13485 (funcall set-function prompt all nil nil "" nil current)))))) 13486 13487 (defvar org-last-set-property nil) 13488 (defvar org-last-set-property-value nil) 13489 (defun org-read-property-name () 13490 "Read a property name." 13491 (let ((completion-ignore-case t) 13492 (default-prop (or (and (org-at-property-p) 13493 (match-string-no-properties 2)) 13494 org-last-set-property))) 13495 (org-completing-read 13496 (concat "Property" 13497 (if default-prop (concat " [" default-prop "]") "") 13498 ": ") 13499 (mapcar #'list (org-buffer-property-keys nil t t)) 13500 nil nil nil nil default-prop))) 13501 13502 (defun org-set-property-and-value (use-last) 13503 "Allow to set [PROPERTY]: [value] direction from prompt. 13504 When use-default, don't even ask, just use the last 13505 \"[PROPERTY]: [value]\" string from the history." 13506 (interactive "P") 13507 (let* ((completion-ignore-case t) 13508 (pv (or (and use-last org-last-set-property-value) 13509 (org-completing-read 13510 "Enter a \"[Property]: [value]\" pair: " 13511 nil nil nil nil nil 13512 org-last-set-property-value))) 13513 prop val) 13514 (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv) 13515 (setq prop (match-string 1 pv) 13516 val (match-string 2 pv)) 13517 (org-set-property prop val)))) 13518 13519 (defun org-set-property (property value) 13520 "In the current entry, set PROPERTY to VALUE. 13521 13522 When called interactively, this will prompt for a property name, offering 13523 completion on existing and default properties. And then it will prompt 13524 for a value, offering completion either on allowed values (via an inherited 13525 xxx_ALL property) or on existing values in other instances of this property 13526 in the current file. 13527 13528 Throw an error when trying to set a property with an invalid name." 13529 (interactive (list nil nil)) 13530 (let ((property (or property (org-read-property-name)))) 13531 ;; `org-entry-put' also makes the following check, but this one 13532 ;; avoids polluting `org-last-set-property' and 13533 ;; `org-last-set-property-value' needlessly. 13534 (unless (org--valid-property-p property) 13535 (user-error "Invalid property name: \"%s\"" property)) 13536 (let ((value (or value (org-read-property-value property))) 13537 (fn (cdr (assoc-string property org-properties-postprocess-alist t)))) 13538 (setq org-last-set-property property) 13539 (setq org-last-set-property-value (concat property ": " value)) 13540 ;; Possibly postprocess the inserted value: 13541 (when fn (setq value (funcall fn value))) 13542 (unless (equal (org-entry-get nil property) value) 13543 (org-entry-put nil property value))))) 13544 13545 (defun org-find-property (property &optional value) 13546 "Find first entry in buffer that sets PROPERTY. 13547 13548 When optional argument VALUE is non-nil, only consider an entry 13549 if it contains PROPERTY set to this value. If PROPERTY should be 13550 explicitly set to nil, use string \"nil\" for VALUE. 13551 13552 Return position where the entry begins, or nil if there is no 13553 such entry. If narrowing is in effect, only search the visible 13554 part of the buffer." 13555 (save-excursion 13556 (goto-char (point-min)) 13557 (let ((case-fold-search t) 13558 (re (org-re-property property nil (not value) value))) 13559 (catch 'exit 13560 (while (re-search-forward re nil t) 13561 (when (if value (org-at-property-p) 13562 (org-entry-get (point) property nil t)) 13563 (throw 'exit (progn (org-back-to-heading-or-point-min t) 13564 (point))))))))) 13565 13566 (defun org-delete-property (property) 13567 "In the current entry, delete PROPERTY." 13568 (interactive 13569 (let* ((completion-ignore-case t) 13570 (cat (org-entry-get (point) "CATEGORY")) 13571 (props0 (org-entry-properties nil 'standard)) 13572 (props (if cat props0 13573 (delete `("CATEGORY" . ,(org-get-category)) props0))) 13574 (prop (if (< 1 (length props)) 13575 (completing-read "Property: " props nil t) 13576 (caar props)))) 13577 (list prop))) 13578 (if (not property) 13579 (message "No property to delete in this entry") 13580 (org-entry-delete nil property) 13581 (message "Property \"%s\" deleted" property))) 13582 13583 (defun org-delete-property-globally (property) 13584 "Remove PROPERTY globally, from all entries. 13585 This function ignores narrowing, if any." 13586 (interactive 13587 (let* ((completion-ignore-case t) 13588 (prop (completing-read 13589 "Globally remove property: " 13590 (mapcar #'list (org-buffer-property-keys))))) 13591 (list prop))) 13592 (org-with-wide-buffer 13593 (goto-char (point-min)) 13594 (let ((count 0) 13595 (re (org-re-property (concat (regexp-quote property) "\\+?") t t))) 13596 (while (re-search-forward re nil t) 13597 (when (org-entry-delete (point) property) (cl-incf count))) 13598 (message "Property \"%s\" removed from %d entries" property count)))) 13599 13600 (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el 13601 13602 (defun org-compute-property-at-point () 13603 "Compute the property at point. 13604 This looks for an enclosing column format, extracts the operator and 13605 then applies it to the property in the column format's scope." 13606 (interactive) 13607 (unless (org-at-property-p) 13608 (user-error "Not at a property")) 13609 (let ((prop (match-string-no-properties 2))) 13610 (org-columns-get-format-and-top-level) 13611 (unless (nth 3 (assoc-string prop org-columns-current-fmt-compiled t)) 13612 (user-error "No operator defined for property %s" prop)) 13613 (org-columns-compute prop))) 13614 13615 (defvar org-property-allowed-value-functions nil 13616 "Hook for functions supplying allowed values for a specific property. 13617 The functions must take a single argument, the name of the property, and 13618 return a flat list of allowed values. If \":ETC\" is one of 13619 the values, this means that these values are intended as defaults for 13620 completion, but that other values should be allowed too. 13621 The functions must return nil if they are not responsible for this 13622 property.") 13623 13624 (defun org-property-get-allowed-values (pom property &optional table) 13625 "Get allowed values for the property PROPERTY. 13626 When TABLE is non-nil, return an alist that can directly be used for 13627 completion." 13628 (let (vals) 13629 (cond 13630 ((equal property "TODO") 13631 (setq vals (org-with-point-at pom 13632 (append org-todo-keywords-1 '(""))))) 13633 ((equal property "PRIORITY") 13634 (let ((n org-priority-lowest)) 13635 (while (>= n org-priority-highest) 13636 (push (char-to-string n) vals) 13637 (setq n (1- n))))) 13638 ((equal property "CATEGORY")) 13639 ((member property org-special-properties)) 13640 ((setq vals (run-hook-with-args-until-success 13641 'org-property-allowed-value-functions property))) 13642 (t 13643 (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) 13644 (when (and vals (string-match "\\S-" vals)) 13645 (setq vals (car (read-from-string (concat "(" vals ")")))) 13646 (setq vals (mapcar (lambda (x) 13647 (cond ((stringp x) x) 13648 ((numberp x) (number-to-string x)) 13649 ((symbolp x) (symbol-name x)) 13650 (t "???"))) 13651 vals))))) 13652 (when (member ":ETC" vals) 13653 (setq vals (remove ":ETC" vals)) 13654 (org-add-props (car vals) '(org-unrestricted t))) 13655 (if table (mapcar 'list vals) vals))) 13656 13657 (defun org-property-previous-allowed-value (&optional _previous) 13658 "Switch to the next allowed value for this property." 13659 (interactive) 13660 (org-property-next-allowed-value t)) 13661 13662 (defun org-property-next-allowed-value (&optional previous) 13663 "Switch to the next allowed value for this property." 13664 (interactive) 13665 (unless (org-at-property-p) 13666 (user-error "Not at a property")) 13667 (let* ((prop (car (save-match-data (org-split-string (match-string 1) ":")))) 13668 (key (match-string 2)) 13669 (value (match-string 3)) 13670 (allowed (or (org-property-get-allowed-values (point) key) 13671 (and (member value '("[ ]" "[-]" "[X]")) 13672 '("[ ]" "[X]")))) 13673 (heading (save-match-data (nth 4 (org-heading-components)))) 13674 nval) 13675 (unless allowed 13676 (user-error "Allowed values for this property have not been defined")) 13677 (when previous (setq allowed (reverse allowed))) 13678 (when (member value allowed) 13679 (setq nval (car (cdr (member value allowed))))) 13680 (setq nval (or nval (car allowed))) 13681 (when (equal nval value) 13682 (user-error "Only one allowed value for this property")) 13683 (org-at-property-p) 13684 (replace-match (concat " :" key ": " nval) t t) 13685 (org-indent-line) 13686 (beginning-of-line 1) 13687 (skip-chars-forward " \t") 13688 (when (equal prop org-effort-property) 13689 (org-refresh-property 13690 '((effort . identity) 13691 (effort-minutes . org-duration-to-minutes)) 13692 nval) 13693 (when (string= org-clock-current-task heading) 13694 (setq org-clock-effort nval) 13695 (org-clock-update-mode-line))) 13696 (run-hook-with-args 'org-property-changed-functions key nval))) 13697 13698 (defun org-find-olp (path &optional this-buffer) 13699 "Return a marker pointing to the entry at outline path OLP. 13700 If anything goes wrong, throw an error, and if you need to do 13701 something based on this error, you can catch it with 13702 `condition-case'. 13703 13704 If THIS-BUFFER is set, the outline path does not contain a file, 13705 only headings." 13706 (let* ((file (if this-buffer buffer-file-name (pop path))) 13707 (buffer (if this-buffer (current-buffer) (find-file-noselect file))) 13708 (level 1) 13709 (lmin 1) 13710 (lmax 1) 13711 end found flevel) 13712 (unless buffer (error "File not found :%s" file)) 13713 (with-current-buffer buffer 13714 (unless (derived-mode-p 'org-mode) 13715 (error "Buffer %s needs to be in Org mode" buffer)) 13716 (org-with-wide-buffer 13717 (goto-char (point-min)) 13718 (dolist (heading path) 13719 (let ((re (format org-complex-heading-regexp-format 13720 (regexp-quote heading))) 13721 (cnt 0)) 13722 (while (re-search-forward re end t) 13723 (setq level (- (match-end 1) (match-beginning 1))) 13724 (when (and (>= level lmin) (<= level lmax)) 13725 (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) 13726 (when (= cnt 0) 13727 (error "Heading not found on level %d: %s" lmax heading)) 13728 (when (> cnt 1) 13729 (error "Heading not unique on level %d: %s" lmax heading)) 13730 (goto-char found) 13731 (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) 13732 (setq end (save-excursion (org-end-of-subtree t t))))) 13733 (when (org-at-heading-p) 13734 (point-marker)))))) 13735 13736 (defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) 13737 "Find node HEADING in BUFFER. 13738 Return a marker to the heading if it was found, or nil if not. 13739 If POS-ONLY is set, return just the position instead of a marker. 13740 13741 The heading text must match exact, but it may have a TODO keyword, 13742 a priority cookie and tags in the standard locations." 13743 (with-current-buffer (or buffer (current-buffer)) 13744 (org-with-wide-buffer 13745 (goto-char (point-min)) 13746 (let (case-fold-search) 13747 (when (re-search-forward 13748 (format org-complex-heading-regexp-format 13749 (regexp-quote heading)) nil t) 13750 (if pos-only 13751 (match-beginning 0) 13752 (move-marker (make-marker) (match-beginning 0)))))))) 13753 13754 (defun org-find-exact-heading-in-directory (heading &optional dir) 13755 "Find Org node headline HEADING in all \".org\" files in directory DIR. 13756 When the target headline is found, return a marker to this location." 13757 (let ((files (directory-files (or dir default-directory) 13758 t "\\`[^.#].*\\.org\\'")) 13759 visiting m buffer) 13760 (catch 'found 13761 (dolist (file files) 13762 (message "trying %s" file) 13763 (setq visiting (org-find-base-buffer-visiting file)) 13764 (setq buffer (or visiting (find-file-noselect file))) 13765 (setq m (org-find-exact-headline-in-buffer 13766 heading buffer)) 13767 (when (and (not m) (not visiting)) (kill-buffer buffer)) 13768 (and m (throw 'found m)))))) 13769 13770 (defun org-find-entry-with-id (ident) 13771 "Locate the entry that contains the ID property with exact value IDENT. 13772 IDENT can be a string, a symbol or a number, this function will search for 13773 the string representation of it. 13774 Return the position where this entry starts, or nil if there is no such entry." 13775 (interactive "sID: ") 13776 (let ((id (cond 13777 ((stringp ident) ident) 13778 ((symbolp ident) (symbol-name ident)) 13779 ((numberp ident) (number-to-string ident)) 13780 (t (error "IDENT %s must be a string, symbol or number" ident))))) 13781 (org-with-wide-buffer (org-find-property "ID" id)))) 13782 13783 ;;;; Timestamps 13784 13785 (defvar org-last-changed-timestamp nil) 13786 (defvar org-last-inserted-timestamp nil 13787 "The last time stamp inserted with `org-insert-time-stamp'.") 13788 13789 (defun org-time-stamp (arg &optional inactive) 13790 "Prompt for a date/time and insert a time stamp. 13791 13792 If the user specifies a time like HH:MM or if this command is 13793 called with at least one prefix argument, the time stamp contains 13794 the date and the time. Otherwise, only the date is included. 13795 13796 All parts of a date not specified by the user are filled in from 13797 the timestamp at point, if any, or the current date/time 13798 otherwise. 13799 13800 If there is already a timestamp at the cursor, it is replaced. 13801 13802 With two universal prefix arguments, insert an active timestamp 13803 with the current time without prompting the user. 13804 13805 When called from Lisp, the timestamp is inactive if INACTIVE is 13806 non-nil." 13807 (interactive "P") 13808 (let* ((ts (cond 13809 ((org-at-date-range-p t) 13810 (match-string (if (< (point) (- (match-beginning 2) 2)) 1 2))) 13811 ((org-at-timestamp-p 'lax) (match-string 0)))) 13812 ;; Default time is either the timestamp at point or today. 13813 ;; When entering a range, only the range start is considered. 13814 (default-time (and ts (org-time-string-to-time ts))) 13815 (default-input (and ts (org-get-compact-tod ts))) 13816 (repeater (and ts 13817 (string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts) 13818 (match-string 0 ts))) 13819 org-time-was-given 13820 org-end-time-was-given 13821 (time 13822 (if (equal arg '(16)) (current-time) 13823 ;; Preserve `this-command' and `last-command'. 13824 (let ((this-command this-command) 13825 (last-command last-command)) 13826 (org-read-date 13827 arg 'totime nil nil default-time default-input 13828 inactive))))) 13829 (cond 13830 ((and ts 13831 (memq last-command '(org-time-stamp org-time-stamp-inactive)) 13832 (memq this-command '(org-time-stamp org-time-stamp-inactive))) 13833 (insert "--") 13834 (org-insert-time-stamp time (or org-time-was-given arg) inactive)) 13835 (ts 13836 ;; Make sure we're on a timestamp. When in the middle of a date 13837 ;; range, move arbitrarily to range end. 13838 (unless (org-at-timestamp-p 'lax) 13839 (skip-chars-forward "-") 13840 (org-at-timestamp-p 'lax)) 13841 (replace-match "") 13842 (setq org-last-changed-timestamp 13843 (org-insert-time-stamp 13844 time (or org-time-was-given arg) 13845 inactive nil nil (list org-end-time-was-given))) 13846 (when repeater 13847 (backward-char) 13848 (insert " " repeater) 13849 (setq org-last-changed-timestamp 13850 (concat (substring org-last-inserted-timestamp 0 -1) 13851 " " repeater ">"))) 13852 (message "Timestamp updated")) 13853 ((equal arg '(16)) (org-insert-time-stamp time t inactive)) 13854 (t (org-insert-time-stamp 13855 time (or org-time-was-given arg) inactive nil nil 13856 (list org-end-time-was-given)))))) 13857 13858 ;; FIXME: can we use this for something else, like computing time differences? 13859 (defun org-get-compact-tod (s) 13860 (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s) 13861 (let* ((t1 (match-string 1 s)) 13862 (h1 (string-to-number (match-string 2 s))) 13863 (m1 (string-to-number (match-string 3 s))) 13864 (t2 (and (match-end 4) (match-string 5 s))) 13865 (h2 (and t2 (string-to-number (match-string 6 s)))) 13866 (m2 (and t2 (string-to-number (match-string 7 s)))) 13867 dh dm) 13868 (if (not t2) 13869 t1 13870 (setq dh (- h2 h1) dm (- m2 m1)) 13871 (when (< dm 0) (setq dm (+ dm 60) dh (1- dh))) 13872 (concat t1 "+" (number-to-string dh) 13873 (and (/= 0 dm) (format ":%02d" dm))))))) 13874 13875 (defun org-time-stamp-inactive (&optional arg) 13876 "Insert an inactive time stamp. 13877 13878 An inactive time stamp is enclosed in square brackets instead of 13879 angle brackets. It is inactive in the sense that it does not 13880 trigger agenda entries. So these are more for recording a 13881 certain time/date. 13882 13883 If the user specifies a time like HH:MM or if this command is called with 13884 at least one prefix argument, the time stamp contains the date and the time. 13885 Otherwise, only the date is included. 13886 13887 When called with two universal prefix arguments, insert an inactive time stamp 13888 with the current time without prompting the user." 13889 (interactive "P") 13890 (org-time-stamp arg 'inactive)) 13891 13892 (defvar org-date-ovl (make-overlay 1 1)) 13893 (overlay-put org-date-ovl 'face 'org-date-selected) 13894 (delete-overlay org-date-ovl) 13895 13896 (defvar org-ans1) ; dynamically scoped parameter 13897 (defvar org-ans2) ; dynamically scoped parameter 13898 13899 (defvar org-plain-time-of-day-regexp) ; defined below 13900 13901 (defvar org-overriding-default-time nil) ; dynamically scoped 13902 (defvar org-read-date-overlay nil) 13903 (defvar org-read-date-history nil) 13904 (defvar org-read-date-final-answer nil) 13905 (defvar org-read-date-analyze-futurep nil) 13906 (defvar org-read-date-analyze-forced-year nil) 13907 (defvar org-read-date-inactive) 13908 (defvar org-def) 13909 (defvar org-defdecode) 13910 (defvar org-with-time) 13911 13912 (defvar calendar-setup) ; Dynamically scoped. 13913 (defun org-read-date (&optional with-time to-time from-string prompt 13914 default-time default-input inactive) 13915 "Read a date, possibly a time, and make things smooth for the user. 13916 The prompt will suggest to enter an ISO date, but you can also enter anything 13917 which will at least partially be understood by `parse-time-string'. 13918 Unrecognized parts of the date will default to the current day, month, year, 13919 hour and minute. If this command is called to replace a timestamp at point, 13920 or to enter the second timestamp of a range, the default time is taken 13921 from the existing stamp. Furthermore, the command prefers the future, 13922 so if you are giving a date where the year is not given, and the day-month 13923 combination is already past in the current year, it will assume you 13924 mean next year. For details, see the manual. A few examples: 13925 13926 3-2-5 --> 2003-02-05 13927 feb 15 --> currentyear-02-15 13928 2/15 --> currentyear-02-15 13929 sep 12 9 --> 2009-09-12 13930 12:45 --> today 12:45 13931 22 sept 0:34 --> currentyear-09-22 0:34 13932 12 --> currentyear-currentmonth-12 13933 Fri --> nearest Friday after today 13934 -Tue --> last Tuesday 13935 etc. 13936 13937 Furthermore you can specify a relative date by giving, as the *first* thing 13938 in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate 13939 change in days weeks, months, years. 13940 With a single plus or minus, the date is relative to today. With a double 13941 plus or minus, it is relative to the date in DEFAULT-TIME. E.g. 13942 +4d --> four days from today 13943 +4 --> same as above 13944 +2w --> two weeks from today 13945 ++5 --> five days from default date 13946 13947 The function understands only English month and weekday abbreviations. 13948 13949 While prompting, a calendar is popped up - you can also select the 13950 date with the mouse (button 1). The calendar shows a period of three 13951 months. To scroll it to other months, use the keys `>' and `<'. 13952 If you don't like the calendar, turn it off with 13953 (setq org-read-date-popup-calendar nil) 13954 13955 With optional argument TO-TIME, the date will immediately be converted 13956 to an internal time. 13957 With an optional argument WITH-TIME, the prompt will suggest to 13958 also insert a time. Note that when WITH-TIME is not set, you can 13959 still enter a time, and this function will inform the calling routine 13960 about this change. The calling routine may then choose to change the 13961 format used to insert the time stamp into the buffer to include the time. 13962 With optional argument FROM-STRING, read from this string instead from 13963 the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is 13964 the time/date that is used for everything that is not specified by the 13965 user." 13966 (require 'parse-time) 13967 (let* ((org-with-time with-time) 13968 (org-time-stamp-rounding-minutes 13969 (if (equal org-with-time '(16)) 13970 '(0 0) 13971 org-time-stamp-rounding-minutes)) 13972 (ct (org-current-time)) 13973 (org-def (or org-overriding-default-time default-time ct)) 13974 (org-defdecode (decode-time org-def)) 13975 (cur-frame (selected-frame)) 13976 (mouse-autoselect-window nil) ; Don't let the mouse jump 13977 (calendar-setup 13978 (and (eq calendar-setup 'calendar-only) 'calendar-only)) 13979 (calendar-move-hook nil) 13980 (calendar-view-diary-initially-flag nil) 13981 (calendar-view-holidays-initially-flag nil) 13982 ans (org-ans0 "") org-ans1 org-ans2 final cal-frame) 13983 ;; Rationalize `org-def' and `org-defdecode', if required. 13984 (when (< (nth 2 org-defdecode) org-extend-today-until) 13985 (setf (nth 2 org-defdecode) -1) 13986 (setf (nth 1 org-defdecode) 59) 13987 (setq org-def (apply #'encode-time org-defdecode)) 13988 (setq org-defdecode (decode-time org-def))) 13989 (let* ((timestr (format-time-string 13990 (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") 13991 org-def)) 13992 (prompt (concat (if prompt (concat prompt " ") "") 13993 (format "Date+time [%s]: " timestr)))) 13994 (cond 13995 (from-string (setq ans from-string)) 13996 (org-read-date-popup-calendar 13997 (save-excursion 13998 (save-window-excursion 13999 (calendar) 14000 (when (eq calendar-setup 'calendar-only) 14001 (setq cal-frame 14002 (window-frame (get-buffer-window "*Calendar*" 'visible))) 14003 (select-frame cal-frame)) 14004 (org-eval-in-calendar '(setq cursor-type nil) t) 14005 (unwind-protect 14006 (progn 14007 (calendar-forward-day (- (time-to-days org-def) 14008 (calendar-absolute-from-gregorian 14009 (calendar-current-date)))) 14010 (org-eval-in-calendar nil t) 14011 (let* ((old-map (current-local-map)) 14012 (map (copy-keymap calendar-mode-map)) 14013 (minibuffer-local-map 14014 (copy-keymap org-read-date-minibuffer-local-map))) 14015 (org-defkey map (kbd "RET") 'org-calendar-select) 14016 (org-defkey map [mouse-1] 'org-calendar-select-mouse) 14017 (org-defkey map [mouse-2] 'org-calendar-select-mouse) 14018 (unwind-protect 14019 (progn 14020 (use-local-map map) 14021 (setq org-read-date-inactive inactive) 14022 (add-hook 'post-command-hook 'org-read-date-display) 14023 (setq org-ans0 14024 (read-string prompt 14025 default-input 14026 'org-read-date-history 14027 nil)) 14028 ;; org-ans0: from prompt 14029 ;; org-ans1: from mouse click 14030 ;; org-ans2: from calendar motion 14031 (setq ans 14032 (concat org-ans0 " " (or org-ans1 org-ans2)))) 14033 (remove-hook 'post-command-hook 'org-read-date-display) 14034 (use-local-map old-map) 14035 (when org-read-date-overlay 14036 (delete-overlay org-read-date-overlay) 14037 (setq org-read-date-overlay nil))))) 14038 (bury-buffer "*Calendar*") 14039 (when cal-frame 14040 (delete-frame cal-frame) 14041 (select-frame-set-input-focus cur-frame)))))) 14042 14043 (t ; Naked prompt only 14044 (unwind-protect 14045 (setq ans (read-string prompt default-input 14046 'org-read-date-history timestr)) 14047 (when org-read-date-overlay 14048 (delete-overlay org-read-date-overlay) 14049 (setq org-read-date-overlay nil)))))) 14050 14051 (setq final (org-read-date-analyze ans org-def org-defdecode)) 14052 14053 (when org-read-date-analyze-forced-year 14054 (message "Year was forced into %s" 14055 (if org-read-date-force-compatible-dates 14056 "compatible range (1970-2037)" 14057 "range representable on this machine")) 14058 (ding)) 14059 14060 (setq final (apply #'encode-time final)) 14061 14062 (setq org-read-date-final-answer ans) 14063 14064 (if to-time 14065 final 14066 ;; This round-trip gets rid of 34th of August and stuff like that.... 14067 (setq final (decode-time final)) 14068 (if (and (boundp 'org-time-was-given) org-time-was-given) 14069 (format "%04d-%02d-%02d %02d:%02d" 14070 (nth 5 final) (nth 4 final) (nth 3 final) 14071 (nth 2 final) (nth 1 final)) 14072 (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) 14073 14074 (defun org-read-date-display () 14075 "Display the current date prompt interpretation in the minibuffer." 14076 (when org-read-date-display-live 14077 (when org-read-date-overlay 14078 (delete-overlay org-read-date-overlay)) 14079 (when (minibufferp (current-buffer)) 14080 (save-excursion 14081 (end-of-line 1) 14082 (while (not (equal (buffer-substring 14083 (max (point-min) (- (point) 4)) (point)) 14084 " ")) 14085 (insert " "))) 14086 (let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) 14087 " " (or org-ans1 org-ans2))) 14088 (org-end-time-was-given nil) 14089 (f (org-read-date-analyze ans org-def org-defdecode)) 14090 (fmts (if org-display-custom-times 14091 org-time-stamp-custom-formats 14092 org-time-stamp-formats)) 14093 (fmt (if (or org-with-time 14094 (and (boundp 'org-time-was-given) org-time-was-given)) 14095 (cdr fmts) 14096 (car fmts))) 14097 (txt (format-time-string fmt (apply #'encode-time f))) 14098 (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt)) 14099 (txt (concat "=> " txt))) 14100 (when (and org-end-time-was-given 14101 (string-match org-plain-time-of-day-regexp txt)) 14102 (setq txt (concat (substring txt 0 (match-end 0)) "-" 14103 org-end-time-was-given 14104 (substring txt (match-end 0))))) 14105 (when org-read-date-analyze-futurep 14106 (setq txt (concat txt " (=>F)"))) 14107 (setq org-read-date-overlay 14108 (make-overlay (1- (point-at-eol)) (point-at-eol))) 14109 (org-overlay-display org-read-date-overlay txt 'secondary-selection))))) 14110 14111 (defun org-read-date-analyze (ans def defdecode) 14112 "Analyze the combined answer of the date prompt." 14113 ;; FIXME: cleanup and comment 14114 (let ((org-def def) 14115 (org-defdecode defdecode) 14116 (nowdecode (decode-time)) 14117 delta deltan deltaw deltadef year month day 14118 hour minute second wday pm h2 m2 tl wday1 14119 iso-year iso-weekday iso-week iso-date futurep kill-year) 14120 (setq org-read-date-analyze-futurep nil 14121 org-read-date-analyze-forced-year nil) 14122 (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) 14123 (setq ans "+0")) 14124 14125 (when (setq delta (org-read-date-get-relative ans nil org-def)) 14126 (setq ans (replace-match "" t t ans) 14127 deltan (car delta) 14128 deltaw (nth 1 delta) 14129 deltadef (nth 2 delta))) 14130 14131 ;; Check if there is an iso week date in there. If yes, store the 14132 ;; info and postpone interpreting it until the rest of the parsing 14133 ;; is done. 14134 (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) 14135 (setq iso-year (when (match-end 1) 14136 (org-small-year-to-year 14137 (string-to-number (match-string 1 ans)))) 14138 iso-weekday (when (match-end 3) 14139 (string-to-number (match-string 3 ans))) 14140 iso-week (string-to-number (match-string 2 ans))) 14141 (setq ans (replace-match "" t t ans))) 14142 14143 ;; Help matching ISO dates with single digit month or day, like 2006-8-11. 14144 (when (string-match 14145 "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) 14146 (setq year (if (match-end 2) 14147 (string-to-number (match-string 2 ans)) 14148 (progn (setq kill-year t) 14149 (string-to-number (format-time-string "%Y")))) 14150 month (string-to-number (match-string 3 ans)) 14151 day (string-to-number (match-string 4 ans))) 14152 (setq year (org-small-year-to-year year)) 14153 (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) 14154 t nil ans))) 14155 14156 ;; Help matching dotted european dates 14157 (when (string-match 14158 "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\.\\( ?[1-9][0-9]\\{3\\}\\)?" ans) 14159 (setq year (if (match-end 3) (string-to-number (match-string 3 ans)) 14160 (setq kill-year t) 14161 (string-to-number (format-time-string "%Y"))) 14162 day (string-to-number (match-string 1 ans)) 14163 month (string-to-number (match-string 2 ans)) 14164 ans (replace-match (format "%04d-%02d-%02d" year month day) 14165 t nil ans))) 14166 14167 ;; Help matching american dates, like 5/30 or 5/30/7 14168 (when (string-match 14169 "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) 14170 (setq year (if (match-end 4) 14171 (string-to-number (match-string 4 ans)) 14172 (progn (setq kill-year t) 14173 (string-to-number (format-time-string "%Y")))) 14174 month (string-to-number (match-string 1 ans)) 14175 day (string-to-number (match-string 2 ans))) 14176 (setq year (org-small-year-to-year year)) 14177 (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) 14178 t nil ans))) 14179 ;; Help matching am/pm times, because `parse-time-string' does not do that. 14180 ;; If there is a time with am/pm, and *no* time without it, we convert 14181 ;; so that matching will be successful. 14182 (cl-loop for i from 1 to 2 do ; twice, for end time as well 14183 (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) 14184 (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) 14185 (setq hour (string-to-number (match-string 1 ans)) 14186 minute (if (match-end 3) 14187 (string-to-number (match-string 3 ans)) 14188 0) 14189 pm (equal ?p 14190 (string-to-char (downcase (match-string 4 ans))))) 14191 (if (and (= hour 12) (not pm)) 14192 (setq hour 0) 14193 (when (and pm (< hour 12)) (setq hour (+ 12 hour)))) 14194 (setq ans (replace-match (format "%02d:%02d" hour minute) 14195 t t ans)))) 14196 14197 ;; Help matching HHhMM times, similarly as for am/pm times. 14198 (cl-loop for i from 1 to 2 do ; twice, for end time as well 14199 (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) 14200 (string-match "\\(?:\\(?1:[012]?[0-9]\\)?h\\(?2:[0-5][0-9]\\)\\)\\|\\(?:\\(?1:[012]?[0-9]\\)h\\(?2:[0-5][0-9]\\)?\\)\\>" ans)) 14201 (setq hour (if (match-end 1) 14202 (string-to-number (match-string 1 ans)) 14203 0) 14204 minute (if (match-end 2) 14205 (string-to-number (match-string 2 ans)) 14206 0)) 14207 (setq ans (replace-match (format "%02d:%02d" hour minute) 14208 t t ans)))) 14209 14210 ;; Check if a time range is given as a duration 14211 (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans) 14212 (setq hour (string-to-number (match-string 1 ans)) 14213 h2 (+ hour (string-to-number (match-string 3 ans))) 14214 minute (string-to-number (match-string 2 ans)) 14215 m2 (+ minute (if (match-end 5) (string-to-number 14216 (match-string 5 ans))0))) 14217 (when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) 14218 (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) 14219 t t ans))) 14220 14221 ;; Check if there is a time range 14222 (when (boundp 'org-end-time-was-given) 14223 (setq org-time-was-given nil) 14224 (when (and (string-match org-plain-time-of-day-regexp ans) 14225 (match-end 8)) 14226 (setq org-end-time-was-given (match-string 8 ans)) 14227 (setq ans (concat (substring ans 0 (match-beginning 7)) 14228 (substring ans (match-end 7)))))) 14229 14230 (setq tl (parse-time-string ans) 14231 day (or (nth 3 tl) (nth 3 org-defdecode)) 14232 month 14233 (cond ((nth 4 tl)) 14234 ((not org-read-date-prefer-future) (nth 4 org-defdecode)) 14235 ;; Day was specified. Make sure DAY+MONTH 14236 ;; combination happens in the future. 14237 ((nth 3 tl) 14238 (setq futurep t) 14239 (if (< day (nth 3 nowdecode)) (1+ (nth 4 nowdecode)) 14240 (nth 4 nowdecode))) 14241 (t (nth 4 org-defdecode))) 14242 year 14243 (cond ((and (not kill-year) (nth 5 tl))) 14244 ((not org-read-date-prefer-future) (nth 5 org-defdecode)) 14245 ;; Month was guessed in the future and is at least 14246 ;; equal to NOWDECODE's. Fix year accordingly. 14247 (futurep 14248 (if (or (> month (nth 4 nowdecode)) 14249 (>= day (nth 3 nowdecode))) 14250 (nth 5 nowdecode) 14251 (1+ (nth 5 nowdecode)))) 14252 ;; Month was specified. Make sure MONTH+YEAR 14253 ;; combination happens in the future. 14254 ((nth 4 tl) 14255 (setq futurep t) 14256 (cond ((> month (nth 4 nowdecode)) (nth 5 nowdecode)) 14257 ((< month (nth 4 nowdecode)) (1+ (nth 5 nowdecode))) 14258 ((< day (nth 3 nowdecode)) (1+ (nth 5 nowdecode))) 14259 (t (nth 5 nowdecode)))) 14260 (t (nth 5 org-defdecode))) 14261 hour (or (nth 2 tl) (nth 2 org-defdecode)) 14262 minute (or (nth 1 tl) (nth 1 org-defdecode)) 14263 second (or (nth 0 tl) 0) 14264 wday (nth 6 tl)) 14265 14266 (when (and (eq org-read-date-prefer-future 'time) 14267 (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl)) 14268 (equal day (nth 3 nowdecode)) 14269 (equal month (nth 4 nowdecode)) 14270 (equal year (nth 5 nowdecode)) 14271 (nth 2 tl) 14272 (or (< (nth 2 tl) (nth 2 nowdecode)) 14273 (and (= (nth 2 tl) (nth 2 nowdecode)) 14274 (nth 1 tl) 14275 (< (nth 1 tl) (nth 1 nowdecode))))) 14276 (setq day (1+ day) 14277 futurep t)) 14278 14279 ;; Special date definitions below 14280 (cond 14281 (iso-week 14282 ;; There was an iso week 14283 (require 'cal-iso) 14284 (setq futurep nil) 14285 (setq year (or iso-year year) 14286 day (or iso-weekday wday 1) 14287 wday nil ; to make sure that the trigger below does not match 14288 iso-date (calendar-gregorian-from-absolute 14289 (calendar-iso-to-absolute 14290 (list iso-week day year)))) 14291 ; FIXME: Should we also push ISO weeks into the future? 14292 ; (when (and org-read-date-prefer-future 14293 ; (not iso-year) 14294 ; (< (calendar-absolute-from-gregorian iso-date) 14295 ; (time-to-days nil))) 14296 ; (setq year (1+ year) 14297 ; iso-date (calendar-gregorian-from-absolute 14298 ; (calendar-iso-to-absolute 14299 ; (list iso-week day year))))) 14300 (setq month (car iso-date) 14301 year (nth 2 iso-date) 14302 day (nth 1 iso-date))) 14303 (deltan 14304 (setq futurep nil) 14305 (unless deltadef 14306 (let ((now (decode-time))) 14307 (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) 14308 (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) 14309 ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) 14310 ((equal deltaw "m") (setq month (+ month deltan))) 14311 ((equal deltaw "y") (setq year (+ year deltan))))) 14312 ((and wday (not (nth 3 tl))) 14313 ;; Weekday was given, but no day, so pick that day in the week 14314 ;; on or after the derived date. 14315 (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) 14316 (unless (equal wday wday1) 14317 (setq day (+ day (% (- wday wday1 -7) 7)))))) 14318 (when (and (boundp 'org-time-was-given) 14319 (nth 2 tl)) 14320 (setq org-time-was-given t)) 14321 (when (< year 100) (setq year (+ 2000 year))) 14322 ;; Check of the date is representable 14323 (if org-read-date-force-compatible-dates 14324 (progn 14325 (when (< year 1970) 14326 (setq year 1970 org-read-date-analyze-forced-year t)) 14327 (when (> year 2037) 14328 (setq year 2037 org-read-date-analyze-forced-year t))) 14329 (condition-case nil 14330 (ignore (encode-time second minute hour day month year)) 14331 (error 14332 (setq year (nth 5 org-defdecode)) 14333 (setq org-read-date-analyze-forced-year t)))) 14334 (setq org-read-date-analyze-futurep futurep) 14335 (list second minute hour day month year))) 14336 14337 (defvar parse-time-weekdays) 14338 (defun org-read-date-get-relative (s today default) 14339 "Check string S for special relative date string. 14340 TODAY and DEFAULT are internal times, for today and for a default. 14341 Return shift list (N what def-flag) 14342 WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year. 14343 N is the number of WHATs to shift. 14344 DEF-FLAG is t when a double ++ or -- indicates shift relative to 14345 the DEFAULT date rather than TODAY." 14346 (require 'parse-time) 14347 (when (and 14348 (string-match 14349 (concat 14350 "\\`[ \t]*\\([-+]\\{0,2\\}\\)" 14351 "\\([0-9]+\\)?" 14352 "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" 14353 "\\([ \t]\\|$\\)") s) 14354 (or (> (match-end 1) (match-beginning 1)) (match-end 4))) 14355 (let* ((dir (if (> (match-end 1) (match-beginning 1)) 14356 (string-to-char (substring (match-string 1 s) -1)) 14357 ?+)) 14358 (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1))))) 14359 (n (if (match-end 2) (string-to-number (match-string 2 s)) 1)) 14360 (what (if (match-end 3) (match-string 3 s) "d")) 14361 (wday1 (cdr (assoc (downcase what) parse-time-weekdays))) 14362 (date (if rel default today)) 14363 (wday (nth 6 (decode-time date))) 14364 delta) 14365 (if wday1 14366 (progn 14367 (setq delta (mod (+ 7 (- wday1 wday)) 7)) 14368 (when (= delta 0) (setq delta 7)) 14369 (when (= dir ?-) 14370 (setq delta (- delta 7)) 14371 (when (= delta 0) (setq delta -7))) 14372 (when (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) 14373 (list delta "d" rel)) 14374 (list (* n (if (= dir ?-) -1 1)) what rel))))) 14375 14376 (defun org-order-calendar-date-args (arg1 arg2 arg3) 14377 "Turn a user-specified date into the internal representation. 14378 The internal representation needed by the calendar is (month day year). 14379 This is a wrapper to handle the brain-dead convention in calendar that 14380 user function argument order change dependent on argument order." 14381 (pcase calendar-date-style 14382 (`american (list arg1 arg2 arg3)) 14383 (`european (list arg2 arg1 arg3)) 14384 (`iso (list arg2 arg3 arg1)))) 14385 14386 (defun org-eval-in-calendar (form &optional keepdate) 14387 "Eval FORM in the calendar window and return to current window. 14388 Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date." 14389 (let ((sf (selected-frame)) 14390 (sw (selected-window))) 14391 (select-window (get-buffer-window "*Calendar*" t)) 14392 (eval form) 14393 (when (and (not keepdate) (calendar-cursor-to-date)) 14394 (let* ((date (calendar-cursor-to-date)) 14395 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 14396 (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) 14397 (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) 14398 (select-window sw) 14399 (select-frame-set-input-focus sf))) 14400 14401 (defun org-calendar-select () 14402 "Return to `org-read-date' with the date currently selected. 14403 This is used by `org-read-date' in a temporary keymap for the calendar buffer." 14404 (interactive) 14405 (when (calendar-cursor-to-date) 14406 (let* ((date (calendar-cursor-to-date)) 14407 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 14408 (setq org-ans1 (format-time-string "%Y-%m-%d" time))) 14409 (when (active-minibuffer-window) (exit-minibuffer)))) 14410 14411 (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) 14412 "Insert a date stamp for the date given by the internal TIME. 14413 See `format-time-string' for the format of TIME. 14414 WITH-HM means use the stamp format that includes the time of the day. 14415 INACTIVE means use square brackets instead of angular ones, so that the 14416 stamp will not contribute to the agenda. 14417 PRE and POST are optional strings to be inserted before and after the 14418 stamp. 14419 The command returns the inserted time stamp." 14420 (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) 14421 stamp) 14422 (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) 14423 (insert-before-markers (or pre "")) 14424 (when (listp extra) 14425 (setq extra (car extra)) 14426 (if (and (stringp extra) 14427 (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) 14428 (setq extra (format "-%02d:%02d" 14429 (string-to-number (match-string 1 extra)) 14430 (string-to-number (match-string 2 extra)))) 14431 (setq extra nil))) 14432 (when extra 14433 (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) 14434 (insert-before-markers (setq stamp (format-time-string fmt time))) 14435 (insert-before-markers (or post "")) 14436 (setq org-last-inserted-timestamp stamp))) 14437 14438 (defun org-toggle-time-stamp-overlays () 14439 "Toggle the use of custom time stamp formats." 14440 (interactive) 14441 (setq org-display-custom-times (not org-display-custom-times)) 14442 (unless org-display-custom-times 14443 (let ((p (point-min)) (bmp (buffer-modified-p))) 14444 (while (setq p (next-single-property-change p 'display)) 14445 (when (and (get-text-property p 'display) 14446 (eq (get-text-property p 'face) 'org-date)) 14447 (remove-text-properties 14448 p (setq p (next-single-property-change p 'display)) 14449 '(display t)))) 14450 (set-buffer-modified-p bmp))) 14451 (org-restart-font-lock) 14452 (setq org-table-may-need-update t) 14453 (if org-display-custom-times 14454 (message "Time stamps are overlaid with custom format") 14455 (message "Time stamp overlays removed"))) 14456 14457 (defun org-display-custom-time (beg end) 14458 "Overlay modified time stamp format over timestamp between BEG and END." 14459 (let* ((ts (buffer-substring beg end)) 14460 t1 with-hm tf time str (off 0)) 14461 (save-match-data 14462 (setq t1 (org-parse-time-string ts t)) 14463 (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) 14464 (setq off (- (match-end 0) (match-beginning 0))))) 14465 (setq end (- end off)) 14466 (setq with-hm (and (nth 1 t1) (nth 2 t1)) 14467 tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats) 14468 time (org-fix-decoded-time t1) 14469 str (org-add-props 14470 (format-time-string 14471 (substring tf 1 -1) (apply 'encode-time time)) 14472 nil 'mouse-face 'highlight)) 14473 (put-text-property beg end 'display str))) 14474 14475 (defun org-fix-decoded-time (time) 14476 "Set 0 instead of nil for the first 6 elements of time. 14477 Don't touch the rest." 14478 (let ((n 0)) 14479 (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) 14480 14481 (defun org-time-stamp-to-now (timestamp-string &optional seconds) 14482 "Difference between TIMESTAMP-STRING and now in days. 14483 If SECONDS is non-nil, return the difference in seconds." 14484 (let ((fdiff (if seconds #'float-time #'time-to-days))) 14485 (- (funcall fdiff (org-time-string-to-time timestamp-string)) 14486 (funcall fdiff nil)))) 14487 14488 (defun org-deadline-close-p (timestamp-string &optional ndays) 14489 "Is the time in TIMESTAMP-STRING close to the current date?" 14490 (setq ndays (or ndays (org-get-wdays timestamp-string))) 14491 (and (<= (org-time-stamp-to-now timestamp-string) ndays) 14492 (not (org-entry-is-done-p)))) 14493 14494 (defun org-get-wdays (ts &optional delay zero-delay) 14495 "Get the deadline lead time appropriate for timestring TS. 14496 When DELAY is non-nil, get the delay time for scheduled items 14497 instead of the deadline lead time. When ZERO-DELAY is non-nil 14498 and `org-scheduled-delay-days' is 0, enforce 0 as the delay, 14499 don't try to find the delay cookie in the scheduled timestamp." 14500 (let ((tv (if delay org-scheduled-delay-days 14501 org-deadline-warning-days))) 14502 (cond 14503 ((or (and delay (< tv 0)) 14504 (and delay zero-delay (<= tv 0)) 14505 (and (not delay) (<= tv 0))) 14506 ;; Enforce this value no matter what 14507 (- tv)) 14508 ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) 14509 ;; lead time is specified. 14510 (floor (* (string-to-number (match-string 1 ts)) 14511 (cdr (assoc (match-string 2 ts) 14512 '(("d" . 1) ("w" . 7) 14513 ("m" . 30.4) ("y" . 365.25) 14514 ("h" . 0.041667))))))) 14515 ;; go for the default. 14516 (t tv)))) 14517 14518 (defun org-calendar-select-mouse (ev) 14519 "Return to `org-read-date' with the date currently selected. 14520 This is used by `org-read-date' in a temporary keymap for the calendar buffer." 14521 (interactive "e") 14522 (mouse-set-point ev) 14523 (when (calendar-cursor-to-date) 14524 (let* ((date (calendar-cursor-to-date)) 14525 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 14526 (setq org-ans1 (format-time-string "%Y-%m-%d" time))) 14527 (when (active-minibuffer-window) (exit-minibuffer)))) 14528 14529 (defun org-check-deadlines (ndays) 14530 "Check if there are any deadlines due or past due. 14531 A deadline is considered due if it happens within `org-deadline-warning-days' 14532 days from today's date. If the deadline appears in an entry marked DONE, 14533 it is not shown. A numeric prefix argument NDAYS can be used to test that 14534 many days. If the prefix is a raw `\\[universal-argument]', all deadlines \ 14535 are shown." 14536 (interactive "P") 14537 (let* ((org-warn-days 14538 (cond 14539 ((equal ndays '(4)) 100000) 14540 (ndays (prefix-numeric-value ndays)) 14541 (t (abs org-deadline-warning-days)))) 14542 (case-fold-search nil) 14543 (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) 14544 (callback 14545 (lambda () (org-deadline-close-p (match-string 1) org-warn-days)))) 14546 (message "%d deadlines past-due or due within %d days" 14547 (org-occur regexp nil callback) 14548 org-warn-days))) 14549 14550 (defsubst org-re-timestamp (type) 14551 "Return a regexp for timestamp TYPE. 14552 Allowed values for TYPE are: 14553 14554 all: all timestamps 14555 active: only active timestamps (<...>) 14556 inactive: only inactive timestamps ([...]) 14557 scheduled: only scheduled timestamps 14558 deadline: only deadline timestamps 14559 closed: only closed time-stamps 14560 14561 When TYPE is nil, fall back on returning a regexp that matches 14562 both scheduled and deadline timestamps." 14563 (cl-case type 14564 (all org-ts-regexp-both) 14565 (active org-ts-regexp) 14566 (inactive org-ts-regexp-inactive) 14567 (scheduled org-scheduled-time-regexp) 14568 (deadline org-deadline-time-regexp) 14569 (closed org-closed-time-regexp) 14570 (otherwise 14571 (concat "\\<" 14572 (regexp-opt (list org-deadline-string org-scheduled-string)) 14573 " *<\\([^>]+\\)>")))) 14574 14575 (defun org-check-before-date (d) 14576 "Check if there are deadlines or scheduled entries before date D." 14577 (interactive (list (org-read-date))) 14578 (let* ((case-fold-search nil) 14579 (regexp (org-re-timestamp org-ts-type)) 14580 (ts-type org-ts-type) 14581 (callback 14582 (lambda () 14583 (let ((match (match-string 1))) 14584 (and (if (memq ts-type '(active inactive all)) 14585 (eq (org-element-type (save-excursion 14586 (backward-char) 14587 (org-element-context))) 14588 'timestamp) 14589 (org-at-planning-p)) 14590 (time-less-p 14591 (org-time-string-to-time match) 14592 (org-time-string-to-time d))))))) 14593 (message "%d entries before %s" 14594 (org-occur regexp nil callback) 14595 d))) 14596 14597 (defun org-check-after-date (d) 14598 "Check if there are deadlines or scheduled entries after date D." 14599 (interactive (list (org-read-date))) 14600 (let* ((case-fold-search nil) 14601 (regexp (org-re-timestamp org-ts-type)) 14602 (ts-type org-ts-type) 14603 (callback 14604 (lambda () 14605 (let ((match (match-string 1))) 14606 (and (if (memq ts-type '(active inactive all)) 14607 (eq (org-element-type (save-excursion 14608 (backward-char) 14609 (org-element-context))) 14610 'timestamp) 14611 (org-at-planning-p)) 14612 (not (time-less-p 14613 (org-time-string-to-time match) 14614 (org-time-string-to-time d)))))))) 14615 (message "%d entries after %s" 14616 (org-occur regexp nil callback) 14617 d))) 14618 14619 (defun org-check-dates-range (start-date end-date) 14620 "Check for deadlines/scheduled entries between START-DATE and END-DATE." 14621 (interactive (list (org-read-date nil nil nil "Range starts") 14622 (org-read-date nil nil nil "Range end"))) 14623 (let ((case-fold-search nil) 14624 (regexp (org-re-timestamp org-ts-type)) 14625 (callback 14626 (let ((type org-ts-type)) 14627 (lambda () 14628 (let ((match (match-string 1))) 14629 (and 14630 (if (memq type '(active inactive all)) 14631 (eq (org-element-type (save-excursion 14632 (backward-char) 14633 (org-element-context))) 14634 'timestamp) 14635 (org-at-planning-p)) 14636 (not (time-less-p 14637 (org-time-string-to-time match) 14638 (org-time-string-to-time start-date))) 14639 (time-less-p 14640 (org-time-string-to-time match) 14641 (org-time-string-to-time end-date)))))))) 14642 (message "%d entries between %s and %s" 14643 (org-occur regexp nil callback) start-date end-date))) 14644 14645 (defun org-evaluate-time-range (&optional to-buffer) 14646 "Evaluate a time range by computing the difference between start and end. 14647 Normally the result is just printed in the echo area, but with prefix arg 14648 TO-BUFFER, the result is inserted just after the date stamp into the buffer. 14649 If the time range is actually in a table, the result is inserted into the 14650 next column. 14651 For time difference computation, a year is assumed to be exactly 365 14652 days in order to avoid rounding problems." 14653 (interactive "P") 14654 (or 14655 (org-clock-update-time-maybe) 14656 (save-excursion 14657 (unless (org-at-date-range-p t) 14658 (goto-char (point-at-bol)) 14659 (re-search-forward org-tr-regexp-both (point-at-eol) t)) 14660 (unless (org-at-date-range-p t) 14661 (user-error "Not at a time-stamp range, and none found in current line"))) 14662 (let* ((ts1 (match-string 1)) 14663 (ts2 (match-string 2)) 14664 (havetime (or (> (length ts1) 15) (> (length ts2) 15))) 14665 (match-end (match-end 0)) 14666 (time1 (org-time-string-to-time ts1)) 14667 (time2 (org-time-string-to-time ts2)) 14668 (diff (abs (float-time (time-subtract time2 time1)))) 14669 (negative (time-less-p time2 time1)) 14670 ;; (ys (floor (* 365 24 60 60))) 14671 (ds (* 24 60 60)) 14672 (hs (* 60 60)) 14673 (fy "%dy %dd %02d:%02d") 14674 (fy1 "%dy %dd") 14675 (fd "%dd %02d:%02d") 14676 (fd1 "%dd") 14677 (fh "%02d:%02d") 14678 y d h m align) 14679 (if havetime 14680 (setq ; y (floor diff ys) diff (mod diff ys) 14681 y 0 14682 d (floor diff ds) diff (mod diff ds) 14683 h (floor diff hs) diff (mod diff hs) 14684 m (floor diff 60)) 14685 (setq ; y (floor diff ys) diff (mod diff ys) 14686 y 0 14687 d (round diff ds) 14688 h 0 m 0)) 14689 (if (not to-buffer) 14690 (message "%s" (org-make-tdiff-string y d h m)) 14691 (if (org-at-table-p) 14692 (progn 14693 (goto-char match-end) 14694 (setq align t) 14695 (and (looking-at " *|") (goto-char (match-end 0)))) 14696 (goto-char match-end)) 14697 (when (looking-at 14698 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") 14699 (replace-match "")) 14700 (when negative (insert " -")) 14701 (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) 14702 (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) 14703 (insert " " (format fh h m)))) 14704 (when align (org-table-align)) 14705 (message "Time difference inserted"))))) 14706 14707 (defun org-make-tdiff-string (y d h m) 14708 (let ((fmt "") 14709 (l nil)) 14710 (when (> y 0) 14711 (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ")) 14712 (push y l)) 14713 (when (> d 0) 14714 (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ")) 14715 (push d l)) 14716 (when (> h 0) 14717 (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ")) 14718 (push h l)) 14719 (when (> m 0) 14720 (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ")) 14721 (push m l)) 14722 (apply 'format fmt (nreverse l)))) 14723 14724 (defun org-time-string-to-time (s) 14725 "Convert timestamp string S into internal time." 14726 (apply #'encode-time (org-parse-time-string s))) 14727 14728 (defun org-time-string-to-seconds (s) 14729 "Convert a timestamp string S into a number of seconds." 14730 (float-time (org-time-string-to-time s))) 14731 14732 (org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp") 14733 14734 (defun org-time-string-to-absolute (s &optional daynr prefer buffer pos) 14735 "Convert time stamp S to an absolute day number. 14736 14737 If DAYNR in non-nil, and there is a specifier for a cyclic time 14738 stamp, get the closest date to DAYNR. If PREFER is 14739 `past' (respectively `future') return a date past (respectively 14740 after) or equal to DAYNR. 14741 14742 POS is the location of time stamp S, as a buffer position in 14743 BUFFER. 14744 14745 Diary sexp timestamps are matched against DAYNR, when non-nil. 14746 If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is 14747 signaled." 14748 (cond 14749 ((string-match "\\`%%\\((.*)\\)" s) 14750 ;; Sexp timestamp: try to match DAYNR, if available, since we're 14751 ;; only able to match individual dates. If it fails, raise an 14752 ;; error. 14753 (if (and daynr 14754 (org-diary-sexp-entry 14755 (match-string 1 s) "" (calendar-gregorian-from-absolute daynr))) 14756 daynr 14757 (signal 'org-diary-sexp-no-match (list s)))) 14758 (daynr (org-closest-date s daynr prefer)) 14759 (t (time-to-days 14760 (condition-case errdata 14761 (org-time-string-to-time s) 14762 (error (error "Bad timestamp `%s'%s\nError was: %s" 14763 s 14764 (if (not (and buffer pos)) "" 14765 (format-message " at %d in buffer `%s'" pos buffer)) 14766 (cdr errdata)))))))) 14767 14768 (defun org-days-to-iso-week (days) 14769 "Return the ISO week number." 14770 (require 'cal-iso) 14771 (car (calendar-iso-from-absolute days))) 14772 14773 (defun org-small-year-to-year (year) 14774 "Convert 2-digit years into 4-digit years. 14775 YEAR is expanded into one of the 30 next years, if possible, or 14776 into a past one. Any year larger than 99 is returned unchanged." 14777 (if (>= year 100) year 14778 (let* ((current (string-to-number (format-time-string "%Y"))) 14779 (century (/ current 100)) 14780 (offset (- year (% current 100)))) 14781 (cond ((> offset 30) (+ (* (1- century) 100) year)) 14782 ((> offset -70) (+ (* century 100) year)) 14783 (t (+ (* (1+ century) 100) year)))))) 14784 14785 (defun org-time-from-absolute (d) 14786 "Return the time corresponding to date D. 14787 D may be an absolute day number, or a calendar-type list (month day year)." 14788 (when (numberp d) (setq d (calendar-gregorian-from-absolute d))) 14789 (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) 14790 14791 (defvar org-agenda-current-date) 14792 (defun org-calendar-holiday () 14793 "List of holidays, for Diary display in Org mode." 14794 (require 'holidays) 14795 (let ((hl (calendar-check-holidays org-agenda-current-date))) 14796 (and hl (mapconcat #'identity hl "; ")))) 14797 14798 (defun org-diary-sexp-entry (sexp entry d) 14799 "Process a SEXP diary ENTRY for date D." 14800 (require 'diary-lib) 14801 ;; `org-anniversary' and alike expect ENTRY and DATE to be bound 14802 ;; dynamically. 14803 (let* ((sexp `(let ((entry ,entry) 14804 (date ',d)) 14805 ,(car (read-from-string sexp)))) 14806 (result (if calendar-debug-sexp (eval sexp) 14807 (condition-case nil 14808 (eval sexp) 14809 (error 14810 (beep) 14811 (message "Bad sexp at line %d in %s: %s" 14812 (org-current-line) 14813 (buffer-file-name) sexp) 14814 (sleep-for 2)))))) 14815 (cond ((stringp result) (split-string result "; ")) 14816 ((and (consp result) 14817 (not (consp (cdr result))) 14818 (stringp (cdr result))) (cdr result)) 14819 ((and (consp result) 14820 (stringp (car result))) result) 14821 (result entry)))) 14822 14823 (defun org-diary-to-ical-string (frombuf) 14824 "Get iCalendar entries from diary entries in buffer FROMBUF. 14825 This uses the icalendar.el library." 14826 (let* ((tmpdir temporary-file-directory) 14827 (tmpfile (make-temp-name 14828 (expand-file-name "orgics" tmpdir))) 14829 buf rtn b e) 14830 (with-current-buffer frombuf 14831 (icalendar-export-region (point-min) (point-max) tmpfile) 14832 (setq buf (find-buffer-visiting tmpfile)) 14833 (set-buffer buf) 14834 (goto-char (point-min)) 14835 (when (re-search-forward "^BEGIN:VEVENT" nil t) 14836 (setq b (match-beginning 0))) 14837 (goto-char (point-max)) 14838 (when (re-search-backward "^END:VEVENT" nil t) 14839 (setq e (match-end 0))) 14840 (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") ""))) 14841 (kill-buffer buf) 14842 (delete-file tmpfile) 14843 rtn)) 14844 14845 (defun org-closest-date (start current prefer) 14846 "Return closest date to CURRENT starting from START. 14847 14848 CURRENT and START are both time stamps. 14849 14850 When PREFER is `past', return a date that is either CURRENT or 14851 past. When PREFER is `future', return a date that is either 14852 CURRENT or future. 14853 14854 Only time stamps with a repeater are modified. Any other time 14855 stamp stay unchanged. In any case, return value is an absolute 14856 day number." 14857 (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start)) 14858 ;; No repeater. Do not shift time stamp. 14859 (time-to-days (org-time-string-to-time start)) 14860 (let ((value (string-to-number (match-string 1 start))) 14861 (type (match-string 2 start))) 14862 (if (= 0 value) 14863 ;; Repeater with a 0-value is considered as void. 14864 (time-to-days (org-time-string-to-time start)) 14865 (let* ((base (org-date-to-gregorian start)) 14866 (target (org-date-to-gregorian current)) 14867 (sday (calendar-absolute-from-gregorian base)) 14868 (cday (calendar-absolute-from-gregorian target)) 14869 n1 n2) 14870 ;; If START is already past CURRENT, just return START. 14871 (if (<= cday sday) sday 14872 ;; Compute closest date before (N1) and closest date past 14873 ;; (N2) CURRENT. 14874 (pcase type 14875 ("h" 14876 (let ((missing-hours 14877 (mod (+ (- (* 24 (- cday sday)) 14878 (nth 2 (org-parse-time-string start))) 14879 org-extend-today-until) 14880 value))) 14881 (setf n1 (if (= missing-hours 0) cday 14882 (- cday (1+ (/ missing-hours 24))))) 14883 (setf n2 (+ cday (/ (- value missing-hours) 24))))) 14884 ((or "d" "w") 14885 (let ((value (if (equal type "w") (* 7 value) value))) 14886 (setf n1 (+ sday (* value (/ (- cday sday) value)))) 14887 (setf n2 (+ n1 value)))) 14888 ("m" 14889 (let* ((add-months 14890 (lambda (d n) 14891 ;; Add N months to gregorian date D, i.e., 14892 ;; a list (MONTH DAY YEAR). Return a valid 14893 ;; gregorian date. 14894 (let ((m (+ (nth 0 d) n))) 14895 (list (mod m 12) 14896 (nth 1 d) 14897 (+ (/ m 12) (nth 2 d)))))) 14898 (months ; Complete months to TARGET. 14899 (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base))) 14900 (- (nth 0 target) (nth 0 base)) 14901 ;; If START's day is greater than 14902 ;; TARGET's, remove incomplete month. 14903 (if (> (nth 1 target) (nth 1 base)) 0 -1)) 14904 value) 14905 value)) 14906 (before (funcall add-months base months))) 14907 (setf n1 (calendar-absolute-from-gregorian before)) 14908 (setf n2 14909 (calendar-absolute-from-gregorian 14910 (funcall add-months before value))))) 14911 (_ 14912 (let* ((d (nth 1 base)) 14913 (m (nth 0 base)) 14914 (y (nth 2 base)) 14915 (years ; Complete years to TARGET. 14916 (* (/ (- (nth 2 target) 14917 y 14918 ;; If START's month and day are 14919 ;; greater than TARGET's, remove 14920 ;; incomplete year. 14921 (if (or (> (nth 0 target) m) 14922 (and (= (nth 0 target) m) 14923 (> (nth 1 target) d))) 14924 0 14925 1)) 14926 value) 14927 value)) 14928 (before (list m d (+ y years)))) 14929 (setf n1 (calendar-absolute-from-gregorian before)) 14930 (setf n2 (calendar-absolute-from-gregorian 14931 (list m d (+ (nth 2 before) value))))))) 14932 ;; Handle PREFER parameter, if any. 14933 (cond 14934 ((eq prefer 'past) (if (= cday n2) n2 n1)) 14935 ((eq prefer 'future) (if (= cday n1) n1 n2)) 14936 (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))))))))) 14937 14938 (defun org-date-to-gregorian (d) 14939 "Turn any specification of date D into a Gregorian date for the calendar." 14940 (cond ((integerp d) (calendar-gregorian-from-absolute d)) 14941 ((and (listp d) (= (length d) 3)) d) 14942 ((stringp d) 14943 (let ((d (org-parse-time-string d))) 14944 (list (nth 4 d) (nth 3 d) (nth 5 d)))) 14945 ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d))))) 14946 14947 (defun org-timestamp-up (&optional arg) 14948 "Increase the date item at the cursor by one. 14949 If the cursor is on the year, change the year. If it is on the month, 14950 the day or the time, change that. If the cursor is on the enclosing 14951 bracket, change the timestamp type. 14952 With prefix ARG, change by that many units." 14953 (interactive "p") 14954 (org-timestamp-change (prefix-numeric-value arg) nil 'updown)) 14955 14956 (defun org-timestamp-down (&optional arg) 14957 "Decrease the date item at the cursor by one. 14958 If the cursor is on the year, change the year. If it is on the month, 14959 the day or the time, change that. If the cursor is on the enclosing 14960 bracket, change the timestamp type. 14961 With prefix ARG, change by that many units." 14962 (interactive "p") 14963 (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown)) 14964 14965 (defun org-timestamp-up-day (&optional arg) 14966 "Increase the date in the time stamp by one day. 14967 With prefix ARG, change that many days." 14968 (interactive "p") 14969 (if (and (not (org-at-timestamp-p 'lax)) 14970 (org-at-heading-p)) 14971 (org-todo 'up) 14972 (org-timestamp-change (prefix-numeric-value arg) 'day 'updown))) 14973 14974 (defun org-timestamp-down-day (&optional arg) 14975 "Decrease the date in the time stamp by one day. 14976 With prefix ARG, change that many days." 14977 (interactive "p") 14978 (if (and (not (org-at-timestamp-p 'lax)) 14979 (org-at-heading-p)) 14980 (org-todo 'down) 14981 (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) 14982 14983 (defun org-at-timestamp-p (&optional extended) 14984 "Non-nil if point is inside a timestamp. 14985 14986 By default, the function only consider syntactically valid active 14987 timestamps. However, the caller may have a broader definition 14988 for timestamps. As a consequence, optional argument EXTENDED can 14989 be set to the following values 14990 14991 `inactive' 14992 14993 Include also syntactically valid inactive timestamps. 14994 14995 `agenda' 14996 14997 Include timestamps allowed in Agenda, i.e., those in 14998 properties drawers, planning lines and clock lines. 14999 15000 `lax' 15001 15002 Ignore context. The function matches any part of the 15003 document looking like a timestamp. This includes comments, 15004 example blocks... 15005 15006 For backward-compatibility with Org 9.0, every other non-nil 15007 value is equivalent to `inactive'. 15008 15009 When at a timestamp, return the position of the point as a symbol 15010 among `bracket', `after', `year', `month', `hour', `minute', 15011 `day' or a number of character from the last know part of the 15012 time stamp. 15013 15014 When matching, the match groups are the following: 15015 group 1: year 15016 group 2: month 15017 group 3: day number 15018 group 4: day name 15019 group 5: hours, if any 15020 group 6: minutes, if any" 15021 (let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2)) 15022 (pos (point)) 15023 (match? 15024 (let ((boundaries (org-in-regexp regexp))) 15025 (save-match-data 15026 (cond ((null boundaries) nil) 15027 ((eq extended 'lax) t) 15028 (t 15029 (or (and (eq extended 'agenda) 15030 (or (org-at-planning-p) 15031 (org-at-property-p) 15032 (and (bound-and-true-p 15033 org-agenda-include-inactive-timestamps) 15034 (org-at-clock-log-p)))) 15035 (eq 'timestamp 15036 (save-excursion 15037 (when (= pos (cdr boundaries)) (forward-char -1)) 15038 (org-element-type (org-element-context))))))))))) 15039 (cond 15040 ((not match?) nil) 15041 ((= pos (match-beginning 0)) 'bracket) 15042 ;; Distinguish location right before the closing bracket from 15043 ;; right after it. 15044 ((= pos (1- (match-end 0))) 'bracket) 15045 ((= pos (match-end 0)) 'after) 15046 ((org-pos-in-match-range pos 2) 'year) 15047 ((org-pos-in-match-range pos 3) 'month) 15048 ((org-pos-in-match-range pos 7) 'hour) 15049 ((org-pos-in-match-range pos 8) 'minute) 15050 ((or (org-pos-in-match-range pos 4) 15051 (org-pos-in-match-range pos 5)) 'day) 15052 ((and (> pos (or (match-end 8) (match-end 5))) 15053 (< pos (match-end 0))) 15054 (- pos (or (match-end 8) (match-end 5)))) 15055 (t 'day)))) 15056 15057 (defun org-toggle-timestamp-type () 15058 "Toggle the type (<active> or [inactive]) of a time stamp." 15059 (interactive) 15060 (when (org-at-timestamp-p 'lax) 15061 (let ((beg (match-beginning 0)) (end (match-end 0)) 15062 (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]")))) 15063 (save-excursion 15064 (goto-char beg) 15065 (while (re-search-forward "[][<>]" end t) 15066 (replace-match (cdr (assoc (char-after (match-beginning 0)) map)) 15067 t t))) 15068 (message "Timestamp is now %sactive" 15069 (if (equal (char-after beg) ?<) "" "in"))))) 15070 15071 (defun org-at-clock-log-p () 15072 "Non-nil if point is on a clock log line." 15073 (and (org-match-line org-clock-line-re) 15074 (eq (org-element-type (save-match-data (org-element-at-point))) 'clock))) 15075 15076 (defvar org-clock-history) ; defined in org-clock.el 15077 (defvar org-clock-adjust-closest nil) ; defined in org-clock.el 15078 (defun org-timestamp-change (n &optional what updown suppress-tmp-delay) 15079 "Change the date in the time stamp at point. 15080 15081 The date is changed by N times WHAT. WHAT can be `day', `month', 15082 `year', `hour', or `minute'. If WHAT is not given, the cursor 15083 position in the timestamp determines what is changed. 15084 15085 When optional argument UPDOWN is non-nil, minutes are rounded 15086 according to `org-time-stamp-rounding-minutes'. 15087 15088 When SUPPRESS-TMP-DELAY is non-nil, suppress delays like 15089 \"--2d\"." 15090 (let ((origin (point)) 15091 (timestamp? (org-at-timestamp-p 'lax)) 15092 origin-cat 15093 with-hm inactive 15094 (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) 15095 extra rem 15096 ts time time0 fixnext clrgx) 15097 (unless timestamp? (user-error "Not at a timestamp")) 15098 (if (and (not what) (eq timestamp? 'bracket)) 15099 (org-toggle-timestamp-type) 15100 ;; Point isn't on brackets. Remember the part of the time-stamp 15101 ;; the point was in. Indeed, size of time-stamps may change, 15102 ;; but point must be kept in the same category nonetheless. 15103 (setq origin-cat timestamp?) 15104 (when (and (not what) (not (eq timestamp? 'day)) 15105 org-display-custom-times 15106 (get-text-property (point) 'display) 15107 (not (get-text-property (1- (point)) 'display))) 15108 (setq timestamp? 'day)) 15109 (setq timestamp? (or what timestamp?) 15110 inactive (= (char-after (match-beginning 0)) ?\[) 15111 ts (match-string 0)) 15112 (replace-match "") 15113 (when (string-match 15114 "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" 15115 ts) 15116 (setq extra (match-string 1 ts)) 15117 (when suppress-tmp-delay 15118 (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) 15119 (when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) 15120 (setq with-hm t)) 15121 (setq time0 (org-parse-time-string ts)) 15122 (when (and updown 15123 (eq timestamp? 'minute) 15124 (not current-prefix-arg)) 15125 ;; This looks like s-up and s-down. Change by one rounding step. 15126 (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) 15127 (unless (= 0 (setq rem (% (nth 1 time0) dm))) 15128 (setcar (cdr time0) (+ (nth 1 time0) 15129 (if (> n 0) (- rem) (- dm rem)))))) 15130 (setq time 15131 (apply #'encode-time 15132 (or (car time0) 0) 15133 (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0)) 15134 (+ (if (eq timestamp? 'hour) n 0) (nth 2 time0)) 15135 (+ (if (eq timestamp? 'day) n 0) (nth 3 time0)) 15136 (+ (if (eq timestamp? 'month) n 0) (nth 4 time0)) 15137 (+ (if (eq timestamp? 'year) n 0) (nth 5 time0)) 15138 (nthcdr 6 time0))) 15139 (when (and (memq timestamp? '(hour minute)) 15140 extra 15141 (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) 15142 (setq extra (org-modify-ts-extra 15143 extra 15144 (if (eq timestamp? 'hour) 2 5) 15145 n dm))) 15146 (when (integerp timestamp?) 15147 (setq extra (org-modify-ts-extra extra timestamp? n dm))) 15148 (when (eq what 'calendar) 15149 (let ((cal-date (org-get-date-from-calendar))) 15150 (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month 15151 (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day 15152 (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year 15153 (setcar time0 (or (car time0) 0)) 15154 (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) 15155 (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) 15156 (setq time (apply 'encode-time time0)))) 15157 ;; Insert the new time-stamp, and ensure point stays in the same 15158 ;; category as before (i.e. not after the last position in that 15159 ;; category). 15160 (let ((pos (point))) 15161 ;; Stay before inserted string. `save-excursion' is of no use. 15162 (setq org-last-changed-timestamp 15163 (org-insert-time-stamp time with-hm inactive nil nil extra)) 15164 (goto-char pos)) 15165 (save-match-data 15166 (looking-at org-ts-regexp3) 15167 (goto-char 15168 (pcase origin-cat 15169 ;; `day' category ends before `hour' if any, or at the end 15170 ;; of the day name. 15171 (`day (min (or (match-beginning 7) (1- (match-end 5))) origin)) 15172 (`hour (min (match-end 7) origin)) 15173 (`minute (min (1- (match-end 8)) origin)) 15174 ((pred integerp) (min (1- (match-end 0)) origin)) 15175 ;; Point was right after the time-stamp. However, the 15176 ;; time-stamp length might have changed, so refer to 15177 ;; (match-end 0) instead. 15178 (`after (match-end 0)) 15179 ;; `year' and `month' have both fixed size: point couldn't 15180 ;; have moved into another part. 15181 (_ origin)))) 15182 ;; Update clock if on a CLOCK line. 15183 (org-clock-update-time-maybe) 15184 ;; Maybe adjust the closest clock in `org-clock-history' 15185 (when org-clock-adjust-closest 15186 (if (not (and (org-at-clock-log-p) 15187 (< 1 (length (delq nil (mapcar 'marker-position 15188 org-clock-history)))))) 15189 (message "No clock to adjust") 15190 (cond ((save-excursion ; fix previous clock? 15191 (re-search-backward org-ts-regexp0 nil t) 15192 (looking-back (concat org-clock-string " \\[") 15193 (line-beginning-position))) 15194 (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$"))) 15195 ((save-excursion ; fix next clock? 15196 (re-search-backward org-ts-regexp0 nil t) 15197 (looking-at (concat org-ts-regexp0 "\\] =>"))) 15198 (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0)))) 15199 (save-window-excursion 15200 ;; Find closest clock to point, adjust the previous/next one in history 15201 (let* ((p (save-excursion (org-back-to-heading t))) 15202 (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history)) 15203 (clfixnth 15204 (+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100)))) 15205 (clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history)))) 15206 (if (not clfixpos) 15207 (message "No clock to adjust") 15208 (save-excursion 15209 (org-goto-marker-or-bmk clfixpos) 15210 (org-show-subtree) 15211 (when (re-search-forward clrgx nil t) 15212 (goto-char (match-beginning 1)) 15213 (let (org-clock-adjust-closest) 15214 (org-timestamp-change n timestamp? updown)) 15215 (message "Clock adjusted in %s for heading: %s" 15216 (file-name-nondirectory (buffer-file-name)) 15217 (org-get-heading t t))))))))) 15218 ;; Try to recenter the calendar window, if any. 15219 (when (and org-calendar-follow-timestamp-change 15220 (get-buffer-window "*Calendar*" t) 15221 (memq timestamp? '(day month year))) 15222 (org-recenter-calendar (time-to-days time)))))) 15223 15224 (defun org-modify-ts-extra (s pos n dm) 15225 "Change the different parts of the lead-time and repeat fields in timestamp." 15226 (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4))) 15227 ng h m new rem) 15228 (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s) 15229 (cond 15230 ((or (org-pos-in-match-range pos 2) 15231 (org-pos-in-match-range pos 3)) 15232 (setq m (string-to-number (match-string 3 s)) 15233 h (string-to-number (match-string 2 s))) 15234 (if (org-pos-in-match-range pos 2) 15235 (setq h (+ h n)) 15236 (setq n (* dm (with-no-warnings (cl-signum n)))) 15237 (unless (= 0 (setq rem (% m dm))) 15238 (setq m (+ m (if (> n 0) (- rem) (- dm rem))))) 15239 (setq m (+ m n))) 15240 (when (< m 0) (setq m (+ m 60) h (1- h))) 15241 (when (> m 59) (setq m (- m 60) h (1+ h))) 15242 (setq h (mod h 24)) 15243 (setq ng 1 new (format "-%02d:%02d" h m))) 15244 ((org-pos-in-match-range pos 6) 15245 (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx)))) 15246 ((org-pos-in-match-range pos 5) 15247 (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s))))))) 15248 15249 ((org-pos-in-match-range pos 9) 15250 (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx)))) 15251 ((org-pos-in-match-range pos 8) 15252 (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s)))))))) 15253 15254 (when ng 15255 (setq s (concat 15256 (substring s 0 (match-beginning ng)) 15257 new 15258 (substring s (match-end ng)))))) 15259 s)) 15260 15261 (defun org-recenter-calendar (d) 15262 "If the calendar is visible, recenter it to date D." 15263 (let ((cwin (get-buffer-window "*Calendar*" t))) 15264 (when cwin 15265 (let ((calendar-move-hook nil)) 15266 (with-selected-window cwin 15267 (calendar-goto-date 15268 (if (listp d) d (calendar-gregorian-from-absolute d)))))))) 15269 15270 (defun org-goto-calendar (&optional arg) 15271 "Go to the Emacs calendar at the current date. 15272 If there is a time stamp in the current line, go to that date. 15273 A prefix ARG can be used to force the current date." 15274 (interactive "P") 15275 (let ((calendar-move-hook nil) 15276 (calendar-view-holidays-initially-flag nil) 15277 (calendar-view-diary-initially-flag nil) 15278 diff) 15279 (when (or (org-at-timestamp-p 'lax) 15280 (org-match-line (concat ".*" org-ts-regexp))) 15281 (let ((d1 (time-to-days nil)) 15282 (d2 (time-to-days (org-time-string-to-time (match-string 1))))) 15283 (setq diff (- d2 d1)))) 15284 (calendar) 15285 (calendar-goto-today) 15286 (when (and diff (not arg)) (calendar-forward-day diff)))) 15287 15288 (defun org-get-date-from-calendar () 15289 "Return a list (month day year) of date at point in calendar." 15290 (with-current-buffer "*Calendar*" 15291 (save-match-data 15292 (calendar-cursor-to-date)))) 15293 15294 (defun org-date-from-calendar () 15295 "Insert time stamp corresponding to cursor date in *Calendar* buffer. 15296 If there is already a time stamp at the cursor position, update it." 15297 (interactive) 15298 (if (org-at-timestamp-p 'lax) 15299 (org-timestamp-change 0 'calendar) 15300 (let ((cal-date (org-get-date-from-calendar))) 15301 (org-insert-time-stamp 15302 (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) 15303 15304 (defcustom org-image-actual-width t 15305 "When non-nil, use the actual width of images when inlining them. 15306 15307 When set to a number, use imagemagick (when available) to set the 15308 image's width to this value. 15309 15310 When set to a number in a list, try to get the width from any 15311 #+ATTR.* keyword if it matches a width specification like 15312 15313 #+ATTR_HTML: :width 300px 15314 15315 and fall back on that number if none is found. 15316 15317 When set to nil, try to get the width from an #+ATTR.* keyword 15318 and fall back on the original width if none is found. 15319 15320 When set to any other non-nil value, always use the image width. 15321 15322 This requires Emacs >= 24.1, built with imagemagick support." 15323 :group 'org-appearance 15324 :version "24.4" 15325 :package-version '(Org . "8.0") 15326 :type '(choice 15327 (const :tag "Use the image width" t) 15328 (integer :tag "Use a number of pixels") 15329 (list :tag "Use #+ATTR* or a number of pixels" (integer)) 15330 (const :tag "Use #+ATTR* or don't resize" nil))) 15331 15332 (defcustom org-agenda-inhibit-startup nil 15333 "Inhibit startup when preparing agenda buffers. 15334 When this variable is t, the initialization of the Org agenda 15335 buffers is inhibited: e.g. the visibility state is not set, the 15336 tables are not re-aligned, etc." 15337 :type 'boolean 15338 :version "24.3" 15339 :group 'org-agenda) 15340 15341 (defcustom org-agenda-ignore-properties nil 15342 "Avoid updating text properties when building the agenda. 15343 Properties are used to prepare buffers for effort estimates, 15344 appointments, statistics and subtree-local categories. 15345 If you don't use these in the agenda, you can add them to this 15346 list and agenda building will be a bit faster. 15347 The value is a list, with zero or more of the symbols `effort', `appt', 15348 `stats' or `category'." 15349 :type '(set :greedy t 15350 (const effort) 15351 (const appt) 15352 (const stats) 15353 (const category)) 15354 :version "26.1" 15355 :package-version '(Org . "8.3") 15356 :group 'org-agenda) 15357 15358 ;;;; Files 15359 15360 (defun org-save-all-org-buffers () 15361 "Save all Org buffers without user confirmation." 15362 (interactive) 15363 (message "Saving all Org buffers...") 15364 (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) 15365 (when (featurep 'org-id) (org-id-locations-save)) 15366 (message "Saving all Org buffers... done")) 15367 15368 (defun org-revert-all-org-buffers () 15369 "Revert all Org buffers. 15370 Prompt for confirmation when there are unsaved changes. 15371 Be sure you know what you are doing before letting this function 15372 overwrite your changes. 15373 15374 This function is useful in a setup where one tracks Org files 15375 with a version control system, to revert on one machine after pulling 15376 changes from another. I believe the procedure must be like this: 15377 15378 1. \\[org-save-all-org-buffers] 15379 2. Pull changes from the other machine, resolve conflicts 15380 3. \\[org-revert-all-org-buffers]" 15381 (interactive) 15382 (unless (yes-or-no-p "Revert all Org buffers from their files? ") 15383 (user-error "Abort")) 15384 (save-excursion 15385 (save-window-excursion 15386 (dolist (b (buffer-list)) 15387 (when (and (with-current-buffer b (derived-mode-p 'org-mode)) 15388 (with-current-buffer b buffer-file-name)) 15389 (pop-to-buffer-same-window b) 15390 (revert-buffer t 'no-confirm))) 15391 (when (and (featurep 'org-id) org-id-track-globally) 15392 (org-id-locations-load))))) 15393 15394 ;;;; Agenda files 15395 15396 ;;;###autoload 15397 (defun org-switchb (&optional arg) 15398 "Switch between Org buffers. 15399 15400 With `\\[universal-argument]' prefix, restrict available buffers to files. 15401 15402 With `\\[universal-argument] \\[universal-argument]' \ 15403 prefix, restrict available buffers to agenda files." 15404 (interactive "P") 15405 (let ((blist (org-buffer-list 15406 (cond ((equal arg '(4)) 'files) 15407 ((equal arg '(16)) 'agenda))))) 15408 (pop-to-buffer-same-window 15409 (completing-read "Org buffer: " 15410 (mapcar #'list (mapcar #'buffer-name blist)) 15411 nil t)))) 15412 15413 (defun org-buffer-list (&optional predicate exclude-tmp) 15414 "Return a list of Org buffers. 15415 PREDICATE can be `export', `files' or `agenda'. 15416 15417 export restrict the list to Export buffers. 15418 files restrict the list to buffers visiting Org files. 15419 agenda restrict the list to buffers visiting agenda files. 15420 15421 If EXCLUDE-TMP is non-nil, ignore temporary buffers." 15422 (let* ((bfn nil) 15423 (agenda-files (and (eq predicate 'agenda) 15424 (mapcar 'file-truename (org-agenda-files t)))) 15425 (filter 15426 (cond 15427 ((eq predicate 'files) 15428 (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) 15429 ((eq predicate 'export) 15430 (lambda (b) (string-match "\\*Org .*Export" (buffer-name b)))) 15431 ((eq predicate 'agenda) 15432 (lambda (b) 15433 (with-current-buffer b 15434 (and (derived-mode-p 'org-mode) 15435 (setq bfn (buffer-file-name b)) 15436 (member (file-truename bfn) agenda-files))))) 15437 (t (lambda (b) (with-current-buffer b 15438 (or (derived-mode-p 'org-mode) 15439 (string-match "\\*Org .*Export" 15440 (buffer-name b))))))))) 15441 (delq nil 15442 (mapcar 15443 (lambda(b) 15444 (if (and (funcall filter b) 15445 (or (not exclude-tmp) 15446 (not (string-match "tmp" (buffer-name b))))) 15447 b 15448 nil)) 15449 (buffer-list))))) 15450 15451 (defun org-agenda-files (&optional unrestricted archives) 15452 "Get the list of agenda files. 15453 Optional UNRESTRICTED means return the full list even if a restriction 15454 is currently in place. 15455 When ARCHIVES is t, include all archive files that are really being 15456 used by the agenda files. If ARCHIVE is `ifmode', do this only if 15457 `org-agenda-archives-mode' is t." 15458 (let ((files 15459 (cond 15460 ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) 15461 ((stringp org-agenda-files) (org-read-agenda-file-list)) 15462 ((listp org-agenda-files) org-agenda-files) 15463 (t (error "Invalid value of `org-agenda-files'"))))) 15464 (setq files (apply 'append 15465 (mapcar (lambda (f) 15466 (if (file-directory-p f) 15467 (directory-files 15468 f t org-agenda-file-regexp) 15469 (list (expand-file-name f org-directory)))) 15470 files))) 15471 (when org-agenda-skip-unavailable-files 15472 (setq files (delq nil 15473 (mapcar (lambda (file) 15474 (and (file-readable-p file) file)) 15475 files)))) 15476 (when (or (eq archives t) 15477 (and (eq archives 'ifmode) (eq org-agenda-archives-mode t))) 15478 (setq files (org-add-archive-files files))) 15479 files)) 15480 15481 (defun org-agenda-file-p (&optional file) 15482 "Return non-nil, if FILE is an agenda file. 15483 If FILE is omitted, use the file associated with the current 15484 buffer." 15485 (let ((fname (or file (buffer-file-name)))) 15486 (and fname 15487 (member (file-truename fname) 15488 (mapcar #'file-truename (org-agenda-files t)))))) 15489 15490 (defun org-edit-agenda-file-list () 15491 "Edit the list of agenda files. 15492 Depending on setup, this either uses customize to edit the variable 15493 `org-agenda-files', or it visits the file that is holding the list. In the 15494 latter case, the buffer is set up in a way that saving it automatically kills 15495 the buffer and restores the previous window configuration." 15496 (interactive) 15497 (if (stringp org-agenda-files) 15498 (let ((cw (current-window-configuration))) 15499 (find-file org-agenda-files) 15500 (setq-local org-window-configuration cw) 15501 (add-hook 'after-save-hook 15502 (lambda () 15503 (set-window-configuration 15504 (prog1 org-window-configuration 15505 (kill-buffer (current-buffer)))) 15506 (org-install-agenda-files-menu) 15507 (message "New agenda file list installed")) 15508 nil 'local) 15509 (message "%s" (substitute-command-keys 15510 "Edit list and finish with \\[save-buffer]"))) 15511 (customize-variable 'org-agenda-files))) 15512 15513 (defun org-store-new-agenda-file-list (list) 15514 "Set new value for the agenda file list and save it correctly." 15515 (if (stringp org-agenda-files) 15516 (let ((fe (org-read-agenda-file-list t)) b u) 15517 (while (setq b (find-buffer-visiting org-agenda-files)) 15518 (kill-buffer b)) 15519 (with-temp-file org-agenda-files 15520 (insert 15521 (mapconcat 15522 (lambda (f) ;; Keep un-expanded entries. 15523 (if (setq u (assoc f fe)) 15524 (cdr u) 15525 f)) 15526 list "\n") 15527 "\n"))) 15528 (let ((org-mode-hook nil) (org-inhibit-startup t) 15529 (org-insert-mode-line-in-empty-file nil)) 15530 (setq org-agenda-files list) 15531 (customize-save-variable 'org-agenda-files org-agenda-files)))) 15532 15533 (defun org-read-agenda-file-list (&optional pair-with-expansion) 15534 "Read the list of agenda files from a file. 15535 If PAIR-WITH-EXPANSION is t return pairs with un-expanded 15536 filenames, used by `org-store-new-agenda-file-list' to write back 15537 un-expanded file names." 15538 (when (file-directory-p org-agenda-files) 15539 (error "`org-agenda-files' cannot be a single directory")) 15540 (when (stringp org-agenda-files) 15541 (with-temp-buffer 15542 (insert-file-contents org-agenda-files) 15543 (mapcar 15544 (lambda (f) 15545 (let ((e (expand-file-name (substitute-in-file-name f) 15546 org-directory))) 15547 (if pair-with-expansion 15548 (cons e f) 15549 e))) 15550 (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*"))))) 15551 15552 ;;;###autoload 15553 (defun org-cycle-agenda-files () 15554 "Cycle through the files in `org-agenda-files'. 15555 If the current buffer visits an agenda file, find the next one in the list. 15556 If the current buffer does not, find the first agenda file." 15557 (interactive) 15558 (let* ((fs (or (org-agenda-files t) 15559 (user-error "No agenda files"))) 15560 (files (copy-sequence fs)) 15561 (tcf (and buffer-file-name (file-truename buffer-file-name))) 15562 file) 15563 (when tcf 15564 (while (and (setq file (pop files)) 15565 (not (equal (file-truename file) tcf))))) 15566 (find-file (car (or files fs))) 15567 (when (buffer-base-buffer) (pop-to-buffer-same-window (buffer-base-buffer))))) 15568 15569 (defun org-agenda-file-to-front (&optional to-end) 15570 "Move/add the current file to the top of the agenda file list. 15571 If the file is not present in the list, it is added to the front. If it is 15572 present, it is moved there. With optional argument TO-END, add/move to the 15573 end of the list." 15574 (interactive "P") 15575 (let ((org-agenda-skip-unavailable-files nil) 15576 (file-alist (mapcar (lambda (x) 15577 (cons (file-truename x) x)) 15578 (org-agenda-files t))) 15579 (ctf (file-truename 15580 (or buffer-file-name 15581 (user-error "Please save the current buffer to a file")))) 15582 x had) 15583 (setq x (assoc ctf file-alist) had x) 15584 15585 (unless x (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) 15586 (if to-end 15587 (setq file-alist (append (delq x file-alist) (list x))) 15588 (setq file-alist (cons x (delq x file-alist)))) 15589 (org-store-new-agenda-file-list (mapcar 'cdr file-alist)) 15590 (org-install-agenda-files-menu) 15591 (message "File %s to %s of agenda file list" 15592 (if had "moved" "added") (if to-end "end" "front")))) 15593 15594 (defun org-remove-file (&optional file) 15595 "Remove current file from the list of files in variable `org-agenda-files'. 15596 These are the files which are being checked for agenda entries. 15597 Optional argument FILE means use this file instead of the current." 15598 (interactive) 15599 (let* ((org-agenda-skip-unavailable-files nil) 15600 (file (or file buffer-file-name 15601 (user-error "Current buffer does not visit a file"))) 15602 (true-file (file-truename file)) 15603 (afile (abbreviate-file-name file)) 15604 (files (delq nil (mapcar 15605 (lambda (x) 15606 (unless (equal true-file 15607 (file-truename x)) 15608 x)) 15609 (org-agenda-files t))))) 15610 (if (not (= (length files) (length (org-agenda-files t)))) 15611 (progn 15612 (org-store-new-agenda-file-list files) 15613 (org-install-agenda-files-menu) 15614 (message "Removed from Org Agenda list: %s" afile)) 15615 (message "File was not in list: %s (not removed)" afile)))) 15616 15617 (defun org-file-menu-entry (file) 15618 (vector file (list 'find-file file) t)) 15619 15620 (defun org-check-agenda-file (file) 15621 "Make sure FILE exists. If not, ask user what to do." 15622 (unless (file-exists-p file) 15623 (message "Non-existent agenda file %s. [R]emove from list or [A]bort?" 15624 (abbreviate-file-name file)) 15625 (let ((r (downcase (read-char-exclusive)))) 15626 (cond 15627 ((equal r ?r) 15628 (org-remove-file file) 15629 (throw 'nextfile t)) 15630 (t (user-error "Abort")))))) 15631 15632 (defun org-get-agenda-file-buffer (file) 15633 "Get an agenda buffer visiting FILE. 15634 If the buffer needs to be created, add it to the list of buffers 15635 which might be released later." 15636 (let ((buf (org-find-base-buffer-visiting file))) 15637 (if buf 15638 buf ; just return it 15639 ;; Make a new buffer and remember it 15640 (setq buf (find-file-noselect file)) 15641 (when buf (push buf org-agenda-new-buffers)) 15642 buf))) 15643 15644 (defun org-release-buffers (blist) 15645 "Release all buffers in list, asking the user for confirmation when needed. 15646 When a buffer is unmodified, it is just killed. When modified, it is saved 15647 \(if the user agrees) and then killed." 15648 (let (file) 15649 (dolist (buf blist) 15650 (setq file (buffer-file-name buf)) 15651 (when (and (buffer-modified-p buf) 15652 file 15653 (y-or-n-p (format "Save file %s? " file))) 15654 (with-current-buffer buf (save-buffer))) 15655 (kill-buffer buf)))) 15656 15657 (defun org-agenda-prepare-buffers (files) 15658 "Create buffers for all agenda files, protect archived trees and comments." 15659 (interactive) 15660 (let ((pa '(:org-archived t)) 15661 (pc '(:org-comment t)) 15662 (pall '(:org-archived t :org-comment t)) 15663 (inhibit-read-only t) 15664 (org-inhibit-startup org-agenda-inhibit-startup) 15665 (rea (org-make-tag-string (list org-archive-tag))) 15666 re pos) 15667 (setq org-tag-alist-for-agenda nil 15668 org-tag-groups-alist-for-agenda nil) 15669 (save-excursion 15670 (save-restriction 15671 (dolist (file files) 15672 (catch 'nextfile 15673 (if (bufferp file) 15674 (set-buffer file) 15675 (org-check-agenda-file file) 15676 (set-buffer (org-get-agenda-file-buffer file))) 15677 (widen) 15678 (org-set-regexps-and-options 'tags-only) 15679 (setq pos (point)) 15680 (or (memq 'category org-agenda-ignore-properties) 15681 (org-refresh-category-properties)) 15682 (or (memq 'stats org-agenda-ignore-properties) 15683 (org-refresh-stats-properties)) 15684 (or (memq 'effort org-agenda-ignore-properties) 15685 (org-refresh-effort-properties)) 15686 (or (memq 'appt org-agenda-ignore-properties) 15687 (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)) 15688 (setq org-todo-keywords-for-agenda 15689 (append org-todo-keywords-for-agenda org-todo-keywords-1)) 15690 (setq org-done-keywords-for-agenda 15691 (append org-done-keywords-for-agenda org-done-keywords)) 15692 (setq org-todo-keyword-alist-for-agenda 15693 (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) 15694 (setq org-tag-alist-for-agenda 15695 (org--tag-add-to-alist 15696 org-tag-alist-for-agenda 15697 org-current-tag-alist)) 15698 ;; Merge current file's tag groups into global 15699 ;; `org-tag-groups-alist-for-agenda'. 15700 (when org-group-tags 15701 (dolist (alist org-tag-groups-alist) 15702 (let ((old (assoc (car alist) org-tag-groups-alist-for-agenda))) 15703 (if old 15704 (setcdr old (org-uniquify (append (cdr old) (cdr alist)))) 15705 (push alist org-tag-groups-alist-for-agenda))))) 15706 (with-silent-modifications 15707 (save-excursion 15708 (remove-text-properties (point-min) (point-max) pall) 15709 (when org-agenda-skip-archived-trees 15710 (goto-char (point-min)) 15711 (while (re-search-forward rea nil t) 15712 (when (org-at-heading-p t) 15713 (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) 15714 (goto-char (point-min)) 15715 (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string)) 15716 (while (re-search-forward re nil t) 15717 (when (save-match-data (org-in-commented-heading-p t)) 15718 (add-text-properties 15719 (match-beginning 0) (org-end-of-subtree t) pc))))) 15720 (goto-char pos))))) 15721 (setq org-todo-keywords-for-agenda 15722 (org-uniquify org-todo-keywords-for-agenda)) 15723 (setq org-todo-keyword-alist-for-agenda 15724 (org-uniquify org-todo-keyword-alist-for-agenda)))) 15725 15726 15727 ;;;; CDLaTeX minor mode 15728 15729 (defvar org-cdlatex-mode-map (make-sparse-keymap) 15730 "Keymap for the minor `org-cdlatex-mode'.") 15731 15732 (org-defkey org-cdlatex-mode-map (kbd "_") #'org-cdlatex-underscore-caret) 15733 (org-defkey org-cdlatex-mode-map (kbd "^") #'org-cdlatex-underscore-caret) 15734 (org-defkey org-cdlatex-mode-map (kbd "`") #'cdlatex-math-symbol) 15735 (org-defkey org-cdlatex-mode-map (kbd "'") #'org-cdlatex-math-modify) 15736 (org-defkey org-cdlatex-mode-map (kbd "C-c {") #'org-cdlatex-environment-indent) 15737 15738 (defvar org-cdlatex-texmathp-advice-is-done nil 15739 "Flag remembering if we have applied the advice to texmathp already.") 15740 15741 (define-minor-mode org-cdlatex-mode 15742 "Toggle the minor `org-cdlatex-mode'. 15743 This mode supports entering LaTeX environment and math in LaTeX fragments 15744 in Org mode. 15745 \\{org-cdlatex-mode-map}" 15746 :lighter " OCDL" 15747 (when org-cdlatex-mode 15748 (require 'cdlatex) 15749 (run-hooks 'cdlatex-mode-hook) 15750 (cdlatex-compute-tables)) 15751 (unless org-cdlatex-texmathp-advice-is-done 15752 (setq org-cdlatex-texmathp-advice-is-done t) 15753 (defadvice texmathp (around org-math-always-on activate) 15754 "Always return t in Org buffers. 15755 This is because we want to insert math symbols without dollars even outside 15756 the LaTeX math segments. If Org mode thinks that point is actually inside 15757 an embedded LaTeX fragment, let `texmathp' do its job. 15758 `\\[org-cdlatex-mode-map]'" 15759 (interactive) 15760 (let (p) 15761 (cond 15762 ((not (derived-mode-p 'org-mode)) ad-do-it) 15763 ((eq this-command 'cdlatex-math-symbol) 15764 (setq ad-return-value t 15765 texmathp-why '("cdlatex-math-symbol in org-mode" . 0))) 15766 (t 15767 (let ((p (org-inside-LaTeX-fragment-p))) 15768 (if (and p (member (car p) (plist-get org-format-latex-options :matchers))) 15769 (setq ad-return-value t 15770 texmathp-why '("Org mode embedded math" . 0)) 15771 (when p ad-do-it))))))))) 15772 15773 (defun turn-on-org-cdlatex () 15774 "Unconditionally turn on `org-cdlatex-mode'." 15775 (org-cdlatex-mode 1)) 15776 15777 (defun org-try-cdlatex-tab () 15778 "Check if it makes sense to execute `cdlatex-tab', and do it if yes. 15779 It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is 15780 - inside a LaTeX fragment, or 15781 - after the first word in a line, where an abbreviation expansion could 15782 insert a LaTeX environment." 15783 (when org-cdlatex-mode 15784 (cond 15785 ;; Before any word on the line: No expansion possible. 15786 ((save-excursion (skip-chars-backward " \t") (bolp)) nil) 15787 ;; Just after first word on the line: Expand it. Make sure it 15788 ;; cannot happen on headlines, though. 15789 ((save-excursion 15790 (skip-chars-backward "a-zA-Z0-9*") 15791 (skip-chars-backward " \t") 15792 (and (bolp) (not (org-at-heading-p)))) 15793 (cdlatex-tab) t) 15794 ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) 15795 15796 (defun org-cdlatex-underscore-caret (&optional _arg) 15797 "Execute `cdlatex-sub-superscript' in LaTeX fragments. 15798 Revert to the normal definition outside of these fragments." 15799 (interactive "P") 15800 (if (org-inside-LaTeX-fragment-p) 15801 (call-interactively 'cdlatex-sub-superscript) 15802 (let (org-cdlatex-mode) 15803 (call-interactively (key-binding (vector last-input-event)))))) 15804 15805 (defun org-cdlatex-math-modify (&optional _arg) 15806 "Execute `cdlatex-math-modify' in LaTeX fragments. 15807 Revert to the normal definition outside of these fragments." 15808 (interactive "P") 15809 (if (org-inside-LaTeX-fragment-p) 15810 (call-interactively 'cdlatex-math-modify) 15811 (let (org-cdlatex-mode) 15812 (call-interactively (key-binding (vector last-input-event)))))) 15813 15814 (defun org-cdlatex-environment-indent (&optional environment item) 15815 "Execute `cdlatex-environment' and indent the inserted environment. 15816 15817 ENVIRONMENT and ITEM are passed to `cdlatex-environment'. 15818 15819 The inserted environment is indented to current indentation 15820 unless point is at the beginning of the line, in which the 15821 environment remains unintended." 15822 (interactive) 15823 ;; cdlatex-environment always return nil. Therefore, capture output 15824 ;; first and determine if an environment was selected. 15825 (let* ((beg (point-marker)) 15826 (end (copy-marker (point) t)) 15827 (inserted (progn 15828 (ignore-errors (cdlatex-environment environment item)) 15829 (< beg end))) 15830 ;; Figure out how many lines to move forward after the 15831 ;; environment has been inserted. 15832 (lines (when inserted 15833 (save-excursion 15834 (- (cl-loop while (< beg (point)) 15835 with x = 0 15836 do (forward-line -1) 15837 (cl-incf x) 15838 finally return x) 15839 (if (progn (goto-char beg) 15840 (and (progn (skip-chars-forward " \t") (eolp)) 15841 (progn (skip-chars-backward " \t") (bolp)))) 15842 1 0))))) 15843 (env (org-trim (delete-and-extract-region beg end)))) 15844 (when inserted 15845 ;; Get indentation of next line unless at column 0. 15846 (let ((ind (if (bolp) 0 15847 (save-excursion 15848 (org-return t) 15849 (prog1 (current-indentation) 15850 (when (progn (skip-chars-forward " \t") (eolp)) 15851 (delete-region beg (point))))))) 15852 (bol (progn (skip-chars-backward " \t") (bolp)))) 15853 ;; Insert a newline before environment unless at column zero 15854 ;; to "escape" the current line. Insert a newline if 15855 ;; something is one the same line as \end{ENVIRONMENT}. 15856 (insert 15857 (concat (unless bol "\n") env 15858 (when (and (skip-chars-forward " \t") (not (eolp))) "\n"))) 15859 (unless (zerop ind) 15860 (save-excursion 15861 (goto-char beg) 15862 (while (< (point) end) 15863 (unless (eolp) (indent-line-to ind)) 15864 (forward-line)))) 15865 (goto-char beg) 15866 (forward-line lines) 15867 (indent-line-to ind))) 15868 (set-marker beg nil) 15869 (set-marker end nil))) 15870 15871 15872 ;;;; LaTeX fragments 15873 15874 (defun org-inside-LaTeX-fragment-p () 15875 "Test if point is inside a LaTeX fragment. 15876 I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing 15877 sequence appearing also before point. 15878 Even though the matchers for math are configurable, this function assumes 15879 that \\begin, \\(, \\[, and $$ are always used. Only the single dollar 15880 delimiters are skipped when they have been removed by customization. 15881 The return value is nil, or a cons cell with the delimiter and the 15882 position of this delimiter. 15883 15884 This function does a reasonably good job, but can locally be fooled by 15885 for example currency specifications. For example it will assume being in 15886 inline math after \"$22.34\". The LaTeX fragment formatter will only format 15887 fragments that are properly closed, but during editing, we have to live 15888 with the uncertainty caused by missing closing delimiters. This function 15889 looks only before point, not after." 15890 (catch 'exit 15891 (let ((pos (point)) 15892 (dodollar (member "$" (plist-get org-format-latex-options :matchers))) 15893 (lim (progn 15894 (re-search-backward (concat "^\\(" paragraph-start "\\)") nil 15895 'move) 15896 (point))) 15897 dd-on str (start 0) m re) 15898 (goto-char pos) 15899 (when dodollar 15900 (setq str (concat (buffer-substring lim (point)) "\000 X$.") 15901 re (nth 1 (assoc "$" org-latex-regexps))) 15902 (while (string-match re str start) 15903 (cond 15904 ((= (match-end 0) (length str)) 15905 (throw 'exit (cons "$" (+ lim (match-beginning 0) 1)))) 15906 ((= (match-end 0) (- (length str) 5)) 15907 (throw 'exit nil)) 15908 (t (setq start (match-end 0)))))) 15909 (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t)) 15910 (goto-char pos) 15911 (and (match-beginning 1) (throw 'exit (cons (match-string 1) m))) 15912 (and (match-beginning 2) (throw 'exit nil)) 15913 ;; count $$ 15914 (while (re-search-backward "\\$\\$" lim t) 15915 (setq dd-on (not dd-on))) 15916 (goto-char pos) 15917 (when dd-on (cons "$$" m)))))) 15918 15919 (defun org-inside-latex-macro-p () 15920 "Is point inside a LaTeX macro or its arguments?" 15921 (save-match-data 15922 (org-in-regexp 15923 "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) 15924 15925 (defun org--make-preview-overlay (beg end image &optional imagetype) 15926 "Build an overlay between BEG and END using IMAGE file. 15927 Argument IMAGETYPE is the extension of the displayed image, 15928 as a string. It defaults to \"png\"." 15929 (let ((ov (make-overlay beg end)) 15930 (imagetype (or (intern imagetype) 'png))) 15931 (overlay-put ov 'org-overlay-type 'org-latex-overlay) 15932 (overlay-put ov 'evaporate t) 15933 (overlay-put ov 15934 'modification-hooks 15935 (list (lambda (o _flag _beg _end &optional _l) 15936 (delete-overlay o)))) 15937 (overlay-put ov 15938 'display 15939 (list 'image :type imagetype :file image :ascent 'center)))) 15940 15941 (defun org-clear-latex-preview (&optional beg end) 15942 "Remove all overlays with LaTeX fragment images in current buffer. 15943 When optional arguments BEG and END are non-nil, remove all 15944 overlays between them instead. Return a non-nil value when some 15945 overlays were removed, nil otherwise." 15946 (let ((overlays 15947 (cl-remove-if-not 15948 (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)) 15949 (overlays-in (or beg (point-min)) (or end (point-max)))))) 15950 (mapc #'delete-overlay overlays) 15951 overlays)) 15952 15953 (defun org--latex-preview-region (beg end) 15954 "Preview LaTeX fragments between BEG and END. 15955 BEG and END are buffer positions." 15956 (let ((file (buffer-file-name (buffer-base-buffer)))) 15957 (save-excursion 15958 (org-format-latex 15959 (concat org-preview-latex-image-directory "org-ltximg") 15960 beg end 15961 ;; Emacs cannot overlay images from remote hosts. Create it in 15962 ;; `temporary-file-directory' instead. 15963 (if (or (not file) (file-remote-p file)) 15964 temporary-file-directory 15965 default-directory) 15966 'overlays nil 'forbuffer org-preview-latex-default-process)))) 15967 15968 (defun org-latex-preview (&optional arg) 15969 "Toggle preview of the LaTeX fragment at point. 15970 15971 If the cursor is on a LaTeX fragment, create the image and 15972 overlay it over the source code, if there is none. Remove it 15973 otherwise. If there is no fragment at point, display images for 15974 all fragments in the current section. 15975 15976 With a `\\[universal-argument]' prefix argument ARG, clear images \ 15977 for all fragments 15978 in the current section. 15979 15980 With a `\\[universal-argument] \\[universal-argument]' prefix \ 15981 argument ARG, display image for all 15982 fragments in the buffer. 15983 15984 With a `\\[universal-argument] \\[universal-argument] \ 15985 \\[universal-argument]' prefix argument ARG, clear image for all 15986 fragments in the buffer." 15987 (interactive "P") 15988 (cond 15989 ((not (display-graphic-p)) nil) 15990 ;; Clear whole buffer. 15991 ((equal arg '(64)) 15992 (org-clear-latex-preview (point-min) (point-max)) 15993 (message "LaTeX previews removed from buffer")) 15994 ;; Preview whole buffer. 15995 ((equal arg '(16)) 15996 (message "Creating LaTeX previews in buffer...") 15997 (org--latex-preview-region (point-min) (point-max)) 15998 (message "Creating LaTeX previews in buffer... done.")) 15999 ;; Clear current section. 16000 ((equal arg '(4)) 16001 (org-clear-latex-preview 16002 (if (org-before-first-heading-p) (point-min) 16003 (save-excursion 16004 (org-with-limited-levels (org-back-to-heading t) (point)))) 16005 (org-with-limited-levels (org-entry-end-position)))) 16006 ;; Toggle preview on LaTeX code at point. 16007 ((let ((datum (org-element-context))) 16008 (and (memq (org-element-type datum) '(latex-environment latex-fragment)) 16009 (let ((beg (org-element-property :begin datum)) 16010 (end (org-element-property :end datum))) 16011 (if (org-clear-latex-preview beg end) 16012 (message "LaTeX preview removed") 16013 (message "Creating LaTeX preview...") 16014 (org--latex-preview-region beg end) 16015 (message "Creating LaTeX preview... done.")) 16016 t)))) 16017 ;; Preview current section. 16018 (t 16019 (let ((beg (if (org-before-first-heading-p) (point-min) 16020 (save-excursion 16021 (org-with-limited-levels (org-back-to-heading t) (point))))) 16022 (end (org-with-limited-levels (org-entry-end-position)))) 16023 (message "Creating LaTeX previews in section...") 16024 (org--latex-preview-region beg end) 16025 (message "Creating LaTeX previews in section... done."))))) 16026 16027 (defun org-format-latex 16028 (prefix &optional beg end dir overlays msg forbuffer processing-type) 16029 "Replace LaTeX fragments with links to an image. 16030 16031 The function takes care of creating the replacement image. 16032 16033 Only consider fragments between BEG and END when those are 16034 provided. 16035 16036 When optional argument OVERLAYS is non-nil, display the image on 16037 top of the fragment instead of replacing it. 16038 16039 PROCESSING-TYPE is the conversion method to use, as a symbol. 16040 16041 Some of the options can be changed using the variable 16042 `org-format-latex-options', which see." 16043 (when (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) 16044 (unless (eq processing-type 'verbatim) 16045 (let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}") 16046 (cnt 0) 16047 checkdir-flag) 16048 (goto-char (or beg (point-min))) 16049 ;; Optimize overlay creation: (info "(elisp) Managing Overlays"). 16050 (when (and overlays (memq processing-type '(dvipng imagemagick))) 16051 (overlay-recenter (or end (point-max)))) 16052 (while (re-search-forward math-regexp end t) 16053 (unless (and overlays 16054 (eq (get-char-property (point) 'org-overlay-type) 16055 'org-latex-overlay)) 16056 (let* ((context (org-element-context)) 16057 (type (org-element-type context))) 16058 (when (memq type '(latex-environment latex-fragment)) 16059 (let ((block-type (eq type 'latex-environment)) 16060 (value (org-element-property :value context)) 16061 (beg (org-element-property :begin context)) 16062 (end (save-excursion 16063 (goto-char (org-element-property :end context)) 16064 (skip-chars-backward " \r\t\n") 16065 (point)))) 16066 (cond 16067 ((eq processing-type 'mathjax) 16068 ;; Prepare for MathJax processing. 16069 (if (not (string-match "\\`\\$\\$?" value)) 16070 (goto-char end) 16071 (delete-region beg end) 16072 (if (string= (match-string 0 value) "$$") 16073 (insert "\\[" (substring value 2 -2) "\\]") 16074 (insert "\\(" (substring value 1 -1) "\\)")))) 16075 ((eq processing-type 'html) 16076 (goto-char beg) 16077 (delete-region beg end) 16078 (insert (org-format-latex-as-html value))) 16079 ((assq processing-type org-preview-latex-process-alist) 16080 ;; Process to an image. 16081 (cl-incf cnt) 16082 (goto-char beg) 16083 (let* ((processing-info 16084 (cdr (assq processing-type org-preview-latex-process-alist))) 16085 (face (face-at-point)) 16086 ;; Get the colors from the face at point. 16087 (fg 16088 (let ((color (plist-get org-format-latex-options 16089 :foreground))) 16090 (if forbuffer 16091 (cond 16092 ((eq color 'auto) 16093 (face-attribute face :foreground nil 'default)) 16094 ((eq color 'default) 16095 (face-attribute 'default :foreground nil)) 16096 (t color)) 16097 color))) 16098 (bg 16099 (let ((color (plist-get org-format-latex-options 16100 :background))) 16101 (if forbuffer 16102 (cond 16103 ((eq color 'auto) 16104 (face-attribute face :background nil 'default)) 16105 ((eq color 'default) 16106 (face-attribute 'default :background nil)) 16107 (t color)) 16108 color))) 16109 (hash (sha1 (prin1-to-string 16110 (list org-format-latex-header 16111 org-latex-default-packages-alist 16112 org-latex-packages-alist 16113 org-format-latex-options 16114 forbuffer value fg bg)))) 16115 (imagetype (or (plist-get processing-info :image-output-type) "png")) 16116 (absprefix (expand-file-name prefix dir)) 16117 (linkfile (format "%s_%s.%s" prefix hash imagetype)) 16118 (movefile (format "%s_%s.%s" absprefix hash imagetype)) 16119 (sep (and block-type "\n\n")) 16120 (link (concat sep "[[file:" linkfile "]]" sep)) 16121 (options 16122 (org-combine-plists 16123 org-format-latex-options 16124 `(:foreground ,fg :background ,bg)))) 16125 (when msg (message msg cnt)) 16126 (unless checkdir-flag ; Ensure the directory exists. 16127 (setq checkdir-flag t) 16128 (let ((todir (file-name-directory absprefix))) 16129 (unless (file-directory-p todir) 16130 (make-directory todir t)))) 16131 (unless (file-exists-p movefile) 16132 (org-create-formula-image 16133 value movefile options forbuffer processing-type)) 16134 (if overlays 16135 (progn 16136 (dolist (o (overlays-in beg end)) 16137 (when (eq (overlay-get o 'org-overlay-type) 16138 'org-latex-overlay) 16139 (delete-overlay o))) 16140 (org--make-preview-overlay beg end movefile imagetype) 16141 (goto-char end)) 16142 (delete-region beg end) 16143 (insert 16144 (org-add-props link 16145 (list 'org-latex-src 16146 (replace-regexp-in-string "\"" "" value) 16147 'org-latex-src-embed-type 16148 (if block-type 'paragraph 'character))))))) 16149 ((eq processing-type 'mathml) 16150 ;; Process to MathML. 16151 (unless (org-format-latex-mathml-available-p) 16152 (user-error "LaTeX to MathML converter not configured")) 16153 (cl-incf cnt) 16154 (when msg (message msg cnt)) 16155 (goto-char beg) 16156 (delete-region beg end) 16157 (insert (org-format-latex-as-mathml 16158 value block-type prefix dir))) 16159 (t 16160 (error "Unknown conversion process %s for LaTeX fragments" 16161 processing-type))))))))))) 16162 16163 (defun org-create-math-formula (latex-frag &optional mathml-file) 16164 "Convert LATEX-FRAG to MathML and store it in MATHML-FILE. 16165 Use `org-latex-to-mathml-convert-command'. If the conversion is 16166 successful, return the portion between \"<math...> </math>\" 16167 elements otherwise return nil. When MATHML-FILE is specified, 16168 write the results in to that file. When invoked as an 16169 interactive command, prompt for LATEX-FRAG, with initial value 16170 set to the current active region and echo the results for user 16171 inspection." 16172 (interactive (list (let ((frag (when (org-region-active-p) 16173 (buffer-substring-no-properties 16174 (region-beginning) (region-end))))) 16175 (read-string "LaTeX Fragment: " frag nil frag)))) 16176 (unless latex-frag (user-error "Invalid LaTeX fragment")) 16177 (let* ((tmp-in-file 16178 (let ((file (file-relative-name 16179 (make-temp-name (expand-file-name "ltxmathml-in"))))) 16180 (write-region latex-frag nil file) 16181 file)) 16182 (tmp-out-file (file-relative-name 16183 (make-temp-name (expand-file-name "ltxmathml-out")))) 16184 (cmd (format-spec 16185 org-latex-to-mathml-convert-command 16186 `((?j . ,(and org-latex-to-mathml-jar-file 16187 (shell-quote-argument 16188 (expand-file-name 16189 org-latex-to-mathml-jar-file)))) 16190 (?I . ,(shell-quote-argument tmp-in-file)) 16191 (?i . ,latex-frag) 16192 (?o . ,(shell-quote-argument tmp-out-file))))) 16193 mathml shell-command-output) 16194 (when (called-interactively-p 'any) 16195 (unless (org-format-latex-mathml-available-p) 16196 (user-error "LaTeX to MathML converter not configured"))) 16197 (message "Running %s" cmd) 16198 (setq shell-command-output (shell-command-to-string cmd)) 16199 (setq mathml 16200 (when (file-readable-p tmp-out-file) 16201 (with-current-buffer (find-file-noselect tmp-out-file t) 16202 (goto-char (point-min)) 16203 (when (re-search-forward 16204 (format "<math[^>]*?%s[^>]*?>\\(.\\|\n\\)*</math>" 16205 (regexp-quote 16206 "xmlns=\"http://www.w3.org/1998/Math/MathML\"")) 16207 nil t) 16208 (prog1 (match-string 0) (kill-buffer)))))) 16209 (cond 16210 (mathml 16211 (setq mathml 16212 (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml)) 16213 (when mathml-file 16214 (write-region mathml nil mathml-file)) 16215 (when (called-interactively-p 'any) 16216 (message mathml))) 16217 ((warn "LaTeX to MathML conversion failed") 16218 (message shell-command-output))) 16219 (delete-file tmp-in-file) 16220 (when (file-exists-p tmp-out-file) 16221 (delete-file tmp-out-file)) 16222 mathml)) 16223 16224 (defun org-format-latex-as-mathml (latex-frag latex-frag-type 16225 prefix &optional dir) 16226 "Use `org-create-math-formula' but check local cache first." 16227 (let* ((absprefix (expand-file-name prefix dir)) 16228 (print-length nil) (print-level nil) 16229 (formula-id (concat 16230 "formula-" 16231 (sha1 16232 (prin1-to-string 16233 (list latex-frag 16234 org-latex-to-mathml-convert-command))))) 16235 (formula-cache (format "%s-%s.mathml" absprefix formula-id)) 16236 (formula-cache-dir (file-name-directory formula-cache))) 16237 16238 (unless (file-directory-p formula-cache-dir) 16239 (make-directory formula-cache-dir t)) 16240 16241 (unless (file-exists-p formula-cache) 16242 (org-create-math-formula latex-frag formula-cache)) 16243 16244 (if (file-exists-p formula-cache) 16245 ;; Successful conversion. Return the link to MathML file. 16246 (org-add-props 16247 (format "[[file:%s]]" (file-relative-name formula-cache dir)) 16248 (list 'org-latex-src (replace-regexp-in-string "\"" "" latex-frag) 16249 'org-latex-src-embed-type (if latex-frag-type 16250 'paragraph 'character))) 16251 ;; Failed conversion. Return the LaTeX fragment verbatim 16252 latex-frag))) 16253 16254 (defun org-format-latex-as-html (latex-fragment) 16255 "Convert LATEX-FRAGMENT to HTML. 16256 This uses `org-latex-to-html-convert-command', which see." 16257 (let ((cmd (format-spec org-latex-to-html-convert-command 16258 `((?i . ,latex-fragment))))) 16259 (message "Running %s" cmd) 16260 (shell-command-to-string cmd))) 16261 16262 (defun org--get-display-dpi () 16263 "Get the DPI of the display. 16264 The function assumes that the display has the same pixel width in 16265 the horizontal and vertical directions." 16266 (if (display-graphic-p) 16267 (round (/ (display-pixel-height) 16268 (/ (display-mm-height) 25.4))) 16269 (error "Attempt to calculate the dpi of a non-graphic display"))) 16270 16271 (defun org-create-formula-image 16272 (string tofile options buffer &optional processing-type) 16273 "Create an image from LaTeX source using external processes. 16274 16275 The LaTeX STRING is saved to a temporary LaTeX file, then 16276 converted to an image file by process PROCESSING-TYPE defined in 16277 `org-preview-latex-process-alist'. A nil value defaults to 16278 `org-preview-latex-default-process'. 16279 16280 The generated image file is eventually moved to TOFILE. 16281 16282 The OPTIONS argument controls the size, foreground color and 16283 background color of the generated image. 16284 16285 When BUFFER non-nil, this function is used for LaTeX previewing. 16286 Otherwise, it is used to deal with LaTeX snippets showed in 16287 a HTML file." 16288 (let* ((processing-type (or processing-type 16289 org-preview-latex-default-process)) 16290 (processing-info 16291 (cdr (assq processing-type org-preview-latex-process-alist))) 16292 (programs (plist-get processing-info :programs)) 16293 (error-message (or (plist-get processing-info :message) "")) 16294 (image-input-type (plist-get processing-info :image-input-type)) 16295 (image-output-type (plist-get processing-info :image-output-type)) 16296 (post-clean (or (plist-get processing-info :post-clean) 16297 '(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log" 16298 ".svg" ".png" ".jpg" ".jpeg" ".out"))) 16299 (latex-header 16300 (or (plist-get processing-info :latex-header) 16301 (org-latex-make-preamble 16302 (org-export-get-environment (org-export-get-backend 'latex)) 16303 org-format-latex-header 16304 'snippet))) 16305 (latex-compiler (plist-get processing-info :latex-compiler)) 16306 (image-converter (plist-get processing-info :image-converter)) 16307 (tmpdir temporary-file-directory) 16308 (texfilebase (make-temp-name 16309 (expand-file-name "orgtex" tmpdir))) 16310 (texfile (concat texfilebase ".tex")) 16311 (image-size-adjust (or (plist-get processing-info :image-size-adjust) 16312 '(1.0 . 1.0))) 16313 (scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust)) 16314 (or (plist-get options (if buffer :scale :html-scale)) 1.0))) 16315 (dpi (* scale (if buffer (org--get-display-dpi) 140.0))) 16316 (fg (or (plist-get options (if buffer :foreground :html-foreground)) 16317 "Black")) 16318 (bg (or (plist-get options (if buffer :background :html-background)) 16319 "Transparent")) 16320 (log-buf (get-buffer-create "*Org Preview LaTeX Output*")) 16321 (resize-mini-windows nil)) ;Fix Emacs flicker when creating image. 16322 (dolist (program programs) 16323 (org-check-external-command program error-message)) 16324 (if (eq fg 'default) 16325 (setq fg (org-latex-color :foreground)) 16326 (setq fg (org-latex-color-format fg))) 16327 (setq bg (cond 16328 ((eq bg 'default) (org-latex-color :background)) 16329 ((string= bg "Transparent") nil) 16330 (t (org-latex-color-format bg)))) 16331 ;; Remove TeX \par at end of snippet to avoid trailing space. 16332 (if (string-suffix-p string "\n") 16333 (aset string (1- (length string)) ?%) 16334 (setq string (concat string "%"))) 16335 (with-temp-file texfile 16336 (insert latex-header) 16337 (insert "\n\\begin{document}\n" 16338 "\\definecolor{fg}{rgb}{" fg "}%\n" 16339 (if bg 16340 (concat "\\definecolor{bg}{rgb}{" bg "}%\n" 16341 "\n\\pagecolor{bg}%\n") 16342 "") 16343 "\n{\\color{fg}\n" 16344 string 16345 "\n}\n" 16346 "\n\\end{document}\n")) 16347 (let* ((err-msg (format "Please adjust `%s' part of \ 16348 `org-preview-latex-process-alist'." 16349 processing-type)) 16350 (image-input-file 16351 (org-compile-file 16352 texfile latex-compiler image-input-type err-msg log-buf)) 16353 (image-output-file 16354 (org-compile-file 16355 image-input-file image-converter image-output-type err-msg log-buf 16356 `((?D . ,(shell-quote-argument (format "%s" dpi))) 16357 (?S . ,(shell-quote-argument (format "%s" (/ dpi 140.0)))))))) 16358 (copy-file image-output-file tofile 'replace) 16359 (dolist (e post-clean) 16360 (when (file-exists-p (concat texfilebase e)) 16361 (delete-file (concat texfilebase e)))) 16362 image-output-file))) 16363 16364 (defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) 16365 "Fill a LaTeX header template TPL. 16366 In the template, the following place holders will be recognized: 16367 16368 [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG 16369 [NO-DEFAULT-PACKAGES] do not include DEF-PKG 16370 [PACKAGES] \\usepackage statements for PKG 16371 [NO-PACKAGES] do not include PKG 16372 [EXTRA] the string EXTRA 16373 [NO-EXTRA] do not include EXTRA 16374 16375 For backward compatibility, if both the positive and the negative place 16376 holder is missing, the positive one (without the \"NO-\") will be 16377 assumed to be present at the end of the template. 16378 DEF-PKG and PKG are assumed to be alists of options/packagename lists. 16379 EXTRA is a string. 16380 SNIPPETS-P indicates if this is run to create snippet images for HTML." 16381 (let (rpl (end "")) 16382 (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl) 16383 (setq rpl (if (or (match-end 1) (not def-pkg)) 16384 "" (org-latex-packages-to-string def-pkg snippets-p t)) 16385 tpl (replace-match rpl t t tpl)) 16386 (when def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) 16387 16388 (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl) 16389 (setq rpl (if (or (match-end 1) (not pkg)) 16390 "" (org-latex-packages-to-string pkg snippets-p t)) 16391 tpl (replace-match rpl t t tpl)) 16392 (when pkg (setq end 16393 (concat end "\n" 16394 (org-latex-packages-to-string pkg snippets-p))))) 16395 16396 (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl) 16397 (setq rpl (if (or (match-end 1) (not extra)) 16398 "" (concat extra "\n")) 16399 tpl (replace-match rpl t t tpl)) 16400 (when (and extra (string-match "\\S-" extra)) 16401 (setq end (concat end "\n" extra)))) 16402 16403 (if (string-match "\\S-" end) 16404 (concat tpl "\n" end) 16405 tpl))) 16406 16407 (defun org-latex-packages-to-string (pkg &optional snippets-p newline) 16408 "Turn an alist of packages into a string with the \\usepackage macros." 16409 (setq pkg (mapconcat (lambda(p) 16410 (cond 16411 ((stringp p) p) 16412 ((and snippets-p (>= (length p) 3) (not (nth 2 p))) 16413 (format "%% Package %s omitted" (cadr p))) 16414 ((equal "" (car p)) 16415 (format "\\usepackage{%s}" (cadr p))) 16416 (t 16417 (format "\\usepackage[%s]{%s}" 16418 (car p) (cadr p))))) 16419 pkg 16420 "\n")) 16421 (if newline (concat pkg "\n") pkg)) 16422 16423 (defun org-dvipng-color (attr) 16424 "Return a RGB color specification for dvipng." 16425 (org-dvipng-color-format (face-attribute 'default attr nil))) 16426 16427 (defun org-dvipng-color-format (color-name) 16428 "Convert COLOR-NAME to a RGB color value for dvipng." 16429 (apply #'format "rgb %s %s %s" 16430 (mapcar 'org-normalize-color 16431 (color-values color-name)))) 16432 16433 (defun org-latex-color (attr) 16434 "Return a RGB color for the LaTeX color package." 16435 (org-latex-color-format (face-attribute 'default attr nil))) 16436 16437 (defun org-latex-color-format (color-name) 16438 "Convert COLOR-NAME to a RGB color value." 16439 (apply #'format "%s,%s,%s" 16440 (mapcar 'org-normalize-color 16441 (color-values color-name)))) 16442 16443 (defun org-normalize-color (value) 16444 "Return string to be used as color value for an RGB component." 16445 (format "%g" (/ value 65535.0))) 16446 16447 16448 ;; Image display 16449 16450 (defvar-local org-inline-image-overlays nil) 16451 16452 (defun org-toggle-inline-images (&optional include-linked) 16453 "Toggle the display of inline images. 16454 INCLUDE-LINKED is passed to `org-display-inline-images'." 16455 (interactive "P") 16456 (if org-inline-image-overlays 16457 (progn 16458 (org-remove-inline-images) 16459 (when (called-interactively-p 'interactive) 16460 (message "Inline image display turned off"))) 16461 (org-display-inline-images include-linked) 16462 (when (called-interactively-p 'interactive) 16463 (message (if org-inline-image-overlays 16464 (format "%d images displayed inline" 16465 (length org-inline-image-overlays)) 16466 "No images to display inline"))))) 16467 16468 (defun org-redisplay-inline-images () 16469 "Assure display of inline images and refresh them." 16470 (interactive) 16471 (org-toggle-inline-images) 16472 (unless org-inline-image-overlays 16473 (org-toggle-inline-images))) 16474 16475 ;; For without-x builds. 16476 (declare-function image-refresh "image" (spec &optional frame)) 16477 16478 (defcustom org-display-remote-inline-images 'skip 16479 "How to display remote inline images. 16480 Possible values of this option are: 16481 16482 skip Don't display remote images. 16483 download Always download and display remote images. 16484 cache Display remote images, and open them in separate buffers 16485 for caching. Silently update the image buffer when a file 16486 change is detected." 16487 :group 'org-appearance 16488 :package-version '(Org . "9.4") 16489 :type '(choice 16490 (const :tag "Ignore remote images" skip) 16491 (const :tag "Always display remote images" download) 16492 (const :tag "Display and silently update remote images" cache)) 16493 :safe #'symbolp) 16494 16495 (defun org--create-inline-image (file width) 16496 "Create image located at FILE, or return nil. 16497 WIDTH is the width of the image. The image may not be created 16498 according to the value of `org-display-remote-inline-images'." 16499 (let* ((remote? (file-remote-p file)) 16500 (file-or-data 16501 (pcase org-display-remote-inline-images 16502 ((guard (not remote?)) file) 16503 (`download (with-temp-buffer 16504 (set-buffer-multibyte nil) 16505 (insert-file-contents-literally file) 16506 (buffer-string))) 16507 (`cache (let ((revert-without-query '("."))) 16508 (with-current-buffer (find-file-noselect file) 16509 (buffer-string)))) 16510 (`skip nil) 16511 (other 16512 (message "Invalid value of `org-display-remote-inline-images': %S" 16513 other) 16514 nil)))) 16515 (when file-or-data 16516 (create-image file-or-data 16517 (and (image-type-available-p 'imagemagick) 16518 width 16519 'imagemagick) 16520 remote? 16521 :width width)))) 16522 16523 (defun org-display-inline-images (&optional include-linked refresh beg end) 16524 "Display inline images. 16525 16526 An inline image is a link which follows either of these 16527 conventions: 16528 16529 1. Its path is a file with an extension matching return value 16530 from `image-file-name-regexp' and it has no contents. 16531 16532 2. Its description consists in a single link of the previous 16533 type. In this case, that link must be a well-formed plain 16534 or angle link, i.e., it must have an explicit \"file\" type. 16535 16536 Equip each image with the key-map `image-map'. 16537 16538 When optional argument INCLUDE-LINKED is non-nil, also links with 16539 a text description part will be inlined. This can be nice for 16540 a quick look at those images, but it does not reflect what 16541 exported files will look like. 16542 16543 When optional argument REFRESH is non-nil, refresh existing 16544 images between BEG and END. This will create new image displays 16545 only if necessary. 16546 16547 BEG and END define the considered part. They default to the 16548 buffer boundaries with possible narrowing." 16549 (interactive "P") 16550 (when (display-graphic-p) 16551 (unless refresh 16552 (org-remove-inline-images) 16553 (when (fboundp 'clear-image-cache) (clear-image-cache))) 16554 (let ((end (or end (point-max)))) 16555 (org-with-point-at (or beg (point-min)) 16556 (let* ((case-fold-search t) 16557 (file-extension-re (image-file-name-regexp)) 16558 (link-abbrevs (mapcar #'car 16559 (append org-link-abbrev-alist-local 16560 org-link-abbrev-alist))) 16561 ;; Check absolute, relative file names and explicit 16562 ;; "file:" links. Also check link abbreviations since 16563 ;; some might expand to "file" links. 16564 (file-types-re 16565 (format "\\[\\[\\(?:file%s:\\|attachment:\\|[./~]\\)\\|\\]\\[\\(<?file:\\)" 16566 (if (not link-abbrevs) "" 16567 (concat "\\|" (regexp-opt link-abbrevs)))))) 16568 (while (re-search-forward file-types-re end t) 16569 (let* ((link (org-element-lineage 16570 (save-match-data (org-element-context)) 16571 '(link) t)) 16572 (linktype (org-element-property :type link)) 16573 (inner-start (match-beginning 1)) 16574 (path 16575 (cond 16576 ;; No link at point; no inline image. 16577 ((not link) nil) 16578 ;; File link without a description. Also handle 16579 ;; INCLUDE-LINKED here since it should have 16580 ;; precedence over the next case. I.e., if link 16581 ;; contains filenames in both the path and the 16582 ;; description, prioritize the path only when 16583 ;; INCLUDE-LINKED is non-nil. 16584 ((or (not (org-element-property :contents-begin link)) 16585 include-linked) 16586 (and (or (equal "file" linktype) 16587 (equal "attachment" linktype)) 16588 (org-element-property :path link))) 16589 ;; Link with a description. Check if description 16590 ;; is a filename. Even if Org doesn't have syntax 16591 ;; for those -- clickable image -- constructs, fake 16592 ;; them, as in `org-export-insert-image-links'. 16593 ((not inner-start) nil) 16594 (t 16595 (org-with-point-at inner-start 16596 (and (looking-at 16597 (if (char-equal ?< (char-after inner-start)) 16598 org-link-angle-re 16599 org-link-plain-re)) 16600 ;; File name must fill the whole 16601 ;; description. 16602 (= (org-element-property :contents-end link) 16603 (match-end 0)) 16604 (match-string 2))))))) 16605 (when (and path (string-match-p file-extension-re path)) 16606 (let ((file (if (equal "attachment" linktype) 16607 (progn 16608 (require 'org-attach) 16609 (ignore-errors (org-attach-expand path))) 16610 (expand-file-name path)))) 16611 (when (and file (file-exists-p file)) 16612 (let ((width (org-display-inline-image--width link)) 16613 (old (get-char-property-and-overlay 16614 (org-element-property :begin link) 16615 'org-image-overlay))) 16616 (if (and (car-safe old) refresh) 16617 (image-refresh (overlay-get (cdr old) 'display)) 16618 (let ((image (org--create-inline-image file width))) 16619 (when image 16620 (let ((ov (make-overlay 16621 (org-element-property :begin link) 16622 (progn 16623 (goto-char 16624 (org-element-property :end link)) 16625 (skip-chars-backward " \t") 16626 (point))))) 16627 (overlay-put ov 'display image) 16628 (overlay-put ov 'face 'default) 16629 (overlay-put ov 'org-image-overlay t) 16630 (overlay-put 16631 ov 'modification-hooks 16632 (list 'org-display-inline-remove-overlay)) 16633 (when (boundp 'image-map) 16634 (overlay-put ov 'keymap image-map)) 16635 (push ov org-inline-image-overlays)))))))))))))))) 16636 16637 (defvar visual-fill-column-width) ; Silence compiler warning 16638 (defun org-display-inline-image--width (link) 16639 "Determine the display width of the image LINK, in pixels. 16640 - When `org-image-actual-width' is t, the image's pixel width is used. 16641 - When `org-image-actual-width' is a number, that value will is used. 16642 - When `org-image-actual-width' is nil or a list, the first :width attribute 16643 set (if it exists) is used to set the image width. A width of X% is 16644 divided by 100. 16645 If no :width attribute is given and `org-image-actual-width' is a list with 16646 a number as the car, then that number is used as the default value. 16647 If the value is a float between 0 and 2, it interpreted as that proportion 16648 of the text width in the buffer." 16649 ;; Apply `org-image-actual-width' specifications. 16650 (cond 16651 ((eq org-image-actual-width t) nil) 16652 ((listp org-image-actual-width) 16653 (let* ((case-fold-search t) 16654 (par (org-element-lineage link '(paragraph))) 16655 (attr-re "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)") 16656 (par-end (org-element-property :post-affiliated par)) 16657 ;; Try to find an attribute providing a :width. 16658 (attr-width 16659 (when (and par (org-with-point-at 16660 (org-element-property :begin par) 16661 (re-search-forward attr-re par-end t))) 16662 (match-string 1))) 16663 (attr-width-val 16664 (cond 16665 ((null attr-width) nil) 16666 ((string-match-p "\\`[0-9.]+%" attr-width) 16667 (/ (string-to-number attr-width) 100.0)) 16668 (t (string-to-number attr-width)))) 16669 ;; Fallback to `org-image-actual-width' if no explicit width is given. 16670 (width (or attr-width-val (car org-image-actual-width)))) 16671 (if (and (floatp width) (<= 0.0 width 2.0)) 16672 ;; A float in [0,2] should be interpereted as this portion of 16673 ;; the text width in the window. This works well with cases like 16674 ;; #+attr_latex: :width 0.X\{line,page,column,etc.}width, 16675 ;; as the "0.X" is pulled out as a float. We use 2 as the upper 16676 ;; bound as cases such as 1.2\linewidth are feasible. 16677 (round (* width 16678 (window-pixel-width) 16679 (/ (or (and (bound-and-true-p visual-fill-column-mode) 16680 (or visual-fill-column-width auto-fill-function)) 16681 (when auto-fill-function fill-column) 16682 (window-text-width)) 16683 (float (window-total-width))))) 16684 width))) 16685 ((numberp org-image-actual-width) 16686 org-image-actual-width) 16687 (t nil))) 16688 16689 (defun org-display-inline-remove-overlay (ov after _beg _end &optional _len) 16690 "Remove inline-display overlay if a corresponding region is modified." 16691 (let ((inhibit-modification-hooks t)) 16692 (when (and ov after) 16693 (delete ov org-inline-image-overlays) 16694 (delete-overlay ov)))) 16695 16696 (defun org-remove-inline-images () 16697 "Remove inline display of images." 16698 (interactive) 16699 (mapc #'delete-overlay org-inline-image-overlays) 16700 (setq org-inline-image-overlays nil)) 16701 16702 (defvar org-self-insert-command-undo-counter 0) 16703 (defvar org-speed-command nil) 16704 16705 (defun org-self-insert-command (N) 16706 "Like `self-insert-command', use overwrite-mode for whitespace in tables. 16707 If the cursor is in a table looking at whitespace, the whitespace is 16708 overwritten, and the table is not marked as requiring realignment." 16709 (interactive "p") 16710 (org-check-before-invisible-edit 'insert) 16711 (cond 16712 ((and org-use-speed-commands 16713 (let ((kv (this-command-keys-vector))) 16714 (setq org-speed-command 16715 (run-hook-with-args-until-success 16716 'org-speed-command-hook 16717 (make-string 1 (aref kv (1- (length kv)))))))) 16718 (cond 16719 ((commandp org-speed-command) 16720 (setq this-command org-speed-command) 16721 (call-interactively org-speed-command)) 16722 ((functionp org-speed-command) 16723 (funcall org-speed-command)) 16724 ((and org-speed-command (listp org-speed-command)) 16725 (eval org-speed-command)) 16726 (t (let (org-use-speed-commands) 16727 (call-interactively 'org-self-insert-command))))) 16728 ((and 16729 (= N 1) 16730 (not (org-region-active-p)) 16731 (org-at-table-p) 16732 (progn 16733 ;; Check if we blank the field, and if that triggers align. 16734 (and (featurep 'org-table) 16735 org-table-auto-blank-field 16736 (memq last-command 16737 '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) 16738 (if (or (eq (char-after) ?\s) (looking-at "[^|\n]* |")) 16739 ;; Got extra space, this field does not determine 16740 ;; column width. 16741 (let (org-table-may-need-update) (org-table-blank-field)) 16742 ;; No extra space, this field may determine column 16743 ;; width. 16744 (org-table-blank-field))) 16745 t) 16746 (looking-at "[^|\n]* |")) 16747 ;; There is room for insertion without re-aligning the table. 16748 (self-insert-command N) 16749 (org-table-with-shrunk-field 16750 (save-excursion 16751 (skip-chars-forward "^|") 16752 ;; Do not delete last space, which is 16753 ;; `org-table-separator-space', but the regular space before 16754 ;; it. 16755 (delete-region (- (point) 2) (1- (point)))))) 16756 (t 16757 (setq org-table-may-need-update t) 16758 (self-insert-command N) 16759 (org-fix-tags-on-the-fly) 16760 (when org-self-insert-cluster-for-undo 16761 (if (not (eq last-command 'org-self-insert-command)) 16762 (setq org-self-insert-command-undo-counter 1) 16763 (if (>= org-self-insert-command-undo-counter 20) 16764 (setq org-self-insert-command-undo-counter 1) 16765 (and (> org-self-insert-command-undo-counter 0) 16766 buffer-undo-list (listp buffer-undo-list) 16767 (not (cadr buffer-undo-list)) ; remove nil entry 16768 (setcdr buffer-undo-list (cddr buffer-undo-list))) 16769 (setq org-self-insert-command-undo-counter 16770 (1+ org-self-insert-command-undo-counter)))))))) 16771 16772 (defun org-check-before-invisible-edit (kind) 16773 "Check if editing kind KIND would be dangerous with invisible text around. 16774 The detailed reaction depends on the user option `org-catch-invisible-edits'." 16775 ;; First, try to get out of here as quickly as possible, to reduce overhead 16776 (when (and org-catch-invisible-edits 16777 (or (not (boundp 'visible-mode)) (not visible-mode)) 16778 (or (get-char-property (point) 'invisible) 16779 (get-char-property (max (point-min) (1- (point))) 'invisible))) 16780 ;; OK, we need to take a closer look. Do not consider 16781 ;; invisibility obtained through text properties (e.g., link 16782 ;; fontification), as it cannot be toggled. 16783 (let* ((invisible-at-point 16784 (pcase (get-char-property-and-overlay (point) 'invisible) 16785 (`(,_ . ,(and (pred overlayp) o)) o))) 16786 ;; Assume that point cannot land in the middle of an 16787 ;; overlay, or between two overlays. 16788 (invisible-before-point 16789 (and (not invisible-at-point) 16790 (not (bobp)) 16791 (pcase (get-char-property-and-overlay (1- (point)) 'invisible) 16792 (`(,_ . ,(and (pred overlayp) o)) o)))) 16793 (border-and-ok-direction 16794 (or 16795 ;; Check if we are acting predictably before invisible 16796 ;; text. 16797 (and invisible-at-point 16798 (memq kind '(insert delete-backward))) 16799 ;; Check if we are acting predictably after invisible text 16800 ;; This works not well, and I have turned it off. It seems 16801 ;; better to always show and stop after invisible text. 16802 ;; (and (not invisible-at-point) invisible-before-point 16803 ;; (memq kind '(insert delete))) 16804 ))) 16805 (when (or invisible-at-point invisible-before-point) 16806 (when (eq org-catch-invisible-edits 'error) 16807 (user-error "Editing in invisible areas is prohibited, make them visible first")) 16808 (if (and org-custom-properties-overlays 16809 (y-or-n-p "Display invisible properties in this buffer? ")) 16810 (org-toggle-custom-properties-visibility) 16811 ;; Make the area visible 16812 (save-excursion 16813 (when invisible-before-point 16814 (goto-char 16815 (previous-single-char-property-change (point) 'invisible))) 16816 ;; Remove whatever overlay is currently making yet-to-be 16817 ;; edited text invisible. Also remove nested invisibility 16818 ;; related overlays. 16819 (delete-overlay (or invisible-at-point invisible-before-point)) 16820 (let ((origin (if invisible-at-point (point) (1- (point))))) 16821 (while (pcase (get-char-property-and-overlay origin 'invisible) 16822 (`(,_ . ,(and (pred overlayp) o)) 16823 (delete-overlay o) 16824 t))))) 16825 (cond 16826 ((eq org-catch-invisible-edits 'show) 16827 ;; That's it, we do the edit after showing 16828 (message 16829 "Unfolding invisible region around point before editing") 16830 (sit-for 1)) 16831 ((and (eq org-catch-invisible-edits 'smart) 16832 border-and-ok-direction) 16833 (message "Unfolding invisible region around point before editing")) 16834 (t 16835 ;; Don't do the edit, make the user repeat it in full visibility 16836 (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) 16837 16838 (defun org-fix-tags-on-the-fly () 16839 "Align tags in headline at point. 16840 Unlike `org-align-tags', this function does nothing if point is 16841 either not currently on a tagged headline or on a tag." 16842 (when (and (org-match-line org-tag-line-re) 16843 (< (point) (match-beginning 1))) 16844 (org-align-tags))) 16845 16846 (defun org-delete-backward-char (N) 16847 "Like `delete-backward-char', insert whitespace at field end in tables. 16848 When deleting backwards, in tables this function will insert whitespace in 16849 front of the next \"|\" separator, to keep the table aligned. The table will 16850 still be marked for re-alignment if the field did fill the entire column, 16851 because, in this case the deletion might narrow the column." 16852 (interactive "p") 16853 (save-match-data 16854 (org-check-before-invisible-edit 'delete-backward) 16855 (if (and (= N 1) 16856 (not overwrite-mode) 16857 (not (org-region-active-p)) 16858 (not (eq (char-before) ?|)) 16859 (save-excursion (skip-chars-backward " \t") (not (bolp))) 16860 (looking-at-p ".*?|") 16861 (org-at-table-p)) 16862 (progn (forward-char -1) (org-delete-char 1)) 16863 (backward-delete-char N) 16864 (org-fix-tags-on-the-fly)))) 16865 16866 (defun org-delete-char (N) 16867 "Like `delete-char', but insert whitespace at field end in tables. 16868 When deleting characters, in tables this function will insert whitespace in 16869 front of the next \"|\" separator, to keep the table aligned. The table will 16870 still be marked for re-alignment if the field did fill the entire column, 16871 because, in this case the deletion might narrow the column." 16872 (interactive "p") 16873 (save-match-data 16874 (org-check-before-invisible-edit 'delete) 16875 (cond 16876 ((or (/= N 1) 16877 (eq (char-after) ?|) 16878 (save-excursion (skip-chars-backward " \t") (bolp)) 16879 (not (org-at-table-p))) 16880 (delete-char N) 16881 (org-fix-tags-on-the-fly)) 16882 ((looking-at ".\\(.*?\\)|") 16883 (let* ((update? org-table-may-need-update) 16884 (noalign (looking-at-p ".*? |"))) 16885 (delete-char 1) 16886 (org-table-with-shrunk-field 16887 (save-excursion 16888 ;; Last space is `org-table-separator-space', so insert 16889 ;; a regular one before it instead. 16890 (goto-char (- (match-end 0) 2)) 16891 (insert " "))) 16892 ;; If there were two spaces at the end, this field does not 16893 ;; determine the width of the column. 16894 (when noalign (setq org-table-may-need-update update?)))) 16895 (t 16896 (delete-char N))))) 16897 16898 ;; Make `delete-selection-mode' work with Org mode and Orgtbl mode 16899 (put 'org-self-insert-command 'delete-selection 16900 (lambda () 16901 (not (run-hook-with-args-until-success 16902 'self-insert-uses-region-functions)))) 16903 (put 'orgtbl-self-insert-command 'delete-selection 16904 (lambda () 16905 (not (run-hook-with-args-until-success 16906 'self-insert-uses-region-functions)))) 16907 (put 'org-delete-char 'delete-selection 'supersede) 16908 (put 'org-delete-backward-char 'delete-selection 'supersede) 16909 (put 'org-yank 'delete-selection 'yank) 16910 (put 'org-return 'delete-selection t) 16911 16912 ;; Make `flyspell-mode' delay after some commands 16913 (put 'org-self-insert-command 'flyspell-delayed t) 16914 (put 'orgtbl-self-insert-command 'flyspell-delayed t) 16915 (put 'org-delete-char 'flyspell-delayed t) 16916 (put 'org-delete-backward-char 'flyspell-delayed t) 16917 16918 ;; Make pabbrev-mode expand after Org mode commands 16919 (put 'org-self-insert-command 'pabbrev-expand-after-command t) 16920 (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) 16921 16922 (defun org-transpose-words () 16923 "Transpose words for Org. 16924 This uses the `org-mode-transpose-word-syntax-table' syntax 16925 table, which interprets characters in `org-emphasis-alist' as 16926 word constituents." 16927 (interactive) 16928 (with-syntax-table org-mode-transpose-word-syntax-table 16929 (call-interactively 'transpose-words))) 16930 16931 (defvar org-ctrl-c-ctrl-c-hook nil 16932 "Hook for functions attaching themselves to `C-c C-c'. 16933 16934 This can be used to add additional functionality to the `C-c C-c' 16935 key which executes context-dependent commands. This hook is run 16936 before any other test, while `org-ctrl-c-ctrl-c-final-hook' is 16937 run after the last test. 16938 16939 Each function will be called with no arguments. The function 16940 must check if the context is appropriate for it to act. If yes, 16941 it should do its thing and then return a non-nil value. If the 16942 context is wrong, just do nothing and return nil.") 16943 16944 (defvar org-ctrl-c-ctrl-c-final-hook nil 16945 "Hook for functions attaching themselves to `C-c C-c'. 16946 16947 This can be used to add additional functionality to the `C-c C-c' 16948 key which executes context-dependent commands. This hook is run 16949 after any other test, while `org-ctrl-c-ctrl-c-hook' is run 16950 before the first test. 16951 16952 Each function will be called with no arguments. The function 16953 must check if the context is appropriate for it to act. If yes, 16954 it should do its thing and then return a non-nil value. If the 16955 context is wrong, just do nothing and return nil.") 16956 16957 (defvar org-tab-first-hook nil 16958 "Hook for functions to attach themselves to TAB. 16959 See `org-ctrl-c-ctrl-c-hook' for more information. 16960 This hook runs as the first action when TAB is pressed, even before 16961 `org-cycle' messes around with the `outline-regexp' to cater for 16962 inline tasks and plain list item folding. 16963 If any function in this hook returns t, any other actions that 16964 would have been caused by TAB (such as table field motion or visibility 16965 cycling) will not occur.") 16966 16967 (defvar org-tab-after-check-for-table-hook nil 16968 "Hook for functions to attach themselves to TAB. 16969 See `org-ctrl-c-ctrl-c-hook' for more information. 16970 This hook runs after it has been established that the cursor is not in a 16971 table, but before checking if the cursor is in a headline or if global cycling 16972 should be done. 16973 If any function in this hook returns t, not other actions like visibility 16974 cycling will be done.") 16975 16976 (defvar org-tab-after-check-for-cycling-hook nil 16977 "Hook for functions to attach themselves to TAB. 16978 See `org-ctrl-c-ctrl-c-hook' for more information. 16979 This hook runs after it has been established that not table field motion and 16980 not visibility should be done because of current context. This is probably 16981 the place where a package like yasnippets can hook in.") 16982 16983 (defvar org-tab-before-tab-emulation-hook nil 16984 "Hook for functions to attach themselves to TAB. 16985 See `org-ctrl-c-ctrl-c-hook' for more information. 16986 This hook runs after every other options for TAB have been exhausted, but 16987 before indentation and \t insertion takes place.") 16988 16989 (defvar org-metaleft-hook nil 16990 "Hook for functions attaching themselves to `M-left'. 16991 See `org-ctrl-c-ctrl-c-hook' for more information.") 16992 (defvar org-metaright-hook nil 16993 "Hook for functions attaching themselves to `M-right'. 16994 See `org-ctrl-c-ctrl-c-hook' for more information.") 16995 (defvar org-metaup-hook nil 16996 "Hook for functions attaching themselves to `M-up'. 16997 See `org-ctrl-c-ctrl-c-hook' for more information.") 16998 (defvar org-metadown-hook nil 16999 "Hook for functions attaching themselves to `M-down'. 17000 See `org-ctrl-c-ctrl-c-hook' for more information.") 17001 (defvar org-shiftmetaleft-hook nil 17002 "Hook for functions attaching themselves to `M-S-left'. 17003 See `org-ctrl-c-ctrl-c-hook' for more information.") 17004 (defvar org-shiftmetaright-hook nil 17005 "Hook for functions attaching themselves to `M-S-right'. 17006 See `org-ctrl-c-ctrl-c-hook' for more information.") 17007 (defvar org-shiftmetaup-hook nil 17008 "Hook for functions attaching themselves to `M-S-up'. 17009 See `org-ctrl-c-ctrl-c-hook' for more information.") 17010 (defvar org-shiftmetadown-hook nil 17011 "Hook for functions attaching themselves to `M-S-down'. 17012 See `org-ctrl-c-ctrl-c-hook' for more information.") 17013 (defvar org-metareturn-hook nil 17014 "Hook for functions attaching themselves to `M-RET'. 17015 See `org-ctrl-c-ctrl-c-hook' for more information.") 17016 (defvar org-shiftup-hook nil 17017 "Hook for functions attaching themselves to `S-up'. 17018 See `org-ctrl-c-ctrl-c-hook' for more information.") 17019 (defvar org-shiftup-final-hook nil 17020 "Hook for functions attaching themselves to `S-up'. 17021 This one runs after all other options except shift-select have been excluded. 17022 See `org-ctrl-c-ctrl-c-hook' for more information.") 17023 (defvar org-shiftdown-hook nil 17024 "Hook for functions attaching themselves to `S-down'. 17025 See `org-ctrl-c-ctrl-c-hook' for more information.") 17026 (defvar org-shiftdown-final-hook nil 17027 "Hook for functions attaching themselves to `S-down'. 17028 This one runs after all other options except shift-select have been excluded. 17029 See `org-ctrl-c-ctrl-c-hook' for more information.") 17030 (defvar org-shiftleft-hook nil 17031 "Hook for functions attaching themselves to `S-left'. 17032 See `org-ctrl-c-ctrl-c-hook' for more information.") 17033 (defvar org-shiftleft-final-hook nil 17034 "Hook for functions attaching themselves to `S-left'. 17035 This one runs after all other options except shift-select have been excluded. 17036 See `org-ctrl-c-ctrl-c-hook' for more information.") 17037 (defvar org-shiftright-hook nil 17038 "Hook for functions attaching themselves to `S-right'. 17039 See `org-ctrl-c-ctrl-c-hook' for more information.") 17040 (defvar org-shiftright-final-hook nil 17041 "Hook for functions attaching themselves to `S-right'. 17042 This one runs after all other options except shift-select have been excluded. 17043 See `org-ctrl-c-ctrl-c-hook' for more information.") 17044 17045 (defun org-modifier-cursor-error () 17046 "Throw an error, a modified cursor command was applied in wrong context." 17047 (user-error "This command is active in special context like tables, headlines or items")) 17048 17049 (defun org-shiftselect-error () 17050 "Throw an error because Shift-Cursor command was applied in wrong context." 17051 (if (and (boundp 'shift-select-mode) shift-select-mode) 17052 (user-error "To use shift-selection with Org mode, customize `org-support-shift-select'") 17053 (user-error "This command works only in special context like headlines or timestamps"))) 17054 17055 (defun org-call-for-shift-select (cmd) 17056 (let ((this-command-keys-shift-translated t)) 17057 (call-interactively cmd))) 17058 17059 (defun org-shifttab (&optional arg) 17060 "Global visibility cycling or move to previous table field. 17061 Call `org-table-previous-field' within a table. 17062 When ARG is nil, cycle globally through visibility states. 17063 When ARG is a numeric prefix, show contents of this level." 17064 (interactive "P") 17065 (cond 17066 ((org-at-table-p) (call-interactively 'org-table-previous-field)) 17067 ((integerp arg) 17068 (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg))) 17069 (message "Content view to level: %d" arg) 17070 (org-content (prefix-numeric-value arg2)) 17071 (org-cycle-show-empty-lines t) 17072 (setq org-cycle-global-status 'overview) 17073 (run-hook-with-args 'org-cycle-hook 'overview))) 17074 (t (call-interactively 'org-global-cycle)))) 17075 17076 (defun org-shiftmetaleft () 17077 "Promote subtree or delete table column. 17078 Calls `org-promote-subtree', `org-outdent-item-tree', or 17079 `org-table-delete-column', depending on context. See the 17080 individual commands for more information." 17081 (interactive) 17082 (cond 17083 ((run-hook-with-args-until-success 'org-shiftmetaleft-hook)) 17084 ((org-at-table-p) (call-interactively 'org-table-delete-column)) 17085 ((org-at-heading-p) (call-interactively 'org-promote-subtree)) 17086 ((if (not (org-region-active-p)) (org-at-item-p) 17087 (save-excursion (goto-char (region-beginning)) 17088 (org-at-item-p))) 17089 (call-interactively 'org-outdent-item-tree)) 17090 (t (org-modifier-cursor-error)))) 17091 17092 (defun org-shiftmetaright () 17093 "Demote subtree or insert table column. 17094 Calls `org-demote-subtree', `org-indent-item-tree', or 17095 `org-table-insert-column', depending on context. See the 17096 individual commands for more information." 17097 (interactive) 17098 (cond 17099 ((run-hook-with-args-until-success 'org-shiftmetaright-hook)) 17100 ((org-at-table-p) (call-interactively 'org-table-insert-column)) 17101 ((org-at-heading-p) (call-interactively 'org-demote-subtree)) 17102 ((if (not (org-region-active-p)) (org-at-item-p) 17103 (save-excursion (goto-char (region-beginning)) 17104 (org-at-item-p))) 17105 (call-interactively 'org-indent-item-tree)) 17106 (t (org-modifier-cursor-error)))) 17107 17108 (defun org-shiftmetaup (&optional _arg) 17109 "Drag the line at point up. 17110 In a table, kill the current row. 17111 On a clock timestamp, update the value of the timestamp like `S-<up>' 17112 but also adjust the previous clocked item in the clock history. 17113 Everywhere else, drag the line at point up." 17114 (interactive "P") 17115 (cond 17116 ((run-hook-with-args-until-success 'org-shiftmetaup-hook)) 17117 ((org-at-table-p) (call-interactively 'org-table-kill-row)) 17118 ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) 17119 (call-interactively 'org-timestamp-up))) 17120 (t (call-interactively 'org-drag-line-backward)))) 17121 17122 (defun org-shiftmetadown (&optional _arg) 17123 "Drag the line at point down. 17124 In a table, insert an empty row at the current line. 17125 On a clock timestamp, update the value of the timestamp like `S-<down>' 17126 but also adjust the previous clocked item in the clock history. 17127 Everywhere else, drag the line at point down." 17128 (interactive "P") 17129 (cond 17130 ((run-hook-with-args-until-success 'org-shiftmetadown-hook)) 17131 ((org-at-table-p) (call-interactively 'org-table-insert-row)) 17132 ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) 17133 (call-interactively 'org-timestamp-down))) 17134 (t (call-interactively 'org-drag-line-forward)))) 17135 17136 (defsubst org-hidden-tree-error () 17137 (user-error 17138 "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>")) 17139 17140 (defun org-metaleft (&optional _arg) 17141 "Promote heading, list item at point or move table column left. 17142 17143 Calls `org-do-promote', `org-outdent-item' or `org-table-move-column', 17144 depending on context. With no specific context, calls the Emacs 17145 default `backward-word'. See the individual commands for more 17146 information. 17147 17148 This function runs the hook `org-metaleft-hook' as a first step, 17149 and returns at first non-nil value." 17150 (interactive "P") 17151 (cond 17152 ((run-hook-with-args-until-success 'org-metaleft-hook)) 17153 ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) 17154 ((org-with-limited-levels 17155 (or (org-at-heading-p) 17156 (and (org-region-active-p) 17157 (save-excursion 17158 (goto-char (region-beginning)) 17159 (org-at-heading-p))))) 17160 (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) 17161 (call-interactively 'org-do-promote)) 17162 ;; At an inline task. 17163 ((org-at-heading-p) 17164 (call-interactively 'org-inlinetask-promote)) 17165 ((or (org-at-item-p) 17166 (and (org-region-active-p) 17167 (save-excursion 17168 (goto-char (region-beginning)) 17169 (org-at-item-p)))) 17170 (when (org-check-for-hidden 'items) (org-hidden-tree-error)) 17171 (call-interactively 'org-outdent-item)) 17172 (t (call-interactively 'backward-word)))) 17173 17174 (defun org-metaright (&optional _arg) 17175 "Demote heading, list item at point or move table column right. 17176 17177 In front of a drawer or a block keyword, indent it correctly. 17178 17179 Calls `org-do-demote', `org-indent-item', `org-table-move-column', 17180 `org-indent-drawer' or `org-indent-block' depending on context. 17181 With no specific context, calls the Emacs default `forward-word'. 17182 See the individual commands for more information. 17183 17184 This function runs the hook `org-metaright-hook' as a first step, 17185 and returns at first non-nil value." 17186 (interactive "P") 17187 (cond 17188 ((run-hook-with-args-until-success 'org-metaright-hook)) 17189 ((org-at-table-p) (call-interactively 'org-table-move-column)) 17190 ((org-at-drawer-p) (call-interactively 'org-indent-drawer)) 17191 ((org-at-block-p) (call-interactively 'org-indent-block)) 17192 ((org-with-limited-levels 17193 (or (org-at-heading-p) 17194 (and (org-region-active-p) 17195 (save-excursion 17196 (goto-char (region-beginning)) 17197 (org-at-heading-p))))) 17198 (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) 17199 (call-interactively 'org-do-demote)) 17200 ;; At an inline task. 17201 ((org-at-heading-p) 17202 (call-interactively 'org-inlinetask-demote)) 17203 ((or (org-at-item-p) 17204 (and (org-region-active-p) 17205 (save-excursion 17206 (goto-char (region-beginning)) 17207 (org-at-item-p)))) 17208 (when (org-check-for-hidden 'items) (org-hidden-tree-error)) 17209 (call-interactively 'org-indent-item)) 17210 (t (call-interactively 'forward-word)))) 17211 17212 (defun org-check-for-hidden (what) 17213 "Check if there are hidden headlines/items in the current visual line. 17214 WHAT can be either `headlines' or `items'. If the current line is 17215 an outline or item heading and it has a folded subtree below it, 17216 this function returns t, nil otherwise." 17217 (let ((re (cond 17218 ((eq what 'headlines) org-outline-regexp-bol) 17219 ((eq what 'items) (org-item-beginning-re)) 17220 (t (error "This should not happen")))) 17221 beg end) 17222 (save-excursion 17223 (catch 'exit 17224 (unless (org-region-active-p) 17225 (setq beg (point-at-bol)) 17226 (beginning-of-line 2) 17227 (while (and (not (eobp)) ;; this is like `next-line' 17228 (get-char-property (1- (point)) 'invisible)) 17229 (beginning-of-line 2)) 17230 (setq end (point)) 17231 (goto-char beg) 17232 (goto-char (point-at-eol)) 17233 (setq end (max end (point))) 17234 (while (re-search-forward re end t) 17235 (when (get-char-property (match-beginning 0) 'invisible) 17236 (throw 'exit t)))) 17237 nil)))) 17238 17239 (defun org-metaup (&optional _arg) 17240 "Move subtree up or move table row up. 17241 Calls `org-move-subtree-up' or `org-table-move-row' or 17242 `org-move-item-up', depending on context. See the individual commands 17243 for more information." 17244 (interactive "P") 17245 (cond 17246 ((run-hook-with-args-until-success 'org-metaup-hook)) 17247 ((org-region-active-p) 17248 (let* ((a (save-excursion 17249 (goto-char (min (region-beginning) (region-end))) 17250 (line-beginning-position))) 17251 (b (save-excursion 17252 (goto-char (max (region-beginning) (region-end))) 17253 (if (bolp) (1- (point)) (line-end-position)))) 17254 (c (save-excursion 17255 (goto-char a) 17256 (move-beginning-of-line 0) 17257 (point))) 17258 (d (save-excursion 17259 (goto-char a) 17260 (move-end-of-line 0) 17261 (point)))) 17262 (transpose-regions a b c d) 17263 (goto-char c))) 17264 ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) 17265 ((and (featurep 'org-inlinetask) 17266 (org-inlinetask-in-task-p)) 17267 (org-drag-element-backward)) 17268 ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) 17269 ((org-at-item-p) (call-interactively 'org-move-item-up)) 17270 (t (org-drag-element-backward)))) 17271 17272 (defun org-metadown (&optional _arg) 17273 "Move subtree down or move table row down. 17274 Calls `org-move-subtree-down' or `org-table-move-row' or 17275 `org-move-item-down', depending on context. See the individual 17276 commands for more information." 17277 (interactive "P") 17278 (cond 17279 ((run-hook-with-args-until-success 'org-metadown-hook)) 17280 ((org-region-active-p) 17281 (let* ((a (save-excursion 17282 (goto-char (min (region-beginning) (region-end))) 17283 (line-beginning-position))) 17284 (b (save-excursion 17285 (goto-char (max (region-beginning) (region-end))) 17286 (if (bolp) (1- (point)) (line-end-position)))) 17287 (c (save-excursion 17288 (goto-char b) 17289 (move-beginning-of-line (if (bolp) 1 2)) 17290 (point))) 17291 (d (save-excursion 17292 (goto-char b) 17293 (move-end-of-line (if (bolp) 1 2)) 17294 (point)))) 17295 (transpose-regions a b c d) 17296 (goto-char d))) 17297 ((org-at-table-p) (call-interactively 'org-table-move-row)) 17298 ((and (featurep 'org-inlinetask) 17299 (org-inlinetask-in-task-p)) 17300 (org-drag-element-forward)) 17301 ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) 17302 ((org-at-item-p) (call-interactively 'org-move-item-down)) 17303 (t (org-drag-element-forward)))) 17304 17305 (defun org-shiftup (&optional arg) 17306 "Act on current element according to context. 17307 Call `org-timestamp-up' or `org-priority-up', or 17308 `org-previous-item', or `org-table-move-cell-up'. See the 17309 individual commands for more information." 17310 (interactive "P") 17311 (cond 17312 ((run-hook-with-args-until-success 'org-shiftup-hook)) 17313 ((and org-support-shift-select (org-region-active-p)) 17314 (org-call-for-shift-select 'previous-line)) 17315 ((org-at-timestamp-p 'lax) 17316 (call-interactively (if org-edit-timestamp-down-means-later 17317 'org-timestamp-down 'org-timestamp-up))) 17318 ((and (not (eq org-support-shift-select 'always)) 17319 org-priority-enable-commands 17320 (org-at-heading-p)) 17321 (call-interactively 'org-priority-up)) 17322 ((and (not org-support-shift-select) (org-at-item-p)) 17323 (call-interactively 'org-previous-item)) 17324 ((org-clocktable-try-shift 'up arg)) 17325 ((and (not (eq org-support-shift-select 'always)) 17326 (org-at-table-p)) 17327 (org-table-move-cell-up)) 17328 ((run-hook-with-args-until-success 'org-shiftup-final-hook)) 17329 (org-support-shift-select 17330 (org-call-for-shift-select 'previous-line)) 17331 (t (org-shiftselect-error)))) 17332 17333 (defun org-shiftdown (&optional arg) 17334 "Act on current element according to context. 17335 Call `org-timestamp-down' or `org-priority-down', or 17336 `org-next-item', or `org-table-move-cell-down'. See the 17337 individual commands for more information." 17338 (interactive "P") 17339 (cond 17340 ((run-hook-with-args-until-success 'org-shiftdown-hook)) 17341 ((and org-support-shift-select (org-region-active-p)) 17342 (org-call-for-shift-select 'next-line)) 17343 ((org-at-timestamp-p 'lax) 17344 (call-interactively (if org-edit-timestamp-down-means-later 17345 'org-timestamp-up 'org-timestamp-down))) 17346 ((and (not (eq org-support-shift-select 'always)) 17347 org-priority-enable-commands 17348 (org-at-heading-p)) 17349 (call-interactively 'org-priority-down)) 17350 ((and (not org-support-shift-select) (org-at-item-p)) 17351 (call-interactively 'org-next-item)) 17352 ((org-clocktable-try-shift 'down arg)) 17353 ((and (not (eq org-support-shift-select 'always)) 17354 (org-at-table-p)) 17355 (org-table-move-cell-down)) 17356 ((run-hook-with-args-until-success 'org-shiftdown-final-hook)) 17357 (org-support-shift-select 17358 (org-call-for-shift-select 'next-line)) 17359 (t (org-shiftselect-error)))) 17360 17361 (defun org-shiftright (&optional arg) 17362 "Act on the current element according to context. 17363 This does one of the following: 17364 17365 - switch a timestamp at point one day into the future 17366 - on a headline, switch to the next TODO keyword 17367 - on an item, switch entire list to the next bullet type 17368 - on a property line, switch to the next allowed value 17369 - on a clocktable definition line, move time block into the future 17370 - in a table, move a single cell right" 17371 (interactive "P") 17372 (cond 17373 ((run-hook-with-args-until-success 'org-shiftright-hook)) 17374 ((and org-support-shift-select (org-region-active-p)) 17375 (org-call-for-shift-select 'forward-char)) 17376 ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-up-day)) 17377 ((and (not (eq org-support-shift-select 'always)) 17378 (org-at-heading-p)) 17379 (let ((org-inhibit-logging 17380 (not org-treat-S-cursor-todo-selection-as-state-change)) 17381 (org-inhibit-blocking 17382 (not org-treat-S-cursor-todo-selection-as-state-change))) 17383 (org-call-with-arg 'org-todo 'right))) 17384 ((or (and org-support-shift-select 17385 (not (eq org-support-shift-select 'always)) 17386 (org-at-item-bullet-p)) 17387 (and (not org-support-shift-select) (org-at-item-p))) 17388 (org-call-with-arg 'org-cycle-list-bullet nil)) 17389 ((and (not (eq org-support-shift-select 'always)) 17390 (org-at-property-p)) 17391 (call-interactively 'org-property-next-allowed-value)) 17392 ((org-clocktable-try-shift 'right arg)) 17393 ((and (not (eq org-support-shift-select 'always)) 17394 (org-at-table-p)) 17395 (org-table-move-cell-right)) 17396 ((run-hook-with-args-until-success 'org-shiftright-final-hook)) 17397 (org-support-shift-select 17398 (org-call-for-shift-select 'forward-char)) 17399 (t (org-shiftselect-error)))) 17400 17401 (defun org-shiftleft (&optional arg) 17402 "Act on current element according to context. 17403 This does one of the following: 17404 17405 - switch a timestamp at point one day into the past 17406 - on a headline, switch to the previous TODO keyword. 17407 - on an item, switch entire list to the previous bullet type 17408 - on a property line, switch to the previous allowed value 17409 - on a clocktable definition line, move time block into the past 17410 - in a table, move a single cell left" 17411 (interactive "P") 17412 (cond 17413 ((run-hook-with-args-until-success 'org-shiftleft-hook)) 17414 ((and org-support-shift-select (org-region-active-p)) 17415 (org-call-for-shift-select 'backward-char)) 17416 ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-down-day)) 17417 ((and (not (eq org-support-shift-select 'always)) 17418 (org-at-heading-p)) 17419 (let ((org-inhibit-logging 17420 (not org-treat-S-cursor-todo-selection-as-state-change)) 17421 (org-inhibit-blocking 17422 (not org-treat-S-cursor-todo-selection-as-state-change))) 17423 (org-call-with-arg 'org-todo 'left))) 17424 ((or (and org-support-shift-select 17425 (not (eq org-support-shift-select 'always)) 17426 (org-at-item-bullet-p)) 17427 (and (not org-support-shift-select) (org-at-item-p))) 17428 (org-call-with-arg 'org-cycle-list-bullet 'previous)) 17429 ((and (not (eq org-support-shift-select 'always)) 17430 (org-at-property-p)) 17431 (call-interactively 'org-property-previous-allowed-value)) 17432 ((org-clocktable-try-shift 'left arg)) 17433 ((and (not (eq org-support-shift-select 'always)) 17434 (org-at-table-p)) 17435 (org-table-move-cell-left)) 17436 ((run-hook-with-args-until-success 'org-shiftleft-final-hook)) 17437 (org-support-shift-select 17438 (org-call-for-shift-select 'backward-char)) 17439 (t (org-shiftselect-error)))) 17440 17441 (defun org-shiftcontrolright () 17442 "Switch to next TODO set." 17443 (interactive) 17444 (cond 17445 ((and org-support-shift-select (org-region-active-p)) 17446 (org-call-for-shift-select 'forward-word)) 17447 ((and (not (eq org-support-shift-select 'always)) 17448 (org-at-heading-p)) 17449 (org-call-with-arg 'org-todo 'nextset)) 17450 (org-support-shift-select 17451 (org-call-for-shift-select 'forward-word)) 17452 (t (org-shiftselect-error)))) 17453 17454 (defun org-shiftcontrolleft () 17455 "Switch to previous TODO set." 17456 (interactive) 17457 (cond 17458 ((and org-support-shift-select (org-region-active-p)) 17459 (org-call-for-shift-select 'backward-word)) 17460 ((and (not (eq org-support-shift-select 'always)) 17461 (org-at-heading-p)) 17462 (org-call-with-arg 'org-todo 'previousset)) 17463 (org-support-shift-select 17464 (org-call-for-shift-select 'backward-word)) 17465 (t (org-shiftselect-error)))) 17466 17467 (defun org-shiftcontrolup (&optional n) 17468 "Change timestamps synchronously up in CLOCK log lines. 17469 Optional argument N tells to change by that many units." 17470 (interactive "P") 17471 (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax)) 17472 (let (org-support-shift-select) 17473 (org-clock-timestamps-up n)) 17474 (user-error "Not at a clock log"))) 17475 17476 (defun org-shiftcontroldown (&optional n) 17477 "Change timestamps synchronously down in CLOCK log lines. 17478 Optional argument N tells to change by that many units." 17479 (interactive "P") 17480 (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax)) 17481 (let (org-support-shift-select) 17482 (org-clock-timestamps-down n)) 17483 (user-error "Not at a clock log"))) 17484 17485 (defun org-increase-number-at-point (&optional inc) 17486 "Increment the number at point. 17487 With an optional prefix numeric argument INC, increment using 17488 this numeric value." 17489 (interactive "p") 17490 (if (not (number-at-point)) 17491 (user-error "Not on a number") 17492 (unless inc (setq inc 1)) 17493 (let ((pos (point)) 17494 (beg (skip-chars-backward "-+^/*0-9eE.")) 17495 (end (skip-chars-forward "-+^/*0-9eE.")) nap) 17496 (setq nap (buffer-substring-no-properties 17497 (+ pos beg) (+ pos beg end))) 17498 (delete-region (+ pos beg) (+ pos beg end)) 17499 (insert (calc-eval (concat (number-to-string inc) "+" nap)))) 17500 (when (org-at-table-p) 17501 (org-table-align) 17502 (org-table-end-of-field 1)))) 17503 17504 (defun org-decrease-number-at-point (&optional inc) 17505 "Decrement the number at point. 17506 With an optional prefix numeric argument INC, decrement using 17507 this numeric value." 17508 (interactive "p") 17509 (org-increase-number-at-point (- (or inc 1)))) 17510 17511 (defun org-ctrl-c-ret () 17512 "Call `org-table-hline-and-move' or `org-insert-heading'." 17513 (interactive) 17514 (cond 17515 ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) 17516 (t (call-interactively 'org-insert-heading)))) 17517 17518 (defun org-copy-visible (beg end) 17519 "Copy the visible parts of the region." 17520 (interactive "r") 17521 (let ((result "")) 17522 (while (/= beg end) 17523 (when (get-char-property beg 'invisible) 17524 (setq beg (next-single-char-property-change beg 'invisible nil end))) 17525 (let ((next (next-single-char-property-change beg 'invisible nil end))) 17526 (setq result (concat result (buffer-substring beg next))) 17527 (setq beg next))) 17528 (setq deactivate-mark t) 17529 (kill-new result) 17530 (message "Visible strings have been copied to the kill ring."))) 17531 17532 (defun org-copy-special () 17533 "Copy region in table or copy current subtree. 17534 Calls `org-table-copy-region' or `org-copy-subtree', depending on 17535 context. See the individual commands for more information." 17536 (interactive) 17537 (call-interactively 17538 (if (org-at-table-p) #'org-table-copy-region #'org-copy-subtree))) 17539 17540 (defun org-cut-special () 17541 "Cut region in table or cut current subtree. 17542 Calls `org-table-cut-region' or `org-cut-subtree', depending on 17543 context. See the individual commands for more information." 17544 (interactive) 17545 (call-interactively 17546 (if (org-at-table-p) #'org-table-cut-region #'org-cut-subtree))) 17547 17548 (defun org-paste-special (arg) 17549 "Paste rectangular region into table, or past subtree relative to level. 17550 Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. 17551 See the individual commands for more information." 17552 (interactive "P") 17553 (if (org-at-table-p) 17554 (org-table-paste-rectangle) 17555 (org-paste-subtree arg))) 17556 17557 (defun org-edit-special (&optional arg) 17558 "Call a special editor for the element at point. 17559 When at a table, call the formula editor with `org-table-edit-formulas'. 17560 When in a source code block, call `org-edit-src-code'. 17561 When in a fixed-width region, call `org-edit-fixed-width-region'. 17562 When in an export block, call `org-edit-export-block'. 17563 When in a LaTeX environment, call `org-edit-latex-environment'. 17564 When at an INCLUDE, SETUPFILE or BIBLIOGRAPHY keyword, visit the included file. 17565 When at a footnote reference, call `org-edit-footnote-reference'. 17566 When at a planning line call, `org-deadline' and/or `org-schedule'. 17567 When at an active timestamp, call `org-time-stamp'. 17568 When at an inactive timestamp, call `org-time-stamp-inactive'. 17569 On a link, call `ffap' to visit the link at point. 17570 Otherwise, return a user error." 17571 (interactive "P") 17572 (let ((element (org-element-at-point))) 17573 (barf-if-buffer-read-only) 17574 (pcase (org-element-type element) 17575 (`src-block 17576 (if (not arg) (org-edit-src-code) 17577 (let* ((info (org-babel-get-src-block-info)) 17578 (lang (nth 0 info)) 17579 (params (nth 2 info)) 17580 (session (cdr (assq :session params)))) 17581 (if (not session) (org-edit-src-code) 17582 ;; At a source block with a session and function called 17583 ;; with an ARG: switch to the buffer related to the 17584 ;; inferior process. 17585 (switch-to-buffer 17586 (funcall (intern (concat "org-babel-prep-session:" lang)) 17587 session params)))))) 17588 (`keyword 17589 (unless (member (org-element-property :key element) 17590 '("BIBLIOGRAPHY" "INCLUDE" "SETUPFILE")) 17591 (user-error "No special environment to edit here")) 17592 (let ((value (org-element-property :value element))) 17593 (unless (org-string-nw-p value) (user-error "No file to edit")) 17594 (let ((file (and (string-match "\\`\"\\(.*?\\)\"\\|\\S-+" value) 17595 (or (match-string 1 value) 17596 (match-string 0 value))))) 17597 (when (org-url-p file) 17598 (user-error "Files located with a URL cannot be edited")) 17599 (org-link-open-from-string 17600 (format "[[%s]]" (expand-file-name file)))))) 17601 (`table 17602 (if (eq (org-element-property :type element) 'table.el) 17603 (org-edit-table.el) 17604 (call-interactively 'org-table-edit-formulas))) 17605 ;; Only Org tables contain `table-row' type elements. 17606 (`table-row (call-interactively 'org-table-edit-formulas)) 17607 (`example-block (org-edit-src-code)) 17608 (`export-block (org-edit-export-block)) 17609 (`fixed-width (org-edit-fixed-width-region)) 17610 (`latex-environment (org-edit-latex-environment)) 17611 (`planning 17612 (let ((proplist (cadr element))) 17613 (mapc #'call-interactively 17614 (remq nil 17615 (list 17616 (when (plist-get proplist :deadline) #'org-deadline) 17617 (when (plist-get proplist :scheduled) #'org-schedule)))))) 17618 (_ 17619 ;; No notable element at point. Though, we may be at a link or 17620 ;; a footnote reference, which are objects. Thus, scan deeper. 17621 (let ((context (org-element-context element))) 17622 (pcase (org-element-type context) 17623 (`footnote-reference (org-edit-footnote-reference)) 17624 (`inline-src-block (org-edit-inline-src-code)) 17625 (`latex-fragment (org-edit-latex-fragment)) 17626 (`timestamp (if (eq 'inactive (org-element-property :type context)) 17627 (call-interactively #'org-time-stamp-inactive) 17628 (call-interactively #'org-time-stamp))) 17629 (`link (call-interactively #'ffap)) 17630 (_ (user-error "No special environment to edit here")))))))) 17631 17632 (defun org-ctrl-c-ctrl-c (&optional arg) 17633 "Set tags in headline, or update according to changed information at point. 17634 17635 This command does many different things, depending on context: 17636 17637 - If column view is active, in agenda or org buffers, quit it. 17638 17639 - If there are highlights, remove them. 17640 17641 - If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location, 17642 this is what we do. 17643 17644 - If the cursor is on a statistics cookie, update it. 17645 17646 - If the cursor is in a headline, in an agenda or an org buffer, 17647 prompt for tags and insert them into the current line, aligned 17648 to `org-tags-column'. When called with prefix arg, realign all 17649 tags in the current buffer. 17650 17651 - If the cursor is in one of the special #+KEYWORD lines, this 17652 triggers scanning the buffer for these lines and updating the 17653 information. 17654 17655 - If the cursor is inside a table, realign the table. This command 17656 works even if the automatic table editor has been turned off. 17657 17658 - If the cursor is on a #+TBLFM line, re-apply the formulas to 17659 the entire table. 17660 17661 - If the cursor is at a footnote reference or definition, jump to 17662 the corresponding definition or references, respectively. 17663 17664 - If the cursor is a the beginning of a dynamic block, update it. 17665 17666 - If the current buffer is a capture buffer, close note and file it. 17667 17668 - If the cursor is on a <<<target>>>, update radio targets and 17669 corresponding links in this buffer. 17670 17671 - If the cursor is on a numbered item in a plain list, renumber the 17672 ordered list. 17673 17674 - If the cursor is on a checkbox, toggle it. 17675 17676 - If the cursor is on a code block, evaluate it. The variable 17677 `org-confirm-babel-evaluate' can be used to control prompting 17678 before code block evaluation, by default every code block 17679 evaluation requires confirmation. Code block evaluation can be 17680 inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." 17681 (interactive "P") 17682 (cond 17683 ((bound-and-true-p org-columns-overlays) (org-columns-quit)) 17684 ((or (bound-and-true-p org-clock-overlays) org-occur-highlights) 17685 (when (boundp 'org-clock-overlays) (org-clock-remove-overlays)) 17686 (org-remove-occur-highlights) 17687 (message "Temporary highlights/overlays removed from current buffer")) 17688 ((and (local-variable-p 'org-finish-function) 17689 (fboundp org-finish-function)) 17690 (funcall org-finish-function)) 17691 ((org-babel-hash-at-point)) 17692 ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) 17693 (t 17694 (let* ((context 17695 (org-element-lineage 17696 (org-element-context) 17697 ;; Limit to supported contexts. 17698 '(babel-call clock dynamic-block footnote-definition 17699 footnote-reference inline-babel-call inline-src-block 17700 inlinetask item keyword node-property paragraph 17701 plain-list planning property-drawer radio-target 17702 src-block statistics-cookie table table-cell table-row 17703 timestamp) 17704 t)) 17705 (radio-list-p (org-at-radio-list-p)) 17706 (type (org-element-type context))) 17707 ;; For convenience: at the first line of a paragraph on the same 17708 ;; line as an item, apply function on that item instead. 17709 (when (eq type 'paragraph) 17710 (let ((parent (org-element-property :parent context))) 17711 (when (and (eq (org-element-type parent) 'item) 17712 (= (line-beginning-position) 17713 (org-element-property :begin parent))) 17714 (setq context parent) 17715 (setq type 'item)))) 17716 ;; Act according to type of element or object at point. 17717 ;; 17718 ;; Do nothing on a blank line, except if it is contained in 17719 ;; a source block. Hence, we first check if point is in such 17720 ;; a block and then if it is at a blank line. 17721 (pcase type 17722 ((or `inline-src-block `src-block) 17723 (unless org-babel-no-eval-on-ctrl-c-ctrl-c 17724 (org-babel-eval-wipe-error-buffer) 17725 (org-babel-execute-src-block 17726 current-prefix-arg (org-babel-get-src-block-info nil context)))) 17727 ((guard (org-match-line "[ \t]*$")) 17728 (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) 17729 (user-error 17730 (substitute-command-keys 17731 "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))) 17732 ((or `babel-call `inline-babel-call) 17733 (let ((info (org-babel-lob-get-info context))) 17734 (when info (org-babel-execute-src-block nil info)))) 17735 (`clock (org-clock-update-time-maybe)) 17736 (`dynamic-block 17737 (save-excursion 17738 (goto-char (org-element-property :post-affiliated context)) 17739 (org-update-dblock))) 17740 (`footnote-definition 17741 (goto-char (org-element-property :post-affiliated context)) 17742 (call-interactively 'org-footnote-action)) 17743 (`footnote-reference (call-interactively #'org-footnote-action)) 17744 ((or `headline `inlinetask) 17745 (save-excursion (goto-char (org-element-property :begin context)) 17746 (call-interactively #'org-set-tags-command))) 17747 (`item 17748 ;; At an item: `C-u C-u' sets checkbox to "[-]" 17749 ;; unconditionally, whereas `C-u' will toggle its presence. 17750 ;; Without a universal argument, if the item has a checkbox, 17751 ;; toggle it. Otherwise repair the list. 17752 (if (or radio-list-p 17753 (and (boundp org-list-checkbox-radio-mode) 17754 org-list-checkbox-radio-mode)) 17755 (org-toggle-radio-button arg) 17756 (let* ((box (org-element-property :checkbox context)) 17757 (struct (org-element-property :structure context)) 17758 (old-struct (copy-tree struct)) 17759 (parents (org-list-parents-alist struct)) 17760 (prevs (org-list-prevs-alist struct)) 17761 (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) 17762 (org-list-set-checkbox 17763 (org-element-property :begin context) struct 17764 (cond ((equal arg '(16)) "[-]") 17765 ((and (not box) (equal arg '(4))) "[ ]") 17766 ((or (not box) (equal arg '(4))) nil) 17767 ((eq box 'on) "[ ]") 17768 (t "[X]"))) 17769 ;; Mimic `org-list-write-struct' but with grabbing a return 17770 ;; value from `org-list-struct-fix-box'. 17771 (org-list-struct-fix-ind struct parents 2) 17772 (org-list-struct-fix-item-end struct) 17773 (org-list-struct-fix-bul struct prevs) 17774 (org-list-struct-fix-ind struct parents) 17775 (let ((block-item 17776 (org-list-struct-fix-box struct parents prevs orderedp))) 17777 (if (and box (equal struct old-struct)) 17778 (if (equal arg '(16)) 17779 (message "Checkboxes already reset") 17780 (user-error "Cannot toggle this checkbox: %s" 17781 (if (eq box 'on) 17782 "all subitems checked" 17783 "unchecked subitems"))) 17784 (org-list-struct-apply-struct struct old-struct) 17785 (org-update-checkbox-count-maybe)) 17786 (when block-item 17787 (message "Checkboxes were removed due to empty box at line %d" 17788 (org-current-line block-item))))))) 17789 (`plain-list 17790 ;; At a plain list, with a double C-u argument, set 17791 ;; checkboxes of each item to "[-]", whereas a single one 17792 ;; will toggle their presence according to the state of the 17793 ;; first item in the list. Without an argument, repair the 17794 ;; list. 17795 (if (or radio-list-p 17796 (and (boundp org-list-checkbox-radio-mode) 17797 org-list-checkbox-radio-mode)) 17798 (org-toggle-radio-button arg) 17799 (let* ((begin (org-element-property :contents-begin context)) 17800 (struct (org-element-property :structure context)) 17801 (old-struct (copy-tree struct)) 17802 (first-box (save-excursion 17803 (goto-char begin) 17804 (looking-at org-list-full-item-re) 17805 (match-string-no-properties 3))) 17806 (new-box (cond ((equal arg '(16)) "[-]") 17807 ((equal arg '(4)) (unless first-box "[ ]")) 17808 ((equal first-box "[X]") "[ ]") 17809 (t "[X]")))) 17810 (cond 17811 (arg 17812 (dolist (pos 17813 (org-list-get-all-items 17814 begin struct (org-list-prevs-alist struct))) 17815 (org-list-set-checkbox pos struct new-box))) 17816 ((and first-box (eq (point) begin)) 17817 ;; For convenience, when point is at bol on the first 17818 ;; item of the list and no argument is provided, simply 17819 ;; toggle checkbox of that item, if any. 17820 (org-list-set-checkbox begin struct new-box))) 17821 (when (equal 17822 (org-list-write-struct 17823 struct (org-list-parents-alist struct) old-struct) 17824 old-struct) 17825 (message "Cannot update this checkbox")) 17826 (org-update-checkbox-count-maybe)))) 17827 (`keyword 17828 (let ((org-inhibit-startup-visibility-stuff t) 17829 (org-startup-align-all-tables nil)) 17830 (when (boundp 'org-table-coordinate-overlays) 17831 (mapc #'delete-overlay org-table-coordinate-overlays) 17832 (setq org-table-coordinate-overlays nil)) 17833 (org-save-outline-visibility 'use-markers (org-mode-restart))) 17834 (message "Local setup has been refreshed")) 17835 ((or `property-drawer `node-property) 17836 (call-interactively #'org-property-action)) 17837 (`radio-target 17838 (call-interactively #'org-update-radio-target-regexp)) 17839 (`statistics-cookie 17840 (call-interactively #'org-update-statistics-cookies)) 17841 ((or `table `table-cell `table-row) 17842 ;; At a table, generate a plot if on the #+plot line, 17843 ;; recalculate every field and align it otherwise. Also 17844 ;; send the table if necessary. 17845 (cond 17846 ((and (org-match-line "[ \t]*#\\+plot:") 17847 (< (point) (org-element-property :post-affiliated context))) 17848 (org-plot/gnuplot)) 17849 ;; If the table has a `table.el' type, just give up. 17850 ((eq (org-element-property :type context) 'table.el) 17851 (message "%s" (substitute-command-keys "\\<org-mode-map>\ 17852 Use `\\[org-edit-special]' to edit table.el tables"))) 17853 ;; At a table row or cell, maybe recalculate line but always 17854 ;; align table. 17855 ((or (eq type 'table) 17856 ;; Check if point is at a TBLFM line. 17857 (and (eq type 'table-row) 17858 (= (point) (org-element-property :end context)))) 17859 (save-excursion 17860 (if (org-at-TBLFM-p) 17861 (progn (require 'org-table) 17862 (org-table-calc-current-TBLFM)) 17863 (goto-char (org-element-property :contents-begin context)) 17864 (org-call-with-arg 'org-table-recalculate (or arg t)) 17865 (orgtbl-send-table 'maybe)))) 17866 (t 17867 (org-table-maybe-eval-formula) 17868 (cond (arg (call-interactively #'org-table-recalculate)) 17869 ((org-table-maybe-recalculate-line)) 17870 (t (org-table-align)))))) 17871 ((or `timestamp (and `planning (guard (org-at-timestamp-p 'lax)))) 17872 (org-timestamp-change 0 'day)) 17873 ((and `nil (guard (org-at-heading-p))) 17874 ;; When point is on an unsupported object type, we can miss 17875 ;; the fact that it also is at a heading. Handle it here. 17876 (call-interactively #'org-set-tags-command)) 17877 ((guard 17878 (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook))) 17879 (_ 17880 (user-error 17881 (substitute-command-keys 17882 "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))))))) 17883 17884 (defun org-mode-restart () 17885 "Restart `org-mode'." 17886 (interactive) 17887 (let ((indent-status (bound-and-true-p org-indent-mode))) 17888 (funcall major-mode) 17889 (hack-local-variables) 17890 (when (and indent-status (not (bound-and-true-p org-indent-mode))) 17891 (org-indent-mode -1)) 17892 (org-reset-file-cache)) 17893 (message "%s restarted" major-mode)) 17894 17895 (defun org-flag-above-first-heading (&optional arg) 17896 "Hide from bob up to the first heading. 17897 Move point to the beginning of first heading or end of buffer." 17898 (goto-char (point-min)) 17899 (unless (org-at-heading-p) 17900 (outline-next-heading)) 17901 (unless (bobp) 17902 (org-flag-region 1 (1- (point)) (not arg) 'outline))) 17903 17904 (defun org-show-branches-buffer () 17905 "Show all branches in the buffer." 17906 (org-flag-above-first-heading) 17907 (outline-hide-sublevels 1) 17908 (unless (eobp) 17909 (outline-show-branches) 17910 (while (outline-get-next-sibling) 17911 (outline-show-branches))) 17912 (goto-char (point-min))) 17913 17914 (defun org-kill-note-or-show-branches () 17915 "Abort storing current note, or show just branches." 17916 (interactive) 17917 (cond (org-finish-function 17918 (let ((org-note-abort t)) (funcall org-finish-function))) 17919 ((org-before-first-heading-p) 17920 (org-show-branches-buffer) 17921 (org-hide-archived-subtrees (point-min) (point-max))) 17922 (t 17923 (let ((beg (progn (org-back-to-heading) (point))) 17924 (end (save-excursion (org-end-of-subtree t t) (point)))) 17925 (outline-hide-subtree) 17926 (outline-show-branches) 17927 (org-hide-archived-subtrees beg end))))) 17928 17929 (defun org-delete-indentation (&optional arg) 17930 "Join current line to previous and fix whitespace at join. 17931 17932 If previous line is a headline add to headline title. Otherwise 17933 the function calls `delete-indentation'. 17934 17935 I.e. with a non-nil optional argument, join the line with the 17936 following one. If there is a region then join the lines in that 17937 region." 17938 (interactive "*P") 17939 (if (save-excursion 17940 (beginning-of-line (if arg 1 0)) 17941 (let ((case-fold-search nil)) 17942 (looking-at org-complex-heading-regexp))) 17943 ;; At headline. 17944 (let ((tags-column (when (match-beginning 5) 17945 (save-excursion (goto-char (match-beginning 5)) 17946 (current-column)))) 17947 (string (concat " " (progn (when arg (forward-line 1)) 17948 (org-trim (delete-and-extract-region 17949 (line-beginning-position) 17950 (line-end-position))))))) 17951 (unless (bobp) (delete-region (point) (1- (point)))) 17952 (goto-char (or (match-end 4) 17953 (match-beginning 5) 17954 (match-end 0))) 17955 (skip-chars-backward " \t") 17956 (save-excursion (insert string)) 17957 ;; Adjust alignment of tags. 17958 (cond 17959 ((not tags-column)) ;no tags 17960 (org-auto-align-tags (org-align-tags)) 17961 (t (org--align-tags-here tags-column)))) ;preserve tags column 17962 (let ((current-prefix-arg arg)) 17963 (call-interactively #'delete-indentation)))) 17964 17965 (defun org-open-line (n) 17966 "Insert a new row in tables, call `open-line' elsewhere. 17967 If `org-special-ctrl-o' is nil, just call `open-line' everywhere. 17968 As a special case, when a document starts with a table, allow to 17969 call `open-line' on the very first character." 17970 (interactive "*p") 17971 (if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p)) 17972 (org-table-insert-row) 17973 (open-line n))) 17974 17975 (defun org--newline (indent arg interactive) 17976 "Call `newline-and-indent' or just `newline'. 17977 If INDENT is non-nil, call `newline-and-indent' with ARG to 17978 indent unconditionally; otherwise, call `newline' with ARG and 17979 INTERACTIVE, which can trigger indentation if 17980 `electric-indent-mode' is enabled." 17981 (if indent 17982 (org-newline-and-indent arg) 17983 (newline arg interactive))) 17984 17985 (defun org-return (&optional indent arg interactive) 17986 "Goto next table row or insert a newline. 17987 17988 Calls `org-table-next-row' or `newline', depending on context. 17989 17990 When optional INDENT argument is non-nil, call 17991 `newline-and-indent' with ARG, otherwise call `newline' with ARG 17992 and INTERACTIVE. 17993 17994 When `org-return-follows-link' is non-nil and point is on 17995 a timestamp or a link, call `org-open-at-point'. However, it 17996 will not happen if point is in a table or on a \"dead\" 17997 object (e.g., within a comment). In these case, you need to use 17998 `org-open-at-point' directly." 17999 (interactive "i\nP\np") 18000 (let* ((context (if org-return-follows-link (org-element-context) 18001 (org-element-at-point))) 18002 (element-type (org-element-type context))) 18003 (cond 18004 ;; In a table, call `org-table-next-row'. However, before first 18005 ;; column or after last one, split the table. 18006 ((or (and (eq 'table element-type) 18007 (not (eq 'table.el (org-element-property :type context))) 18008 (>= (point) (org-element-property :contents-begin context)) 18009 (< (point) (org-element-property :contents-end context))) 18010 (org-element-lineage context '(table-row table-cell) t)) 18011 (if (or (looking-at-p "[ \t]*$") 18012 (save-excursion (skip-chars-backward " \t") (bolp))) 18013 (insert "\n") 18014 (org-table-justify-field-maybe) 18015 (call-interactively #'org-table-next-row))) 18016 ;; On a link or a timestamp, call `org-open-at-point' if 18017 ;; `org-return-follows-link' allows it. Tolerate fuzzy 18018 ;; locations, e.g., in a comment, as `org-open-at-point'. 18019 ((and org-return-follows-link 18020 (or (and (eq 'link element-type) 18021 ;; Ensure point is not on the white spaces after 18022 ;; the link. 18023 (let ((origin (point))) 18024 (org-with-point-at (org-element-property :end context) 18025 (skip-chars-backward " \t") 18026 (> (point) origin)))) 18027 (org-in-regexp org-ts-regexp-both nil t) 18028 (org-in-regexp org-tsr-regexp-both nil t) 18029 (org-in-regexp org-link-any-re nil t))) 18030 (call-interactively #'org-open-at-point)) 18031 ;; Insert newline in heading, but preserve tags. 18032 ((and (not (bolp)) 18033 (let ((case-fold-search nil)) 18034 (org-match-line org-complex-heading-regexp))) 18035 ;; At headline. Split line. However, if point is on keyword, 18036 ;; priority cookie or tags, do not break any of them: add 18037 ;; a newline after the headline instead. 18038 (let ((tags-column (and (match-beginning 5) 18039 (save-excursion (goto-char (match-beginning 5)) 18040 (current-column)))) 18041 (string 18042 (when (and (match-end 4) (org-point-in-group (point) 4)) 18043 (delete-and-extract-region (point) (match-end 4))))) 18044 ;; Adjust tag alignment. 18045 (cond 18046 ((not (and tags-column string))) 18047 (org-auto-align-tags (org-align-tags)) 18048 (t (org--align-tags-here tags-column))) ;preserve tags column 18049 (end-of-line) 18050 (org-show-entry) 18051 (org--newline indent arg interactive) 18052 (when string (save-excursion (insert (org-trim string)))))) 18053 ;; In a list, make sure indenting keeps trailing text within. 18054 ((and (not (eolp)) 18055 (org-element-lineage context '(item))) 18056 (let ((trailing-data 18057 (delete-and-extract-region (point) (line-end-position)))) 18058 (org--newline indent arg interactive) 18059 (save-excursion (insert trailing-data)))) 18060 (t 18061 ;; Do not auto-fill when point is in an Org property drawer. 18062 (let ((auto-fill-function (and (not (org-at-property-p)) 18063 auto-fill-function))) 18064 (org--newline indent arg interactive)))))) 18065 18066 (defun org-return-and-maybe-indent () 18067 "Goto next table row, or insert a newline, maybe indented. 18068 Call `org-table-next-row' or `org-return', depending on context. 18069 See the individual commands for more information. 18070 18071 When inserting a newline, if `org-adapt-indentation' is t: 18072 indent the line if `electric-indent-mode' is disabled, don't 18073 indent it if it is enabled." 18074 (interactive) 18075 (org-return (not electric-indent-mode))) 18076 18077 (defun org-ctrl-c-tab (&optional arg) 18078 "Toggle columns width in a table, or show children. 18079 Call `org-table-toggle-column-width' if point is in a table. 18080 Otherwise provide a compact view of the children. ARG is the 18081 level to hide." 18082 (interactive "p") 18083 (cond 18084 ((org-at-table-p) 18085 (call-interactively #'org-table-toggle-column-width)) 18086 ((org-before-first-heading-p) 18087 (save-excursion 18088 (org-flag-above-first-heading) 18089 (outline-hide-sublevels (or arg 1)))) 18090 (t 18091 (outline-hide-subtree) 18092 (org-show-children arg)))) 18093 18094 (defun org-ctrl-c-star () 18095 "Compute table, or change heading status of lines. 18096 Calls `org-table-recalculate' or `org-toggle-heading', 18097 depending on context." 18098 (interactive) 18099 (cond 18100 ((org-at-table-p) 18101 (call-interactively 'org-table-recalculate)) 18102 (t 18103 ;; Convert all lines in region to list items 18104 (call-interactively 'org-toggle-heading)))) 18105 18106 (defun org-ctrl-c-minus () 18107 "Insert separator line in table or modify bullet status of line. 18108 Also turns a plain line or a region of lines into list items. 18109 Calls `org-table-insert-hline', `org-toggle-item', or 18110 `org-cycle-list-bullet', depending on context." 18111 (interactive) 18112 (cond 18113 ((org-at-table-p) 18114 (call-interactively 'org-table-insert-hline)) 18115 ((org-region-active-p) 18116 (call-interactively 'org-toggle-item)) 18117 ((org-in-item-p) 18118 (call-interactively 'org-cycle-list-bullet)) 18119 (t 18120 (call-interactively 'org-toggle-item)))) 18121 18122 (defun org-toggle-heading (&optional nstars) 18123 "Convert headings to normal text, or items or text to headings. 18124 If there is no active region, only convert the current line. 18125 18126 With a `\\[universal-argument]' prefix, convert the whole list at 18127 point into heading. 18128 18129 In a region: 18130 18131 - If the first non blank line is a headline, remove the stars 18132 from all headlines in the region. 18133 18134 - If it is a normal line, turn each and every normal line (i.e., 18135 not an heading or an item) in the region into headings. If you 18136 want to convert only the first line of this region, use one 18137 universal prefix argument. 18138 18139 - If it is a plain list item, turn all plain list items into headings. 18140 18141 When converting a line into a heading, the number of stars is chosen 18142 such that the lines become children of the current entry. However, 18143 when a numeric prefix argument is given, its value determines the 18144 number of stars to add." 18145 (interactive "P") 18146 (let ((skip-blanks 18147 ;; Return beginning of first non-blank line, starting from 18148 ;; line at POS. 18149 (lambda (pos) 18150 (save-excursion 18151 (goto-char pos) 18152 (while (org-at-comment-p) (forward-line)) 18153 (skip-chars-forward " \r\t\n") 18154 (point-at-bol)))) 18155 beg end toggled) 18156 ;; Determine boundaries of changes. If a universal prefix has 18157 ;; been given, put the list in a region. If region ends at a bol, 18158 ;; do not consider the last line to be in the region. 18159 18160 (when (and current-prefix-arg (org-at-item-p)) 18161 (when (listp current-prefix-arg) (setq current-prefix-arg 1)) 18162 (org-mark-element)) 18163 18164 (if (org-region-active-p) 18165 (setq beg (funcall skip-blanks (region-beginning)) 18166 end (copy-marker (save-excursion 18167 (goto-char (region-end)) 18168 (if (bolp) (point) (point-at-eol))))) 18169 (setq beg (funcall skip-blanks (point-at-bol)) 18170 end (copy-marker (point-at-eol)))) 18171 ;; Ensure inline tasks don't count as headings. 18172 (org-with-limited-levels 18173 (save-excursion 18174 (goto-char beg) 18175 (cond 18176 ;; Case 1. Started at an heading: de-star headings. 18177 ((org-at-heading-p) 18178 (while (< (point) end) 18179 (when (org-at-heading-p t) 18180 (looking-at org-outline-regexp) (replace-match "") 18181 (setq toggled t)) 18182 (forward-line))) 18183 ;; Case 2. Started at an item: change items into headlines. 18184 ;; One star will be added by `org-list-to-subtree'. 18185 ((org-at-item-p) 18186 (while (< (point) end) 18187 (when (org-at-item-p) 18188 ;; Pay attention to cases when region ends before list. 18189 (let* ((struct (org-list-struct)) 18190 (list-end 18191 (min (org-list-get-bottom-point struct) (1+ end)))) 18192 (save-restriction 18193 (narrow-to-region (point) list-end) 18194 (insert (org-list-to-subtree 18195 (org-list-to-lisp t) 18196 (pcase (org-current-level) 18197 (`nil 1) 18198 (l (1+ (org-reduced-level l))))) 18199 "\n"))) 18200 (setq toggled t)) 18201 (forward-line))) 18202 ;; Case 3. Started at normal text: make every line an heading, 18203 ;; skipping headlines and items. 18204 (t (let* ((stars 18205 (make-string 18206 (if (numberp nstars) nstars (or (org-current-level) 0)) ?*)) 18207 (add-stars 18208 (cond (nstars "") ; stars from prefix only 18209 ((equal stars "") "*") ; before first heading 18210 (org-odd-levels-only "**") ; inside heading, odd 18211 (t "*"))) ; inside heading, oddeven 18212 (rpl (concat stars add-stars " ")) 18213 (lend (when (listp nstars) (save-excursion (end-of-line) (point))))) 18214 (while (< (point) (if (equal nstars '(4)) lend end)) 18215 (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) 18216 (looking-at "\\([ \t]*\\)\\(\\S-\\)")) 18217 (replace-match (concat rpl (match-string 2))) (setq toggled t)) 18218 (forward-line))))))) 18219 (unless toggled (message "Cannot toggle heading from here")))) 18220 18221 (defun org-meta-return (&optional arg) 18222 "Insert a new heading or wrap a region in a table. 18223 Calls `org-insert-heading', `org-insert-item' or 18224 `org-table-wrap-region', depending on context. When called with 18225 an argument, unconditionally call `org-insert-heading'." 18226 (interactive "P") 18227 (org-check-before-invisible-edit 'insert) 18228 (or (run-hook-with-args-until-success 'org-metareturn-hook) 18229 (call-interactively (cond (arg #'org-insert-heading) 18230 ((org-at-table-p) #'org-table-wrap-region) 18231 ((org-in-item-p) #'org-insert-item) 18232 (t #'org-insert-heading))))) 18233 18234 ;;; Menu entries 18235 (defsubst org-in-subtree-not-table-p () 18236 "Are we in a subtree and not in a table?" 18237 (and (not (org-before-first-heading-p)) 18238 (not (org-at-table-p)))) 18239 18240 ;; Define the Org mode menus 18241 (easy-menu-define org-org-menu org-mode-map "Org menu." 18242 `("Org" 18243 ("Show/Hide" 18244 ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))] 18245 ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] 18246 ["Sparse Tree..." org-sparse-tree t] 18247 ["Reveal Context" org-reveal t] 18248 ["Show All" org-show-all t] 18249 "--" 18250 ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) 18251 "--" 18252 ["New Heading" org-insert-heading t] 18253 ("Navigate Headings" 18254 ["Up" outline-up-heading t] 18255 ["Next" outline-next-visible-heading t] 18256 ["Previous" outline-previous-visible-heading t] 18257 ["Next Same Level" outline-forward-same-level t] 18258 ["Previous Same Level" outline-backward-same-level t] 18259 "--" 18260 ["Jump" org-goto t]) 18261 ("Edit Structure" 18262 ["Move Subtree Up" org-metaup (org-at-heading-p)] 18263 ["Move Subtree Down" org-metadown (org-at-heading-p)] 18264 "--" 18265 ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)] 18266 ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)] 18267 ["Paste Subtree" org-paste-special (not (org-at-table-p))] 18268 "--" 18269 ["Clone subtree, shift time" org-clone-subtree-with-time-shift t] 18270 "--" 18271 ["Copy visible text" org-copy-visible t] 18272 "--" 18273 ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)] 18274 ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)] 18275 ["Demote Heading" org-metaright (org-in-subtree-not-table-p)] 18276 ["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)] 18277 "--" 18278 ["Sort Region/Children" org-sort t] 18279 "--" 18280 ["Convert to odd levels" org-convert-to-odd-levels t] 18281 ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) 18282 ("Editing" 18283 ["Emphasis..." org-emphasize t] 18284 ["Add block structure" org-insert-structure-template t] 18285 ["Edit Source Example" org-edit-special t] 18286 "--" 18287 ["Footnote new/jump" org-footnote-action t] 18288 ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"]) 18289 ("Archive" 18290 ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)] 18291 "--" 18292 ["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)] 18293 ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)] 18294 ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)]) 18295 "--" 18296 ("Hyperlinks" 18297 ["Store Link (Global)" org-store-link t] 18298 ["Find existing link to here" org-occur-link-in-agenda-files t] 18299 ["Insert Link" org-insert-link t] 18300 ["Follow Link" org-open-at-point t] 18301 "--" 18302 ["Next link" org-next-link t] 18303 ["Previous link" org-previous-link t] 18304 "--" 18305 ["Descriptive Links" 18306 org-toggle-link-display 18307 :style radio 18308 :selected org-descriptive-links 18309 ] 18310 ["Literal Links" 18311 org-toggle-link-display 18312 :style radio 18313 :selected (not org-descriptive-links)]) 18314 "--" 18315 ("TODO Lists" 18316 ["TODO/DONE/-" org-todo t] 18317 ("Select keyword" 18318 ["Next keyword" org-shiftright (org-at-heading-p)] 18319 ["Previous keyword" org-shiftleft (org-at-heading-p)] 18320 ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))] 18321 ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))] 18322 ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]) 18323 ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"] 18324 ["Global TODO list" org-todo-list :active t :keys "\\[org-agenda] t"] 18325 "--" 18326 ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies) 18327 :selected org-enforce-todo-dependencies :style toggle :active t] 18328 "Settings for tree at point" 18329 ["Do Children sequentially" org-toggle-ordered-property :style radio 18330 :selected (org-entry-get nil "ORDERED") 18331 :active org-enforce-todo-dependencies :keys "C-c C-x o"] 18332 ["Do Children parallel" org-toggle-ordered-property :style radio 18333 :selected (not (org-entry-get nil "ORDERED")) 18334 :active org-enforce-todo-dependencies :keys "C-c C-x o"] 18335 "--" 18336 ["Set Priority" org-priority t] 18337 ["Priority Up" org-shiftup t] 18338 ["Priority Down" org-shiftdown t] 18339 "--" 18340 ["Get news from all feeds" org-feed-update-all t] 18341 ["Go to the inbox of a feed..." org-feed-goto-inbox t] 18342 ["Customize feeds" (customize-variable 'org-feed-alist) t]) 18343 ("TAGS and Properties" 18344 ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))] 18345 ["Change tag in region" org-change-tag-in-region (org-region-active-p)] 18346 "--" 18347 ["Set property" org-set-property (not (org-before-first-heading-p))] 18348 ["Column view of properties" org-columns t] 18349 ["Insert Column View DBlock" org-columns-insert-dblock t]) 18350 ("Dates and Scheduling" 18351 ["Timestamp" org-time-stamp (not (org-before-first-heading-p))] 18352 ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))] 18353 ("Change Date" 18354 ["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)] 18355 ["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)] 18356 ["1 ... Later" org-shiftup (org-at-timestamp-p 'lax)] 18357 ["1 ... Earlier" org-shiftdown (org-at-timestamp-p 'lax)]) 18358 ["Compute Time Range" org-evaluate-time-range t] 18359 ["Schedule Item" org-schedule (not (org-before-first-heading-p))] 18360 ["Deadline" org-deadline (not (org-before-first-heading-p))] 18361 "--" 18362 ["Custom time format" org-toggle-time-stamp-overlays 18363 :style radio :selected org-display-custom-times] 18364 "--" 18365 ["Goto Calendar" org-goto-calendar t] 18366 ["Date from Calendar" org-date-from-calendar t] 18367 "--" 18368 ["Start/Restart Timer" org-timer-start t] 18369 ["Pause/Continue Timer" org-timer-pause-or-continue t] 18370 ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"] 18371 ["Insert Timer String" org-timer t] 18372 ["Insert Timer Item" org-timer-item t]) 18373 ("Logging work" 18374 ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"] 18375 ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"] 18376 ["Clock out" org-clock-out t] 18377 ["Clock cancel" org-clock-cancel t] 18378 "--" 18379 ["Mark as default task" org-clock-mark-default-task t] 18380 ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"] 18381 ["Goto running clock" org-clock-goto t] 18382 "--" 18383 ["Display times" org-clock-display t] 18384 ["Create clock table" org-clock-report t] 18385 "--" 18386 ["Record DONE time" 18387 (progn (setq org-log-done (not org-log-done)) 18388 (message "Switching to %s will %s record a timestamp" 18389 (car org-done-keywords) 18390 (if org-log-done "automatically" "not"))) 18391 :style toggle :selected org-log-done]) 18392 "--" 18393 ["Agenda Command..." org-agenda t] 18394 ["Set Restriction Lock" org-agenda-set-restriction-lock t] 18395 ("File List for Agenda") 18396 ("Special views current file" 18397 ["TODO Tree" org-show-todo-tree t] 18398 ["Check Deadlines" org-check-deadlines t] 18399 ["Tags/Property tree" org-match-sparse-tree t]) 18400 "--" 18401 ["Export/Publish..." org-export-dispatch t] 18402 ("LaTeX" 18403 ["Org CDLaTeX mode" org-cdlatex-mode :active (require 'cdlatex nil t) 18404 :style toggle :selected org-cdlatex-mode] 18405 ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] 18406 ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] 18407 ["Modify math symbol" org-cdlatex-math-modify 18408 (org-inside-LaTeX-fragment-p)] 18409 ["Insert citation" org-reftex-citation t]) 18410 "--" 18411 ("Documentation" 18412 ["Show Version" org-version t] 18413 ["Info Documentation" org-info t] 18414 ["Browse Org News" org-browse-news t]) 18415 ("Customize" 18416 ["Browse Org Group" org-customize t] 18417 "--" 18418 ["Expand This Menu" org-create-customize-menu t]) 18419 ["Send bug report" org-submit-bug-report t] 18420 "--" 18421 ("Refresh/Reload" 18422 ["Refresh setup current buffer" org-mode-restart t] 18423 ["Reload Org (after update)" org-reload t] 18424 ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x !"]))) 18425 18426 (easy-menu-define org-tbl-menu org-mode-map "Org Table menu." 18427 '("Table" 18428 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)] 18429 ["Next Field" org-cycle (org-at-table-p)] 18430 ["Previous Field" org-shifttab (org-at-table-p)] 18431 ["Next Row" org-return (org-at-table-p)] 18432 "--" 18433 ["Blank Field" org-table-blank-field (org-at-table-p)] 18434 ["Edit Field" org-table-edit-field (org-at-table-p)] 18435 ["Copy Field from Above" org-table-copy-down (org-at-table-p)] 18436 "--" 18437 ("Column" 18438 ["Move Column Left" org-metaleft (org-at-table-p)] 18439 ["Move Column Right" org-metaright (org-at-table-p)] 18440 ["Delete Column" org-shiftmetaleft (org-at-table-p)] 18441 ["Insert Column" org-shiftmetaright (org-at-table-p)] 18442 ["Shrink Column" org-table-toggle-column-width (org-at-table-p)]) 18443 ("Row" 18444 ["Move Row Up" org-metaup (org-at-table-p)] 18445 ["Move Row Down" org-metadown (org-at-table-p)] 18446 ["Delete Row" org-shiftmetaup (org-at-table-p)] 18447 ["Insert Row" org-shiftmetadown (org-at-table-p)] 18448 ["Sort lines in region" org-table-sort-lines (org-at-table-p)] 18449 "--" 18450 ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) 18451 ("Rectangle" 18452 ["Copy Rectangle" org-copy-special (org-at-table-p)] 18453 ["Cut Rectangle" org-cut-special (org-at-table-p)] 18454 ["Paste Rectangle" org-paste-special (org-at-table-p)] 18455 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) 18456 "--" 18457 ("Calculate" 18458 ["Set Column Formula" org-table-eval-formula (org-at-table-p)] 18459 ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] 18460 ["Edit Formulas" org-edit-special (org-at-table-p)] 18461 "--" 18462 ["Recalculate line" org-table-recalculate (org-at-table-p)] 18463 ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] 18464 ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] 18465 "--" 18466 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] 18467 "--" 18468 ["Sum Column/Rectangle" org-table-sum 18469 (or (org-at-table-p) (org-region-active-p))] 18470 ["Which Column?" org-table-current-column (org-at-table-p)]) 18471 ["Debug Formulas" 18472 org-table-toggle-formula-debugger 18473 :style toggle :selected (bound-and-true-p org-table-formula-debug)] 18474 ["Show Col/Row Numbers" 18475 org-table-toggle-coordinate-overlays 18476 :style toggle 18477 :selected (bound-and-true-p org-table-overlay-coordinates)] 18478 "--" 18479 ["Create" org-table-create (not (org-at-table-p))] 18480 ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] 18481 ["Import from File" org-table-import (not (org-at-table-p))] 18482 ["Export to File" org-table-export (org-at-table-p)] 18483 "--" 18484 ["Create/Convert from/to table.el" org-table-create-with-table.el t] 18485 "--" 18486 ("Plot" 18487 ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"] 18488 ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"]))) 18489 18490 (defun org-info (&optional node) 18491 "Read documentation for Org in the info system. 18492 With optional NODE, go directly to that node." 18493 (interactive) 18494 (info (format "(org)%s" (or node "")))) 18495 18496 (defun org-browse-news () 18497 "Browse the news for the latest major release." 18498 (interactive) 18499 (browse-url "https://orgmode.org/Changes.html")) 18500 18501 ;;;###autoload 18502 (defun org-submit-bug-report () 18503 "Submit a bug report on Org via mail. 18504 18505 Don't hesitate to report any problems or inaccurate documentation. 18506 18507 If you don't have setup sending mail from (X)Emacs, please copy the 18508 output buffer into your mail program, as it gives us important 18509 information about your Org version and configuration." 18510 (interactive) 18511 (require 'reporter) 18512 (defvar reporter-prompt-for-summary-p) 18513 (org-load-modules-maybe) 18514 (org-require-autoloaded-modules) 18515 (let ((reporter-prompt-for-summary-p "Bug report subject: ")) 18516 (reporter-submit-bug-report 18517 "emacs-orgmode@gnu.org" 18518 (org-version nil 'full) 18519 (let (list) 18520 (save-window-excursion 18521 (pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) 18522 (delete-other-windows) 18523 (erase-buffer) 18524 (insert "You are about to submit a bug report to the Org mailing list. 18525 18526 If your report is about Org installation, please read this section: 18527 https://orgmode.org/org.html#Installation 18528 18529 Please read https://orgmode.org/org.html#Feedback on how to make 18530 a good report, it will help Org contributors fixing your problem. 18531 18532 Search https://lists.gnu.org/archive/html/emacs-orgmode/ to see 18533 if the issue you are about to raise has already been dealt with. 18534 18535 We also would like to add your full Org and Outline configuration 18536 to the bug report. It will help us debugging the issue. 18537 18538 *HOWEVER*, some variables you have customized may contain private 18539 information. The names of customers, colleagues, or friends, might 18540 appear in the form of file names, tags, todo states or search strings. 18541 If you answer \"yes\" to the prompt, you might want to check and remove 18542 such private information before sending the email.") 18543 (add-text-properties (point-min) (point-max) '(face org-warning)) 18544 (when (yes-or-no-p "Include your Org configuration ") 18545 (mapatoms 18546 (lambda (v) 18547 (and (boundp v) 18548 (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v)) 18549 (or (and (symbol-value v) 18550 (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v))) 18551 (and 18552 (get v 'custom-type) (get v 'standard-value) 18553 (not (equal (symbol-value v) (eval (car (get v 'standard-value))))))) 18554 (push v list))))) 18555 (kill-buffer (get-buffer "*Warn about privacy*")) 18556 list)) 18557 nil nil 18558 "Remember to cover the basics, that is, what you expected to happen and 18559 what in fact did happen. You don't know how to make a good report? See 18560 18561 https://orgmode.org/manual/Feedback.html#Feedback 18562 18563 Your bug report will be posted to the Org mailing list. 18564 ------------------------------------------------------------------------") 18565 (save-excursion 18566 (when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t) 18567 (replace-match "\\1[BUG] \\3 [\\2]"))))) 18568 18569 18570 (defun org-install-agenda-files-menu () 18571 "Install agenda file menu." 18572 (let ((bl (buffer-list))) 18573 (save-excursion 18574 (while bl 18575 (set-buffer (pop bl)) 18576 (when (derived-mode-p 'org-mode) (setq bl nil))) 18577 (when (derived-mode-p 'org-mode) 18578 (easy-menu-change 18579 '("Org") "File List for Agenda" 18580 (append 18581 (list 18582 ["Edit File List" (org-edit-agenda-file-list) t] 18583 ["Add/Move Current File to Front of List" org-agenda-file-to-front t] 18584 ["Remove Current File from List" org-remove-file t] 18585 ["Cycle through agenda files" org-cycle-agenda-files t] 18586 ["Occur in all agenda files" org-occur-in-agenda-files t] 18587 "--") 18588 (mapcar 'org-file-menu-entry 18589 ;; Prevent initialization from failing. 18590 (ignore-errors (org-agenda-files t))))))))) 18591 18592 ;;;; Documentation 18593 18594 (defun org-require-autoloaded-modules () 18595 (interactive) 18596 (mapc #'require 18597 '(org-agenda org-archive org-attach org-clock org-colview org-id 18598 org-table org-timer))) 18599 18600 ;;;###autoload 18601 (defun org-reload (&optional uncompiled) 18602 "Reload all Org Lisp files. 18603 With prefix arg UNCOMPILED, load the uncompiled versions." 18604 (interactive "P") 18605 (require 'loadhist) 18606 (let* ((org-dir (org-find-library-dir "org")) 18607 (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir)) 18608 (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?") 18609 (remove-re (format "\\`%s\\'" 18610 (regexp-opt '("org" "org-loaddefs" "org-version")))) 18611 (feats (delete-dups 18612 (mapcar 'file-name-sans-extension 18613 (mapcar 'file-name-nondirectory 18614 (delq nil 18615 (mapcar 'feature-file 18616 features)))))) 18617 (lfeat (append 18618 (sort 18619 (setq feats 18620 (delq nil (mapcar 18621 (lambda (f) 18622 (if (and (string-match feature-re f) 18623 (not (string-match remove-re f))) 18624 f nil)) 18625 feats))) 18626 'string-lessp) 18627 (list "org-version" "org"))) 18628 (load-suffixes (when (boundp 'load-suffixes) load-suffixes)) 18629 (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes)) 18630 load-uncore load-misses) 18631 (setq load-misses 18632 (delq 't 18633 (mapcar (lambda (f) 18634 (or (org-load-noerror-mustsuffix (concat org-dir f)) 18635 (and (string= org-dir contrib-dir) 18636 (org-load-noerror-mustsuffix (concat contrib-dir f))) 18637 (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f)) 18638 (push f load-uncore) 18639 't) 18640 f)) 18641 lfeat))) 18642 (when load-uncore 18643 (message "The following feature%s found in load-path, please check if that's correct:\n%s" 18644 (if (> (length load-uncore) 1) "s were" " was") 18645 (reverse load-uncore))) 18646 (if load-misses 18647 (message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" 18648 (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full)) 18649 (message "Successfully reloaded Org\n%s" (org-version nil 'full))))) 18650 18651 ;;;###autoload 18652 (defun org-customize () 18653 "Call the customize function with org as argument." 18654 (interactive) 18655 (org-load-modules-maybe) 18656 (org-require-autoloaded-modules) 18657 (customize-browse 'org)) 18658 18659 (defun org-create-customize-menu () 18660 "Create a full customization menu for Org mode, insert it into the menu." 18661 (interactive) 18662 (org-load-modules-maybe) 18663 (org-require-autoloaded-modules) 18664 (easy-menu-change 18665 '("Org") "Customize" 18666 `(["Browse Org group" org-customize t] 18667 "--" 18668 ,(customize-menu-create 'org) 18669 ["Set" Custom-set t] 18670 ["Save" Custom-save t] 18671 ["Reset to Current" Custom-reset-current t] 18672 ["Reset to Saved" Custom-reset-saved t] 18673 ["Reset to Standard Settings" Custom-reset-standard t])) 18674 (message "\"Org\"-menu now contains full customization menu")) 18675 18676 ;;;; Miscellaneous stuff 18677 18678 ;;; Generally useful functions 18679 18680 (defun org-in-clocktable-p () 18681 "Check if the cursor is in a clocktable." 18682 (let ((pos (point)) start) 18683 (save-excursion 18684 (end-of-line 1) 18685 (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t) 18686 (setq start (match-beginning 0)) 18687 (re-search-forward "^[ \t]*#\\+END:.*" nil t) 18688 (>= (match-end 0) pos) 18689 start)))) 18690 18691 (defun org-in-verbatim-emphasis () 18692 (save-match-data 18693 (and (org-in-regexp org-verbatim-re 2) 18694 (>= (point) (match-beginning 3)) 18695 (<= (point) (match-end 4))))) 18696 18697 (defun org-goto-marker-or-bmk (marker &optional bookmark) 18698 "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." 18699 (if (and marker (marker-buffer marker) 18700 (buffer-live-p (marker-buffer marker))) 18701 (progn 18702 (pop-to-buffer-same-window (marker-buffer marker)) 18703 (when (or (> marker (point-max)) (< marker (point-min))) 18704 (widen)) 18705 (goto-char marker) 18706 (org-show-context 'org-goto)) 18707 (if bookmark 18708 (bookmark-jump bookmark) 18709 (error "Cannot find location")))) 18710 18711 (defun org-quote-csv-field (s) 18712 "Quote field for inclusion in CSV material." 18713 (if (string-match "[\",]" s) 18714 (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") 18715 s)) 18716 18717 (defun org-force-self-insert (N) 18718 "Needed to enforce self-insert under remapping." 18719 (interactive "p") 18720 (self-insert-command N)) 18721 18722 (defun org-quote-vert (s) 18723 "Replace \"|\" with \"\\vert\"." 18724 (while (string-match "|" s) 18725 (setq s (replace-match "\\vert" t t s))) 18726 s) 18727 18728 (defun org-uuidgen-p (s) 18729 "Is S an ID created by UUIDGEN?" 18730 (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) 18731 18732 (defun org-in-src-block-p (&optional inside) 18733 "Whether point is in a code source block. 18734 When INSIDE is non-nil, don't consider we are within a source 18735 block when point is at #+BEGIN_SRC or #+END_SRC." 18736 (let ((case-fold-search t)) 18737 (or (and (eq (get-char-property (point) 'src-block) t)) 18738 (and (not inside) 18739 (save-match-data 18740 (save-excursion 18741 (beginning-of-line) 18742 (looking-at ".*#\\+\\(begin\\|end\\)_src"))))))) 18743 18744 (defun org-context () 18745 "Return a list of contexts of the current cursor position. 18746 If several contexts apply, all are returned. 18747 Each context entry is a list with a symbol naming the context, and 18748 two positions indicating start and end of the context. Possible 18749 contexts are: 18750 18751 :headline anywhere in a headline 18752 :headline-stars on the leading stars in a headline 18753 :todo-keyword on a TODO keyword (including DONE) in a headline 18754 :tags on the TAGS in a headline 18755 :priority on the priority cookie in a headline 18756 :item on the first line of a plain list item 18757 :item-bullet on the bullet/number of a plain list item 18758 :checkbox on the checkbox in a plain list item 18759 :table in an Org table 18760 :table-special on a special filed in a table 18761 :table-table in a table.el table 18762 :clocktable in a clocktable 18763 :src-block in a source block 18764 :link on a hyperlink 18765 :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT. 18766 :latex-fragment on a LaTeX fragment 18767 :latex-preview on a LaTeX fragment with overlaid preview image 18768 18769 This function expects the position to be visible because it uses font-lock 18770 faces as a help to recognize the following contexts: :table-special, :link, 18771 and :keyword." 18772 (let* ((f (get-text-property (point) 'face)) 18773 (faces (if (listp f) f (list f))) 18774 (case-fold-search t) 18775 (p (point)) clist o) 18776 ;; First the large context 18777 (cond 18778 ((org-at-heading-p t) 18779 (push (list :headline (point-at-bol) (point-at-eol)) clist) 18780 (when (progn 18781 (beginning-of-line 1) 18782 (looking-at org-todo-line-tags-regexp)) 18783 (push (org-point-in-group p 1 :headline-stars) clist) 18784 (push (org-point-in-group p 2 :todo-keyword) clist) 18785 (push (org-point-in-group p 4 :tags) clist)) 18786 (goto-char p) 18787 (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1)) 18788 (when (looking-at "\\[#[A-Z0-9]\\]") 18789 (push (org-point-in-group p 0 :priority) clist))) 18790 18791 ((org-at-item-p) 18792 (push (org-point-in-group p 2 :item-bullet) clist) 18793 (push (list :item (point-at-bol) 18794 (save-excursion (org-end-of-item) (point))) 18795 clist) 18796 (and (org-at-item-checkbox-p) 18797 (push (org-point-in-group p 0 :checkbox) clist))) 18798 18799 ((org-at-table-p) 18800 (push (list :table (org-table-begin) (org-table-end)) clist) 18801 (when (memq 'org-formula faces) 18802 (push (list :table-special 18803 (previous-single-property-change p 'face) 18804 (next-single-property-change p 'face)) 18805 clist))) 18806 ((org-at-table-p 'any) 18807 (push (list :table-table) clist))) 18808 (goto-char p) 18809 18810 (let ((case-fold-search t)) 18811 ;; New the "medium" contexts: clocktables, source blocks 18812 (cond ((org-in-clocktable-p) 18813 (push (list :clocktable 18814 (and (or (looking-at "[ \t]*\\(#\\+BEGIN: clocktable\\)") 18815 (re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t)) 18816 (match-beginning 1)) 18817 (and (re-search-forward "[ \t]*#\\+END:?" nil t) 18818 (match-end 0))) 18819 clist)) 18820 ((org-in-src-block-p) 18821 (push (list :src-block 18822 (and (or (looking-at "[ \t]*\\(#\\+BEGIN_SRC\\)") 18823 (re-search-backward "[ \t]*\\(#+BEGIN_SRC\\)" nil t)) 18824 (match-beginning 1)) 18825 (and (search-forward "#+END_SRC" nil t) 18826 (match-beginning 0))) 18827 clist)))) 18828 (goto-char p) 18829 18830 ;; Now the small context 18831 (cond 18832 ((org-at-timestamp-p) 18833 (push (org-point-in-group p 0 :timestamp) clist)) 18834 ((memq 'org-link faces) 18835 (push (list :link 18836 (previous-single-property-change p 'face) 18837 (next-single-property-change p 'face)) 18838 clist)) 18839 ((memq 'org-special-keyword faces) 18840 (push (list :keyword 18841 (previous-single-property-change p 'face) 18842 (next-single-property-change p 'face)) 18843 clist)) 18844 ((setq o (cl-some 18845 (lambda (o) 18846 (and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay) 18847 o)) 18848 (overlays-at (point)))) 18849 (push (list :latex-fragment 18850 (overlay-start o) (overlay-end o)) 18851 clist) 18852 (push (list :latex-preview 18853 (overlay-start o) (overlay-end o)) 18854 clist)) 18855 ((org-inside-LaTeX-fragment-p) 18856 ;; FIXME: positions wrong. 18857 (push (list :latex-fragment (point) (point)) clist))) 18858 18859 (setq clist (nreverse (delq nil clist))) 18860 clist)) 18861 18862 (defun org-between-regexps-p (start-re end-re &optional lim-up lim-down) 18863 "Non-nil when point is between matches of START-RE and END-RE. 18864 18865 Also return a non-nil value when point is on one of the matches. 18866 18867 Optional arguments LIM-UP and LIM-DOWN bound the search; they are 18868 buffer positions. Default values are the positions of headlines 18869 surrounding the point. 18870 18871 The functions returns a cons cell whose car (resp. cdr) is the 18872 position before START-RE (resp. after END-RE)." 18873 (save-match-data 18874 (let ((pos (point)) 18875 (limit-up (or lim-up (save-excursion (outline-previous-heading)))) 18876 (limit-down (or lim-down (save-excursion (outline-next-heading)))) 18877 beg end) 18878 (save-excursion 18879 ;; Point is on a block when on START-RE or if START-RE can be 18880 ;; found before it... 18881 (and (or (org-in-regexp start-re) 18882 (re-search-backward start-re limit-up t)) 18883 (setq beg (match-beginning 0)) 18884 ;; ... and END-RE after it... 18885 (goto-char (match-end 0)) 18886 (re-search-forward end-re limit-down t) 18887 (> (setq end (match-end 0)) pos) 18888 ;; ... without another START-RE in-between. 18889 (goto-char (match-beginning 0)) 18890 (not (re-search-backward start-re (1+ beg) t)) 18891 ;; Return value. 18892 (cons beg end)))))) 18893 18894 (defun org-in-block-p (names) 18895 "Non-nil when point belongs to a block whose name belongs to NAMES. 18896 18897 NAMES is a list of strings containing names of blocks. 18898 18899 Return first block name matched, or nil. Beware that in case of 18900 nested blocks, the returned name may not belong to the closest 18901 block from point." 18902 (save-match-data 18903 (catch 'exit 18904 (let ((case-fold-search t) 18905 (lim-up (save-excursion (outline-previous-heading))) 18906 (lim-down (save-excursion (outline-next-heading)))) 18907 (dolist (name names) 18908 (let ((n (regexp-quote name))) 18909 (when (org-between-regexps-p 18910 (concat "^[ \t]*#\\+begin_" n) 18911 (concat "^[ \t]*#\\+end_" n) 18912 lim-up lim-down) 18913 (throw 'exit n))))) 18914 nil))) 18915 18916 (defun org-occur-in-agenda-files (regexp &optional _nlines) 18917 "Call `multi-occur' with buffers for all agenda files." 18918 (interactive "sOrg-files matching: ") 18919 (let* ((files (org-agenda-files)) 18920 (tnames (mapcar #'file-truename files)) 18921 (extra org-agenda-text-search-extra-files)) 18922 (when (eq (car extra) 'agenda-archives) 18923 (setq extra (cdr extra)) 18924 (setq files (org-add-archive-files files))) 18925 (dolist (f extra) 18926 (unless (member (file-truename f) tnames) 18927 (unless (member f files) (setq files (append files (list f)))) 18928 (setq tnames (append tnames (list (file-truename f)))))) 18929 (multi-occur 18930 (mapcar (lambda (x) 18931 (with-current-buffer 18932 ;; FIXME: Why not just (find-file-noselect x)? 18933 ;; Is it to avoid the "revert buffer" prompt? 18934 (or (get-file-buffer x) (find-file-noselect x)) 18935 (widen) 18936 (current-buffer))) 18937 files) 18938 regexp))) 18939 18940 (add-hook 'occur-mode-find-occurrence-hook 18941 (lambda () (when (derived-mode-p 'org-mode) (org-reveal)))) 18942 18943 (defun org-occur-link-in-agenda-files () 18944 "Create a link and search for it in the agendas. 18945 The link is not stored in `org-stored-links', it is just created 18946 for the search purpose." 18947 (interactive) 18948 (let ((link (condition-case nil 18949 (org-store-link nil) 18950 (error "Unable to create a link to here")))) 18951 (org-occur-in-agenda-files (regexp-quote link)))) 18952 18953 (defun org-back-over-empty-lines () 18954 "Move backwards over whitespace, to the beginning of the first empty line. 18955 Returns the number of empty lines passed." 18956 (let ((pos (point))) 18957 (if (cdr (assq 'heading org-blank-before-new-entry)) 18958 (skip-chars-backward " \t\n\r") 18959 (unless (eobp) 18960 (forward-line -1))) 18961 (beginning-of-line 2) 18962 (goto-char (min (point) pos)) 18963 (count-lines (point) pos))) 18964 18965 ;;; TODO: Only called once, from ox-odt which should probably use 18966 ;;; org-export-inline-image-p or something. 18967 (defun org-file-image-p (file) 18968 "Return non-nil if FILE is an image." 18969 (save-match-data 18970 (string-match (image-file-name-regexp) file))) 18971 18972 (defun org-get-cursor-date (&optional with-time) 18973 "Return the date at cursor in as a time. 18974 This works in the calendar and in the agenda, anywhere else it just 18975 returns the current time. 18976 If WITH-TIME is non-nil, returns the time of the event at point (in 18977 the agenda) or the current time of the day; otherwise returns the 18978 earliest time on the cursor date that Org treats as that date 18979 (bearing in mind `org-extend-today-until')." 18980 (let (date day defd tp hod mod) 18981 (when with-time 18982 (setq tp (get-text-property (point) 'time)) 18983 (when (and tp (string-match "\\([0-2]?[0-9]\\):\\([0-5][0-9]\\)" tp)) 18984 (setq hod (string-to-number (match-string 1 tp)) 18985 mod (string-to-number (match-string 2 tp)))) 18986 (or tp (let ((now (decode-time))) 18987 (setq hod (nth 2 now) 18988 mod (nth 1 now))))) 18989 (cond 18990 ((eq major-mode 'calendar-mode) 18991 (setq date (calendar-cursor-to-date) 18992 defd (encode-time 0 (or mod 0) (or hod org-extend-today-until) 18993 (nth 1 date) (nth 0 date) (nth 2 date)))) 18994 ((eq major-mode 'org-agenda-mode) 18995 (setq day (get-text-property (point) 'day)) 18996 (when day 18997 (setq date (calendar-gregorian-from-absolute day) 18998 defd (encode-time 0 (or mod 0) (or hod org-extend-today-until) 18999 (nth 1 date) (nth 0 date) (nth 2 date)))))) 19000 (or defd (current-time)))) 19001 19002 (defun org-mark-subtree (&optional up) 19003 "Mark the current subtree. 19004 This puts point at the start of the current subtree, and mark at 19005 the end. If a numeric prefix UP is given, move up into the 19006 hierarchy of headlines by UP levels before marking the subtree." 19007 (interactive "P") 19008 (org-with-limited-levels 19009 (cond ((org-at-heading-p) (beginning-of-line)) 19010 ((org-before-first-heading-p) (user-error "Not in a subtree")) 19011 (t (outline-previous-visible-heading 1)))) 19012 (when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up))) 19013 (if (called-interactively-p 'any) 19014 (call-interactively 'org-mark-element) 19015 (org-mark-element))) 19016 19017 ;;; Indentation 19018 19019 (defvar org-element-greater-elements) 19020 (defun org--get-expected-indentation (element contentsp) 19021 "Expected indentation column for current line, according to ELEMENT. 19022 ELEMENT is an element containing point. CONTENTSP is non-nil 19023 when indentation is to be computed according to contents of 19024 ELEMENT." 19025 (let ((type (org-element-type element)) 19026 (start (org-element-property :begin element)) 19027 (post-affiliated (org-element-property :post-affiliated element))) 19028 (org-with-wide-buffer 19029 (cond 19030 (contentsp 19031 (cl-case type 19032 ((diary-sexp footnote-definition) 0) 19033 ((headline inlinetask nil) 19034 (if (not org-adapt-indentation) 0 19035 (let ((level (org-current-level))) 19036 (if level (1+ level) 0)))) 19037 ((item plain-list) (org-list-item-body-column post-affiliated)) 19038 (t 19039 (goto-char start) 19040 (current-indentation)))) 19041 ((memq type '(headline inlinetask nil)) 19042 (if (org-match-line "[ \t]*$") 19043 (org--get-expected-indentation element t) 19044 0)) 19045 ((memq type '(diary-sexp footnote-definition)) 0) 19046 ;; First paragraph of a footnote definition or an item. 19047 ;; Indent like parent. 19048 ((< (line-beginning-position) start) 19049 (org--get-expected-indentation 19050 (org-element-property :parent element) t)) 19051 ;; At first line: indent according to previous sibling, if any, 19052 ;; ignoring footnote definitions and inline tasks, or parent's 19053 ;; contents. 19054 ((and ( = (line-beginning-position) start) 19055 (eq org-adapt-indentation t)) 19056 (catch 'exit 19057 (while t 19058 (if (= (point-min) start) (throw 'exit 0) 19059 (goto-char (1- start)) 19060 (let* ((previous (org-element-at-point)) 19061 (parent previous)) 19062 (while (and parent (<= (org-element-property :end parent) start)) 19063 (setq previous parent 19064 parent (org-element-property :parent parent))) 19065 (cond 19066 ((not previous) (throw 'exit 0)) 19067 ((> (org-element-property :end previous) start) 19068 (throw 'exit (org--get-expected-indentation previous t))) 19069 ((memq (org-element-type previous) 19070 '(footnote-definition inlinetask)) 19071 (setq start (org-element-property :begin previous))) 19072 (t (goto-char (org-element-property :begin previous)) 19073 (throw 'exit 19074 (if (bolp) (current-indentation) 19075 ;; At first paragraph in an item or 19076 ;; a footnote definition. 19077 (org--get-expected-indentation 19078 (org-element-property :parent previous) t)))))))))) 19079 ;; Otherwise, move to the first non-blank line above. 19080 (t 19081 (beginning-of-line) 19082 (let ((pos (point))) 19083 (skip-chars-backward " \r\t\n") 19084 (cond 19085 ;; Two blank lines end a footnote definition or a plain 19086 ;; list. When we indent an empty line after them, the 19087 ;; containing list or footnote definition is over, so it 19088 ;; qualifies as a previous sibling. Therefore, we indent 19089 ;; like its first line. 19090 ((and (memq type '(footnote-definition plain-list)) 19091 (> (count-lines (point) pos) 2)) 19092 (goto-char start) 19093 (current-indentation)) 19094 ;; Line above is the first one of a paragraph at the 19095 ;; beginning of an item or a footnote definition. Indent 19096 ;; like parent. 19097 ((< (line-beginning-position) start) 19098 (org--get-expected-indentation 19099 (org-element-property :parent element) t)) 19100 ;; Line above is the beginning of an element, i.e., point 19101 ;; was originally on the blank lines between element's start 19102 ;; and contents. 19103 ((= (line-beginning-position) post-affiliated) 19104 (org--get-expected-indentation element t)) 19105 ;; POS is after contents in a greater element. Indent like 19106 ;; the beginning of the element. 19107 ((and (memq type org-element-greater-elements) 19108 (let ((cend (org-element-property :contents-end element))) 19109 (and cend (<= cend pos)))) 19110 ;; As a special case, if point is at the end of a footnote 19111 ;; definition or an item, indent like the very last element 19112 ;; within. If that last element is an item, indent like 19113 ;; its contents. 19114 (if (memq type '(footnote-definition item plain-list)) 19115 (let ((last (org-element-at-point))) 19116 (goto-char pos) 19117 (org--get-expected-indentation 19118 last (eq (org-element-type last) 'item))) 19119 (goto-char start) 19120 (current-indentation))) 19121 ;; In any other case, indent like the current line. 19122 (t (current-indentation))))) 19123 ;; Finally, no indentation is needed, fall back to 0. 19124 (t (current-indentation)))))) 19125 19126 (defun org--align-node-property () 19127 "Align node property at point. 19128 Alignment is done according to `org-property-format', which see." 19129 (when (save-excursion 19130 (beginning-of-line) 19131 (looking-at org-property-re)) 19132 (replace-match 19133 (concat (match-string 4) 19134 (org-trim 19135 (format org-property-format (match-string 1) (match-string 3)))) 19136 t t))) 19137 19138 (defun org-indent-line () 19139 "Indent line depending on context. 19140 19141 Indentation is done according to the following rules: 19142 19143 - Footnote definitions, diary sexps, headlines and inline tasks 19144 have to start at column 0. 19145 19146 - On the very first line of an element, consider, in order, the 19147 next rules until one matches: 19148 19149 1. If there's a sibling element before, ignoring footnote 19150 definitions and inline tasks, indent like its first line. 19151 19152 2. If element has a parent, indent like its contents. More 19153 precisely, if parent is an item, indent after the bullet. 19154 Else, indent like parent's first line. 19155 19156 3. Otherwise, indent relatively to current level, if 19157 `org-adapt-indentation' is t, or to left margin. 19158 19159 - On a blank line at the end of an element, indent according to 19160 the type of the element. More precisely 19161 19162 1. If element is a plain list, an item, or a footnote 19163 definition, indent like the very last element within. 19164 19165 2. If element is a paragraph, indent like its last non blank 19166 line. 19167 19168 3. Otherwise, indent like its very first line. 19169 19170 - In the code part of a source block, use language major mode 19171 to indent current line if `org-src-tab-acts-natively' is 19172 non-nil. If it is nil, do nothing. 19173 19174 - Otherwise, indent like the first non-blank line above. 19175 19176 The function doesn't indent an item as it could break the whole 19177 list structure. Instead, use \\<org-mode-map>`\\[org-shiftmetaleft]' or \ 19178 `\\[org-shiftmetaright]'. 19179 19180 Also align node properties according to `org-property-format'." 19181 (interactive) 19182 (unless (or (org-at-heading-p) 19183 (and (eq org-adapt-indentation 'headline-data) 19184 (not (or (org-at-clock-log-p) 19185 (org-at-planning-p))) 19186 (save-excursion 19187 (beginning-of-line 1) 19188 (skip-chars-backward "\n") 19189 (or (org-at-heading-p) 19190 (looking-back ":END:.*" (point-at-bol)))))) 19191 (let* ((element (save-excursion (beginning-of-line) (org-element-at-point))) 19192 (type (org-element-type element))) 19193 (cond ((and (memq type '(plain-list item)) 19194 (= (line-beginning-position) 19195 (org-element-property :post-affiliated element))) 19196 nil) 19197 ((and (eq type 'latex-environment) 19198 (>= (point) (org-element-property :post-affiliated element)) 19199 (< (point) 19200 (org-with-point-at (org-element-property :end element) 19201 (skip-chars-backward " \t\n") 19202 (line-beginning-position 2)))) 19203 nil) 19204 ((and (eq type 'src-block) 19205 org-src-tab-acts-natively 19206 (> (line-beginning-position) 19207 (org-element-property :post-affiliated element)) 19208 (< (line-beginning-position) 19209 (org-with-point-at (org-element-property :end element) 19210 (skip-chars-backward " \t\n") 19211 (line-beginning-position)))) 19212 ;; At the beginning of a blank line, do some preindentation. This 19213 ;; signals org-src--edit-element to preserve the indentation on exit 19214 (when (and (looking-at-p "^[[:space:]]*$") 19215 (not org-src-preserve-indentation)) 19216 (let ((element (org-element-at-point)) 19217 block-content-ind some-ind) 19218 (org-with-point-at (org-element-property :begin element) 19219 (setq block-content-ind (+ (current-indentation) 19220 org-edit-src-content-indentation)) 19221 (forward-line) 19222 (save-match-data (re-search-forward "^[ \t]*\\S-" nil t)) 19223 (backward-char) 19224 (setq some-ind (if (looking-at-p "#\\+end_src") 19225 block-content-ind (current-indentation)))) 19226 (indent-line-to (min block-content-ind some-ind)))) 19227 (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))) 19228 (t 19229 (let ((column (org--get-expected-indentation element nil))) 19230 ;; Preserve current column. 19231 (if (<= (current-column) (current-indentation)) 19232 (indent-line-to column) 19233 (save-excursion (indent-line-to column)))) 19234 ;; Align node property. Also preserve current column. 19235 (when (eq type 'node-property) 19236 (let ((column (current-column))) 19237 (org--align-node-property) 19238 (org-move-to-column column)))))))) 19239 19240 (defun org-indent-region (start end) 19241 "Indent each non-blank line in the region. 19242 Called from a program, START and END specify the region to 19243 indent. The function will not indent contents of example blocks, 19244 verse blocks and export blocks as leading white spaces are 19245 assumed to be significant there." 19246 (interactive "r") 19247 (save-excursion 19248 (goto-char start) 19249 (skip-chars-forward " \r\t\n") 19250 (unless (eobp) (beginning-of-line)) 19251 (let ((indent-to 19252 (lambda (ind pos) 19253 ;; Set IND as indentation for all lines between point and 19254 ;; POS. Blank lines are ignored. Leave point after POS 19255 ;; once done. 19256 (let ((limit (copy-marker pos))) 19257 (while (< (point) limit) 19258 (unless (looking-at-p "[ \t]*$") (indent-line-to ind)) 19259 (forward-line)) 19260 (set-marker limit nil)))) 19261 (end (copy-marker end))) 19262 (while (< (point) end) 19263 (if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line) 19264 (let* ((element (org-element-at-point)) 19265 (type (org-element-type element)) 19266 (element-end (copy-marker (org-element-property :end element))) 19267 (ind (org--get-expected-indentation element nil))) 19268 (cond 19269 ;; Element indented as a single block. Example blocks 19270 ;; preserving indentation are a special case since the 19271 ;; "contents" must not be indented whereas the block 19272 ;; boundaries can. 19273 ((or (memq type '(export-block latex-environment)) 19274 (and (eq type 'example-block) 19275 (not 19276 (or org-src-preserve-indentation 19277 (org-element-property :preserve-indent element))))) 19278 (let ((offset (- ind (current-indentation)))) 19279 (unless (zerop offset) 19280 (indent-rigidly (org-element-property :begin element) 19281 (org-element-property :end element) 19282 offset))) 19283 (goto-char element-end)) 19284 ;; Elements indented line wise. Be sure to exclude 19285 ;; example blocks (preserving indentation) and source 19286 ;; blocks from this category as they are treated 19287 ;; specially later. 19288 ((or (memq type '(paragraph table table-row)) 19289 (not (or (org-element-property :contents-begin element) 19290 (memq type '(example-block src-block))))) 19291 (when (eq type 'node-property) 19292 (org--align-node-property) 19293 (beginning-of-line)) 19294 (funcall indent-to ind (min element-end end))) 19295 ;; Elements consisting of three parts: before the 19296 ;; contents, the contents, and after the contents. The 19297 ;; contents are treated specially, according to the 19298 ;; element type, or not indented at all. Other parts are 19299 ;; indented as a single block. 19300 (t 19301 (let* ((post (copy-marker 19302 (org-element-property :post-affiliated element))) 19303 (cbeg 19304 (copy-marker 19305 (cond 19306 ((not (org-element-property :contents-begin element)) 19307 ;; Fake contents for source blocks. 19308 (org-with-wide-buffer 19309 (goto-char post) 19310 (line-beginning-position 2))) 19311 ((memq type '(footnote-definition item plain-list)) 19312 ;; Contents in these elements could start on 19313 ;; the same line as the beginning of the 19314 ;; element. Make sure we start indenting 19315 ;; from the second line. 19316 (org-with-wide-buffer 19317 (goto-char post) 19318 (end-of-line) 19319 (skip-chars-forward " \r\t\n") 19320 (if (eobp) (point) (line-beginning-position)))) 19321 (t (org-element-property :contents-begin element))))) 19322 (cend (copy-marker 19323 (or (org-element-property :contents-end element) 19324 ;; Fake contents for source blocks. 19325 (org-with-wide-buffer 19326 (goto-char element-end) 19327 (skip-chars-backward " \r\t\n") 19328 (line-beginning-position))) 19329 t))) 19330 ;; Do not change items indentation individually as it 19331 ;; might break the list as a whole. On the other 19332 ;; hand, when at a plain list, indent it as a whole. 19333 (cond ((eq type 'plain-list) 19334 (let ((offset (- ind (current-indentation)))) 19335 (unless (zerop offset) 19336 (indent-rigidly (org-element-property :begin element) 19337 (org-element-property :end element) 19338 offset)) 19339 (goto-char cbeg))) 19340 ((eq type 'item) (goto-char cbeg)) 19341 (t (funcall indent-to ind (min cbeg end)))) 19342 (when (< (point) end) 19343 (cl-case type 19344 ((example-block verse-block)) 19345 (src-block 19346 ;; In a source block, indent source code 19347 ;; according to language major mode, but only if 19348 ;; `org-src-tab-acts-natively' is non-nil. 19349 (when (and (< (point) end) org-src-tab-acts-natively) 19350 (ignore-errors 19351 (org-babel-do-in-edit-buffer 19352 (indent-region (point-min) (point-max)))))) 19353 (t (org-indent-region (point) (min cend end)))) 19354 (goto-char (min cend end)) 19355 (when (< (point) end) 19356 (funcall indent-to ind (min element-end end)))) 19357 (set-marker post nil) 19358 (set-marker cbeg nil) 19359 (set-marker cend nil)))) 19360 (set-marker element-end nil)))) 19361 (set-marker end nil)))) 19362 19363 (defun org-indent-drawer () 19364 "Indent the drawer at point." 19365 (interactive) 19366 (unless (save-excursion 19367 (beginning-of-line) 19368 (looking-at-p org-drawer-regexp)) 19369 (user-error "Not at a drawer")) 19370 (let ((element (org-element-at-point))) 19371 (unless (memq (org-element-type element) '(drawer property-drawer)) 19372 (user-error "Not at a drawer")) 19373 (org-with-wide-buffer 19374 (org-indent-region (org-element-property :begin element) 19375 (org-element-property :end element)))) 19376 (message "Drawer at point indented")) 19377 19378 (defun org-indent-block () 19379 "Indent the block at point." 19380 (interactive) 19381 (unless (save-excursion 19382 (beginning-of-line) 19383 (let ((case-fold-search t)) 19384 (looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_"))) 19385 (user-error "Not at a block")) 19386 (let ((element (org-element-at-point))) 19387 (unless (memq (org-element-type element) 19388 '(comment-block center-block dynamic-block example-block 19389 export-block quote-block special-block 19390 src-block verse-block)) 19391 (user-error "Not at a block")) 19392 (org-with-wide-buffer 19393 (org-indent-region (org-element-property :begin element) 19394 (org-element-property :end element)))) 19395 (message "Block at point indented")) 19396 19397 19398 ;;; Filling 19399 19400 ;; We use our own fill-paragraph and auto-fill functions. 19401 19402 ;; `org-fill-paragraph' relies on adaptive filling and context 19403 ;; checking. Appropriate `fill-prefix' is computed with 19404 ;; `org-adaptive-fill-function'. 19405 19406 ;; `org-auto-fill-function' takes care of auto-filling. It calls 19407 ;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with 19408 ;; `org-adaptive-fill-function' value. Internally, 19409 ;; `org-comment-line-break-function' breaks the line. 19410 19411 ;; `org-setup-filling' installs filling and auto-filling related 19412 ;; variables during `org-mode' initialization. 19413 19414 (defun org-setup-filling () 19415 (require 'org-element) 19416 ;; Prevent auto-fill from inserting unwanted new items. 19417 (when (boundp 'fill-nobreak-predicate) 19418 (setq-local 19419 fill-nobreak-predicate 19420 (org-uniquify 19421 (append fill-nobreak-predicate 19422 '(org-fill-line-break-nobreak-p 19423 org-fill-n-macro-as-item-nobreak-p 19424 org-fill-paragraph-with-timestamp-nobreak-p))))) 19425 (let ((paragraph-ending (substring org-element-paragraph-separate 1))) 19426 (setq-local paragraph-start paragraph-ending) 19427 (setq-local paragraph-separate paragraph-ending)) 19428 (setq-local fill-paragraph-function 'org-fill-paragraph) 19429 (setq-local auto-fill-inhibit-regexp nil) 19430 (setq-local adaptive-fill-function 'org-adaptive-fill-function) 19431 (setq-local normal-auto-fill-function 'org-auto-fill-function) 19432 (setq-local comment-line-break-function 'org-comment-line-break-function)) 19433 19434 (defun org-fill-line-break-nobreak-p () 19435 "Non-nil when a new line at point would create an Org line break." 19436 (save-excursion 19437 (skip-chars-backward " \t") 19438 (skip-chars-backward "\\\\") 19439 (looking-at "\\\\\\\\\\($\\|[^\\]\\)"))) 19440 19441 (defun org-fill-paragraph-with-timestamp-nobreak-p () 19442 "Non-nil when a new line at point would split a timestamp." 19443 (and (org-at-timestamp-p 'lax) 19444 (not (looking-at org-ts-regexp-both)))) 19445 19446 (defun org-fill-n-macro-as-item-nobreak-p () 19447 "Non-nil when a new line at point would create a new list." 19448 ;; During export, a "n" macro followed by a dot or a closing 19449 ;; parenthesis can end up being parsed as a new list item. 19450 (looking-at-p "[ \t]*{{{n\\(?:([^\n)]*)\\)?}}}[.)]\\(?:$\\| \\)")) 19451 19452 (defun org-adaptive-fill-function () 19453 "Compute a fill prefix for the current line. 19454 Return fill prefix, as a string, or nil if current line isn't 19455 meant to be filled. For convenience, if `adaptive-fill-regexp' 19456 matches in paragraphs or comments, use it." 19457 (org-with-wide-buffer 19458 (unless (org-at-heading-p) 19459 (let* ((p (line-beginning-position)) 19460 (element (save-excursion 19461 (beginning-of-line) 19462 (org-element-at-point))) 19463 (type (org-element-type element)) 19464 (post-affiliated (org-element-property :post-affiliated element))) 19465 (unless (< p post-affiliated) 19466 (cl-case type 19467 (comment 19468 (save-excursion 19469 (beginning-of-line) 19470 (looking-at "[ \t]*") 19471 (concat (match-string 0) "# "))) 19472 (footnote-definition "") 19473 ((item plain-list) 19474 (make-string (org-list-item-body-column post-affiliated) ?\s)) 19475 (paragraph 19476 ;; Fill prefix is usually the same as the current line, 19477 ;; unless the paragraph is at the beginning of an item. 19478 (let ((parent (org-element-property :parent element))) 19479 (save-excursion 19480 (beginning-of-line) 19481 (cond ((eq (org-element-type parent) 'item) 19482 (make-string (org-list-item-body-column 19483 (org-element-property :begin parent)) 19484 ?\s)) 19485 ((and adaptive-fill-regexp 19486 ;; Locally disable 19487 ;; `adaptive-fill-function' to let 19488 ;; `fill-context-prefix' handle 19489 ;; `adaptive-fill-regexp' variable. 19490 (let (adaptive-fill-function) 19491 (fill-context-prefix 19492 post-affiliated 19493 (org-element-property :end element))))) 19494 ((looking-at "[ \t]+") (match-string 0)) 19495 (t ""))))) 19496 (comment-block 19497 ;; Only fill contents if P is within block boundaries. 19498 (let* ((cbeg (save-excursion (goto-char post-affiliated) 19499 (forward-line) 19500 (point))) 19501 (cend (save-excursion 19502 (goto-char (org-element-property :end element)) 19503 (skip-chars-backward " \r\t\n") 19504 (line-beginning-position)))) 19505 (when (and (>= p cbeg) (< p cend)) 19506 (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) 19507 (match-string 0) 19508 "")))))))))) 19509 19510 (defun org-fill-element (&optional justify) 19511 "Fill element at point, when applicable. 19512 19513 This function only applies to comment blocks, comments, example 19514 blocks and paragraphs. Also, as a special case, re-align table 19515 when point is at one. 19516 19517 If JUSTIFY is non-nil (interactively, with prefix argument), 19518 justify as well. If `sentence-end-double-space' is non-nil, then 19519 period followed by one space does not end a sentence, so don't 19520 break a line there. The variable `fill-column' controls the 19521 width for filling. 19522 19523 For convenience, when point is at a plain list, an item or 19524 a footnote definition, try to fill the first paragraph within." 19525 (with-syntax-table org-mode-transpose-word-syntax-table 19526 ;; Move to end of line in order to get the first paragraph within 19527 ;; a plain list or a footnote definition. 19528 (let ((element (save-excursion (end-of-line) (org-element-at-point)))) 19529 ;; First check if point is in a blank line at the beginning of 19530 ;; the buffer. In that case, ignore filling. 19531 (cl-case (org-element-type element) 19532 ;; Use major mode filling function is source blocks. 19533 (src-block (org-babel-do-in-edit-buffer 19534 (push-mark (point-min)) 19535 (goto-char (point-max)) 19536 (setq mark-active t) 19537 (funcall-interactively #'fill-paragraph justify 'region))) 19538 ;; Align Org tables, leave table.el tables as-is. 19539 (table-row (org-table-align) t) 19540 (table 19541 (when (eq (org-element-property :type element) 'org) 19542 (save-excursion 19543 (goto-char (org-element-property :post-affiliated element)) 19544 (org-table-align))) 19545 t) 19546 (paragraph 19547 ;; Paragraphs may contain `line-break' type objects. 19548 (let ((beg (max (point-min) 19549 (org-element-property :contents-begin element))) 19550 (end (min (point-max) 19551 (org-element-property :contents-end element)))) 19552 ;; Do nothing if point is at an affiliated keyword. 19553 (if (< (line-end-position) beg) t 19554 ;; Fill paragraph, taking line breaks into account. 19555 (save-excursion 19556 (goto-char beg) 19557 (let ((cuts (list beg))) 19558 (while (re-search-forward "\\\\\\\\[ \t]*\n" end t) 19559 (when (eq 'line-break 19560 (org-element-type 19561 (save-excursion (backward-char) 19562 (org-element-context)))) 19563 (push (point) cuts))) 19564 (dolist (c (delq end cuts)) 19565 (fill-region-as-paragraph c end justify) 19566 (setq end c)))) 19567 t))) 19568 ;; Contents of `comment-block' type elements should be 19569 ;; filled as plain text, but only if point is within block 19570 ;; markers. 19571 (comment-block 19572 (let* ((case-fold-search t) 19573 (beg (save-excursion 19574 (goto-char (org-element-property :begin element)) 19575 (re-search-forward "^[ \t]*#\\+begin_comment" nil t) 19576 (forward-line) 19577 (point))) 19578 (end (save-excursion 19579 (goto-char (org-element-property :end element)) 19580 (re-search-backward "^[ \t]*#\\+end_comment" nil t) 19581 (line-beginning-position)))) 19582 (if (or (< (point) beg) (> (point) end)) t 19583 (fill-region-as-paragraph 19584 (save-excursion (end-of-line) 19585 (re-search-backward "^[ \t]*$" beg 'move) 19586 (line-beginning-position)) 19587 (save-excursion (beginning-of-line) 19588 (re-search-forward "^[ \t]*$" end 'move) 19589 (line-beginning-position)) 19590 justify)))) 19591 ;; Fill comments. 19592 (comment 19593 (let ((begin (org-element-property :post-affiliated element)) 19594 (end (org-element-property :end element))) 19595 (when (and (>= (point) begin) (<= (point) end)) 19596 (let ((begin (save-excursion 19597 (end-of-line) 19598 (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) 19599 (progn (forward-line) (point)) 19600 begin))) 19601 (end (save-excursion 19602 (end-of-line) 19603 (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) 19604 (1- (line-beginning-position)) 19605 (skip-chars-backward " \r\t\n") 19606 (line-end-position))))) 19607 ;; Do not fill comments when at a blank line. 19608 (when (> end begin) 19609 (let ((fill-prefix 19610 (save-excursion 19611 (beginning-of-line) 19612 (looking-at "[ \t]*#") 19613 (let ((comment-prefix (match-string 0))) 19614 (goto-char (match-end 0)) 19615 (if (looking-at adaptive-fill-regexp) 19616 (concat comment-prefix (match-string 0)) 19617 (concat comment-prefix " ")))))) 19618 (save-excursion 19619 (fill-region-as-paragraph begin end justify)))))) 19620 t)) 19621 ;; Ignore every other element. 19622 (otherwise t))))) 19623 19624 (defun org-fill-paragraph (&optional justify region) 19625 "Fill element at point, when applicable. 19626 19627 This function only applies to comment blocks, comments, example 19628 blocks and paragraphs. Also, as a special case, re-align table 19629 when point is at one. 19630 19631 For convenience, when point is at a plain list, an item or 19632 a footnote definition, try to fill the first paragraph within. 19633 19634 If JUSTIFY is non-nil (interactively, with prefix argument), 19635 justify as well. If `sentence-end-double-space' is non-nil, then 19636 period followed by one space does not end a sentence, so don't 19637 break a line there. The variable `fill-column' controls the 19638 width for filling. 19639 19640 The REGION argument is non-nil if called interactively; in that 19641 case, if Transient Mark mode is enabled and the mark is active, 19642 fill each of the elements in the active region, instead of just 19643 filling the current element." 19644 (interactive (progn 19645 (barf-if-buffer-read-only) 19646 (list (when current-prefix-arg 'full) t))) 19647 (let ((hash (and (not (buffer-modified-p)) 19648 (org-buffer-hash)))) 19649 (cond 19650 ((and region transient-mark-mode mark-active 19651 (not (eq (region-beginning) (region-end)))) 19652 (let ((origin (point-marker)) 19653 (start (region-beginning))) 19654 (unwind-protect 19655 (progn 19656 (goto-char (region-end)) 19657 (skip-chars-backward " \t\n") 19658 (while (> (point) start) 19659 (org-fill-element justify) 19660 (org-backward-paragraph))) 19661 (goto-char origin) 19662 (set-marker origin nil)))) 19663 (t 19664 (save-excursion 19665 (when (org-match-line "[ \t]*$") 19666 (skip-chars-forward " \t\n")) 19667 (org-fill-element justify)))) 19668 ;; If we didn't change anything in the buffer (and the buffer was 19669 ;; previously unmodified), then flip the modification status back 19670 ;; to "unchanged". 19671 (when (and hash (equal hash (org-buffer-hash))) 19672 (set-buffer-modified-p nil)) 19673 ;; Return non-nil. 19674 t)) 19675 19676 (defun org-auto-fill-function () 19677 "Auto-fill function." 19678 ;; Check if auto-filling is meaningful. 19679 (let ((fc (current-fill-column))) 19680 (when (and fc (> (current-column) fc)) 19681 (let* ((fill-prefix (org-adaptive-fill-function)) 19682 ;; Enforce empty fill prefix, if required. Otherwise, it 19683 ;; will be computed again. 19684 (adaptive-fill-mode (not (equal fill-prefix "")))) 19685 (when fill-prefix (do-auto-fill)))))) 19686 19687 (defun org-comment-line-break-function (&optional soft) 19688 "Break line at point and indent, continuing comment if within one. 19689 The inserted newline is marked hard if variable 19690 `use-hard-newlines' is true, unless optional argument SOFT is 19691 non-nil." 19692 (if soft (insert-and-inherit ?\n) (newline 1)) 19693 (save-excursion (forward-char -1) (delete-horizontal-space)) 19694 (delete-horizontal-space) 19695 (indent-to-left-margin) 19696 (insert-before-markers-and-inherit fill-prefix)) 19697 19698 19699 ;;; Fixed Width Areas 19700 19701 (defun org-toggle-fixed-width () 19702 "Toggle fixed-width markup. 19703 19704 Add or remove fixed-width markup on current line, whenever it 19705 makes sense. Return an error otherwise. 19706 19707 If a region is active and if it contains only fixed-width areas 19708 or blank lines, remove all fixed-width markup in it. If the 19709 region contains anything else, convert all non-fixed-width lines 19710 to fixed-width ones. 19711 19712 Blank lines at the end of the region are ignored unless the 19713 region only contains such lines." 19714 (interactive) 19715 (if (not (org-region-active-p)) 19716 ;; No region: 19717 ;; 19718 ;; Remove fixed width marker only in a fixed-with element. 19719 ;; 19720 ;; Add fixed width maker in paragraphs, in blank lines after 19721 ;; elements or at the beginning of a headline or an inlinetask, 19722 ;; and before any one-line elements (e.g., a clock). 19723 (progn 19724 (beginning-of-line) 19725 (let* ((element (org-element-at-point)) 19726 (type (org-element-type element))) 19727 (cond 19728 ((and (eq type 'fixed-width) 19729 (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)")) 19730 (replace-match 19731 "" nil nil nil (if (= (line-end-position) (match-end 0)) 0 1))) 19732 ((and (memq type '(babel-call clock comment diary-sexp headline 19733 horizontal-rule keyword paragraph 19734 planning)) 19735 (<= (org-element-property :post-affiliated element) (point))) 19736 (skip-chars-forward " \t") 19737 (insert ": ")) 19738 ((and (looking-at-p "[ \t]*$") 19739 (or (eq type 'inlinetask) 19740 (save-excursion 19741 (skip-chars-forward " \r\t\n") 19742 (<= (org-element-property :end element) (point))))) 19743 (delete-region (point) (line-end-position)) 19744 (org-indent-line) 19745 (insert ": ")) 19746 (t (user-error "Cannot insert a fixed-width line here"))))) 19747 ;; Region active. 19748 (let* ((begin (save-excursion 19749 (goto-char (region-beginning)) 19750 (line-beginning-position))) 19751 (end (copy-marker 19752 (save-excursion 19753 (goto-char (region-end)) 19754 (unless (eolp) (beginning-of-line)) 19755 (if (save-excursion (re-search-backward "\\S-" begin t)) 19756 (progn (skip-chars-backward " \r\t\n") (point)) 19757 (point))))) 19758 (all-fixed-width-p 19759 (catch 'not-all-p 19760 (save-excursion 19761 (goto-char begin) 19762 (skip-chars-forward " \r\t\n") 19763 (when (eobp) (throw 'not-all-p nil)) 19764 (while (< (point) end) 19765 (let ((element (org-element-at-point))) 19766 (if (eq (org-element-type element) 'fixed-width) 19767 (goto-char (org-element-property :end element)) 19768 (throw 'not-all-p nil)))) 19769 t)))) 19770 (if all-fixed-width-p 19771 (save-excursion 19772 (goto-char begin) 19773 (while (< (point) end) 19774 (when (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)") 19775 (replace-match 19776 "" nil nil nil 19777 (if (= (line-end-position) (match-end 0)) 0 1))) 19778 (forward-line))) 19779 (let ((min-ind (point-max))) 19780 ;; Find minimum indentation across all lines. 19781 (save-excursion 19782 (goto-char begin) 19783 (if (not (save-excursion (re-search-forward "\\S-" end t))) 19784 (setq min-ind 0) 19785 (catch 'zerop 19786 (while (< (point) end) 19787 (unless (looking-at-p "[ \t]*$") 19788 (let ((ind (current-indentation))) 19789 (setq min-ind (min min-ind ind)) 19790 (when (zerop ind) (throw 'zerop t)))) 19791 (forward-line))))) 19792 ;; Loop over all lines and add fixed-width markup everywhere 19793 ;; but in fixed-width lines. 19794 (save-excursion 19795 (goto-char begin) 19796 (while (< (point) end) 19797 (cond 19798 ((org-at-heading-p) 19799 (insert ": ") 19800 (forward-line) 19801 (while (and (< (point) end) (looking-at-p "[ \t]*$")) 19802 (insert ":") 19803 (forward-line))) 19804 ((looking-at-p "[ \t]*:\\( \\|$\\)") 19805 (let* ((element (org-element-at-point)) 19806 (element-end (org-element-property :end element))) 19807 (if (eq (org-element-type element) 'fixed-width) 19808 (progn (goto-char element-end) 19809 (skip-chars-backward " \r\t\n") 19810 (forward-line)) 19811 (let ((limit (min end element-end))) 19812 (while (< (point) limit) 19813 (org-move-to-column min-ind t) 19814 (insert ": ") 19815 (forward-line)))))) 19816 (t 19817 (org-move-to-column min-ind t) 19818 (insert ": ") 19819 (forward-line))))))) 19820 (set-marker end nil)))) 19821 19822 19823 ;;; Blocks 19824 19825 (defun org-block-map (function &optional start end) 19826 "Call FUNCTION at the head of all source blocks in the current buffer. 19827 Optional arguments START and END can be used to limit the range." 19828 (let ((start (or start (point-min))) 19829 (end (or end (point-max)))) 19830 (save-excursion 19831 (goto-char start) 19832 (while (and (< (point) end) (re-search-forward org-block-regexp end t)) 19833 (save-excursion 19834 (save-match-data 19835 (goto-char (match-beginning 0)) 19836 (funcall function))))))) 19837 19838 (defun org-next-block (arg &optional backward block-regexp) 19839 "Jump to the next block. 19840 19841 With a prefix argument ARG, jump forward ARG many blocks. 19842 19843 When BACKWARD is non-nil, jump to the previous block. 19844 19845 When BLOCK-REGEXP is non-nil, use this regexp to find blocks. 19846 Match data is set according to this regexp when the function 19847 returns. 19848 19849 Return point at beginning of the opening line of found block. 19850 Throw an error if no block is found." 19851 (interactive "p") 19852 (let ((re (or block-regexp "^[ \t]*#\\+BEGIN")) 19853 (case-fold-search t) 19854 (search-fn (if backward #'re-search-backward #'re-search-forward)) 19855 (count (or arg 1)) 19856 (origin (point)) 19857 last-element) 19858 (if backward (beginning-of-line) (end-of-line)) 19859 (while (and (> count 0) (funcall search-fn re nil t)) 19860 (let ((element (save-excursion 19861 (goto-char (match-beginning 0)) 19862 (save-match-data (org-element-at-point))))) 19863 (when (and (memq (org-element-type element) 19864 '(center-block comment-block dynamic-block 19865 example-block export-block quote-block 19866 special-block src-block verse-block)) 19867 (<= (match-beginning 0) 19868 (org-element-property :post-affiliated element))) 19869 (setq last-element element) 19870 (cl-decf count)))) 19871 (if (= count 0) 19872 (prog1 (goto-char (org-element-property :post-affiliated last-element)) 19873 (save-match-data (org-show-context))) 19874 (goto-char origin) 19875 (user-error "No %s code blocks" (if backward "previous" "further"))))) 19876 19877 (defun org-previous-block (arg &optional block-regexp) 19878 "Jump to the previous block. 19879 With a prefix argument ARG, jump backward ARG many source blocks. 19880 When BLOCK-REGEXP is non-nil, use this regexp to find blocks." 19881 (interactive "p") 19882 (org-next-block arg t block-regexp)) 19883 19884 19885 ;;; Comments 19886 19887 ;; Org comments syntax is quite complex. It requires the entire line 19888 ;; to be just a comment. Also, even with the right syntax at the 19889 ;; beginning of line, some elements (e.g., verse-block or 19890 ;; example-block) don't accept comments. Usual Emacs comment commands 19891 ;; cannot cope with those requirements. Therefore, Org replaces them. 19892 19893 ;; Org still relies on 'comment-dwim', but cannot trust 19894 ;; 'comment-only-p'. So, 'comment-region-function' and 19895 ;; 'uncomment-region-function' both point 19896 ;; to 'org-comment-or-uncomment-region'. Eventually, 19897 ;; 'org-insert-comment' takes care of insertion of comments at the 19898 ;; beginning of line. 19899 19900 ;; 'org-setup-comments-handling' install comments related variables 19901 ;; during 'org-mode' initialization. 19902 19903 (defun org-setup-comments-handling () 19904 (interactive) 19905 (setq-local comment-use-syntax nil) 19906 (setq-local comment-start "# ") 19907 (setq-local comment-start-skip "^\\s-*#\\(?: \\|$\\)") 19908 (setq-local comment-insert-comment-function 'org-insert-comment) 19909 (setq-local comment-region-function 'org-comment-or-uncomment-region) 19910 (setq-local uncomment-region-function 'org-comment-or-uncomment-region)) 19911 19912 (defun org-insert-comment () 19913 "Insert an empty comment above current line. 19914 If the line is empty, insert comment at its beginning. When 19915 point is within a source block, comment according to the related 19916 major mode." 19917 (if (let ((element (org-element-at-point))) 19918 (and (eq (org-element-type element) 'src-block) 19919 (< (save-excursion 19920 (goto-char (org-element-property :post-affiliated element)) 19921 (line-end-position)) 19922 (point)) 19923 (> (save-excursion 19924 (goto-char (org-element-property :end element)) 19925 (skip-chars-backward " \r\t\n") 19926 (line-beginning-position)) 19927 (point)))) 19928 (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim)) 19929 (beginning-of-line) 19930 (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol)) 19931 (open-line 1)) 19932 (org-indent-line) 19933 (insert "# "))) 19934 19935 (defvar comment-empty-lines) ; From newcomment.el. 19936 (defun org-comment-or-uncomment-region (beg end &rest _) 19937 "Comment or uncomment each non-blank line in the region. 19938 Uncomment each non-blank line between BEG and END if it only 19939 contains commented lines. Otherwise, comment them. If region is 19940 strictly within a source block, use appropriate comment syntax." 19941 (if (let ((element (org-element-at-point))) 19942 (and (eq (org-element-type element) 'src-block) 19943 (< (save-excursion 19944 (goto-char (org-element-property :post-affiliated element)) 19945 (line-end-position)) 19946 beg) 19947 (>= (save-excursion 19948 (goto-char (org-element-property :end element)) 19949 (skip-chars-backward " \r\t\n") 19950 (line-beginning-position)) 19951 end))) 19952 ;; Translate region boundaries for the Org buffer to the source 19953 ;; buffer. 19954 (let ((offset (- end beg))) 19955 (save-excursion 19956 (goto-char beg) 19957 (org-babel-do-in-edit-buffer 19958 (comment-or-uncomment-region (point) (+ offset (point)))))) 19959 (save-restriction 19960 ;; Restrict region 19961 (narrow-to-region (save-excursion (goto-char beg) 19962 (skip-chars-forward " \r\t\n" end) 19963 (line-beginning-position)) 19964 (save-excursion (goto-char end) 19965 (skip-chars-backward " \r\t\n" beg) 19966 (line-end-position))) 19967 (let ((uncommentp 19968 ;; UNCOMMENTP is non-nil when every non blank line between 19969 ;; BEG and END is a comment. 19970 (save-excursion 19971 (goto-char (point-min)) 19972 (while (and (not (eobp)) 19973 (let ((element (org-element-at-point))) 19974 (and (eq (org-element-type element) 'comment) 19975 (goto-char (min (point-max) 19976 (org-element-property 19977 :end element))))))) 19978 (eobp)))) 19979 (if uncommentp 19980 ;; Only blank lines and comments in region: uncomment it. 19981 (save-excursion 19982 (goto-char (point-min)) 19983 (while (not (eobp)) 19984 (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") 19985 (replace-match "" nil nil nil 1)) 19986 (forward-line))) 19987 ;; Comment each line in region. 19988 (let ((min-indent (point-max))) 19989 ;; First find the minimum indentation across all lines. 19990 (save-excursion 19991 (goto-char (point-min)) 19992 (while (and (not (eobp)) (not (zerop min-indent))) 19993 (unless (looking-at "[ \t]*$") 19994 (setq min-indent (min min-indent (current-indentation)))) 19995 (forward-line))) 19996 ;; Then loop over all lines. 19997 (save-excursion 19998 (goto-char (point-min)) 19999 (while (not (eobp)) 20000 (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) 20001 ;; Don't get fooled by invisible text (e.g. link path) 20002 ;; when moving to column MIN-INDENT. 20003 (let ((buffer-invisibility-spec nil)) 20004 (org-move-to-column min-indent t)) 20005 (insert comment-start)) 20006 (forward-line))))))))) 20007 20008 (defun org-comment-dwim (_arg) 20009 "Call the comment command you mean. 20010 Call `org-toggle-comment' if on a heading, otherwise call 20011 `comment-dwim', within a source edit buffer if needed." 20012 (interactive "*P") 20013 (cond ((org-at-heading-p) 20014 (call-interactively #'org-toggle-comment)) 20015 ((org-in-src-block-p) 20016 (org-babel-do-in-edit-buffer (call-interactively #'comment-dwim))) 20017 (t (call-interactively #'comment-dwim)))) 20018 20019 20020 ;;; Timestamps API 20021 20022 ;; This section contains tools to operate on, or create, timestamp 20023 ;; objects, as returned by, e.g. `org-element-context'. 20024 20025 (defun org-timestamp-from-string (s) 20026 "Convert Org timestamp S, as a string, into a timestamp object. 20027 Return nil if S is not a valid timestamp string." 20028 (when (org-string-nw-p s) 20029 (with-temp-buffer 20030 (save-excursion (insert s)) 20031 (org-element-timestamp-parser)))) 20032 20033 (defun org-timestamp-from-time (time &optional with-time inactive) 20034 "Convert a time value into a timestamp object. 20035 20036 TIME is an Emacs internal time representation, as returned, e.g., 20037 by `current-time'. 20038 20039 When optional argument WITH-TIME is non-nil, return a timestamp 20040 object with a time part, i.e., with hours and minutes. 20041 20042 Return an inactive timestamp if INACTIVE is non-nil. Otherwise, 20043 return an active timestamp." 20044 (pcase-let ((`(,_ ,minute ,hour ,day ,month ,year . ,_) (decode-time time))) 20045 (org-element-create 'timestamp 20046 (list :type (if inactive 'inactive 'active) 20047 :year-start year 20048 :month-start month 20049 :day-start day 20050 :hour-start (and with-time hour) 20051 :minute-start (and with-time minute))))) 20052 20053 (defun org-timestamp-to-time (timestamp &optional end) 20054 "Convert TIMESTAMP object into an Emacs internal time value. 20055 Use end of date range or time range when END is non-nil. 20056 Otherwise, use its start." 20057 (apply #'encode-time 0 20058 (mapcar 20059 (lambda (prop) (or (org-element-property prop timestamp) 0)) 20060 (if end '(:minute-end :hour-end :day-end :month-end :year-end) 20061 '(:minute-start :hour-start :day-start :month-start 20062 :year-start))))) 20063 20064 (defun org-timestamp-has-time-p (timestamp) 20065 "Non-nil when TIMESTAMP has a time specified." 20066 (org-element-property :hour-start timestamp)) 20067 20068 (defun org-timestamp-format (timestamp format &optional end utc) 20069 "Format a TIMESTAMP object into a string. 20070 20071 FORMAT is a format specifier to be passed to 20072 `format-time-string'. 20073 20074 When optional argument END is non-nil, use end of date-range or 20075 time-range, if possible. 20076 20077 When optional argument UTC is non-nil, time is be expressed as 20078 Universal Time." 20079 (format-time-string format (org-timestamp-to-time timestamp end) 20080 (and utc t))) 20081 20082 (defun org-timestamp-split-range (timestamp &optional end) 20083 "Extract a TIMESTAMP object from a date or time range. 20084 20085 END, when non-nil, means extract the end of the range. 20086 Otherwise, extract its start. 20087 20088 Return a new timestamp object." 20089 (let ((type (org-element-property :type timestamp))) 20090 (if (memq type '(active inactive diary)) timestamp 20091 (let ((split-ts (org-element-copy timestamp))) 20092 ;; Set new type. 20093 (org-element-put-property 20094 split-ts :type (if (eq type 'active-range) 'active 'inactive)) 20095 ;; Copy start properties over end properties if END is 20096 ;; non-nil. Otherwise, copy end properties over `start' ones. 20097 (let ((p-alist '((:minute-start . :minute-end) 20098 (:hour-start . :hour-end) 20099 (:day-start . :day-end) 20100 (:month-start . :month-end) 20101 (:year-start . :year-end)))) 20102 (dolist (p-cell p-alist) 20103 (org-element-put-property 20104 split-ts 20105 (funcall (if end #'car #'cdr) p-cell) 20106 (org-element-property 20107 (funcall (if end #'cdr #'car) p-cell) split-ts))) 20108 ;; Eventually refresh `:raw-value'. 20109 (org-element-put-property split-ts :raw-value nil) 20110 (org-element-put-property 20111 split-ts :raw-value (org-element-interpret-data split-ts))))))) 20112 20113 (defun org-timestamp-translate (timestamp &optional boundary) 20114 "Translate TIMESTAMP object to custom format. 20115 20116 Format string is defined in `org-time-stamp-custom-formats', 20117 which see. 20118 20119 When optional argument BOUNDARY is non-nil, it is either the 20120 symbol `start' or `end'. In this case, only translate the 20121 starting or ending part of TIMESTAMP if it is a date or time 20122 range. Otherwise, translate both parts. 20123 20124 Return timestamp as-is if `org-display-custom-times' is nil or if 20125 it has a `diary' type." 20126 (let ((type (org-element-property :type timestamp))) 20127 (if (or (not org-display-custom-times) (eq type 'diary)) 20128 (org-element-interpret-data timestamp) 20129 (let ((fmt (funcall (if (org-timestamp-has-time-p timestamp) #'cdr #'car) 20130 org-time-stamp-custom-formats))) 20131 (if (and (not boundary) (memq type '(active-range inactive-range))) 20132 (concat (org-timestamp-format timestamp fmt) 20133 "--" 20134 (org-timestamp-format timestamp fmt t)) 20135 (org-timestamp-format timestamp fmt (eq boundary 'end))))))) 20136 20137 ;;; Other stuff 20138 20139 (defvar reftex-docstruct-symbol) 20140 (defvar org--rds) 20141 20142 (defun org-reftex-citation () 20143 "Use `reftex-citation' to insert a citation into the buffer. 20144 This looks for a line like 20145 20146 #+BIBLIOGRAPHY: foo plain option:-d 20147 20148 and derives from it that foo.bib is the bibliography file relevant 20149 for this document. It then installs the necessary environment for RefTeX 20150 to work in this buffer and calls `reftex-citation' to insert a citation 20151 into the buffer. 20152 20153 Export of such citations to both LaTeX and HTML is handled by the contributed 20154 package ox-bibtex by Taru Karttunen." 20155 (interactive) 20156 (let ((reftex-docstruct-symbol 'org--rds) 20157 org--rds bib) 20158 (org-with-wide-buffer 20159 (let ((case-fold-search t) 20160 (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)")) 20161 (if (not (save-excursion 20162 (or (re-search-forward re nil t) 20163 (re-search-backward re nil t)))) 20164 (user-error "No bibliography defined in file") 20165 (setq bib (concat (match-string 1) ".bib") 20166 org--rds (list (list 'bib bib)))))) 20167 (call-interactively 'reftex-citation))) 20168 20169 ;;;; Functions extending outline functionality 20170 20171 (defun org-beginning-of-line (&optional n) 20172 "Go to the beginning of the current visible line. 20173 20174 If this is a headline, and `org-special-ctrl-a/e' is not nil or 20175 symbol `reversed', on the first attempt move to where the 20176 headline text starts, and only move to beginning of line when the 20177 cursor is already before the start of the text of the headline. 20178 20179 If `org-special-ctrl-a/e' is symbol `reversed' then go to the 20180 start of the text on the second attempt. 20181 20182 With argument N not nil or 1, move forward N - 1 lines first." 20183 (interactive "^p") 20184 (let ((origin (point)) 20185 (special (pcase org-special-ctrl-a/e 20186 (`(,C-a . ,_) C-a) (_ org-special-ctrl-a/e))) 20187 deactivate-mark) 20188 ;; First move to a visible line. 20189 (if (bound-and-true-p visual-line-mode) 20190 (beginning-of-visual-line n) 20191 (move-beginning-of-line n) 20192 ;; `move-beginning-of-line' may leave point after invisible 20193 ;; characters if line starts with such of these (e.g., with 20194 ;; a link at column 0). Really move to the beginning of the 20195 ;; current visible line. 20196 (beginning-of-line)) 20197 (cond 20198 ;; No special behavior. Point is already at the beginning of 20199 ;; a line, logical or visual. 20200 ((not special)) 20201 ;; `beginning-of-visual-line' left point before logical beginning 20202 ;; of line: point is at the beginning of a visual line. Bail 20203 ;; out. 20204 ((and (bound-and-true-p visual-line-mode) (not (bolp)))) 20205 ((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp)) 20206 ;; At a headline, special position is before the title, but 20207 ;; after any TODO keyword or priority cookie. 20208 (let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) 20209 (line-end-position))) 20210 (bol (point))) 20211 (if (eq special 'reversed) 20212 (when (and (= origin bol) (eq last-command this-command)) 20213 (goto-char refpos)) 20214 (when (or (> origin refpos) (= origin bol)) 20215 (goto-char refpos))))) 20216 ((and (looking-at org-list-full-item-re) 20217 (memq (org-element-type (save-match-data (org-element-at-point))) 20218 '(item plain-list))) 20219 ;; Set special position at first white space character after 20220 ;; bullet, and check-box, if any. 20221 (let ((after-bullet 20222 (let ((box (match-end 3))) 20223 (cond ((not box) (match-end 1)) 20224 ((eq (char-after box) ?\s) (1+ box)) 20225 (t box))))) 20226 (if (eq special 'reversed) 20227 (when (and (= (point) origin) (eq last-command this-command)) 20228 (goto-char after-bullet)) 20229 (when (or (> origin after-bullet) (= (point) origin)) 20230 (goto-char after-bullet))))) 20231 ;; No special context. Point is already at beginning of line. 20232 (t nil)))) 20233 20234 (defun org-end-of-line (&optional n) 20235 "Go to the end of the line, but before ellipsis, if any. 20236 20237 If this is a headline, and `org-special-ctrl-a/e' is not nil or 20238 symbol `reversed', ignore tags on the first attempt, and only 20239 move to after the tags when the cursor is already beyond the end 20240 of the headline. 20241 20242 If `org-special-ctrl-a/e' is symbol `reversed' then ignore tags 20243 on the second attempt. 20244 20245 With argument N not nil or 1, move forward N - 1 lines first." 20246 (interactive "^p") 20247 (let ((origin (point)) 20248 (special (pcase org-special-ctrl-a/e 20249 (`(,_ . ,C-e) C-e) (_ org-special-ctrl-a/e))) 20250 deactivate-mark) 20251 ;; First move to a visible line. 20252 (if (bound-and-true-p visual-line-mode) 20253 (beginning-of-visual-line n) 20254 (move-beginning-of-line n)) 20255 (cond 20256 ;; At a headline, with tags. 20257 ((and special 20258 (save-excursion 20259 (beginning-of-line) 20260 (let ((case-fold-search nil)) 20261 (looking-at org-complex-heading-regexp))) 20262 (match-end 5)) 20263 (let ((tags (save-excursion 20264 (goto-char (match-beginning 5)) 20265 (skip-chars-backward " \t") 20266 (point))) 20267 (visual-end (and (bound-and-true-p visual-line-mode) 20268 (save-excursion 20269 (end-of-visual-line) 20270 (point))))) 20271 ;; If `end-of-visual-line' brings us before end of line or 20272 ;; even tags, i.e., the headline spans over multiple visual 20273 ;; lines, move there. 20274 (cond ((and visual-end 20275 (< visual-end tags) 20276 (<= origin visual-end)) 20277 (goto-char visual-end)) 20278 ((eq special 'reversed) 20279 (if (and (= origin (line-end-position)) 20280 (eq this-command last-command)) 20281 (goto-char tags) 20282 (end-of-line))) 20283 (t 20284 (if (or (< origin tags) (= origin (line-end-position))) 20285 (goto-char tags) 20286 (end-of-line)))))) 20287 ((bound-and-true-p visual-line-mode) 20288 (let ((bol (line-beginning-position))) 20289 (end-of-visual-line) 20290 ;; If `end-of-visual-line' gets us past the ellipsis at the 20291 ;; end of a line, backtrack and use `end-of-line' instead. 20292 (when (/= bol (line-beginning-position)) 20293 (goto-char bol) 20294 (end-of-line)))) 20295 (t (end-of-line))))) 20296 20297 (defun org-backward-sentence (&optional _arg) 20298 "Go to beginning of sentence, or beginning of table field. 20299 This will call `backward-sentence' or `org-table-beginning-of-field', 20300 depending on context." 20301 (interactive) 20302 (let* ((element (org-element-at-point)) 20303 (contents-begin (org-element-property :contents-begin element)) 20304 (table (org-element-lineage element '(table) t))) 20305 (if (and table 20306 (> (point) contents-begin) 20307 (<= (point) (org-element-property :contents-end table))) 20308 (call-interactively #'org-table-beginning-of-field) 20309 (save-restriction 20310 (when (and contents-begin 20311 (< (point-min) contents-begin) 20312 (> (point) contents-begin)) 20313 (narrow-to-region contents-begin 20314 (org-element-property :contents-end element))) 20315 (call-interactively #'backward-sentence))))) 20316 20317 (defun org-forward-sentence (&optional _arg) 20318 "Go to end of sentence, or end of table field. 20319 This will call `forward-sentence' or `org-table-end-of-field', 20320 depending on context." 20321 (interactive) 20322 (if (and (org-at-heading-p) 20323 (save-restriction (skip-chars-forward " \t") (not (eolp)))) 20324 (save-restriction 20325 (narrow-to-region (line-beginning-position) (line-end-position)) 20326 (call-interactively #'forward-sentence)) 20327 (let* ((element (org-element-at-point)) 20328 (contents-end (org-element-property :contents-end element)) 20329 (table (org-element-lineage element '(table) t))) 20330 (if (and table 20331 (>= (point) (org-element-property :contents-begin table)) 20332 (< (point) contents-end)) 20333 (call-interactively #'org-table-end-of-field) 20334 (save-restriction 20335 (when (and contents-end 20336 (> (point-max) contents-end) 20337 ;; Skip blank lines between elements. 20338 (< (org-element-property :end element) 20339 (save-excursion (goto-char contents-end) 20340 (skip-chars-forward " \r\t\n")))) 20341 (narrow-to-region (org-element-property :contents-begin element) 20342 contents-end)) 20343 ;; End of heading is considered as the end of a sentence. 20344 (let ((sentence-end (concat (sentence-end) "\\|^\\*+ .*$"))) 20345 (call-interactively #'forward-sentence))))))) 20346 20347 (defun org-kill-line (&optional _arg) 20348 "Kill line, to tags or end of line." 20349 (interactive) 20350 (cond 20351 ((or (not org-special-ctrl-k) 20352 (bolp) 20353 (not (org-at-heading-p))) 20354 (when (and (get-char-property (line-end-position) 'invisible) 20355 org-ctrl-k-protect-subtree 20356 (or (eq org-ctrl-k-protect-subtree 'error) 20357 (not (y-or-n-p "Kill hidden subtree along with headline? ")))) 20358 (user-error 20359 (substitute-command-keys 20360 "`\\[org-kill-line]' aborted as it would kill a hidden subtree"))) 20361 (call-interactively 20362 (if (bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) 20363 ((org-match-line org-tag-line-re) 20364 (let ((end (save-excursion 20365 (goto-char (match-beginning 1)) 20366 (skip-chars-backward " \t") 20367 (point)))) 20368 (if (<= end (point)) ;on tags part 20369 (kill-region (point) (line-end-position)) 20370 (kill-region (point) end))) 20371 ;; Only align tags when we are still on a heading: 20372 (if (org-at-heading-p) (org-align-tags))) 20373 (t (kill-region (point) (line-end-position))))) 20374 20375 (defun org-yank (&optional arg) 20376 "Yank. If the kill is a subtree, treat it specially. 20377 This command will look at the current kill and check if is a single 20378 subtree, or a series of subtrees[1]. If it passes the test, and if the 20379 cursor is at the beginning of a line or after the stars of a currently 20380 empty headline, then the yank is handled specially. How exactly depends 20381 on the value of the following variables. 20382 20383 `org-yank-folded-subtrees' 20384 By default, this variable is non-nil, which results in 20385 subtree(s) being folded after insertion, except if doing so 20386 would swallow text after the yanked text. 20387 20388 `org-yank-adjusted-subtrees' 20389 When non-nil (the default value is nil), the subtree will be 20390 promoted or demoted in order to fit into the local outline tree 20391 structure, which means that the level will be adjusted so that it 20392 becomes the smaller one of the two *visible* surrounding headings. 20393 20394 Any prefix to this command will cause `yank' to be called directly with 20395 no special treatment. In particular, a simple `\\[universal-argument]' prefix \ 20396 will just 20397 plainly yank the text as it is. 20398 20399 \[1] The test checks if the first non-white line is a heading 20400 and if there are no other headings with fewer stars." 20401 (interactive "P") 20402 (org-yank-generic 'yank arg)) 20403 20404 (defun org-yank-generic (command arg) 20405 "Perform some yank-like command. 20406 20407 This function implements the behavior described in the `org-yank' 20408 documentation. However, it has been generalized to work for any 20409 interactive command with similar behavior." 20410 20411 ;; pretend to be command COMMAND 20412 (setq this-command command) 20413 20414 (if arg 20415 (call-interactively command) 20416 20417 (let ((subtreep ; is kill a subtree, and the yank position appropriate? 20418 (and (org-kill-is-subtree-p) 20419 (or (bolp) 20420 (and (looking-at "[ \t]*$") 20421 (string-match 20422 "\\`\\*+\\'" 20423 (buffer-substring (point-at-bol) (point))))))) 20424 swallowp) 20425 (cond 20426 ((and subtreep org-yank-folded-subtrees) 20427 (let ((beg (point)) 20428 end) 20429 (if (and subtreep org-yank-adjusted-subtrees) 20430 (org-paste-subtree nil nil 'for-yank) 20431 (call-interactively command)) 20432 20433 (setq end (point)) 20434 (goto-char beg) 20435 (when (and (bolp) subtreep 20436 (not (setq swallowp 20437 (org-yank-folding-would-swallow-text beg end)))) 20438 (org-with-limited-levels 20439 (or (looking-at org-outline-regexp) 20440 (re-search-forward org-outline-regexp-bol end t)) 20441 (while (and (< (point) end) (looking-at org-outline-regexp)) 20442 (org-flag-subtree t) 20443 (org-cycle-show-empty-lines 'folded) 20444 (condition-case nil 20445 (outline-forward-same-level 1) 20446 (error (goto-char end)))))) 20447 (when swallowp 20448 (message 20449 "Inserted text not folded because that would swallow text")) 20450 20451 (goto-char end) 20452 (skip-chars-forward " \t\n\r") 20453 (beginning-of-line 1) 20454 (push-mark beg 'nomsg))) 20455 ((and subtreep org-yank-adjusted-subtrees) 20456 (let ((beg (point-at-bol))) 20457 (org-paste-subtree nil nil 'for-yank) 20458 (push-mark beg 'nomsg))) 20459 (t 20460 (call-interactively command)))))) 20461 20462 (defun org-yank-folding-would-swallow-text (beg end) 20463 "Would `hide-subtree' at BEG swallow any text after END?" 20464 (let (level) 20465 (org-with-limited-levels 20466 (save-excursion 20467 (goto-char beg) 20468 (when (or (looking-at org-outline-regexp) 20469 (re-search-forward org-outline-regexp-bol end t)) 20470 (setq level (org-outline-level))) 20471 (goto-char end) 20472 (skip-chars-forward " \t\r\n\v\f") 20473 (not (or (eobp) 20474 (and (bolp) (looking-at-p org-outline-regexp) 20475 (<= (org-outline-level) level)))))))) 20476 20477 (defun org-back-to-heading (&optional invisible-ok) 20478 "Call `outline-back-to-heading', but provide a better error message." 20479 (condition-case nil 20480 (outline-back-to-heading invisible-ok) 20481 (error 20482 (user-error "Before first headline at position %d in buffer %s" 20483 (point) (current-buffer))))) 20484 20485 (defun org-back-to-heading-or-point-min (&optional invisible-ok) 20486 "Go back to heading or first point in buffer. 20487 If point is before first heading go to first point in buffer 20488 instead of back to heading." 20489 (condition-case nil 20490 (outline-back-to-heading invisible-ok) 20491 (error 20492 (goto-char (point-min))))) 20493 20494 (defun org-before-first-heading-p () 20495 "Before first heading?" 20496 (org-with-limited-levels 20497 (save-excursion 20498 (end-of-line) 20499 (null (re-search-backward org-outline-regexp-bol nil t))))) 20500 20501 (defun org-at-heading-p (&optional _) 20502 "Non-nil when on a headline." 20503 (outline-on-heading-p t)) 20504 20505 (defun org-in-commented-heading-p (&optional no-inheritance) 20506 "Non-nil if point is under a commented heading. 20507 This function also checks ancestors of the current headline, 20508 unless optional argument NO-INHERITANCE is non-nil." 20509 (cond 20510 ((org-before-first-heading-p) nil) 20511 ((let ((headline (nth 4 (org-heading-components)))) 20512 (and headline 20513 (let ((case-fold-search nil)) 20514 (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)") 20515 headline))))) 20516 (no-inheritance nil) 20517 (t 20518 (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p)))))) 20519 20520 (defun org-in-archived-heading-p (&optional no-inheritance) 20521 "Non-nil if point is under an archived heading. 20522 This function also checks ancestors of the current headline, 20523 unless optional argument NO-INHERITANCE is non-nil." 20524 (cond 20525 ((org-before-first-heading-p) nil) 20526 ((let ((tags (org-get-tags nil 'local))) 20527 (and tags 20528 (cl-some (apply-partially #'string= org-archive-tag) tags)))) 20529 (no-inheritance nil) 20530 (t 20531 (save-excursion (and (org-up-heading-safe) (org-in-archived-heading-p)))))) 20532 20533 (defun org-at-comment-p nil 20534 "Return t if cursor is in a commented line." 20535 (save-excursion 20536 (save-match-data 20537 (beginning-of-line) 20538 (looking-at org-comment-regexp)))) 20539 20540 (defun org-at-keyword-p nil 20541 "Return t if cursor is at a keyword-line." 20542 (save-excursion 20543 (move-beginning-of-line 1) 20544 (looking-at org-keyword-regexp))) 20545 20546 (defun org-at-drawer-p nil 20547 "Return t if cursor is at a drawer keyword." 20548 (save-excursion 20549 (move-beginning-of-line 1) 20550 (looking-at org-drawer-regexp))) 20551 20552 (defun org-at-block-p nil 20553 "Return t if cursor is at a block keyword." 20554 (save-excursion 20555 (move-beginning-of-line 1) 20556 (looking-at org-block-regexp))) 20557 20558 (defun org-point-at-end-of-empty-headline () 20559 "If point is at the end of an empty headline, return t, else nil. 20560 If the heading only contains a TODO keyword, it is still considered 20561 empty." 20562 (let ((case-fold-search nil)) 20563 (and (looking-at "[ \t]*$") 20564 org-todo-line-regexp 20565 (save-excursion 20566 (beginning-of-line) 20567 (looking-at org-todo-line-regexp) 20568 (string= (match-string 3) ""))))) 20569 20570 (defun org-at-heading-or-item-p () 20571 (or (org-at-heading-p) (org-at-item-p))) 20572 20573 (defun org-up-heading-all (arg) 20574 "Move to the heading line of which the present line is a subheading. 20575 This function considers both visible and invisible heading lines. 20576 With argument, move up ARG levels." 20577 (outline-up-heading arg t)) 20578 20579 (defvar-local org--up-heading-cache nil 20580 "Buffer-local `org-up-heading-safe' cache.") 20581 (defvar-local org--up-heading-cache-tick nil 20582 "Buffer `buffer-chars-modified-tick' in `org--up-heading-cache'.") 20583 (defun org-up-heading-safe () 20584 "Move to the heading line of which the present line is a subheading. 20585 This version will not throw an error. It will return the level of the 20586 headline found, or nil if no higher level is found. 20587 20588 Also, this function will be a lot faster than `outline-up-heading', 20589 because it relies on stars being the outline starters. This can really 20590 make a significant difference in outlines with very many siblings." 20591 (when (ignore-errors (org-back-to-heading t)) 20592 (let (level-cache) 20593 (unless org--up-heading-cache 20594 (setq org--up-heading-cache (make-hash-table))) 20595 (if (and (eq (buffer-chars-modified-tick) org--up-heading-cache-tick) 20596 (setq level-cache (gethash (point) org--up-heading-cache))) 20597 (when (<= (point-min) (car level-cache) (point-max)) 20598 ;; Parent is inside accessible part of the buffer. 20599 (progn (goto-char (car level-cache)) 20600 (cdr level-cache))) 20601 ;; Buffer modified. Invalidate cache. 20602 (unless (eq (buffer-chars-modified-tick) org--up-heading-cache-tick) 20603 (setq-local org--up-heading-cache-tick 20604 (buffer-chars-modified-tick)) 20605 (clrhash org--up-heading-cache)) 20606 (let* ((level-up (1- (funcall outline-level))) 20607 (pos (point)) 20608 (result (and (> level-up 0) 20609 (re-search-backward 20610 (format "^\\*\\{1,%d\\} " level-up) nil t) 20611 (funcall outline-level)))) 20612 (when result (puthash pos (cons (point) result) org--up-heading-cache)) 20613 result))))) 20614 20615 (defun org-up-heading-or-point-min () 20616 "Move to the heading line of which the present is a subheading, or point-min. 20617 This version is needed to make point-min behave like a virtual 20618 heading of level 0 for property-inheritance. It will return the 20619 level of the headline found (down to 0) or nil if already at a 20620 point before the first headline or at point-min." 20621 (when (ignore-errors (org-back-to-heading t)) 20622 (if (< 1 (funcall outline-level)) 20623 (org-up-heading-safe) 20624 (unless (= (point) (point-min)) (goto-char (point-min)))))) 20625 20626 (defun org-first-sibling-p () 20627 "Is this heading the first child of its parents?" 20628 (interactive) 20629 (let ((re org-outline-regexp-bol) 20630 level l) 20631 (unless (org-at-heading-p t) 20632 (user-error "Not at a heading")) 20633 (setq level (funcall outline-level)) 20634 (save-excursion 20635 (if (not (re-search-backward re nil t)) 20636 t 20637 (setq l (funcall outline-level)) 20638 (< l level))))) 20639 20640 (defun org-goto-sibling (&optional previous) 20641 "Goto the next sibling, even if it is invisible. 20642 When PREVIOUS is set, go to the previous sibling instead. Returns t 20643 when a sibling was found. When none is found, return nil and don't 20644 move point." 20645 (let ((fun (if previous 're-search-backward 're-search-forward)) 20646 (pos (point)) 20647 (re org-outline-regexp-bol) 20648 level l) 20649 (when (ignore-errors (org-back-to-heading t)) 20650 (setq level (funcall outline-level)) 20651 (catch 'exit 20652 (or previous (forward-char 1)) 20653 (while (funcall fun re nil t) 20654 (setq l (funcall outline-level)) 20655 (when (< l level) (goto-char pos) (throw 'exit nil)) 20656 (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) 20657 (goto-char pos) 20658 nil)))) 20659 20660 (defun org-show-siblings () 20661 "Show all siblings of the current headline." 20662 (save-excursion 20663 (while (org-goto-sibling) (org-flag-heading nil))) 20664 (save-excursion 20665 (while (org-goto-sibling 'previous) 20666 (org-flag-heading nil)))) 20667 20668 (defun org-goto-first-child () 20669 "Goto the first child, even if it is invisible. 20670 Return t when a child was found. Otherwise don't move point and 20671 return nil." 20672 (let (level (pos (point)) (re org-outline-regexp-bol)) 20673 (when (org-back-to-heading-or-point-min t) 20674 (setq level (org-outline-level)) 20675 (forward-char 1) 20676 (if (and (re-search-forward re nil t) (> (org-outline-level) level)) 20677 (progn (goto-char (match-beginning 0)) t) 20678 (goto-char pos) nil)))) 20679 20680 (defun org-show-hidden-entry () 20681 "Show an entry where even the heading is hidden." 20682 (save-excursion 20683 (org-show-entry))) 20684 20685 (defun org-flag-heading (flag &optional entry) 20686 "Flag the current heading. FLAG non-nil means make invisible. 20687 When ENTRY is non-nil, show the entire entry." 20688 (save-excursion 20689 (org-back-to-heading t) 20690 ;; Check if we should show the entire entry 20691 (if (not entry) 20692 (org-flag-region 20693 (line-end-position 0) (line-end-position) flag 'outline) 20694 (org-show-entry) 20695 (save-excursion 20696 (and (outline-next-heading) 20697 (org-flag-heading nil)))))) 20698 20699 (defun org-get-next-sibling () 20700 "Move to next heading of the same level, and return point. 20701 If there is no such heading, return nil. 20702 This is like outline-next-sibling, but invisible headings are ok." 20703 (let ((level (funcall outline-level))) 20704 (outline-next-heading) 20705 (while (and (not (eobp)) (> (funcall outline-level) level)) 20706 (outline-next-heading)) 20707 (unless (or (eobp) (< (funcall outline-level) level)) 20708 (point)))) 20709 20710 (defun org-get-previous-sibling () 20711 "Move to previous heading of the same level, and return point. 20712 If there is no such heading, return nil." 20713 (let ((opoint (point)) 20714 (level (funcall outline-level))) 20715 (outline-previous-heading) 20716 (when (and (/= (point) opoint) (outline-on-heading-p t)) 20717 (while (and (> (funcall outline-level) level) 20718 (not (bobp))) 20719 (outline-previous-heading)) 20720 (unless (< (funcall outline-level) level) 20721 (point))))) 20722 20723 (defun org-end-of-subtree (&optional invisible-ok to-heading) 20724 "Goto to the end of a subtree." 20725 ;; This contains an exact copy of the original function, but it uses 20726 ;; `org-back-to-heading-or-point-min', to make it work also in invisible 20727 ;; trees and before first headline. And is uses an invisible-ok argument. 20728 ;; Under Emacs this is not needed, but the old outline.el needs this fix. 20729 ;; Furthermore, when used inside Org, finding the end of a large subtree 20730 ;; with many children and grandchildren etc, this can be much faster 20731 ;; than the outline version. 20732 (org-back-to-heading-or-point-min invisible-ok) 20733 (let ((first t) 20734 (level (funcall outline-level))) 20735 (cond ((= level 0) 20736 (goto-char (point-max))) 20737 ((and (derived-mode-p 'org-mode) (< level 1000)) 20738 ;; A true heading (not a plain list item), in Org 20739 ;; This means we can easily find the end by looking 20740 ;; only for the right number of stars. Using a regexp to do 20741 ;; this is so much faster than using a Lisp loop. 20742 (let ((re (concat "^\\*\\{1," (number-to-string level) "\\} "))) 20743 (forward-char 1) 20744 (and (re-search-forward re nil 'move) (beginning-of-line 1)))) 20745 (t 20746 ;; something else, do it the slow way 20747 (while (and (not (eobp)) 20748 (or first (> (funcall outline-level) level))) 20749 (setq first nil) 20750 (outline-next-heading)))) 20751 (unless to-heading 20752 (when (memq (preceding-char) '(?\n ?\^M)) 20753 ;; Go to end of line before heading 20754 (forward-char -1) 20755 (when (memq (preceding-char) '(?\n ?\^M)) 20756 ;; leave blank line before heading 20757 (forward-char -1))))) 20758 (point)) 20759 20760 (defun org-end-of-meta-data (&optional full) 20761 "Skip planning line and properties drawer in current entry. 20762 20763 When optional argument FULL is t, also skip planning information, 20764 clocking lines and any kind of drawer. 20765 20766 When FULL is non-nil but not t, skip planning information, 20767 properties, clocking lines and logbook drawers." 20768 (org-back-to-heading t) 20769 (forward-line) 20770 ;; Skip planning information. 20771 (when (looking-at-p org-planning-line-re) (forward-line)) 20772 ;; Skip property drawer. 20773 (when (looking-at org-property-drawer-re) 20774 (goto-char (match-end 0)) 20775 (forward-line)) 20776 ;; When FULL is not nil, skip more. 20777 (when (and full (not (org-at-heading-p))) 20778 (catch 'exit 20779 (let ((end (save-excursion (outline-next-heading) (point))) 20780 (re (concat "[ \t]*$" "\\|" org-clock-line-re))) 20781 (while (not (eobp)) 20782 (cond ;; Skip clock lines. 20783 ((looking-at-p re) (forward-line)) 20784 ;; Skip logbook drawer. 20785 ((looking-at-p org-logbook-drawer-re) 20786 (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t) 20787 (forward-line) 20788 (throw 'exit t))) 20789 ;; When FULL is t, skip regular drawer too. 20790 ((and (eq full t) (looking-at-p org-drawer-regexp)) 20791 (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t) 20792 (forward-line) 20793 (throw 'exit t))) 20794 (t (throw 'exit t)))))))) 20795 20796 (defun org--line-fully-invisible-p () 20797 "Return non-nil if the current line is fully invisible." 20798 (let ((line-beg (line-beginning-position)) 20799 (line-pos (1- (line-end-position))) 20800 (is-invisible t)) 20801 (while (and (< line-beg line-pos) is-invisible) 20802 (setq is-invisible (org-invisible-p line-pos)) 20803 (setq line-pos (1- line-pos))) 20804 is-invisible)) 20805 20806 (defun org-forward-heading-same-level (arg &optional invisible-ok) 20807 "Move forward to the ARG'th subheading at same level as this one. 20808 Stop at the first and last subheadings of a superior heading. 20809 Normally this only looks at visible headings, but when INVISIBLE-OK is 20810 non-nil it will also look at invisible ones." 20811 (interactive "p") 20812 (let ((backward? (and arg (< arg 0)))) 20813 (if (org-before-first-heading-p) 20814 (if backward? (goto-char (point-min)) (outline-next-heading)) 20815 (org-back-to-heading invisible-ok) 20816 (unless backward? (end-of-line)) ;do not match current headline 20817 (let ((level (- (match-end 0) (match-beginning 0) 1)) 20818 (f (if backward? #'re-search-backward #'re-search-forward)) 20819 (count (if arg (abs arg) 1)) 20820 (result (point))) 20821 (while (and (> count 0) 20822 (funcall f org-outline-regexp-bol nil 'move)) 20823 (let ((l (- (match-end 0) (match-beginning 0) 1))) 20824 (cond ((< l level) (setq count 0)) 20825 ((and (= l level) 20826 (or invisible-ok 20827 ;; FIXME: See commit a700fadd72 and the 20828 ;; related discussion on why using 20829 ;; `org--line-fully-invisible-p' is needed 20830 ;; here, which is to serve the needs of an 20831 ;; external package. If the change is 20832 ;; wrong regarding Org itself, it should 20833 ;; be removed. 20834 (not (org--line-fully-invisible-p)))) 20835 (cl-decf count) 20836 (when (= l level) (setq result (point))))))) 20837 (goto-char result)) 20838 (beginning-of-line)))) 20839 20840 (defun org-backward-heading-same-level (arg &optional invisible-ok) 20841 "Move backward to the ARG'th subheading at same level as this one. 20842 Stop at the first and last subheadings of a superior heading." 20843 (interactive "p") 20844 (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) 20845 20846 (defun org-next-visible-heading (arg) 20847 "Move to the next visible heading line. 20848 With ARG, repeats or can move backward if negative." 20849 (interactive "p") 20850 (let ((regexp (concat "^" (org-get-limited-outline-regexp)))) 20851 (if (< arg 0) 20852 (beginning-of-line) 20853 (end-of-line)) 20854 (while (and (< arg 0) (re-search-backward regexp nil :move)) 20855 (unless (bobp) 20856 (while (pcase (get-char-property-and-overlay (point) 'invisible) 20857 (`(outline . ,o) 20858 (goto-char (overlay-start o)) 20859 (re-search-backward regexp nil :move)) 20860 (_ nil)))) 20861 (cl-incf arg)) 20862 (while (and (> arg 0) (re-search-forward regexp nil t)) 20863 (while (pcase (get-char-property-and-overlay (point) 'invisible) 20864 (`(outline . ,o) 20865 (goto-char (overlay-end o)) 20866 (re-search-forward regexp nil :move)) 20867 (_ 20868 (end-of-line) 20869 nil))) ;leave the loop 20870 (cl-decf arg)) 20871 (if (> arg 0) (goto-char (point-max)) (beginning-of-line)))) 20872 20873 (defun org-previous-visible-heading (arg) 20874 "Move to the previous visible heading. 20875 With ARG, repeats or can move forward if negative." 20876 (interactive "p") 20877 (org-next-visible-heading (- arg))) 20878 20879 (defun org-forward-paragraph (&optional arg) 20880 "Move forward by a paragraph, or equivalent, unit. 20881 20882 With argument ARG, do it ARG times; 20883 a negative argument ARG = -N means move backward N paragraphs. 20884 20885 The function moves point between two structural 20886 elements (paragraphs, tables, lists, etc.). 20887 20888 It also provides the following special moves for convenience: 20889 20890 - on a table or a property drawer, move to its beginning; 20891 - on comment, example, export, source and verse blocks, stop 20892 at blank lines; 20893 - skip consecutive clocks, diary S-exps, and keywords." 20894 (interactive "^p") 20895 (unless arg (setq arg 1)) 20896 (if (< arg 0) (org-backward-paragraph (- arg)) 20897 (while (and (> arg 0) (not (eobp))) 20898 (org--forward-paragraph-once) 20899 (cl-decf arg)) 20900 ;; Return moves left. 20901 arg)) 20902 20903 (defun org-backward-paragraph (&optional arg) 20904 "Move backward by a paragraph, or equivalent, unit. 20905 20906 With argument ARG, do it ARG times; 20907 a negative argument ARG = -N means move forward N paragraphs. 20908 20909 The function moves point between two structural 20910 elements (paragraphs, tables, lists, etc.). 20911 20912 It also provides the following special moves for convenience: 20913 20914 - on a table or a property drawer, move to its beginning; 20915 - on comment, example, export, source and verse blocks, stop 20916 at blank lines; 20917 - skip consecutive clocks, diary S-exps, and keywords." 20918 (interactive "^p") 20919 (unless arg (setq arg 1)) 20920 (if (< arg 0) (org-forward-paragraph (- arg)) 20921 (while (and (> arg 0) (not (bobp))) 20922 (org--backward-paragraph-once) 20923 (cl-decf arg)) 20924 ;; Return moves left. 20925 arg)) 20926 20927 (defun org--paragraph-at-point () 20928 "Return paragraph, or equivalent, element at point. 20929 20930 Paragraph element at point is the element at point, with the 20931 following special cases: 20932 20933 - treat table rows (resp. node properties) as the table 20934 \(resp. property drawer) containing them. 20935 20936 - treat plain lists with an item every line as a whole. 20937 20938 - treat consecutive keywords, clocks, and diary-sexps as a single 20939 block. 20940 20941 Function may return a real element, or a pseudo-element with type 20942 `pseudo-paragraph'." 20943 (let* ((e (org-element-at-point)) 20944 (type (org-element-type e)) 20945 ;; If we need to fake a new pseudo-element, triplet is 20946 ;; 20947 ;; (BEG END PARENT) 20948 ;; 20949 ;; where BEG and END are element boundaries, and PARENT the 20950 ;; element containing it, or nil. 20951 (triplet 20952 (cond 20953 ((memq type '(table property-drawer)) 20954 (list (org-element-property :begin e) 20955 (org-element-property :end e) 20956 (org-element-property :parent e))) 20957 ((memq type '(node-property table-row)) 20958 (let ((e (org-element-property :parent e))) 20959 (list (org-element-property :begin e) 20960 (org-element-property :end e) 20961 (org-element-property :parent e)))) 20962 ((memq type '(clock diary-sexp keyword)) 20963 (let* ((regexp (pcase type 20964 (`clock org-clock-line-re) 20965 (`diary-sexp "%%(") 20966 (_ org-keyword-regexp))) 20967 (end (if (< 0 (org-element-property :post-blank e)) 20968 (org-element-property :end e) 20969 (org-with-wide-buffer 20970 (forward-line) 20971 (while (looking-at regexp) (forward-line)) 20972 (skip-chars-forward " \t\n") 20973 (line-beginning-position)))) 20974 (begin (org-with-point-at (org-element-property :begin e) 20975 (while (and (not (bobp)) (looking-at regexp)) 20976 (forward-line -1)) 20977 ;; We may have gotten one line too far. 20978 (if (looking-at regexp) 20979 (point) 20980 (line-beginning-position 2))))) 20981 (list begin end (org-element-property :parent e)))) 20982 ;; Find the full plain list containing point, the check it 20983 ;; contains exactly one line per item. 20984 ((let ((l (org-element-lineage e '(plain-list) t))) 20985 (while (memq (org-element-type (org-element-property :parent l)) 20986 '(item plain-list)) 20987 (setq l (org-element-property :parent l))) 20988 (and l 20989 (org-with-point-at (org-element-property :post-affiliated l) 20990 (forward-line (length (org-element-property :structure l))) 20991 (= (point) (org-element-property :contents-end l))) 20992 ;; Return value. 20993 (list (org-element-property :begin l) 20994 (org-element-property :end l) 20995 (org-element-property :parent l))))) 20996 (t nil)))) ;no triplet: return element 20997 (pcase triplet 20998 (`(,b ,e ,p) 20999 (org-element-create 21000 'pseudo-paragraph 21001 (list :begin b :end e :parent p :post-blank 0 :post-affiliated b))) 21002 (_ e)))) 21003 21004 (defun org--forward-paragraph-once () 21005 "Move forward to end of paragraph or equivalent, once. 21006 See `org-forward-paragraph'." 21007 (interactive) 21008 (save-restriction 21009 (widen) 21010 (skip-chars-forward " \t\n") 21011 (cond 21012 ((eobp) nil) 21013 ;; When inside a folded part, move out of it. 21014 ((pcase (get-char-property-and-overlay (point) 'invisible) 21015 (`(,(or `outline `org-hide-block) . ,o) 21016 (goto-char (overlay-end o)) 21017 (forward-line) 21018 t) 21019 (_ nil))) 21020 (t 21021 (let* ((element (org--paragraph-at-point)) 21022 (type (org-element-type element)) 21023 (contents-begin (org-element-property :contents-begin element)) 21024 (end (org-element-property :end element)) 21025 (post-affiliated (org-element-property :post-affiliated element))) 21026 (cond 21027 ((eq type 'plain-list) 21028 (forward-char) 21029 (org--forward-paragraph-once)) 21030 ;; If the element is folded, skip it altogether. 21031 ((pcase (org-with-point-at post-affiliated 21032 (get-char-property-and-overlay (line-end-position) 21033 'invisible)) 21034 (`(,(or `outline `org-hide-block) . ,o) 21035 (goto-char (overlay-end o)) 21036 (forward-line) 21037 t) 21038 (_ nil))) 21039 ;; At a greater element, move inside. 21040 ((and contents-begin 21041 (> contents-begin (point)) 21042 (not (eq type 'paragraph))) 21043 (goto-char contents-begin) 21044 ;; Items and footnote definitions contents may not start at 21045 ;; the beginning of the line. In this case, skip until the 21046 ;; next paragraph. 21047 (cond 21048 ((not (bolp)) (org--forward-paragraph-once)) 21049 ((org-previous-line-empty-p) (forward-line -1)) 21050 (t nil))) 21051 ;; Move between empty lines in some blocks. 21052 ((memq type '(comment-block example-block export-block src-block 21053 verse-block)) 21054 (let ((contents-start 21055 (org-with-point-at post-affiliated 21056 (line-beginning-position 2)))) 21057 (if (< (point) contents-start) 21058 (goto-char contents-start) 21059 (let ((contents-end 21060 (org-with-point-at end 21061 (skip-chars-backward " \t\n") 21062 (line-beginning-position)))) 21063 (cond 21064 ((>= (point) contents-end) 21065 (goto-char end) 21066 (skip-chars-backward " \t\n") 21067 (forward-line)) 21068 ((re-search-forward "^[ \t]*\n" contents-end :move) 21069 (forward-line -1)) 21070 (t nil)))))) 21071 (t 21072 ;; Move to element's end. 21073 (goto-char end) 21074 (skip-chars-backward " \t\n") 21075 (forward-line)))))))) 21076 21077 (defun org--backward-paragraph-once () 21078 "Move backward to start of paragraph or equivalent, once. 21079 See `org-backward-paragraph'." 21080 (interactive) 21081 (save-restriction 21082 (widen) 21083 (cond 21084 ((bobp) nil) 21085 ;; Blank lines at the beginning of the buffer. 21086 ((and (org-match-line "^[ \t]*$") 21087 (save-excursion (skip-chars-backward " \t\n") (bobp))) 21088 (goto-char (point-min))) 21089 ;; When inside a folded part, move out of it. 21090 ((pcase (get-char-property-and-overlay (1- (point)) 'invisible) 21091 (`(,(or `outline `org-hide-block) . ,o) 21092 (goto-char (1- (overlay-start o))) 21093 (org--backward-paragraph-once) 21094 t) 21095 (_ nil))) 21096 (t 21097 (let* ((element (org--paragraph-at-point)) 21098 (type (org-element-type element)) 21099 (begin (org-element-property :begin element)) 21100 (post-affiliated (org-element-property :post-affiliated element)) 21101 (contents-end (org-element-property :contents-end element)) 21102 (end (org-element-property :end element)) 21103 (parent (org-element-property :parent element)) 21104 (reach 21105 ;; Move to the visible empty line above position P, or 21106 ;; to position P. Return t. 21107 (lambda (p) 21108 (goto-char p) 21109 (when (and (org-previous-line-empty-p) 21110 (let ((end (line-end-position 0))) 21111 (or (= end (point-min)) 21112 (not (org-invisible-p (1- end)))))) 21113 (forward-line -1)) 21114 t))) 21115 (cond 21116 ;; Already at the beginning of an element. 21117 ((= begin (point)) 21118 (cond 21119 ;; There is a blank line above. Move there. 21120 ((and (org-previous-line-empty-p) 21121 (let ((lep (line-end-position 0))) 21122 ;; When the first headline start at point 2, don't choke while 21123 ;; checking with `org-invisible-p'. 21124 (or (= lep 1) 21125 (not (org-invisible-p (1- (line-end-position 0))))))) 21126 (forward-line -1)) 21127 ;; At the beginning of the first element within a greater 21128 ;; element. Move to the beginning of the greater element. 21129 ((and parent (= begin (org-element-property :contents-begin parent))) 21130 (funcall reach (org-element-property :begin parent))) 21131 ;; Since we have to move anyway, find the beginning 21132 ;; position of the element above. 21133 (t 21134 (forward-char -1) 21135 (org--backward-paragraph-once)))) 21136 ;; Skip paragraphs at the very beginning of footnote 21137 ;; definitions or items. 21138 ((and (eq type 'paragraph) 21139 (org-with-point-at begin (not (bolp)))) 21140 (funcall reach (progn (goto-char begin) (line-beginning-position)))) 21141 ;; If the element is folded, skip it altogether. 21142 ((org-with-point-at post-affiliated 21143 (org-invisible-p (line-end-position) t)) 21144 (funcall reach begin)) 21145 ;; At the end of a greater element, move inside. 21146 ((and contents-end 21147 (<= contents-end (point)) 21148 (not (eq type 'paragraph))) 21149 (cond 21150 ((memq type '(footnote-definition plain-list)) 21151 (skip-chars-backward " \t\n") 21152 (org--backward-paragraph-once)) 21153 ((= contents-end (point)) 21154 (forward-char -1) 21155 (org--backward-paragraph-once)) 21156 (t 21157 (goto-char contents-end)))) 21158 ;; Move between empty lines in some blocks. 21159 ((and (memq type '(comment-block example-block export-block src-block 21160 verse-block)) 21161 (let ((contents-start 21162 (org-with-point-at post-affiliated 21163 (line-beginning-position 2)))) 21164 (when (> (point) contents-start) 21165 (let ((contents-end 21166 (org-with-point-at end 21167 (skip-chars-backward " \t\n") 21168 (line-beginning-position)))) 21169 (if (> (point) contents-end) 21170 (progn (goto-char contents-end) t) 21171 (skip-chars-backward " \t\n" begin) 21172 (re-search-backward "^[ \t]*\n" contents-start :move) 21173 t)))))) 21174 ;; Move to element's start. 21175 (t 21176 (funcall reach begin)))))))) 21177 21178 (defun org-forward-element () 21179 "Move forward by one element. 21180 Move to the next element at the same level, when possible." 21181 (interactive) 21182 (cond ((eobp) (user-error "Cannot move further down")) 21183 ((org-with-limited-levels (org-at-heading-p)) 21184 (let ((origin (point))) 21185 (goto-char (org-end-of-subtree nil t)) 21186 (unless (org-with-limited-levels (org-at-heading-p)) 21187 (goto-char origin) 21188 (user-error "Cannot move further down")))) 21189 (t 21190 (let* ((elem (org-element-at-point)) 21191 (end (org-element-property :end elem)) 21192 (parent (org-element-property :parent elem))) 21193 (cond ((and parent (= (org-element-property :contents-end parent) end)) 21194 (goto-char (org-element-property :end parent))) 21195 ((integer-or-marker-p end) (goto-char end)) 21196 (t (message "No element at point"))))))) 21197 21198 (defun org-backward-element () 21199 "Move backward by one element. 21200 Move to the previous element at the same level, when possible." 21201 (interactive) 21202 (cond ((bobp) (user-error "Cannot move further up")) 21203 ((org-with-limited-levels (org-at-heading-p)) 21204 ;; At a headline, move to the previous one, if any, or stay 21205 ;; here. 21206 (let ((origin (point))) 21207 (org-with-limited-levels (org-backward-heading-same-level 1)) 21208 ;; When current headline has no sibling above, move to its 21209 ;; parent. 21210 (when (= (point) origin) 21211 (or (org-with-limited-levels (org-up-heading-safe)) 21212 (progn (goto-char origin) 21213 (user-error "Cannot move further up")))))) 21214 (t 21215 (let* ((elem (org-element-at-point)) 21216 (beg (org-element-property :begin elem))) 21217 (cond 21218 ;; Move to beginning of current element if point isn't 21219 ;; there already. 21220 ((null beg) (message "No element at point")) 21221 ((/= (point) beg) (goto-char beg)) 21222 (t (goto-char beg) 21223 (skip-chars-backward " \r\t\n") 21224 (unless (bobp) 21225 (let ((prev (org-element-at-point))) 21226 (goto-char (org-element-property :begin prev)) 21227 (while (and (setq prev (org-element-property :parent prev)) 21228 (<= (org-element-property :end prev) beg)) 21229 (goto-char (org-element-property :begin prev))))))))))) 21230 21231 (defun org-up-element () 21232 "Move to upper element." 21233 (interactive) 21234 (if (org-with-limited-levels (org-at-heading-p)) 21235 (unless (org-up-heading-safe) (user-error "No surrounding element")) 21236 (let* ((elem (org-element-at-point)) 21237 (parent (org-element-property :parent elem))) 21238 (if parent (goto-char (org-element-property :begin parent)) 21239 (if (org-with-limited-levels (org-before-first-heading-p)) 21240 (user-error "No surrounding element") 21241 (org-with-limited-levels (org-back-to-heading))))))) 21242 21243 (defun org-down-element () 21244 "Move to inner element." 21245 (interactive) 21246 (let ((element (org-element-at-point))) 21247 (cond 21248 ((memq (org-element-type element) '(plain-list table)) 21249 (goto-char (org-element-property :contents-begin element)) 21250 (forward-char)) 21251 ((memq (org-element-type element) org-element-greater-elements) 21252 ;; If contents are hidden, first disclose them. 21253 (when (org-invisible-p (line-end-position)) (org-cycle)) 21254 (goto-char (or (org-element-property :contents-begin element) 21255 (user-error "No content for this element")))) 21256 (t (user-error "No inner element"))))) 21257 21258 (defun org-drag-element-backward () 21259 "Move backward element at point." 21260 (interactive) 21261 (let ((elem (or (org-element-at-point) 21262 (user-error "No element at point")))) 21263 (if (eq (org-element-type elem) 'headline) 21264 ;; Preserve point when moving a whole tree, even if point was 21265 ;; on blank lines below the headline. 21266 (let ((offset (skip-chars-backward " \t\n"))) 21267 (unwind-protect (org-move-subtree-up) 21268 (forward-char (- offset)))) 21269 (let ((prev-elem 21270 (save-excursion 21271 (goto-char (org-element-property :begin elem)) 21272 (skip-chars-backward " \r\t\n") 21273 (unless (bobp) 21274 (let* ((beg (org-element-property :begin elem)) 21275 (prev (org-element-at-point)) 21276 (up prev)) 21277 (while (and (setq up (org-element-property :parent up)) 21278 (<= (org-element-property :end up) beg)) 21279 (setq prev up)) 21280 prev))))) 21281 ;; Error out if no previous element or previous element is 21282 ;; a parent of the current one. 21283 (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) 21284 (user-error "Cannot drag element backward") 21285 (let ((pos (point))) 21286 (org-element-swap-A-B prev-elem elem) 21287 (goto-char (+ (org-element-property :begin prev-elem) 21288 (- pos (org-element-property :begin elem)))))))))) 21289 21290 (defun org-drag-element-forward () 21291 "Move forward element at point." 21292 (interactive) 21293 (let* ((pos (point)) 21294 (elem (or (org-element-at-point) 21295 (user-error "No element at point")))) 21296 (when (= (point-max) (org-element-property :end elem)) 21297 (user-error "Cannot drag element forward")) 21298 (goto-char (org-element-property :end elem)) 21299 (let ((next-elem (org-element-at-point))) 21300 (when (or (org-element-nested-p elem next-elem) 21301 (and (eq (org-element-type next-elem) 'headline) 21302 (not (eq (org-element-type elem) 'headline)))) 21303 (goto-char pos) 21304 (user-error "Cannot drag element forward")) 21305 ;; Compute new position of point: it's shifted by NEXT-ELEM 21306 ;; body's length (without final blanks) and by the length of 21307 ;; blanks between ELEM and NEXT-ELEM. 21308 (let ((size-next (- (save-excursion 21309 (goto-char (org-element-property :end next-elem)) 21310 (skip-chars-backward " \r\t\n") 21311 (forward-line) 21312 ;; Small correction if buffer doesn't end 21313 ;; with a newline character. 21314 (if (and (eolp) (not (bolp))) (1+ (point)) (point))) 21315 (org-element-property :begin next-elem))) 21316 (size-blank (- (org-element-property :end elem) 21317 (save-excursion 21318 (goto-char (org-element-property :end elem)) 21319 (skip-chars-backward " \r\t\n") 21320 (forward-line) 21321 (point))))) 21322 (org-element-swap-A-B elem next-elem) 21323 (goto-char (+ pos size-next size-blank)))))) 21324 21325 (defun org-drag-line-forward (arg) 21326 "Drag the line at point ARG lines forward." 21327 (interactive "p") 21328 (dotimes (_ (abs arg)) 21329 (let ((c (current-column))) 21330 (if (< 0 arg) 21331 (progn 21332 (beginning-of-line 2) 21333 (transpose-lines 1) 21334 (beginning-of-line 0)) 21335 (transpose-lines 1) 21336 (beginning-of-line -1)) 21337 (org-move-to-column c)))) 21338 21339 (defun org-drag-line-backward (arg) 21340 "Drag the line at point ARG lines backward." 21341 (interactive "p") 21342 (org-drag-line-forward (- arg))) 21343 21344 (defun org-mark-element () 21345 "Put point at beginning of this element, mark at end. 21346 21347 Interactively, if this command is repeated or (in Transient Mark 21348 mode) if the mark is active, it marks the next element after the 21349 ones already marked." 21350 (interactive) 21351 (let (deactivate-mark) 21352 (if (and (called-interactively-p 'any) 21353 (or (and (eq last-command this-command) (mark t)) 21354 (and transient-mark-mode mark-active))) 21355 (set-mark 21356 (save-excursion 21357 (goto-char (mark)) 21358 (goto-char (org-element-property :end (org-element-at-point))) 21359 (point))) 21360 (let ((element (org-element-at-point))) 21361 (end-of-line) 21362 (push-mark (min (point-max) (org-element-property :end element)) t t) 21363 (goto-char (org-element-property :begin element)))))) 21364 21365 (defun org-narrow-to-element () 21366 "Narrow buffer to current element." 21367 (interactive) 21368 (let ((elem (org-element-at-point))) 21369 (cond 21370 ((eq (car elem) 'headline) 21371 (narrow-to-region 21372 (org-element-property :begin elem) 21373 (org-element-property :end elem))) 21374 ((memq (car elem) org-element-greater-elements) 21375 (narrow-to-region 21376 (org-element-property :contents-begin elem) 21377 (org-element-property :contents-end elem))) 21378 (t 21379 (narrow-to-region 21380 (org-element-property :begin elem) 21381 (org-element-property :end elem)))))) 21382 21383 (defun org-transpose-element () 21384 "Transpose current and previous elements, keeping blank lines between. 21385 Point is moved after both elements." 21386 (interactive) 21387 (org-skip-whitespace) 21388 (let ((end (org-element-property :end (org-element-at-point)))) 21389 (org-drag-element-backward) 21390 (goto-char end))) 21391 21392 (defun org-unindent-buffer () 21393 "Un-indent the visible part of the buffer. 21394 Relative indentation (between items, inside blocks, etc.) isn't 21395 modified." 21396 (interactive) 21397 (unless (eq major-mode 'org-mode) 21398 (user-error "Cannot un-indent a buffer not in Org mode")) 21399 (letrec ((parse-tree (org-element-parse-buffer 'greater-element)) 21400 (unindent-tree 21401 (lambda (contents) 21402 (dolist (element (reverse contents)) 21403 (if (memq (org-element-type element) '(headline section)) 21404 (funcall unindent-tree (org-element-contents element)) 21405 (save-excursion 21406 (save-restriction 21407 (narrow-to-region 21408 (org-element-property :begin element) 21409 (org-element-property :end element)) 21410 (org-do-remove-indentation)))))))) 21411 (funcall unindent-tree (org-element-contents parse-tree)))) 21412 21413 (defun org-make-options-regexp (kwds &optional extra) 21414 "Make a regular expression for keyword lines. 21415 KWDS is a list of keywords, as strings. Optional argument EXTRA, 21416 when non-nil, is a regexp matching keywords names." 21417 (concat "^[ \t]*#\\+\\(" 21418 (regexp-opt kwds) 21419 (and extra (concat (and kwds "\\|") extra)) 21420 "\\):[ \t]*\\(.*\\)")) 21421 21422 21423 ;;; Conveniently switch to Info nodes 21424 21425 (defun org-info-find-node (&optional nodename) 21426 "Find Info documentation NODENAME or Org documentation according context. 21427 Started from `gnus-info-find-node'." 21428 (interactive) 21429 (Info-goto-node 21430 (or nodename 21431 (let ((default-org-info-node "(org) Top")) 21432 (cond 21433 ((eq 'org-agenda-mode major-mode) "(org) Agenda Views") 21434 ((eq 'org-mode major-mode) 21435 (let* ((context (org-element-at-point)) 21436 (element-info-nodes ; compare to `org-element-all-elements'. 21437 `((babel-call . "(org) Evaluating Code Blocks") 21438 (center-block . "(org) Paragraphs") 21439 (clock . ,default-org-info-node) 21440 (comment . "(org) Comment Lines") 21441 (comment-block . "(org) Comment Lines") 21442 (diary-sexp . ,default-org-info-node) 21443 (drawer . "(org) Drawers") 21444 (dynamic-block . "(org) Dynamic Blocks") 21445 (example-block . "(org) Literal Examples") 21446 (export-block . "(org) ASCII/Latin-1/UTF-8 export") 21447 (fixed-width . ,default-org-info-node) 21448 (footnote-definition . "(org) Creating Footnotes") 21449 (headline . "(org) Document Structure") 21450 (horizontal-rule . "(org) Built-in Table Editor") 21451 (inlinetask . ,default-org-info-node) 21452 (item . "(org) Plain Lists") 21453 (keyword . "(org) Per-file keywords") 21454 (latex-environment . "(org) LaTeX Export") 21455 (node-property . "(org) Properties and Columns") 21456 (paragraph . "(org) Paragraphs") 21457 (plain-list . "(org) Plain Lists") 21458 (planning . "(org) Deadlines and Scheduling") 21459 (property-drawer . "(org) Properties and Columns") 21460 (quote-block . "(org) Paragraphs") 21461 (section . ,default-org-info-node) 21462 (special-block . ,default-org-info-node) 21463 (src-block . "(org) Working with Source Code") 21464 (table . "(org) Tables") 21465 (table-row . "(org) Tables") 21466 (verse-block . "(org) Paragraphs")))) 21467 (or (cdr (assoc (car context) element-info-nodes)) 21468 default-org-info-node))) 21469 (t default-org-info-node)))))) 21470 21471 21472 ;;; Finish up 21473 21474 (add-hook 'org-mode-hook ;remove overlays when changing major mode 21475 (lambda () (add-hook 'change-major-mode-hook 21476 'org-show-all 'append 'local))) 21477 21478 (provide 'org) 21479 21480 (run-hooks 'org-load-hook) 21481 21482 ;;; org.el ends here