| commit | author | age | ||
| 76bbd0 | 1 | ;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Carstens outline-mode for keeping track of everything. | |
| 4 | ;; Copyright (C) 2004-2018 Free Software Foundation, Inc. | |
| 5 | ;; | |
| 6 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
| 7 | ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> | |
| 8 | ;; Keywords: outlines, hypermedia, calendar, wp | |
| 9 | ;; Homepage: https://orgmode.org | |
| 10 | ;; Version: 9.1.14 | |
| 11 | ;; | |
| 12 | ;; This file is part of GNU Emacs. | |
| 13 | ;; | |
| 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
| 15 | ;; it under the terms of the GNU General Public License as published by | |
| 16 | ;; the Free Software Foundation, either version 3 of the License, or | |
| 17 | ;; (at your option) any later version. | |
| 18 | ||
| 19 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 22 | ;; GNU General Public License for more details. | |
| 23 | ||
| 24 | ;; You should have received a copy of the GNU General Public License | |
| 25 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | |
| 26 | ;; | |
| 27 | ;;; Commentary: | |
| 28 | ;; | |
| 29 | ;; Org is a mode for keeping notes, maintaining ToDo lists, and doing | |
| 30 | ;; project planning with a fast and effective plain-text system. | |
| 31 | ;; | |
| 32 | ;; Org mode develops organizational tasks around NOTES files that | |
| 33 | ;; contain information about projects as plain text. Org mode is | |
| 34 | ;; implemented on top of outline-mode, which makes it possible to keep | |
| 35 | ;; the content of large files well structured. Visibility cycling and | |
| 36 | ;; structure editing help to work with the tree. Tables are easily | |
| 37 | ;; created with a built-in table editor. Org mode supports ToDo | |
| 38 | ;; items, deadlines, time stamps, and scheduling. It dynamically | |
| 39 | ;; compiles entries into an agenda that utilizes and smoothly | |
| 40 | ;; integrates much of the Emacs calendar and diary. Plain text | |
| 41 | ;; URL-like links connect to websites, emails, Usenet messages, BBDB | |
| 42 | ;; entries, and any files related to the projects. For printing and | |
| 43 | ;; sharing of notes, an Org file can be exported as a structured ASCII | |
| 44 | ;; file, as HTML, or (todo and agenda items only) as an iCalendar | |
| 45 | ;; file. It can also serve as a publishing tool for a set of linked | |
| 46 | ;; webpages. | |
| 47 | ;; | |
| 48 | ;; Installation and Activation | |
| 49 | ;; --------------------------- | |
| 50 | ;; See the corresponding sections in the manual at | |
| 51 | ;; | |
| 52 | ;; https://orgmode.org/org.html#Installation | |
| 53 | ;; | |
| 54 | ;; Documentation | |
| 55 | ;; ------------- | |
| 56 | ;; The documentation of Org mode can be found in the TeXInfo file. The | |
| 57 | ;; distribution also contains a PDF version of it. At the homepage of | |
| 58 | ;; Org mode, you can read the same text online as HTML. There is also an | |
| 59 | ;; excellent reference card made by Philip Rooke. This card can be found | |
| 60 | ;; in the doc/ directory. | |
| 61 | ;; | |
| 62 | ;; A list of recent changes can be found at | |
| 63 | ;; https://orgmode.org/Changes.html | |
| 64 | ;; | |
| 65 | ;;; Code: | |
| 66 | ||
| 67 | (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param | |
| 68 | (defvar-local org-table-formula-constants-local nil | |
| 69 | "Local version of `org-table-formula-constants'.") | |
| 70 | ||
| 71 | ;;;; Require other packages | |
| 72 | ||
| 73 | (require 'cl-lib) | |
| 74 | ||
| 75 | (eval-when-compile (require 'gnus-sum)) | |
| 76 | ||
| 77 | (require 'calendar) | |
| 78 | (require 'find-func) | |
| 79 | (require 'format-spec) | |
| 80 | ||
| 81 | (or (eq this-command 'eval-buffer) | |
| 82 | (condition-case nil | |
| 83 | (load (concat (file-name-directory load-file-name) | |
| 84 | "org-loaddefs.el") | |
| 85 | nil t t t) | |
| 86 | (error | |
| 87 | (message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.") | |
| 88 | (sit-for 3) | |
| 89 | (message "You need to run \"make\" or \"make autoloads\" from Org lisp directory") | |
| 90 | (sit-for 3)))) | |
| 91 | ||
| 92 | (require 'org-macs) | |
| 93 | (require 'org-compat) | |
| 94 | ||
| 95 | ;; `org-outline-regexp' ought to be a defconst but is let-bound in | |
| 96 | ;; some places -- e.g. see the macro `org-with-limited-levels'. | |
| 97 | ;; | |
| 98 | ;; In Org buffers, the value of `outline-regexp' is that of | |
| 99 | ;; `org-outline-regexp'. The only function still directly relying on | |
| 100 | ;; `outline-regexp' is `org-overview' so that `org-cycle' can do its | |
| 101 | ;; job when `orgstruct-mode' is active. | |
| 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 isearch-no-upper-case-p "isearch" (string regexp-flag)) | |
| 117 | (declare-function org-add-archive-files "org-archive" (files)) | |
| 118 | (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) | |
| 119 | (declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) | |
| 120 | (declare-function org-agenda-redo "org-agenda" (&optional all)) | |
| 121 | (declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t) | |
| 122 | (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) | |
| 123 | (declare-function org-beamer-mode "ox-beamer" (&optional prefix) t) | |
| 124 | (declare-function org-clock-get-last-clock-out-time "org-clock" ()) | |
| 125 | (declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) | |
| 126 | (declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove)) | |
| 127 | (declare-function org-clock-sum "org-clock" (&optional tstart tend headline-filter propname)) | |
| 128 | (declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) | |
| 129 | (declare-function org-clock-timestamps-down "org-clock" (&optional n)) | |
| 130 | (declare-function org-clock-timestamps-up "org-clock" (&optional n)) | |
| 131 | (declare-function org-clock-update-time-maybe "org-clock" ()) | |
| 132 | (declare-function org-clocking-buffer "org-clock" ()) | |
| 133 | (declare-function org-clocktable-shift "org-clock" (dir n)) | |
| 134 | (declare-function | |
| 135 | org-duration-from-minutes "org-duration" (minutes &optional fmt canonical)) | |
| 136 | (declare-function org-element-at-point "org-element" ()) | |
| 137 | (declare-function org-element-cache-refresh "org-element" (pos)) | |
| 138 | (declare-function org-element-cache-reset "org-element" (&optional all)) | |
| 139 | (declare-function org-element-contents "org-element" (element)) | |
| 140 | (declare-function org-element-context "org-element" (&optional element)) | |
| 141 | (declare-function org-element-copy "org-element" (datum)) | |
| 142 | (declare-function org-element-interpret-data "org-element" (data)) | |
| 143 | (declare-function org-element-lineage "org-element" (blob &optional types with-self)) | |
| 144 | (declare-function org-element-link-parser "org-element" ()) | |
| 145 | (declare-function org-element-nested-p "org-element" (elem-a elem-b)) | |
| 146 | (declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) | |
| 147 | (declare-function org-element-property "org-element" (property element)) | |
| 148 | (declare-function org-element-put-property "org-element" (element property value)) | |
| 149 | (declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) | |
| 150 | (declare-function org-element-type "org-element" (element)) | |
| 151 | (declare-function org-element-update-syntax "org-element" ()) | |
| 152 | (declare-function org-id-find-id-file "org-id" (id)) | |
| 153 | (declare-function org-id-get-create "org-id" (&optional force)) | |
| 154 | (declare-function org-inlinetask-at-task-p "org-inlinetask" ()) | |
| 155 | (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) | |
| 156 | (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) | |
| 157 | (declare-function org-plot/gnuplot "org-plot" (&optional params)) | |
| 158 | (declare-function org-table-align "org-table" ()) | |
| 159 | (declare-function org-table-begin "org-table" (&optional table-type)) | |
| 160 | (declare-function org-table-beginning-of-field "org-table" (&optional n)) | |
| 161 | (declare-function org-table-blank-field "org-table" ()) | |
| 162 | (declare-function org-table-calc-current-TBLFM "org-table" (&optional arg)) | |
| 163 | (declare-function org-table-copy-region "org-table" (beg end &optional cut)) | |
| 164 | (declare-function org-table-cut-region "org-table" (beg end)) | |
| 165 | (declare-function org-table-edit-field "org-table" (arg)) | |
| 166 | (declare-function org-table-end "org-table" (&optional table-type)) | |
| 167 | (declare-function org-table-end-of-field "org-table" (&optional n)) | |
| 168 | (declare-function org-table-insert-row "org-table" (&optional arg)) | |
| 169 | (declare-function org-table-justify-field-maybe "org-table" (&optional new)) | |
| 170 | (declare-function org-table-maybe-eval-formula "org-table" ()) | |
| 171 | (declare-function org-table-maybe-recalculate-line "org-table" ()) | |
| 172 | (declare-function org-table-next-row "org-table" ()) | |
| 173 | (declare-function org-table-paste-rectangle "org-table" ()) | |
| 174 | (declare-function org-table-recalculate "org-table" (&optional all noalign)) | |
| 175 | (declare-function | |
| 176 | org-table-sort-lines "org-table" | |
| 177 | (&optional with-case sorting-type getkey-func compare-func interactive?)) | |
| 178 | (declare-function org-table-wrap-region "org-table" (arg)) | |
| 179 | (declare-function org-tags-view "org-agenda" (&optional todo-only match)) | |
| 180 | (declare-function orgtbl-ascii-plot "org-table" (&optional ask)) | |
| 181 | (declare-function orgtbl-mode "org-table" (&optional arg)) | |
| 182 | (declare-function org-export-get-backend "ox" (name)) | |
| 183 | (declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist)) | |
| 184 | (declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?)) | |
| 185 | ||
| 186 | (defvar ffap-url-regexp) | |
| 187 | (defvar org-element-paragraph-separate) | |
| 188 | ||
| 189 | (defsubst org-uniquify (list) | |
| 190 | "Non-destructively remove duplicate elements from LIST." | |
| 191 | (let ((res (copy-sequence list))) (delete-dups res))) | |
| 192 | ||
| 193 | (defsubst org-get-at-bol (property) | |
| 194 | "Get text property PROPERTY at the beginning of line." | |
| 195 | (get-text-property (point-at-bol) property)) | |
| 196 | ||
| 197 | (defsubst org-trim (s &optional keep-lead) | |
| 198 | "Remove whitespace at the beginning and the end of string S. | |
| 199 | When optional argument KEEP-LEAD is non-nil, removing blank lines | |
| 200 | at the beginning of the string does not affect leading indentation." | |
| 201 | (replace-regexp-in-string | |
| 202 | (if keep-lead "\\`\\([ \t]*\n\\)+" "\\`[ \t\n\r]+") "" | |
| 203 | (replace-regexp-in-string "[ \t\n\r]+\\'" "" s))) | |
| 204 | ||
| 205 | ;; load languages based on value of `org-babel-load-languages' | |
| 206 | (defvar org-babel-load-languages) | |
| 207 | ||
| 208 | ;;;###autoload | |
| 209 | (defun org-babel-do-load-languages (sym value) | |
| 210 | "Load the languages defined in `org-babel-load-languages'." | |
| 211 | (set-default sym value) | |
| 212 | (dolist (pair org-babel-load-languages) | |
| 213 | (let ((active (cdr pair)) (lang (symbol-name (car pair)))) | |
| 214 | (if active | |
| 215 | (require (intern (concat "ob-" lang))) | |
| 216 | (funcall 'fmakunbound | |
| 217 | (intern (concat "org-babel-execute:" lang))) | |
| 218 | (funcall 'fmakunbound | |
| 219 | (intern (concat "org-babel-expand-body:" lang))))))) | |
| 220 | ||
| 221 | (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) | |
| 222 | ;;;###autoload | |
| 223 | (defun org-babel-load-file (file &optional compile) | |
| 224 | "Load Emacs Lisp source code blocks in the Org FILE. | |
| 225 | This function exports the source code using `org-babel-tangle' | |
| 226 | and then loads the resulting file using `load-file'. With prefix | |
| 227 | arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp | |
| 228 | file to byte-code before it is loaded." | |
| 229 | (interactive "fFile to load: \nP") | |
| 230 | (let* ((age (lambda (file) | |
| 231 | (float-time | |
| 232 | (time-subtract (current-time) | |
| 233 | (nth 5 (or (file-attributes (file-truename file)) | |
| 234 | (file-attributes file))))))) | |
| 235 | (base-name (file-name-sans-extension file)) | |
| 236 | (exported-file (concat base-name ".el"))) | |
| 237 | ;; tangle if the Org file is newer than the elisp file | |
| 238 | (unless (and (file-exists-p exported-file) | |
| 239 | (> (funcall age file) (funcall age exported-file))) | |
| 240 | ;; Tangle-file traversal returns reversed list of tangled files | |
| 241 | ;; and we want to evaluate the first target. | |
| 242 | (setq exported-file | |
| 243 | (car (last (org-babel-tangle-file file exported-file "emacs-lisp"))))) | |
| 244 | (message "%s %s" | |
| 245 | (if compile | |
| 246 | (progn (byte-compile-file exported-file 'load) | |
| 247 | "Compiled and loaded") | |
| 248 | (progn (load-file exported-file) "Loaded")) | |
| 249 | exported-file))) | |
| 250 | ||
| 251 | (defcustom org-babel-load-languages '((emacs-lisp . t)) | |
| 252 | "Languages which can be evaluated in Org buffers. | |
| 253 | This list can be used to load support for any of the languages | |
| 254 | below, note that each language will depend on a different set of | |
| 255 | system executables and/or Emacs modes. When a language is | |
| 256 | \"loaded\", then code blocks in that language can be evaluated | |
| 257 | with `org-babel-execute-src-block' bound by default to C-c | |
| 258 | C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can | |
| 259 | be set to remove code block evaluation from the C-c C-c | |
| 260 | keybinding. By default only Emacs Lisp (which has no | |
| 261 | requirements) is loaded." | |
| 262 | :group 'org-babel | |
| 263 | :set 'org-babel-do-load-languages | |
| 264 | :version "24.1" | |
| 265 | :type '(alist :tag "Babel Languages" | |
| 266 | :key-type | |
| 267 | (choice | |
| 268 | (const :tag "Awk" awk) | |
| 269 | (const :tag "C" C) | |
| 270 | (const :tag "R" R) | |
| 271 | (const :tag "Asymptote" asymptote) | |
| 272 | (const :tag "Calc" calc) | |
| 273 | (const :tag "Clojure" clojure) | |
| 274 | (const :tag "CSS" css) | |
| 275 | (const :tag "Ditaa" ditaa) | |
| 276 | (const :tag "Dot" dot) | |
| 277 | (const :tag "Ebnf2ps" ebnf2ps) | |
| 278 | (const :tag "Emacs Lisp" emacs-lisp) | |
| 279 | (const :tag "Forth" forth) | |
| 280 | (const :tag "Fortran" fortran) | |
| 281 | (const :tag "Gnuplot" gnuplot) | |
| 282 | (const :tag "Haskell" haskell) | |
| 283 | (const :tag "hledger" hledger) | |
| 284 | (const :tag "IO" io) | |
| 285 | (const :tag "J" J) | |
| 286 | (const :tag "Java" java) | |
| 287 | (const :tag "Javascript" js) | |
| 288 | (const :tag "LaTeX" latex) | |
| 289 | (const :tag "Ledger" ledger) | |
| 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 "Mscgen" mscgen) | |
| 296 | (const :tag "Ocaml" ocaml) | |
| 297 | (const :tag "Octave" octave) | |
| 298 | (const :tag "Org" org) | |
| 299 | (const :tag "Perl" perl) | |
| 300 | (const :tag "Pico Lisp" picolisp) | |
| 301 | (const :tag "PlantUML" plantuml) | |
| 302 | (const :tag "Python" python) | |
| 303 | (const :tag "Ruby" ruby) | |
| 304 | (const :tag "Sass" sass) | |
| 305 | (const :tag "Scala" scala) | |
| 306 | (const :tag "Scheme" scheme) | |
| 307 | (const :tag "Screen" screen) | |
| 308 | (const :tag "Shell Script" shell) | |
| 309 | (const :tag "Shen" shen) | |
| 310 | (const :tag "Sql" sql) | |
| 311 | (const :tag "Sqlite" sqlite) | |
| 312 | (const :tag "Stan" stan) | |
| 313 | (const :tag "Vala" vala)) | |
| 314 | :value-type (boolean :tag "Activate" :value t))) | |
| 315 | ||
| 316 | ;;;; Customization variables | |
| 317 | (defcustom org-clone-delete-id nil | |
| 318 | "Remove ID property of clones of a subtree. | |
| 319 | When non-nil, clones of a subtree don't inherit the ID property. | |
| 320 | Otherwise they inherit the ID property with a new unique | |
| 321 | identifier." | |
| 322 | :type 'boolean | |
| 323 | :version "24.1" | |
| 324 | :group 'org-id) | |
| 325 | ||
| 326 | ;;; Version | |
| 327 | (org-check-version) | |
| 328 | ||
| 329 | ;;;###autoload | |
| 330 | (defun org-version (&optional here full message) | |
| 331 | "Show the Org version. | |
| 332 | Interactively, or when MESSAGE is non-nil, show it in echo area. | |
| 333 | With prefix argument, or when HERE is non-nil, insert it at point. | |
| 334 | In non-interactive uses, a reduced version string is output unless | |
| 335 | FULL is given." | |
| 336 | (interactive (list current-prefix-arg t (not current-prefix-arg))) | |
| 337 | (let ((org-dir (ignore-errors (org-find-library-dir "org"))) | |
| 338 | (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) | |
| 339 | (load-suffixes (list ".el")) | |
| 340 | (org-install-dir | |
| 341 | (ignore-errors (org-find-library-dir "org-loaddefs")))) | |
| 342 | (unless (and (fboundp 'org-release) (fboundp 'org-git-version)) | |
| 343 | (org-load-noerror-mustsuffix (concat org-dir "org-version"))) | |
| 344 | (let* ((load-suffixes save-load-suffixes) | |
| 345 | (release (org-release)) | |
| 346 | (git-version (org-git-version)) | |
| 347 | (version (format "Org mode version %s (%s @ %s)" | |
| 348 | release | |
| 349 | git-version | |
| 350 | (if org-install-dir | |
| 351 | (if (string= org-dir org-install-dir) | |
| 352 | org-install-dir | |
| 353 | (concat "mixed installation! " | |
| 354 | org-install-dir | |
| 355 | " and " | |
| 356 | org-dir)) | |
| 357 | "org-loaddefs.el can not be found!"))) | |
| 358 | (version1 (if full version release))) | |
| 359 | (when here (insert version1)) | |
| 360 | (when message (message "%s" version1)) | |
| 361 | version1))) | |
| 362 | ||
| 363 | (defconst org-version (org-version)) | |
| 364 | ||
| 365 | ||
| 366 | ;;; Syntax Constants | |
| 367 | ||
| 368 | ;;;; Block | |
| 369 | ||
| 370 | (defconst org-block-regexp | |
| 371 | "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" | |
| 372 | "Regular expression for hiding blocks.") | |
| 373 | ||
| 374 | (defconst org-dblock-start-re | |
| 375 | "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" | |
| 376 | "Matches the start line of a dynamic block, with parameters.") | |
| 377 | ||
| 378 | (defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" | |
| 379 | "Matches the end of a dynamic block.") | |
| 380 | ||
| 381 | ;;;; Clock and Planning | |
| 382 | ||
| 383 | (defconst org-clock-string "CLOCK:" | |
| 384 | "String used as prefix for timestamps clocking work hours on an item.") | |
| 385 | ||
| 386 | (defvar org-closed-string "CLOSED:" | |
| 387 | "String used as the prefix for timestamps logging closing a TODO entry.") | |
| 388 | ||
| 389 | (defvar org-deadline-string "DEADLINE:" | |
| 390 | "String to mark deadline entries. | |
| 391 | \\<org-mode-map> | |
| 392 | A deadline is this string, followed by a time stamp. It must be | |
| 393 | a word, terminated by a colon. You can insert a schedule keyword | |
| 394 | and a timestamp with `\\[org-deadline]'.") | |
| 395 | ||
| 396 | (defvar org-scheduled-string "SCHEDULED:" | |
| 397 | "String to mark scheduled TODO entries. | |
| 398 | \\<org-mode-map> | |
| 399 | A schedule is this string, followed by a time stamp. It must be | |
| 400 | a word, terminated by a colon. You can insert a schedule keyword | |
| 401 | and a timestamp with `\\[org-schedule]'.") | |
| 402 | ||
| 403 | (defconst org-ds-keyword-length | |
| 404 | (+ 2 | |
| 405 | (apply #'max | |
| 406 | (mapcar #'length | |
| 407 | (list org-deadline-string org-scheduled-string | |
| 408 | org-clock-string org-closed-string)))) | |
| 409 | "Maximum length of the DEADLINE and SCHEDULED keywords.") | |
| 410 | ||
| 411 | (defconst org-planning-line-re | |
| 412 | (concat "^[ \t]*" | |
| 413 | (regexp-opt | |
| 414 | (list org-closed-string org-deadline-string org-scheduled-string) | |
| 415 | t)) | |
| 416 | "Matches a line with planning info. | |
| 417 | Matched keyword is in group 1.") | |
| 418 | ||
| 419 | (defconst org-clock-line-re | |
| 420 | (concat "^[ \t]*" org-clock-string) | |
| 421 | "Matches a line with clock info.") | |
| 422 | ||
| 423 | (defconst org-deadline-regexp (concat "\\<" org-deadline-string) | |
| 424 | "Matches the DEADLINE keyword.") | |
| 425 | ||
| 426 | (defconst org-deadline-time-regexp | |
| 427 | (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") | |
| 428 | "Matches the DEADLINE keyword together with a time stamp.") | |
| 429 | ||
| 430 | (defconst org-deadline-time-hour-regexp | |
| 431 | (concat "\\<" org-deadline-string | |
| 432 | " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") | |
| 433 | "Matches the DEADLINE keyword together with a time-and-hour stamp.") | |
| 434 | ||
| 435 | (defconst org-deadline-line-regexp | |
| 436 | (concat "\\<\\(" org-deadline-string "\\).*") | |
| 437 | "Matches the DEADLINE keyword and the rest of the line.") | |
| 438 | ||
| 439 | (defconst org-scheduled-regexp (concat "\\<" org-scheduled-string) | |
| 440 | "Matches the SCHEDULED keyword.") | |
| 441 | ||
| 442 | (defconst org-scheduled-time-regexp | |
| 443 | (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") | |
| 444 | "Matches the SCHEDULED keyword together with a time stamp.") | |
| 445 | ||
| 446 | (defconst org-scheduled-time-hour-regexp | |
| 447 | (concat "\\<" org-scheduled-string | |
| 448 | " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") | |
| 449 | "Matches the SCHEDULED keyword together with a time-and-hour stamp.") | |
| 450 | ||
| 451 | (defconst org-closed-time-regexp | |
| 452 | (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") | |
| 453 | "Matches the CLOSED keyword together with a time stamp.") | |
| 454 | ||
| 455 | (defconst org-keyword-time-regexp | |
| 456 | (concat "\\<" | |
| 457 | (regexp-opt | |
| 458 | (list org-scheduled-string org-deadline-string org-closed-string | |
| 459 | org-clock-string) | |
| 460 | t) | |
| 461 | " *[[<]\\([^]>]+\\)[]>]") | |
| 462 | "Matches any of the 4 keywords, together with the time stamp.") | |
| 463 | ||
| 464 | (defconst org-keyword-time-not-clock-regexp | |
| 465 | (concat | |
| 466 | "\\<" | |
| 467 | (regexp-opt | |
| 468 | (list org-scheduled-string org-deadline-string org-closed-string) t) | |
| 469 | " *[[<]\\([^]>]+\\)[]>]") | |
| 470 | "Matches any of the 3 keywords, together with the time stamp.") | |
| 471 | ||
| 472 | (defconst org-maybe-keyword-time-regexp | |
| 473 | (concat "\\(\\<" | |
| 474 | (regexp-opt | |
| 475 | (list org-scheduled-string org-deadline-string org-closed-string | |
| 476 | org-clock-string) | |
| 477 | t) | |
| 478 | "\\)?" | |
| 479 | " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]" | |
| 480 | "\\|" | |
| 481 | "<%%([^\r\n>]*>\\)") | |
| 482 | "Matches a timestamp, possibly preceded by a keyword.") | |
| 483 | ||
| 484 | (defconst org-all-time-keywords | |
| 485 | (mapcar (lambda (w) (substring w 0 -1)) | |
| 486 | (list org-scheduled-string org-deadline-string | |
| 487 | org-clock-string org-closed-string)) | |
| 488 | "List of time keywords.") | |
| 489 | ||
| 490 | ;;;; Drawer | |
| 491 | ||
| 492 | (defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$" | |
| 493 | "Matches first or last line of a hidden block. | |
| 494 | Group 1 contains drawer's name or \"END\".") | |
| 495 | ||
| 496 | (defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" | |
| 497 | "Regular expression matching the first line of a property drawer.") | |
| 498 | ||
| 499 | (defconst org-property-end-re "^[ \t]*:END:[ \t]*$" | |
| 500 | "Regular expression matching the last line of a property drawer.") | |
| 501 | ||
| 502 | (defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" | |
| 503 | "Regular expression matching the first line of a clock drawer.") | |
| 504 | ||
| 505 | (defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" | |
| 506 | "Regular expression matching the last line of a clock drawer.") | |
| 507 | ||
| 508 | (defconst org-property-drawer-re | |
| 509 | (concat "^[ \t]*:PROPERTIES:[ \t]*\n" | |
| 510 | "\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?" | |
| 511 | "[ \t]*:END:[ \t]*$") | |
| 512 | "Matches an entire property drawer.") | |
| 513 | ||
| 514 | (defconst org-clock-drawer-re | |
| 515 | (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\(" | |
| 516 | org-clock-drawer-end-re "\\)\n?") | |
| 517 | "Matches an entire clock drawer.") | |
| 518 | ||
| 519 | ;;;; Headline | |
| 520 | ||
| 521 | (defconst org-heading-keyword-regexp-format | |
| 522 | "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" | |
| 523 | "Printf format for a regexp matching a headline with some keyword. | |
| 524 | This regexp will match the headline of any node which has the | |
| 525 | exact keyword that is put into the format. The keyword isn't in | |
| 526 | any group by default, but the stars and the body are.") | |
| 527 | ||
| 528 | (defconst org-heading-keyword-maybe-regexp-format | |
| 529 | "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" | |
| 530 | "Printf format for a regexp matching a headline, possibly with some keyword. | |
| 531 | This regexp can match any headline with the specified keyword, or | |
| 532 | without a keyword. The keyword isn't in any group by default, | |
| 533 | but the stars and the body are.") | |
| 534 | ||
| 535 | (defconst org-archive-tag "ARCHIVE" | |
| 536 | "The tag that marks a subtree as archived. | |
| 537 | An archived subtree does not open during visibility cycling, and does | |
| 538 | not contribute to the agenda listings.") | |
| 539 | ||
| 540 | (eval-and-compile | |
| 541 | (defconst org-comment-string "COMMENT" | |
| 542 | "Entries starting with this keyword will never be exported. | |
| 543 | \\<org-mode-map> | |
| 544 | An entry can be toggled between COMMENT and normal with | |
| 545 | `\\[org-toggle-comment]'.")) | |
| 546 | ||
| 547 | ||
| 548 | ;;;; LaTeX Environments and Fragments | |
| 549 | ||
| 550 | (defconst org-latex-regexps | |
| 551 | '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) | |
| 552 | ;; ("$" "\\([ \t(]\\|^\\)\\(\\(\\([$]\\)\\([^ \t\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \t\n,.$]\\)\\4\\)\\)\\([ \t.,?;:'\")]\\|$\\)" 2 nil) | |
| 553 | ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p | |
| 554 | ("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil) | |
| 555 | ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil) | |
| 556 | ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) | |
| 557 | ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) | |
| 558 | ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) | |
| 559 | "Regular expressions for matching embedded LaTeX.") | |
| 560 | ||
| 561 | ;;;; Node Property | |
| 562 | ||
| 563 | (defconst org-effort-property "Effort" | |
| 564 | "The property that is being used to keep track of effort estimates. | |
| 565 | Effort estimates given in this property need to have the format H:MM.") | |
| 566 | ||
| 567 | ;;;; Table | |
| 568 | ||
| 569 | (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" | |
| 570 | "Detect an org-type or table-type table.") | |
| 571 | ||
| 572 | (defconst org-table-line-regexp "^[ \t]*|" | |
| 573 | "Detect an org-type table line.") | |
| 574 | ||
| 575 | (defconst org-table-dataline-regexp "^[ \t]*|[^-]" | |
| 576 | "Detect an org-type table line.") | |
| 577 | ||
| 578 | (defconst org-table-hline-regexp "^[ \t]*|-" | |
| 579 | "Detect an org-type table hline.") | |
| 580 | ||
| 581 | (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" | |
| 582 | "Detect a table-type table hline.") | |
| 583 | ||
| 584 | (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" | |
| 585 | "Detect the first line outside a table when searching from within it. | |
| 586 | This works for both table types.") | |
| 587 | ||
| 588 | (defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " | |
| 589 | "Detect a #+TBLFM line.") | |
| 590 | ||
| 591 | ;;;; Timestamp | |
| 592 | ||
| 593 | (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" | |
| 594 | "Regular expression for fast time stamp matching.") | |
| 595 | ||
| 596 | (defconst org-ts-regexp-inactive | |
| 597 | "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]" | |
| 598 | "Regular expression for fast inactive time stamp matching.") | |
| 599 | ||
| 600 | (defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" | |
| 601 | "Regular expression for fast time stamp matching.") | |
| 602 | ||
| 603 | (defconst org-ts-regexp0 | |
| 604 | "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" | |
| 605 | "Regular expression matching time strings for analysis. | |
| 606 | This one does not require the space after the date, so it can be used | |
| 607 | on a string that terminates immediately after the date.") | |
| 608 | ||
| 609 | (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" | |
| 610 | "Regular expression matching time strings for analysis.") | |
| 611 | ||
| 612 | (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") | |
| 613 | "Regular expression matching time stamps, with groups.") | |
| 614 | ||
| 615 | (defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") | |
| 616 | "Regular expression matching time stamps (also [..]), with groups.") | |
| 617 | ||
| 618 | (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) | |
| 619 | "Regular expression matching a time stamp range.") | |
| 620 | ||
| 621 | (defconst org-tr-regexp-both | |
| 622 | (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) | |
| 623 | "Regular expression matching a time stamp range.") | |
| 624 | ||
| 625 | (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" | |
| 626 | org-ts-regexp "\\)?") | |
| 627 | "Regular expression matching a time stamp or time stamp range.") | |
| 628 | ||
| 629 | (defconst org-tsr-regexp-both | |
| 630 | (concat org-ts-regexp-both "\\(--?-?" | |
| 631 | org-ts-regexp-both "\\)?") | |
| 632 | "Regular expression matching a time stamp or time stamp range. | |
| 633 | The time stamps may be either active or inactive.") | |
| 634 | ||
| 635 | (defconst org-repeat-re | |
| 636 | "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" | |
| 637 | "Regular expression for specifying repeated events. | |
| 638 | After a match, group 1 contains the repeat expression.") | |
| 639 | ||
| 640 | (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") | |
| 641 | "Formats for `format-time-string' which are used for time stamps.") | |
| 642 | ||
| 643 | ||
| 644 | ;;; The custom variables | |
| 645 | ||
| 646 | (defgroup org nil | |
| 647 | "Outline-based notes management and organizer." | |
| 648 | :tag "Org" | |
| 649 | :group 'outlines | |
| 650 | :group 'calendar) | |
| 651 | ||
| 652 | (defcustom org-mode-hook nil | |
| 653 | "Mode hook for Org mode, run after the mode was turned on." | |
| 654 | :group 'org | |
| 655 | :type 'hook) | |
| 656 | ||
| 657 | (defcustom org-load-hook nil | |
| 658 | "Hook that is run after org.el has been loaded." | |
| 659 | :group 'org | |
| 660 | :type 'hook) | |
| 661 | ||
| 662 | (defcustom org-log-buffer-setup-hook nil | |
| 663 | "Hook that is run after an Org log buffer is created." | |
| 664 | :group 'org | |
| 665 | :version "24.1" | |
| 666 | :type 'hook) | |
| 667 | ||
| 668 | (defvar org-modules) ; defined below | |
| 669 | (defvar org-modules-loaded nil | |
| 670 | "Have the modules been loaded already?") | |
| 671 | ||
| 672 | (defun org-load-modules-maybe (&optional force) | |
| 673 | "Load all extensions listed in `org-modules'." | |
| 674 | (when (or force (not org-modules-loaded)) | |
| 675 | (dolist (ext org-modules) | |
| 676 | (condition-case nil (require ext) | |
| 677 | (error (message "Problems while trying to load feature `%s'" ext)))) | |
| 678 | (setq org-modules-loaded t))) | |
| 679 | ||
| 680 | (defun org-set-modules (var value) | |
| 681 | "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag." | |
| 682 | (set var value) | |
| 683 | (when (featurep 'org) | |
| 684 | (org-load-modules-maybe 'force) | |
| 685 | (org-element-cache-reset 'all))) | |
| 686 | ||
| 687 | (defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail) | |
| 688 | "Modules that should always be loaded together with org.el. | |
| 689 | ||
| 690 | If a description starts with <C>, the file is not part of Emacs | |
| 691 | and loading it will require that you have downloaded and properly | |
| 692 | installed the Org mode distribution. | |
| 693 | ||
| 694 | You can also use this system to load external packages (i.e. neither Org | |
| 695 | core modules, nor modules from the CONTRIB directory). Just add symbols | |
| 696 | to the end of the list. If the package is called org-xyz.el, then you need | |
| 697 | to add the symbol `xyz', and the package must have a call to: | |
| 698 | ||
| 699 | (provide \\='org-xyz) | |
| 700 | ||
| 701 | For export specific modules, see also `org-export-backends'." | |
| 702 | :group 'org | |
| 703 | :set 'org-set-modules | |
| 704 | :version "24.4" | |
| 705 | :package-version '(Org . "8.0") | |
| 706 | :type | |
| 707 | '(set :greedy t | |
| 708 | (const :tag " bbdb: Links to BBDB entries" org-bbdb) | |
| 709 | (const :tag " bibtex: Links to BibTeX entries" org-bibtex) | |
| 710 | (const :tag " crypt: Encryption of subtrees" org-crypt) | |
| 711 | (const :tag " ctags: Access to Emacs tags with links" org-ctags) | |
| 712 | (const :tag " docview: Links to doc-view buffers" org-docview) | |
| 713 | (const :tag " eww: Store link to url of eww" org-eww) | |
| 714 | (const :tag " gnus: Links to GNUS folders/messages" org-gnus) | |
| 715 | (const :tag " habit: Track your consistency with habits" org-habit) | |
| 716 | (const :tag " id: Global IDs for identifying entries" org-id) | |
| 717 | (const :tag " info: Links to Info nodes" org-info) | |
| 718 | (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask) | |
| 719 | (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) | |
| 720 | (const :tag " mhe: Links to MHE folders/messages" org-mhe) | |
| 721 | (const :tag " mouse: Additional mouse support" org-mouse) | |
| 722 | (const :tag " protocol: Intercept calls from emacsclient" org-protocol) | |
| 723 | (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) | |
| 724 | (const :tag " w3m: Special cut/paste from w3m to Org mode." org-w3m) | |
| 725 | ||
| 726 | (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) | |
| 727 | (const :tag "C bookmark: Org links to bookmarks" org-bookmark) | |
| 728 | (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) | |
| 729 | (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) | |
| 730 | (const :tag "C collector: Collect properties into tables" org-collector) | |
| 731 | (const :tag "C depend: TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) | |
| 732 | (const :tag "C drill: Flashcards and spaced repetition for Org mode" org-drill) | |
| 733 | (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol) | |
| 734 | (const :tag "C eshell Support for links to working directories in eshell" org-eshell) | |
| 735 | (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) | |
| 736 | (const :tag "C eval: Include command output as text" org-eval) | |
| 737 | (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry) | |
| 738 | (const :tag "C favtable: Lookup table of favorite references and links" org-favtable) | |
| 739 | (const :tag "C git-link: Provide org links to specific file version" org-git-link) | |
| 740 | (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) | |
| 741 | (const :tag "C invoice: Help manage client invoices in Org mode" org-invoice) | |
| 742 | (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) | |
| 743 | (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) | |
| 744 | (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link) | |
| 745 | (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix) | |
| 746 | (const :tag "C man: Support for links to manpages in Org mode" org-man) | |
| 747 | (const :tag "C mew: Links to Mew folders/messages" org-mew) | |
| 748 | (const :tag "C mtags: Support for muse-like tags" org-mtags) | |
| 749 | (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) | |
| 750 | (const :tag "C panel: Simple routines for us with bad memory" org-panel) | |
| 751 | (const :tag "C registry: A registry for Org links" org-registry) | |
| 752 | (const :tag "C screen: Visit screen sessions through Org links" org-screen) | |
| 753 | (const :tag "C secretary: Team management with Org" org-secretary) | |
| 754 | (const :tag "C sqlinsert: Convert Org tables to SQL insertions" orgtbl-sqlinsert) | |
| 755 | (const :tag "C toc: Table of contents for Org buffer" org-toc) | |
| 756 | (const :tag "C track: Keep up with Org mode development" org-track) | |
| 757 | (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) | |
| 758 | (const :tag "C vm: Links to VM folders/messages" org-vm) | |
| 759 | (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) | |
| 760 | (const :tag "C wl: Links to Wanderlust folders/messages" org-wl) | |
| 761 | (repeat :tag "External packages" :inline t (symbol :tag "Package")))) | |
| 762 | ||
| 763 | (defvar org-export-registered-backends) ; From ox.el. | |
| 764 | (declare-function org-export-derived-backend-p "ox" (backend &rest backends)) | |
| 765 | (declare-function org-export-backend-name "ox" (backend) t) | |
| 766 | (defcustom org-export-backends '(ascii html icalendar latex odt) | |
| 767 | "List of export back-ends that should be always available. | |
| 768 | ||
| 769 | If a description starts with <C>, the file is not part of Emacs | |
| 770 | and loading it will require that you have downloaded and properly | |
| 771 | installed the Org mode distribution. | |
| 772 | ||
| 773 | Unlike to `org-modules', libraries in this list will not be | |
| 774 | loaded along with Org, but only once the export framework is | |
| 775 | needed. | |
| 776 | ||
| 777 | This variable needs to be set before org.el is loaded. If you | |
| 778 | need to make a change while Emacs is running, use the customize | |
| 779 | interface or run the following code, where VAL stands for the new | |
| 780 | value of the variable, after updating it: | |
| 781 | ||
| 782 | (progn | |
| 783 | (setq org-export-registered-backends | |
| 784 | (cl-remove-if-not | |
| 785 | (lambda (backend) | |
| 786 | (let ((name (org-export-backend-name backend))) | |
| 787 | (or (memq name val) | |
| 788 | (catch \\='parentp | |
| 789 | (dolist (b val) | |
| 790 | (and (org-export-derived-backend-p b name) | |
| 791 | (throw \\='parentp t))))))) | |
| 792 | org-export-registered-backends)) | |
| 793 | (let ((new-list (mapcar #\\='org-export-backend-name | |
| 794 | org-export-registered-backends))) | |
| 795 | (dolist (backend val) | |
| 796 | (cond | |
| 797 | ((not (load (format \"ox-%s\" backend) t t)) | |
| 798 | (message \"Problems while trying to load export back-end \\=`%s\\='\" | |
| 799 | backend)) | |
| 800 | ((not (memq backend new-list)) (push backend new-list)))) | |
| 801 | (set-default \\='org-export-backends new-list))) | |
| 802 | ||
| 803 | Adding a back-end to this list will also pull the back-end it | |
| 804 | depends on, if any." | |
| 805 | :group 'org | |
| 806 | :group 'org-export | |
| 807 | :version "26.1" | |
| 808 | :package-version '(Org . "9.0") | |
| 809 | :initialize 'custom-initialize-set | |
| 810 | :set (lambda (var val) | |
| 811 | (if (not (featurep 'ox)) (set-default var val) | |
| 812 | ;; Any back-end not required anymore (not present in VAL and not | |
| 813 | ;; a parent of any back-end in the new value) is removed from the | |
| 814 | ;; list of registered back-ends. | |
| 815 | (setq org-export-registered-backends | |
| 816 | (cl-remove-if-not | |
| 817 | (lambda (backend) | |
| 818 | (let ((name (org-export-backend-name backend))) | |
| 819 | (or (memq name val) | |
| 820 | (catch 'parentp | |
| 821 | (dolist (b val) | |
| 822 | (and (org-export-derived-backend-p b name) | |
| 823 | (throw 'parentp t))))))) | |
| 824 | org-export-registered-backends)) | |
| 825 | ;; Now build NEW-LIST of both new back-ends and required | |
| 826 | ;; parents. | |
| 827 | (let ((new-list (mapcar #'org-export-backend-name | |
| 828 | org-export-registered-backends))) | |
| 829 | (dolist (backend val) | |
| 830 | (cond | |
| 831 | ((not (load (format "ox-%s" backend) t t)) | |
| 832 | (message "Problems while trying to load export back-end `%s'" | |
| 833 | backend)) | |
| 834 | ((not (memq backend new-list)) (push backend new-list)))) | |
| 835 | ;; Set VAR to that list with fixed dependencies. | |
| 836 | (set-default var new-list)))) | |
| 837 | :type '(set :greedy t | |
| 838 | (const :tag " ascii Export buffer to ASCII format" ascii) | |
| 839 | (const :tag " beamer Export buffer to Beamer presentation" beamer) | |
| 840 | (const :tag " html Export buffer to HTML format" html) | |
| 841 | (const :tag " icalendar Export buffer to iCalendar format" icalendar) | |
| 842 | (const :tag " latex Export buffer to LaTeX format" latex) | |
| 843 | (const :tag " man Export buffer to MAN format" man) | |
| 844 | (const :tag " md Export buffer to Markdown format" md) | |
| 845 | (const :tag " odt Export buffer to ODT format" odt) | |
| 846 | (const :tag " org Export buffer to Org format" org) | |
| 847 | (const :tag " texinfo Export buffer to Texinfo format" texinfo) | |
| 848 | (const :tag "C confluence Export buffer to Confluence Wiki format" confluence) | |
| 849 | (const :tag "C deck Export buffer to deck.js presentations" deck) | |
| 850 | (const :tag "C freemind Export buffer to Freemind mindmap format" freemind) | |
| 851 | (const :tag "C groff Export buffer to Groff format" groff) | |
| 852 | (const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter) | |
| 853 | (const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss) | |
| 854 | (const :tag "C s5 Export buffer to s5 presentations" s5) | |
| 855 | (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler))) | |
| 856 | ||
| 857 | (eval-after-load 'ox | |
| 858 | '(dolist (backend org-export-backends) | |
| 859 | (condition-case nil (require (intern (format "ox-%s" backend))) | |
| 860 | (error (message "Problems while trying to load export back-end `%s'" | |
| 861 | backend))))) | |
| 862 | ||
| 863 | (defcustom org-support-shift-select nil | |
| 864 | "Non-nil means make shift-cursor commands select text when possible. | |
| 865 | \\<org-mode-map>\ | |
| 866 | ||
| 867 | In Emacs 23, when `shift-select-mode' is on, shifted cursor keys | |
| 868 | start selecting a region, or enlarge regions started in this way. | |
| 869 | In Org mode, in special contexts, these same keys are used for | |
| 870 | other purposes, important enough to compete with shift selection. | |
| 871 | Org tries to balance these needs by supporting `shift-select-mode' | |
| 872 | outside these special contexts, under control of this variable. | |
| 873 | ||
| 874 | The default of this variable is nil, to avoid confusing behavior. Shifted | |
| 875 | cursor keys will then execute Org commands in the following contexts: | |
| 876 | - on a headline, changing TODO state (left/right) and priority (up/down) | |
| 877 | - on a time stamp, changing the time | |
| 878 | - in a plain list item, changing the bullet type | |
| 879 | - in a property definition line, switching between allowed values | |
| 880 | - in the BEGIN line of a clock table (changing the time block). | |
| 881 | Outside these contexts, the commands will throw an error. | |
| 882 | ||
| 883 | When this variable is t and the cursor is not in a special | |
| 884 | context, Org mode will support shift-selection for making and | |
| 885 | enlarging regions. To make this more effective, the bullet | |
| 886 | cycling will no longer happen anywhere in an item line, but only | |
| 887 | if the cursor is exactly on the bullet. | |
| 888 | ||
| 889 | If you set this variable to the symbol `always', then the keys | |
| 890 | will not be special in headlines, property lines, and item lines, | |
| 891 | to make shift selection work there as well. If this is what you | |
| 892 | want, you can use the following alternative commands: | |
| 893 | `\\[org-todo]' and `\\[org-priority]' \ | |
| 894 | to change TODO state and priority, | |
| 895 | `\\[universal-argument] \\[universal-argument] \\[org-todo]' \ | |
| 896 | can be used to switch TODO sets, | |
| 897 | `\\[org-ctrl-c-minus]' to cycle item bullet types, | |
| 898 | and properties can be edited by hand or in column view. | |
| 899 | ||
| 900 | However, when the cursor is on a timestamp, shift-cursor commands | |
| 901 | will still edit the time stamp - this is just too good to give up." | |
| 902 | :group 'org | |
| 903 | :type '(choice | |
| 904 | (const :tag "Never" nil) | |
| 905 | (const :tag "When outside special context" t) | |
| 906 | (const :tag "Everywhere except timestamps" always))) | |
| 907 | ||
| 908 | (defcustom org-loop-over-headlines-in-active-region nil | |
| 909 | "Shall some commands act upon headlines in the active region? | |
| 910 | ||
| 911 | When set to t, some commands will be performed in all headlines | |
| 912 | within the active region. | |
| 913 | ||
| 914 | When set to `start-level', some commands will be performed in all | |
| 915 | headlines within the active region, provided that these headlines | |
| 916 | are of the same level than the first one. | |
| 917 | ||
| 918 | When set to a string, those commands will be performed on the | |
| 919 | matching headlines within the active region. Such string must be | |
| 920 | a tags/property/todo match as it is used in the agenda tags view. | |
| 921 | ||
| 922 | The list of commands is: `org-schedule', `org-deadline', | |
| 923 | `org-todo', `org-archive-subtree', `org-archive-set-tag' and | |
| 924 | `org-archive-to-archive-sibling'. The archiving commands skip | |
| 925 | already archived entries." | |
| 926 | :type '(choice (const :tag "Don't loop" nil) | |
| 927 | (const :tag "All headlines in active region" t) | |
| 928 | (const :tag "In active region, headlines at the same level than the first one" start-level) | |
| 929 | (string :tag "Tags/Property/Todo matcher")) | |
| 930 | :version "24.1" | |
| 931 | :group 'org-todo | |
| 932 | :group 'org-archive) | |
| 933 | ||
| 934 | (defgroup org-startup nil | |
| 935 | "Options concerning startup of Org mode." | |
| 936 | :tag "Org Startup" | |
| 937 | :group 'org) | |
| 938 | ||
| 939 | (defcustom org-startup-folded t | |
| 940 | "Non-nil means entering Org mode will switch to OVERVIEW. | |
| 941 | ||
| 942 | This can also be configured on a per-file basis by adding one of | |
| 943 | the following lines anywhere in the buffer: | |
| 944 | ||
| 945 | #+STARTUP: fold (or `overview', this is equivalent) | |
| 946 | #+STARTUP: nofold (or `showall', this is equivalent) | |
| 947 | #+STARTUP: content | |
| 948 | #+STARTUP: showeverything | |
| 949 | ||
| 950 | Set `org-agenda-inhibit-startup' to a non-nil value if you want | |
| 951 | to ignore this option when Org opens agenda files for the first | |
| 952 | time." | |
| 953 | :group 'org-startup | |
| 954 | :type '(choice | |
| 955 | (const :tag "nofold: show all" nil) | |
| 956 | (const :tag "fold: overview" t) | |
| 957 | (const :tag "content: all headlines" content) | |
| 958 | (const :tag "show everything, even drawers" showeverything))) | |
| 959 | ||
| 960 | (defcustom org-startup-truncated t | |
| 961 | "Non-nil means entering Org mode will set `truncate-lines'. | |
| 962 | This is useful since some lines containing links can be very long and | |
| 963 | uninteresting. Also tables look terrible when wrapped. | |
| 964 | ||
| 965 | The variable `org-startup-truncated' allows to configure | |
| 966 | truncation for Org mode different to the other modes that use the | |
| 967 | variable `truncate-lines' and as a shortcut instead of putting | |
| 968 | the variable `truncate-lines' into the `org-mode-hook'. If one | |
| 969 | wants to configure truncation for Org mode not statically but | |
| 970 | dynamically e. g. in a hook like `ediff-prepare-buffer-hook' then | |
| 971 | the variable `truncate-lines' has to be used because in such a | |
| 972 | case it is too late to set the variable `org-startup-truncated'." | |
| 973 | :group 'org-startup | |
| 974 | :type 'boolean) | |
| 975 | ||
| 976 | (defcustom org-startup-indented nil | |
| 977 | "Non-nil means turn on `org-indent-mode' on startup. | |
| 978 | This can also be configured on a per-file basis by adding one of | |
| 979 | the following lines anywhere in the buffer: | |
| 980 | ||
| 981 | #+STARTUP: indent | |
| 982 | #+STARTUP: noindent" | |
| 983 | :group 'org-structure | |
| 984 | :type '(choice | |
| 985 | (const :tag "Not" nil) | |
| 986 | (const :tag "Globally (slow on startup in large files)" t))) | |
| 987 | ||
| 988 | (defcustom org-use-sub-superscripts t | |
| 989 | "Non-nil means interpret \"_\" and \"^\" for display. | |
| 990 | ||
| 991 | If you want to control how Org exports those characters, see | |
| 992 | `org-export-with-sub-superscripts'. `org-use-sub-superscripts' | |
| 993 | used to be an alias for `org-export-with-sub-superscripts' in | |
| 994 | Org <8.0, it is not anymore. | |
| 995 | ||
| 996 | When this option is turned on, you can use TeX-like syntax for | |
| 997 | sub- and superscripts within the buffer. Several characters after | |
| 998 | \"_\" or \"^\" will be considered as a single item - so grouping | |
| 999 | with {} is normally not needed. For example, the following things | |
| 1000 | will be parsed as single sub- or superscripts: | |
| 1001 | ||
| 1002 | 10^24 or 10^tau several digits will be considered 1 item. | |
| 1003 | 10^-12 or 10^-tau a leading sign with digits or a word | |
| 1004 | x^2-y^3 will be read as x^2 - y^3, because items are | |
| 1005 | terminated by almost any nonword/nondigit char. | |
| 1006 | x_{i^2} or x^(2-i) braces or parenthesis do grouping. | |
| 1007 | ||
| 1008 | Still, ambiguity is possible. So when in doubt, use {} to enclose | |
| 1009 | the sub/superscript. If you set this variable to the symbol `{}', | |
| 1010 | the braces are *required* in order to trigger interpretations as | |
| 1011 | sub/superscript. This can be helpful in documents that need \"_\" | |
| 1012 | frequently in plain text." | |
| 1013 | :group 'org-startup | |
| 1014 | :version "24.4" | |
| 1015 | :package-version '(Org . "8.0") | |
| 1016 | :type '(choice | |
| 1017 | (const :tag "Always interpret" t) | |
| 1018 | (const :tag "Only with braces" {}) | |
| 1019 | (const :tag "Never interpret" nil))) | |
| 1020 | ||
| 1021 | (defcustom org-startup-with-beamer-mode nil | |
| 1022 | "Non-nil means turn on `org-beamer-mode' on startup. | |
| 1023 | This can also be configured on a per-file basis by adding one of | |
| 1024 | the following lines anywhere in the buffer: | |
| 1025 | ||
| 1026 | #+STARTUP: beamer" | |
| 1027 | :group 'org-startup | |
| 1028 | :version "24.1" | |
| 1029 | :type 'boolean) | |
| 1030 | ||
| 1031 | (defcustom org-startup-align-all-tables nil | |
| 1032 | "Non-nil means align all tables when visiting a file. | |
| 1033 | This is useful when the column width in tables is forced with <N> cookies | |
| 1034 | in table fields. Such tables will look correct only after the first re-align. | |
| 1035 | This can also be configured on a per-file basis by adding one of | |
| 1036 | the following lines anywhere in the buffer: | |
| 1037 | #+STARTUP: align | |
| 1038 | #+STARTUP: noalign" | |
| 1039 | :group 'org-startup | |
| 1040 | :type 'boolean) | |
| 1041 | ||
| 1042 | (defcustom org-startup-with-inline-images nil | |
| 1043 | "Non-nil means show inline images when loading a new Org file. | |
| 1044 | This can also be configured on a per-file basis by adding one of | |
| 1045 | the following lines anywhere in the buffer: | |
| 1046 | #+STARTUP: inlineimages | |
| 1047 | #+STARTUP: noinlineimages" | |
| 1048 | :group 'org-startup | |
| 1049 | :version "24.1" | |
| 1050 | :type 'boolean) | |
| 1051 | ||
| 1052 | (defcustom org-startup-with-latex-preview nil | |
| 1053 | "Non-nil means preview LaTeX fragments when loading a new Org file. | |
| 1054 | ||
| 1055 | This can also be configured on a per-file basis by adding one of | |
| 1056 | the following lines anywhere in the buffer: | |
| 1057 | #+STARTUP: latexpreview | |
| 1058 | #+STARTUP: nolatexpreview" | |
| 1059 | :group 'org-startup | |
| 1060 | :version "24.4" | |
| 1061 | :package-version '(Org . "8.0") | |
| 1062 | :type 'boolean) | |
| 1063 | ||
| 1064 | (defcustom org-insert-mode-line-in-empty-file nil | |
| 1065 | "Non-nil means insert the first line setting Org mode in empty files. | |
| 1066 | When the function `org-mode' is called interactively in an empty file, this | |
| 1067 | normally means that the file name does not automatically trigger Org mode. | |
| 1068 | To ensure that the file will always be in Org mode in the future, a | |
| 1069 | line enforcing Org mode will be inserted into the buffer, if this option | |
| 1070 | has been set." | |
| 1071 | :group 'org-startup | |
| 1072 | :type 'boolean) | |
| 1073 | ||
| 1074 | (defcustom org-replace-disputed-keys nil | |
| 1075 | "Non-nil means use alternative key bindings for some keys. | |
| 1076 | Org mode uses S-<cursor> keys for changing timestamps and priorities. | |
| 1077 | These keys are also used by other packages like shift-selection-mode' | |
| 1078 | \(built into Emacs 23), `CUA-mode' or `windmove.el'. | |
| 1079 | If you want to use Org mode together with one of these other modes, | |
| 1080 | or more generally if you would like to move some Org mode commands to | |
| 1081 | other keys, set this variable and configure the keys with the variable | |
| 1082 | `org-disputed-keys'. | |
| 1083 | ||
| 1084 | This option is only relevant at load-time of Org mode, and must be set | |
| 1085 | *before* org.el is loaded. Changing it requires a restart of Emacs to | |
| 1086 | become effective." | |
| 1087 | :group 'org-startup | |
| 1088 | :type 'boolean) | |
| 1089 | ||
| 1090 | (defcustom org-use-extra-keys nil | |
| 1091 | "Non-nil means use extra key sequence definitions for certain commands. | |
| 1092 | This happens automatically if `window-system' is nil. This | |
| 1093 | variable lets you do the same manually. You must set it before | |
| 1094 | loading Org." | |
| 1095 | :group 'org-startup | |
| 1096 | :type 'boolean) | |
| 1097 | ||
| 1098 | (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) | |
| 1099 | ||
| 1100 | (defcustom org-disputed-keys | |
| 1101 | '(([(shift up)] . [(meta p)]) | |
| 1102 | ([(shift down)] . [(meta n)]) | |
| 1103 | ([(shift left)] . [(meta -)]) | |
| 1104 | ([(shift right)] . [(meta +)]) | |
| 1105 | ([(control shift right)] . [(meta shift +)]) | |
| 1106 | ([(control shift left)] . [(meta shift -)])) | |
| 1107 | "Keys for which Org mode and other modes compete. | |
| 1108 | This is an alist, cars are the default keys, second element specifies | |
| 1109 | the alternative to use when `org-replace-disputed-keys' is t. | |
| 1110 | ||
| 1111 | Keys can be specified in any syntax supported by `define-key'. | |
| 1112 | The value of this option takes effect only at Org mode startup, | |
| 1113 | therefore you'll have to restart Emacs to apply it after changing." | |
| 1114 | :group 'org-startup | |
| 1115 | :type 'alist) | |
| 1116 | ||
| 1117 | (defun org-key (key) | |
| 1118 | "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. | |
| 1119 | Or return the original if not disputed." | |
| 1120 | (when org-replace-disputed-keys | |
| 1121 | (let* ((nkey (key-description key)) | |
| 1122 | (x (cl-find-if (lambda (x) (equal (key-description (car x)) nkey)) | |
| 1123 | org-disputed-keys))) | |
| 1124 | (setq key (if x (cdr x) key)))) | |
| 1125 | key) | |
| 1126 | ||
| 1127 | (defun org-defkey (keymap key def) | |
| 1128 | "Define a key, possibly translated, as returned by `org-key'." | |
| 1129 | (define-key keymap (org-key key) def)) | |
| 1130 | ||
| 1131 | (defcustom org-ellipsis nil | |
| 1132 | "The ellipsis to use in the Org mode outline. | |
| 1133 | ||
| 1134 | When nil, just use the standard three dots. When a non-empty string, | |
| 1135 | use that string instead. | |
| 1136 | ||
| 1137 | The change affects only Org mode (which will then use its own display table). | |
| 1138 | Changing this requires executing `\\[org-mode]' in a buffer to become | |
| 1139 | effective." | |
| 1140 | :group 'org-startup | |
| 1141 | :type '(choice (const :tag "Default" nil) | |
| 1142 | (string :tag "String" :value "...#")) | |
| 1143 | :safe (lambda (v) (and (string-or-null-p v) (not (equal "" v))))) | |
| 1144 | ||
| 1145 | (defvar org-display-table nil | |
| 1146 | "The display table for Org mode, in case `org-ellipsis' is non-nil.") | |
| 1147 | ||
| 1148 | (defgroup org-keywords nil | |
| 1149 | "Keywords in Org mode." | |
| 1150 | :tag "Org Keywords" | |
| 1151 | :group 'org) | |
| 1152 | ||
| 1153 | (defcustom org-closed-keep-when-no-todo nil | |
| 1154 | "Remove CLOSED: time-stamp when switching back to a non-todo state?" | |
| 1155 | :group 'org-todo | |
| 1156 | :group 'org-keywords | |
| 1157 | :version "24.4" | |
| 1158 | :package-version '(Org . "8.0") | |
| 1159 | :type 'boolean) | |
| 1160 | ||
| 1161 | (defgroup org-structure nil | |
| 1162 | "Options concerning the general structure of Org files." | |
| 1163 | :tag "Org Structure" | |
| 1164 | :group 'org) | |
| 1165 | ||
| 1166 | (defgroup org-reveal-location nil | |
| 1167 | "Options about how to make context of a location visible." | |
| 1168 | :tag "Org Reveal Location" | |
| 1169 | :group 'org-structure) | |
| 1170 | ||
| 1171 | (defcustom org-show-context-detail '((agenda . local) | |
| 1172 | (bookmark-jump . lineage) | |
| 1173 | (isearch . lineage) | |
| 1174 | (default . ancestors)) | |
| 1175 | "Alist between context and visibility span when revealing a location. | |
| 1176 | ||
| 1177 | \\<org-mode-map>Some actions may move point into invisible | |
| 1178 | locations. As a consequence, Org always expose a neighborhood | |
| 1179 | around point. How much is shown depends on the initial action, | |
| 1180 | or context. Valid contexts are | |
| 1181 | ||
| 1182 | agenda when exposing an entry from the agenda | |
| 1183 | org-goto when using the command `org-goto' (`\\[org-goto]') | |
| 1184 | occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /') | |
| 1185 | tags-tree when constructing a sparse tree based on tags matches | |
| 1186 | link-search when exposing search matches associated with a link | |
| 1187 | mark-goto when exposing the jump goal of a mark | |
| 1188 | bookmark-jump when exposing a bookmark location | |
| 1189 | isearch when exiting from an incremental search | |
| 1190 | default default for all contexts not set explicitly | |
| 1191 | ||
| 1192 | Allowed visibility spans are | |
| 1193 | ||
| 1194 | minimal show current headline; if point is not on headline, | |
| 1195 | also show entry | |
| 1196 | ||
| 1197 | local show current headline, entry and next headline | |
| 1198 | ||
| 1199 | ancestors show current headline and its direct ancestors; if | |
| 1200 | point is not on headline, also show entry | |
| 1201 | ||
| 1202 | lineage show current headline, its direct ancestors and all | |
| 1203 | their children; if point is not on headline, also show | |
| 1204 | entry and first child | |
| 1205 | ||
| 1206 | tree show current headline, its direct ancestors and all | |
| 1207 | their children; if point is not on headline, also show | |
| 1208 | entry and all children | |
| 1209 | ||
| 1210 | canonical show current headline, its direct ancestors along with | |
| 1211 | their entries and children; if point is not located on | |
| 1212 | the headline, also show current entry and all children | |
| 1213 | ||
| 1214 | As special cases, a nil or t value means show all contexts in | |
| 1215 | `minimal' or `canonical' view, respectively. | |
| 1216 | ||
| 1217 | Some views can make displayed information very compact, but also | |
| 1218 | make it harder to edit the location of the match. In such | |
| 1219 | a case, use the command `org-reveal' (`\\[org-reveal]') to show | |
| 1220 | more context." | |
| 1221 | :group 'org-reveal-location | |
| 1222 | :version "26.1" | |
| 1223 | :package-version '(Org . "9.0") | |
| 1224 | :type '(choice | |
| 1225 | (const :tag "Canonical" t) | |
| 1226 | (const :tag "Minimal" nil) | |
| 1227 | (repeat :greedy t :tag "Individual contexts" | |
| 1228 | (cons | |
| 1229 | (choice :tag "Context" | |
| 1230 | (const agenda) | |
| 1231 | (const org-goto) | |
| 1232 | (const occur-tree) | |
| 1233 | (const tags-tree) | |
| 1234 | (const link-search) | |
| 1235 | (const mark-goto) | |
| 1236 | (const bookmark-jump) | |
| 1237 | (const isearch) | |
| 1238 | (const default)) | |
| 1239 | (choice :tag "Detail level" | |
| 1240 | (const minimal) | |
| 1241 | (const local) | |
| 1242 | (const ancestors) | |
| 1243 | (const lineage) | |
| 1244 | (const tree) | |
| 1245 | (const canonical)))))) | |
| 1246 | ||
| 1247 | (defcustom org-indirect-buffer-display 'other-window | |
| 1248 | "How should indirect tree buffers be displayed? | |
| 1249 | ||
| 1250 | This applies to indirect buffers created with the commands | |
| 1251 | `org-tree-to-indirect-buffer' and `org-agenda-tree-to-indirect-buffer'. | |
| 1252 | ||
| 1253 | Valid values are: | |
| 1254 | current-window Display in the current window | |
| 1255 | other-window Just display in another window. | |
| 1256 | dedicated-frame Create one new frame, and re-use it each time. | |
| 1257 | new-frame Make a new frame each time. Note that in this case | |
| 1258 | previously-made indirect buffers are kept, and you need to | |
| 1259 | kill these buffers yourself." | |
| 1260 | :group 'org-structure | |
| 1261 | :group 'org-agenda-windows | |
| 1262 | :type '(choice | |
| 1263 | (const :tag "In current window" current-window) | |
| 1264 | (const :tag "In current frame, other window" other-window) | |
| 1265 | (const :tag "Each time a new frame" new-frame) | |
| 1266 | (const :tag "One dedicated frame" dedicated-frame))) | |
| 1267 | ||
| 1268 | (defcustom org-use-speed-commands nil | |
| 1269 | "Non-nil means activate single letter commands at beginning of a headline. | |
| 1270 | This may also be a function to test for appropriate locations where speed | |
| 1271 | commands should be active. | |
| 1272 | ||
| 1273 | For example, to activate speed commands when the point is on any | |
| 1274 | star at the beginning of the headline, you can do this: | |
| 1275 | ||
| 1276 | (setq org-use-speed-commands | |
| 1277 | (lambda () (and (looking-at org-outline-regexp) (looking-back \"^\\**\"))))" | |
| 1278 | :group 'org-structure | |
| 1279 | :type '(choice | |
| 1280 | (const :tag "Never" nil) | |
| 1281 | (const :tag "At beginning of headline stars" t) | |
| 1282 | (function))) | |
| 1283 | ||
| 1284 | (defcustom org-speed-commands-user nil | |
| 1285 | "Alist of additional speed commands. | |
| 1286 | This list will be checked before `org-speed-commands-default' | |
| 1287 | when the variable `org-use-speed-commands' is non-nil | |
| 1288 | and when the cursor is at the beginning of a headline. | |
| 1289 | The car of each entry is a string with a single letter, which must | |
| 1290 | be assigned to `self-insert-command' in the global map. | |
| 1291 | The cdr is either a command to be called interactively, a function | |
| 1292 | to be called, or a form to be evaluated. | |
| 1293 | An entry that is just a list with a single string will be interpreted | |
| 1294 | as a descriptive headline that will be added when listing the speed | |
| 1295 | commands in the Help buffer using the `?' speed command." | |
| 1296 | :group 'org-structure | |
| 1297 | :type '(repeat :value ("k" . ignore) | |
| 1298 | (choice :value ("k" . ignore) | |
| 1299 | (list :tag "Descriptive Headline" (string :tag "Headline")) | |
| 1300 | (cons :tag "Letter and Command" | |
| 1301 | (string :tag "Command letter") | |
| 1302 | (choice | |
| 1303 | (function) | |
| 1304 | (sexp)))))) | |
| 1305 | ||
| 1306 | (defcustom org-bookmark-names-plist | |
| 1307 | '(:last-capture "org-capture-last-stored" | |
| 1308 | :last-refile "org-refile-last-stored" | |
| 1309 | :last-capture-marker "org-capture-last-stored-marker") | |
| 1310 | "Names for bookmarks automatically set by some Org commands. | |
| 1311 | This can provide strings as names for a number of bookmarks Org sets | |
| 1312 | automatically. The following keys are currently implemented: | |
| 1313 | :last-capture | |
| 1314 | :last-capture-marker | |
| 1315 | :last-refile | |
| 1316 | When a key does not show up in the property list, the corresponding bookmark | |
| 1317 | is not set." | |
| 1318 | :group 'org-structure | |
| 1319 | :type 'plist) | |
| 1320 | ||
| 1321 | (defgroup org-cycle nil | |
| 1322 | "Options concerning visibility cycling in Org mode." | |
| 1323 | :tag "Org Cycle" | |
| 1324 | :group 'org-structure) | |
| 1325 | ||
| 1326 | (defcustom org-cycle-skip-children-state-if-no-children t | |
| 1327 | "Non-nil means skip CHILDREN state in entries that don't have any." | |
| 1328 | :group 'org-cycle | |
| 1329 | :type 'boolean) | |
| 1330 | ||
| 1331 | (defcustom org-cycle-max-level nil | |
| 1332 | "Maximum level which should still be subject to visibility cycling. | |
| 1333 | Levels higher than this will, for cycling, be treated as text, not a headline. | |
| 1334 | When `org-odd-levels-only' is set, a value of N in this variable actually | |
| 1335 | means 2N-1 stars as the limiting headline. | |
| 1336 | When nil, cycle all levels. | |
| 1337 | Note that the limiting level of cycling is also influenced by | |
| 1338 | `org-inlinetask-min-level'. When `org-cycle-max-level' is not set but | |
| 1339 | `org-inlinetask-min-level' is, cycling will be limited to levels one less | |
| 1340 | than its value." | |
| 1341 | :group 'org-cycle | |
| 1342 | :type '(choice | |
| 1343 | (const :tag "No limit" nil) | |
| 1344 | (integer :tag "Maximum level"))) | |
| 1345 | ||
| 1346 | (defcustom org-hide-block-startup nil | |
| 1347 | "Non-nil means entering Org mode will fold all blocks. | |
| 1348 | This can also be set in on a per-file basis with | |
| 1349 | ||
| 1350 | #+STARTUP: hideblocks | |
| 1351 | #+STARTUP: showblocks" | |
| 1352 | :group 'org-startup | |
| 1353 | :group 'org-cycle | |
| 1354 | :type 'boolean) | |
| 1355 | ||
| 1356 | (defcustom org-cycle-global-at-bob nil | |
| 1357 | "Cycle globally if cursor is at beginning of buffer and not at a headline. | |
| 1358 | ||
| 1359 | This makes it possible to do global cycling without having to use `S-TAB' | |
| 1360 | or `\\[universal-argument] TAB'. For this special case to work, the first \ | |
| 1361 | line of the buffer | |
| 1362 | must not be a headline -- it may be empty or some other text. | |
| 1363 | ||
| 1364 | When used in this way, `org-cycle-hook' is disabled temporarily to make | |
| 1365 | sure the cursor stays at the beginning of the buffer. | |
| 1366 | ||
| 1367 | When this option is nil, don't do anything special at the beginning of | |
| 1368 | the buffer." | |
| 1369 | :group 'org-cycle | |
| 1370 | :type 'boolean) | |
| 1371 | ||
| 1372 | (defcustom org-cycle-level-after-item/entry-creation t | |
| 1373 | "Non-nil means cycle entry level or item indentation in new empty entries. | |
| 1374 | ||
| 1375 | When the cursor is at the end of an empty headline, i.e., with only stars | |
| 1376 | and maybe a TODO keyword, TAB will then switch the entry to become a child, | |
| 1377 | and then all possible ancestor states, before returning to the original state. | |
| 1378 | This makes data entry extremely fast: M-RET to create a new headline, | |
| 1379 | on TAB to make it a child, two or more tabs to make it a (grand-)uncle. | |
| 1380 | ||
| 1381 | When the cursor is at the end of an empty plain list item, one TAB will | |
| 1382 | make it a subitem, two or more tabs will back up to make this an item | |
| 1383 | higher up in the item hierarchy." | |
| 1384 | :group 'org-cycle | |
| 1385 | :type 'boolean) | |
| 1386 | ||
| 1387 | (defcustom org-cycle-emulate-tab t | |
| 1388 | "Where should `org-cycle' emulate TAB. | |
| 1389 | nil Never | |
| 1390 | white Only in completely white lines | |
| 1391 | whitestart Only at the beginning of lines, before the first non-white char | |
| 1392 | t Everywhere except in headlines | |
| 1393 | exc-hl-bol Everywhere except at the start of a headline | |
| 1394 | If TAB is used in a place where it does not emulate TAB, the current subtree | |
| 1395 | visibility is cycled." | |
| 1396 | :group 'org-cycle | |
| 1397 | :type '(choice (const :tag "Never" nil) | |
| 1398 | (const :tag "Only in completely white lines" white) | |
| 1399 | (const :tag "Before first char in a line" whitestart) | |
| 1400 | (const :tag "Everywhere except in headlines" t) | |
| 1401 | (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) | |
| 1402 | ||
| 1403 | (defcustom org-cycle-separator-lines 2 | |
| 1404 | "Number of empty lines needed to keep an empty line between collapsed trees. | |
| 1405 | If you leave an empty line between the end of a subtree and the following | |
| 1406 | headline, this empty line is hidden when the subtree is folded. | |
| 1407 | Org mode will leave (exactly) one empty line visible if the number of | |
| 1408 | empty lines is equal or larger to the number given in this variable. | |
| 1409 | So the default 2 means at least 2 empty lines after the end of a subtree | |
| 1410 | are needed to produce free space between a collapsed subtree and the | |
| 1411 | following headline. | |
| 1412 | ||
| 1413 | If the number is negative, and the number of empty lines is at least -N, | |
| 1414 | all empty lines are shown. | |
| 1415 | ||
| 1416 | Special case: when 0, never leave empty lines in collapsed view." | |
| 1417 | :group 'org-cycle | |
| 1418 | :type 'integer) | |
| 1419 | (put 'org-cycle-separator-lines 'safe-local-variable 'integerp) | |
| 1420 | ||
| 1421 | (defcustom org-pre-cycle-hook nil | |
| 1422 | "Hook that is run before visibility cycling is happening. | |
| 1423 | The function(s) in this hook must accept a single argument which indicates | |
| 1424 | the new state that will be set right after running this hook. The | |
| 1425 | argument is a symbol. Before a global state change, it can have the values | |
| 1426 | `overview', `content', or `all'. Before a local state change, it can have | |
| 1427 | the values `folded', `children', or `subtree'." | |
| 1428 | :group 'org-cycle | |
| 1429 | :type 'hook) | |
| 1430 | ||
| 1431 | (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees | |
| 1432 | org-cycle-hide-drawers | |
| 1433 | org-cycle-show-empty-lines | |
| 1434 | org-optimize-window-after-visibility-change) | |
| 1435 | "Hook that is run after `org-cycle' has changed the buffer visibility. | |
| 1436 | The function(s) in this hook must accept a single argument which indicates | |
| 1437 | the new state that was set by the most recent `org-cycle' command. The | |
| 1438 | argument is a symbol. After a global state change, it can have the values | |
| 1439 | `overview', `contents', or `all'. After a local state change, it can have | |
| 1440 | the values `folded', `children', or `subtree'." | |
| 1441 | :group 'org-cycle | |
| 1442 | :type 'hook | |
| 1443 | :version "26.1" | |
| 1444 | :package-version '(Org . "8.3")) | |
| 1445 | ||
| 1446 | (defgroup org-edit-structure nil | |
| 1447 | "Options concerning structure editing in Org mode." | |
| 1448 | :tag "Org Edit Structure" | |
| 1449 | :group 'org-structure) | |
| 1450 | ||
| 1451 | (defcustom org-odd-levels-only nil | |
| 1452 | "Non-nil means skip even levels and only use odd levels for the outline. | |
| 1453 | This has the effect that two stars are being added/taken away in | |
| 1454 | promotion/demotion commands. It also influences how levels are | |
| 1455 | handled by the exporters. | |
| 1456 | Changing it requires restart of `font-lock-mode' to become effective | |
| 1457 | for fontification also in regions already fontified. | |
| 1458 | You may also set this on a per-file basis by adding one of the following | |
| 1459 | lines to the buffer: | |
| 1460 | ||
| 1461 | #+STARTUP: odd | |
| 1462 | #+STARTUP: oddeven" | |
| 1463 | :group 'org-edit-structure | |
| 1464 | :group 'org-appearance | |
| 1465 | :type 'boolean) | |
| 1466 | ||
| 1467 | (defcustom org-adapt-indentation t | |
| 1468 | "Non-nil means adapt indentation to outline node level. | |
| 1469 | ||
| 1470 | When this variable is set, Org assumes that you write outlines by | |
| 1471 | indenting text in each node to align with the headline (after the | |
| 1472 | stars). The following issues are influenced by this variable: | |
| 1473 | ||
| 1474 | - The indentation is increased by one space in a demotion | |
| 1475 | command, and decreased by one in a promotion command. However, | |
| 1476 | in the latter case, if shifting some line in the entry body | |
| 1477 | would alter document structure (e.g., insert a new headline), | |
| 1478 | indentation is not changed at all. | |
| 1479 | ||
| 1480 | - Property drawers and planning information is inserted indented | |
| 1481 | when this variable is set. When nil, they will not be indented. | |
| 1482 | ||
| 1483 | - TAB indents a line relative to current level. The lines below | |
| 1484 | a headline will be indented when this variable is set. | |
| 1485 | ||
| 1486 | Note that this is all about true indentation, by adding and | |
| 1487 | removing space characters. See also `org-indent.el' which does | |
| 1488 | level-dependent indentation in a virtual way, i.e. at display | |
| 1489 | time in Emacs." | |
| 1490 | :group 'org-edit-structure | |
| 1491 | :type 'boolean) | |
| 1492 | ||
| 1493 | (defcustom org-special-ctrl-a/e nil | |
| 1494 | "Non-nil means `C-a' and `C-e' behave specially in headlines and items. | |
| 1495 | ||
| 1496 | When t, `C-a' will bring back the cursor to the beginning of the | |
| 1497 | headline text, i.e. after the stars and after a possible TODO | |
| 1498 | keyword. In an item, this will be the position after bullet and | |
| 1499 | check-box, if any. When the cursor is already at that position, | |
| 1500 | another `C-a' will bring it to the beginning of the line. | |
| 1501 | ||
| 1502 | `C-e' will jump to the end of the headline, ignoring the presence | |
| 1503 | of tags in the headline. A second `C-e' will then jump to the | |
| 1504 | true end of the line, after any tags. This also means that, when | |
| 1505 | this variable is non-nil, `C-e' also will never jump beyond the | |
| 1506 | end of the heading of a folded section, i.e. not after the | |
| 1507 | ellipses. | |
| 1508 | ||
| 1509 | When set to the symbol `reversed', the first `C-a' or `C-e' works | |
| 1510 | normally, going to the true line boundary first. Only a directly | |
| 1511 | following, identical keypress will bring the cursor to the | |
| 1512 | special positions. | |
| 1513 | ||
| 1514 | This may also be a cons cell where the behavior for `C-a' and | |
| 1515 | `C-e' is set separately." | |
| 1516 | :group 'org-edit-structure | |
| 1517 | :type '(choice | |
| 1518 | (const :tag "off" nil) | |
| 1519 | (const :tag "on: after stars/bullet and before tags first" t) | |
| 1520 | (const :tag "reversed: true line boundary first" reversed) | |
| 1521 | (cons :tag "Set C-a and C-e separately" | |
| 1522 | (choice :tag "Special C-a" | |
| 1523 | (const :tag "off" nil) | |
| 1524 | (const :tag "on: after stars/bullet first" t) | |
| 1525 | (const :tag "reversed: before stars/bullet first" reversed)) | |
| 1526 | (choice :tag "Special C-e" | |
| 1527 | (const :tag "off" nil) | |
| 1528 | (const :tag "on: before tags first" t) | |
| 1529 | (const :tag "reversed: after tags first" reversed))))) | |
| 1530 | (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) | |
| 1531 | ||
| 1532 | (defcustom org-special-ctrl-k nil | |
| 1533 | "Non-nil means `C-k' will behave specially in headlines. | |
| 1534 | When nil, `C-k' will call the default `kill-line' command. | |
| 1535 | When t, the following will happen while the cursor is in the headline: | |
| 1536 | ||
| 1537 | - When the cursor is at the beginning of a headline, kill the entire | |
| 1538 | line and possible the folded subtree below the line. | |
| 1539 | - When in the middle of the headline text, kill the headline up to the tags. | |
| 1540 | - When after the headline text, kill the tags." | |
| 1541 | :group 'org-edit-structure | |
| 1542 | :type 'boolean) | |
| 1543 | ||
| 1544 | (defcustom org-ctrl-k-protect-subtree nil | |
| 1545 | "Non-nil means, do not delete a hidden subtree with C-k. | |
| 1546 | When set to the symbol `error', simply throw an error when C-k is | |
| 1547 | used to kill (part-of) a headline that has hidden text behind it. | |
| 1548 | Any other non-nil value will result in a query to the user, if it is | |
| 1549 | OK to kill that hidden subtree. When nil, kill without remorse." | |
| 1550 | :group 'org-edit-structure | |
| 1551 | :version "24.1" | |
| 1552 | :type '(choice | |
| 1553 | (const :tag "Do not protect hidden subtrees" nil) | |
| 1554 | (const :tag "Protect hidden subtrees with a security query" t) | |
| 1555 | (const :tag "Never kill a hidden subtree with C-k" error))) | |
| 1556 | ||
| 1557 | (defcustom org-special-ctrl-o t | |
| 1558 | "Non-nil means, make `C-o' insert a row in tables." | |
| 1559 | :group 'org-edit-structure | |
| 1560 | :type 'boolean) | |
| 1561 | ||
| 1562 | (defcustom org-catch-invisible-edits nil | |
| 1563 | "Check if in invisible region before inserting or deleting a character. | |
| 1564 | Valid values are: | |
| 1565 | ||
| 1566 | nil Do not check, so just do invisible edits. | |
| 1567 | error Throw an error and do nothing. | |
| 1568 | show Make point visible, and do the requested edit. | |
| 1569 | show-and-error Make point visible, then throw an error and abort the edit. | |
| 1570 | smart Make point visible, and do insertion/deletion if it is | |
| 1571 | adjacent to visible text and the change feels predictable. | |
| 1572 | Never delete a previously invisible character or add in the | |
| 1573 | middle or right after an invisible region. Basically, this | |
| 1574 | allows insertion and backward-delete right before ellipses. | |
| 1575 | FIXME: maybe in this case we should not even show?" | |
| 1576 | :group 'org-edit-structure | |
| 1577 | :version "24.1" | |
| 1578 | :type '(choice | |
| 1579 | (const :tag "Do not check" nil) | |
| 1580 | (const :tag "Throw error when trying to edit" error) | |
| 1581 | (const :tag "Unhide, but do not do the edit" show-and-error) | |
| 1582 | (const :tag "Show invisible part and do the edit" show) | |
| 1583 | (const :tag "Be smart and do the right thing" smart))) | |
| 1584 | ||
| 1585 | (defcustom org-yank-folded-subtrees t | |
| 1586 | "Non-nil means when yanking subtrees, fold them. | |
| 1587 | If the kill is a single subtree, or a sequence of subtrees, i.e. if | |
| 1588 | it starts with a heading and all other headings in it are either children | |
| 1589 | or siblings, then fold all the subtrees. However, do this only if no | |
| 1590 | text after the yank would be swallowed into a folded tree by this action." | |
| 1591 | :group 'org-edit-structure | |
| 1592 | :type 'boolean) | |
| 1593 | ||
| 1594 | (defcustom org-yank-adjusted-subtrees nil | |
| 1595 | "Non-nil means when yanking subtrees, adjust the level. | |
| 1596 | With this setting, `org-paste-subtree' is used to insert the subtree, see | |
| 1597 | this function for details." | |
| 1598 | :group 'org-edit-structure | |
| 1599 | :type 'boolean) | |
| 1600 | ||
| 1601 | (defcustom org-M-RET-may-split-line '((default . t)) | |
| 1602 | "Non-nil means M-RET will split the line at the cursor position. | |
| 1603 | When nil, it will go to the end of the line before making a | |
| 1604 | new line. | |
| 1605 | You may also set this option in a different way for different | |
| 1606 | contexts. Valid contexts are: | |
| 1607 | ||
| 1608 | headline when creating a new headline | |
| 1609 | item when creating a new item | |
| 1610 | table in a table field | |
| 1611 | default the value to be used for all contexts not explicitly | |
| 1612 | customized" | |
| 1613 | :group 'org-structure | |
| 1614 | :group 'org-table | |
| 1615 | :type '(choice | |
| 1616 | (const :tag "Always" t) | |
| 1617 | (const :tag "Never" nil) | |
| 1618 | (repeat :greedy t :tag "Individual contexts" | |
| 1619 | (cons | |
| 1620 | (choice :tag "Context" | |
| 1621 | (const headline) | |
| 1622 | (const item) | |
| 1623 | (const table) | |
| 1624 | (const default)) | |
| 1625 | (boolean))))) | |
| 1626 | ||
| 1627 | ||
| 1628 | (defcustom org-insert-heading-respect-content nil | |
| 1629 | "Non-nil means insert new headings after the current subtree. | |
| 1630 | \\<org-mode-map> | |
| 1631 | When nil, the new heading is created directly after the current line. | |
| 1632 | The commands `\\[org-insert-heading-respect-content]' and \ | |
| 1633 | `\\[org-insert-todo-heading-respect-content]' turn this variable on | |
| 1634 | for the duration of the command." | |
| 1635 | :group 'org-structure | |
| 1636 | :type 'boolean) | |
| 1637 | ||
| 1638 | (defcustom org-blank-before-new-entry '((heading . auto) | |
| 1639 | (plain-list-item . auto)) | |
| 1640 | "Should `org-insert-heading' leave a blank line before new heading/item? | |
| 1641 | The value is an alist, with `heading' and `plain-list-item' as CAR, | |
| 1642 | and a boolean flag as CDR. The cdr may also be the symbol `auto', in | |
| 1643 | which case Org will look at the surrounding headings/items and try to | |
| 1644 | make an intelligent decision whether to insert a blank line or not." | |
| 1645 | :group 'org-edit-structure | |
| 1646 | :type '(list | |
| 1647 | (cons (const heading) | |
| 1648 | (choice (const :tag "Never" nil) | |
| 1649 | (const :tag "Always" t) | |
| 1650 | (const :tag "Auto" auto))) | |
| 1651 | (cons (const plain-list-item) | |
| 1652 | (choice (const :tag "Never" nil) | |
| 1653 | (const :tag "Always" t) | |
| 1654 | (const :tag "Auto" auto))))) | |
| 1655 | ||
| 1656 | (defcustom org-insert-heading-hook nil | |
| 1657 | "Hook being run after inserting a new heading." | |
| 1658 | :group 'org-edit-structure | |
| 1659 | :type 'hook) | |
| 1660 | ||
| 1661 | (defcustom org-enable-fixed-width-editor t | |
| 1662 | "Non-nil means lines starting with \":\" are treated as fixed-width. | |
| 1663 | This currently only means they are never auto-wrapped. | |
| 1664 | When nil, such lines will be treated like ordinary lines." | |
| 1665 | :group 'org-edit-structure | |
| 1666 | :type 'boolean) | |
| 1667 | ||
| 1668 | (defcustom org-goto-auto-isearch t | |
| 1669 | "Non-nil means typing characters in `org-goto' starts incremental search. | |
| 1670 | When nil, you can use these keybindings to navigate the buffer: | |
| 1671 | ||
| 1672 | q Quit the org-goto interface | |
| 1673 | n Go to the next visible heading | |
| 1674 | p Go to the previous visible heading | |
| 1675 | f Go one heading forward on same level | |
| 1676 | b Go one heading backward on same level | |
| 1677 | u Go one heading up" | |
| 1678 | :group 'org-edit-structure | |
| 1679 | :type 'boolean) | |
| 1680 | ||
| 1681 | (defgroup org-sparse-trees nil | |
| 1682 | "Options concerning sparse trees in Org mode." | |
| 1683 | :tag "Org Sparse Trees" | |
| 1684 | :group 'org-structure) | |
| 1685 | ||
| 1686 | (defcustom org-highlight-sparse-tree-matches t | |
| 1687 | "Non-nil means highlight all matches that define a sparse tree. | |
| 1688 | The highlights will automatically disappear the next time the buffer is | |
| 1689 | changed by an edit command." | |
| 1690 | :group 'org-sparse-trees | |
| 1691 | :type 'boolean) | |
| 1692 | ||
| 1693 | (defcustom org-remove-highlights-with-change t | |
| 1694 | "Non-nil means any change to the buffer will remove temporary highlights. | |
| 1695 | \\<org-mode-map>\ | |
| 1696 | Such highlights are created by `org-occur' and `org-clock-display'. | |
| 1697 | When nil, `\\[org-ctrl-c-ctrl-c]' needs to be used \ | |
| 1698 | to get rid of the highlights. | |
| 1699 | The highlights created by `org-toggle-latex-fragment' always need | |
| 1700 | `\\[org-toggle-latex-fragment]' to be removed." | |
| 1701 | :group 'org-sparse-trees | |
| 1702 | :group 'org-time | |
| 1703 | :type 'boolean) | |
| 1704 | ||
| 1705 | (defcustom org-occur-case-fold-search t | |
| 1706 | "Non-nil means `org-occur' should be case-insensitive. | |
| 1707 | If set to `smart' the search will be case-insensitive only if it | |
| 1708 | doesn't specify any upper case character." | |
| 1709 | :group 'org-sparse-trees | |
| 1710 | :version "26.1" | |
| 1711 | :type '(choice | |
| 1712 | (const :tag "Case-sensitive" nil) | |
| 1713 | (const :tag "Case-insensitive" t) | |
| 1714 | (const :tag "Case-insensitive for lower case searches only" smart))) | |
| 1715 | ||
| 1716 | (defcustom org-occur-hook '(org-first-headline-recenter) | |
| 1717 | "Hook that is run after `org-occur' has constructed a sparse tree. | |
| 1718 | This can be used to recenter the window to show as much of the structure | |
| 1719 | as possible." | |
| 1720 | :group 'org-sparse-trees | |
| 1721 | :type 'hook) | |
| 1722 | ||
| 1723 | (defgroup org-imenu-and-speedbar nil | |
| 1724 | "Options concerning imenu and speedbar in Org mode." | |
| 1725 | :tag "Org Imenu and Speedbar" | |
| 1726 | :group 'org-structure) | |
| 1727 | ||
| 1728 | (defcustom org-imenu-depth 2 | |
| 1729 | "The maximum level for Imenu access to Org headlines. | |
| 1730 | This also applied for speedbar access." | |
| 1731 | :group 'org-imenu-and-speedbar | |
| 1732 | :type 'integer) | |
| 1733 | ||
| 1734 | (defgroup org-table nil | |
| 1735 | "Options concerning tables in Org mode." | |
| 1736 | :tag "Org Table" | |
| 1737 | :group 'org) | |
| 1738 | ||
| 1739 | (defcustom org-self-insert-cluster-for-undo nil | |
| 1740 | "Non-nil means cluster self-insert commands for undo when possible. | |
| 1741 | If this is set, then, like in the Emacs command loop, 20 consecutive | |
| 1742 | characters will be undone together. | |
| 1743 | This is configurable, because there is some impact on typing performance." | |
| 1744 | :group 'org-table | |
| 1745 | :type 'boolean) | |
| 1746 | ||
| 1747 | (defcustom org-table-tab-recognizes-table.el t | |
| 1748 | "Non-nil means TAB will automatically notice a table.el table. | |
| 1749 | When it sees such a table, it moves point into it and - if necessary - | |
| 1750 | calls `table-recognize-table'." | |
| 1751 | :group 'org-table-editing | |
| 1752 | :type 'boolean) | |
| 1753 | ||
| 1754 | (defgroup org-link nil | |
| 1755 | "Options concerning links in Org mode." | |
| 1756 | :tag "Org Link" | |
| 1757 | :group 'org) | |
| 1758 | ||
| 1759 | (defvar-local org-link-abbrev-alist-local nil | |
| 1760 | "Buffer-local version of `org-link-abbrev-alist', which see. | |
| 1761 | The value of this is taken from the #+LINK lines.") | |
| 1762 | ||
| 1763 | (defcustom org-link-parameters | |
| 1764 | '(("doi" :follow org--open-doi-link) | |
| 1765 | ("elisp" :follow org--open-elisp-link) | |
| 1766 | ("file" :complete org-file-complete-link) | |
| 1767 | ("ftp" :follow (lambda (path) (browse-url (concat "ftp:" path)))) | |
| 1768 | ("help" :follow org--open-help-link) | |
| 1769 | ("http" :follow (lambda (path) (browse-url (concat "http:" path)))) | |
| 1770 | ("https" :follow (lambda (path) (browse-url (concat "https:" path)))) | |
| 1771 | ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path)))) | |
| 1772 | ("news" :follow (lambda (path) (browse-url (concat "news:" path)))) | |
| 1773 | ("shell" :follow org--open-shell-link)) | |
| 1774 | "An alist of properties that defines all the links in Org mode. | |
| 1775 | The key in each association is a string of the link type. | |
| 1776 | Subsequent optional elements make up a p-list of link properties. | |
| 1777 | ||
| 1778 | :follow - A function that takes the link path as an argument. | |
| 1779 | ||
| 1780 | :export - A function that takes the link path, description and | |
| 1781 | export-backend as arguments. | |
| 1782 | ||
| 1783 | :store - A function responsible for storing the link. See the | |
| 1784 | function `org-store-link-functions'. | |
| 1785 | ||
| 1786 | :complete - A function that inserts a link with completion. The | |
| 1787 | function takes one optional prefix arg. | |
| 1788 | ||
| 1789 | :face - A face for the link, or a function that returns a face. | |
| 1790 | The function takes one argument which is the link path. The | |
| 1791 | default face is `org-link'. | |
| 1792 | ||
| 1793 | :mouse-face - The mouse-face. The default is `highlight'. | |
| 1794 | ||
| 1795 | :display - `full' will not fold the link in descriptive | |
| 1796 | display. Default is `org-link'. | |
| 1797 | ||
| 1798 | :help-echo - A string or function that takes (window object position) | |
| 1799 | as arguments and returns a string. | |
| 1800 | ||
| 1801 | :keymap - A keymap that is active on the link. The default is | |
| 1802 | `org-mouse-map'. | |
| 1803 | ||
| 1804 | :htmlize-link - A function for the htmlize-link. Defaults | |
| 1805 | to (list :uri \"type:path\") | |
| 1806 | ||
| 1807 | :activate-func - A function to run at the end of font-lock | |
| 1808 | activation. The function must accept (link-start link-end path bracketp) | |
| 1809 | as arguments." | |
| 1810 | :group 'org-link | |
| 1811 | :type '(alist :tag "Link display parameters" | |
| 1812 | :value-type plist) | |
| 1813 | :version "26.1" | |
| 1814 | :package-version '(Org . "9.1")) | |
| 1815 | ||
| 1816 | (defun org-link-get-parameter (type key) | |
| 1817 | "Get TYPE link property for KEY. | |
| 1818 | TYPE is a string and KEY is a plist keyword." | |
| 1819 | (plist-get | |
| 1820 | (cdr (assoc type org-link-parameters)) | |
| 1821 | key)) | |
| 1822 | ||
| 1823 | (defun org-link-set-parameters (type &rest parameters) | |
| 1824 | "Set link TYPE properties to PARAMETERS. | |
| 1825 | PARAMETERS should be :key val pairs." | |
| 1826 | (let ((data (assoc type org-link-parameters))) | |
| 1827 | (if data (setcdr data (org-combine-plists (cdr data) parameters)) | |
| 1828 | (push (cons type parameters) org-link-parameters) | |
| 1829 | (org-make-link-regexps) | |
| 1830 | (org-element-update-syntax)))) | |
| 1831 | ||
| 1832 | (defun org-link-types () | |
| 1833 | "Return a list of known link types." | |
| 1834 | (mapcar #'car org-link-parameters)) | |
| 1835 | ||
| 1836 | (defcustom org-link-abbrev-alist nil | |
| 1837 | "Alist of link abbreviations. | |
| 1838 | The car of each element is a string, to be replaced at the start of a link. | |
| 1839 | The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated | |
| 1840 | links in Org buffers can have an optional tag after a double colon, e.g., | |
| 1841 | ||
| 1842 | [[linkkey:tag][description]] | |
| 1843 | ||
| 1844 | The `linkkey' must be a single word, starting with a letter, followed | |
| 1845 | by letters, numbers, `-' or `_'. | |
| 1846 | ||
| 1847 | If REPLACE is a string, the tag will simply be appended to create the link. | |
| 1848 | If the string contains \"%s\", the tag will be inserted there. If the string | |
| 1849 | contains \"%h\", it will cause a url-encoded version of the tag to be inserted | |
| 1850 | at that point (see the function `url-hexify-string'). If the string contains | |
| 1851 | the specifier \"%(my-function)\", then the custom function `my-function' will | |
| 1852 | be invoked: this function takes the tag as its only argument and must return | |
| 1853 | a string. | |
| 1854 | ||
| 1855 | REPLACE may also be a function that will be called with the tag as the | |
| 1856 | only argument to create the link, which should be returned as a string. | |
| 1857 | ||
| 1858 | See the manual for examples." | |
| 1859 | :group 'org-link | |
| 1860 | :type '(repeat | |
| 1861 | (cons | |
| 1862 | (string :tag "Protocol") | |
| 1863 | (choice | |
| 1864 | (string :tag "Format") | |
| 1865 | (function))))) | |
| 1866 | ||
| 1867 | (defcustom org-descriptive-links t | |
| 1868 | "Non-nil means Org will display descriptive links. | |
| 1869 | E.g. [[https://orgmode.org][Org website]] will be displayed as | |
| 1870 | \"Org Website\", hiding the link itself and just displaying its | |
| 1871 | description. When set to nil, Org will display the full links | |
| 1872 | literally. | |
| 1873 | ||
| 1874 | You can interactively set the value of this variable by calling | |
| 1875 | `org-toggle-link-display' or from the menu Org>Hyperlinks menu." | |
| 1876 | :group 'org-link | |
| 1877 | :type 'boolean) | |
| 1878 | ||
| 1879 | (defcustom org-link-file-path-type 'adaptive | |
| 1880 | "How the path name in file links should be stored. | |
| 1881 | Valid values are: | |
| 1882 | ||
| 1883 | relative Relative to the current directory, i.e. the directory of the file | |
| 1884 | into which the link is being inserted. | |
| 1885 | absolute Absolute path, if possible with ~ for home directory. | |
| 1886 | noabbrev Absolute path, no abbreviation of home directory. | |
| 1887 | adaptive Use relative path for files in the current directory and sub- | |
| 1888 | directories of it. For other files, use an absolute path." | |
| 1889 | :group 'org-link | |
| 1890 | :type '(choice | |
| 1891 | (const relative) | |
| 1892 | (const absolute) | |
| 1893 | (const noabbrev) | |
| 1894 | (const adaptive))) | |
| 1895 | ||
| 1896 | (defvaralias 'org-activate-links 'org-highlight-links) | |
| 1897 | (defcustom org-highlight-links '(bracket angle plain radio tag date footnote) | |
| 1898 | "Types of links that should be highlighted in Org files. | |
| 1899 | ||
| 1900 | This is a list of symbols, each one of them leading to the | |
| 1901 | highlighting of a certain link type. | |
| 1902 | ||
| 1903 | You can still open links that are not highlighted. | |
| 1904 | ||
| 1905 | In principle, it does not hurt to turn on highlighting for all | |
| 1906 | link types. There may be a small gain when turning off unused | |
| 1907 | link types. The types are: | |
| 1908 | ||
| 1909 | bracket The recommended [[link][description]] or [[link]] links with hiding. | |
| 1910 | angle Links in angular brackets that may contain whitespace like | |
| 1911 | <bbdb:Carsten Dominik>. | |
| 1912 | plain Plain links in normal text, no whitespace, like http://google.com. | |
| 1913 | radio Text that is matched by a radio target, see manual for details. | |
| 1914 | tag Tag settings in a headline (link to tag search). | |
| 1915 | date Time stamps (link to calendar). | |
| 1916 | footnote Footnote labels. | |
| 1917 | ||
| 1918 | If you set this variable during an Emacs session, use `org-mode-restart' | |
| 1919 | in the Org buffer so that the change takes effect." | |
| 1920 | :group 'org-link | |
| 1921 | :group 'org-appearance | |
| 1922 | :type '(set :greedy t | |
| 1923 | (const :tag "Double bracket links" bracket) | |
| 1924 | (const :tag "Angular bracket links" angle) | |
| 1925 | (const :tag "Plain text links" plain) | |
| 1926 | (const :tag "Radio target matches" radio) | |
| 1927 | (const :tag "Tags" tag) | |
| 1928 | (const :tag "Timestamps" date) | |
| 1929 | (const :tag "Footnotes" footnote))) | |
| 1930 | ||
| 1931 | (defcustom org-make-link-description-function nil | |
| 1932 | "Function to use for generating link descriptions from links. | |
| 1933 | This function must take two parameters: the first one is the | |
| 1934 | link, the second one is the description generated by | |
| 1935 | `org-insert-link'. The function should return the description to | |
| 1936 | use." | |
| 1937 | :group 'org-link | |
| 1938 | :type '(choice (const nil) (function))) | |
| 1939 | ||
| 1940 | (defgroup org-link-store nil | |
| 1941 | "Options concerning storing links in Org mode." | |
| 1942 | :tag "Org Store Link" | |
| 1943 | :group 'org-link) | |
| 1944 | ||
| 1945 | (defcustom org-url-hexify-p t | |
| 1946 | "When non-nil, hexify URL when creating a link." | |
| 1947 | :type 'boolean | |
| 1948 | :version "24.3" | |
| 1949 | :group 'org-link-store) | |
| 1950 | ||
| 1951 | (defcustom org-email-link-description-format "Email %c: %.30s" | |
| 1952 | "Format of the description part of a link to an email or usenet message. | |
| 1953 | The following %-escapes will be replaced by corresponding information: | |
| 1954 | ||
| 1955 | %F full \"From\" field | |
| 1956 | %f name, taken from \"From\" field, address if no name | |
| 1957 | %T full \"To\" field | |
| 1958 | %t first name in \"To\" field, address if no name | |
| 1959 | %c correspondent. Usually \"from NAME\", but if you sent it yourself, it | |
| 1960 | will be \"to NAME\". See also the variable `org-from-is-user-regexp'. | |
| 1961 | %s subject | |
| 1962 | %d date | |
| 1963 | %m message-id. | |
| 1964 | ||
| 1965 | You may use normal field width specification between the % and the letter. | |
| 1966 | This is for example useful to limit the length of the subject. | |
| 1967 | ||
| 1968 | Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" | |
| 1969 | :group 'org-link-store | |
| 1970 | :type 'string) | |
| 1971 | ||
| 1972 | (defcustom org-from-is-user-regexp | |
| 1973 | (let (r1 r2) | |
| 1974 | (when (and user-mail-address (not (string= user-mail-address ""))) | |
| 1975 | (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>"))) | |
| 1976 | (when (and user-full-name (not (string= user-full-name ""))) | |
| 1977 | (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>"))) | |
| 1978 | (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2))) | |
| 1979 | "Regexp matched against the \"From:\" header of an email or usenet message. | |
| 1980 | It should match if the message is from the user him/herself." | |
| 1981 | :group 'org-link-store | |
| 1982 | :type 'regexp) | |
| 1983 | ||
| 1984 | (defcustom org-context-in-file-links t | |
| 1985 | "Non-nil means file links from `org-store-link' contain context. | |
| 1986 | \\<org-mode-map> | |
| 1987 | A search string will be added to the file name with :: as separator | |
| 1988 | and used to find the context when the link is activated by the command | |
| 1989 | `org-open-at-point'. When this option is t, the entire active region | |
| 1990 | will be placed in the search string of the file link. If set to a | |
| 1991 | positive integer, only the first n lines of context will be stored. | |
| 1992 | ||
| 1993 | Using a prefix arg to the command `org-store-link' (`\\[universal-argument] \ | |
| 1994 | \\[org-store-link]') | |
| 1995 | negates this setting for the duration of the command." | |
| 1996 | :group 'org-link-store | |
| 1997 | :type '(choice boolean integer)) | |
| 1998 | ||
| 1999 | (defcustom org-keep-stored-link-after-insertion nil | |
| 2000 | "Non-nil means keep link in list for entire session. | |
| 2001 | \\<org-mode-map> | |
| 2002 | The command `org-store-link' adds a link pointing to the current | |
| 2003 | location to an internal list. These links accumulate during a session. | |
| 2004 | The command `org-insert-link' can be used to insert links into any | |
| 2005 | Org file (offering completion for all stored links). | |
| 2006 | ||
| 2007 | When this option is nil, every link which has been inserted once using | |
| 2008 | `\\[org-insert-link]' will be removed from the list, to make completing the \ | |
| 2009 | unused | |
| 2010 | links more efficient." | |
| 2011 | :group 'org-link-store | |
| 2012 | :type 'boolean) | |
| 2013 | ||
| 2014 | (defgroup org-link-follow nil | |
| 2015 | "Options concerning following links in Org mode." | |
| 2016 | :tag "Org Follow Link" | |
| 2017 | :group 'org-link) | |
| 2018 | ||
| 2019 | (defcustom org-link-translation-function nil | |
| 2020 | "Function to translate links with different syntax to Org syntax. | |
| 2021 | This can be used to translate links created for example by the Planner | |
| 2022 | or emacs-wiki packages to Org syntax. | |
| 2023 | The function must accept two parameters, a TYPE containing the link | |
| 2024 | protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, | |
| 2025 | which is everything after the link protocol. It should return a cons | |
| 2026 | with possibly modified values of type and path. | |
| 2027 | Org contains a function for this, so if you set this variable to | |
| 2028 | `org-translate-link-from-planner', you should be able follow many | |
| 2029 | links created by planner." | |
| 2030 | :group 'org-link-follow | |
| 2031 | :type '(choice (const nil) (function))) | |
| 2032 | ||
| 2033 | (defcustom org-follow-link-hook nil | |
| 2034 | "Hook that is run after a link has been followed." | |
| 2035 | :group 'org-link-follow | |
| 2036 | :type 'hook) | |
| 2037 | ||
| 2038 | (defcustom org-tab-follows-link nil | |
| 2039 | "Non-nil means on links TAB will follow the link. | |
| 2040 | Needs to be set before org.el is loaded. | |
| 2041 | This really should not be used, it does not make sense, and the | |
| 2042 | implementation is bad." | |
| 2043 | :group 'org-link-follow | |
| 2044 | :type 'boolean) | |
| 2045 | ||
| 2046 | (defcustom org-return-follows-link nil | |
| 2047 | "Non-nil means on links RET will follow the link. | |
| 2048 | In tables, the special behavior of RET has precedence." | |
| 2049 | :group 'org-link-follow | |
| 2050 | :type 'boolean) | |
| 2051 | ||
| 2052 | (defcustom org-mouse-1-follows-link | |
| 2053 | (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) | |
| 2054 | "Non-nil means mouse-1 on a link will follow the link. | |
| 2055 | A longer mouse click will still set point. Needs to be set | |
| 2056 | before org.el is loaded." | |
| 2057 | :group 'org-link-follow | |
| 2058 | :version "26.1" | |
| 2059 | :package-version '(Org . "8.3") | |
| 2060 | :type '(choice | |
| 2061 | (const :tag "A double click follows the link" double) | |
| 2062 | (const :tag "Unconditionally follow the link with mouse-1" t) | |
| 2063 | (integer :tag "mouse-1 click does not follow the link if longer than N ms" 450))) | |
| 2064 | ||
| 2065 | (defcustom org-mark-ring-length 4 | |
| 2066 | "Number of different positions to be recorded in the ring. | |
| 2067 | Changing this requires a restart of Emacs to work correctly." | |
| 2068 | :group 'org-link-follow | |
| 2069 | :type 'integer) | |
| 2070 | ||
| 2071 | (defcustom org-link-search-must-match-exact-headline 'query-to-create | |
| 2072 | "Non-nil means internal fuzzy links can only match headlines. | |
| 2073 | ||
| 2074 | When nil, the a fuzzy link may point to a target or a named | |
| 2075 | construct in the document. When set to the special value | |
| 2076 | `query-to-create', offer to create a new headline when none | |
| 2077 | matched. | |
| 2078 | ||
| 2079 | Spaces and statistics cookies are ignored during heading searches." | |
| 2080 | :group 'org-link-follow | |
| 2081 | :version "24.1" | |
| 2082 | :type '(choice | |
| 2083 | (const :tag "Use fuzzy text search" nil) | |
| 2084 | (const :tag "Match only exact headline" t) | |
| 2085 | (const :tag "Match exact headline or query to create it" | |
| 2086 | query-to-create)) | |
| 2087 | :safe #'symbolp) | |
| 2088 | ||
| 2089 | (defcustom org-link-frame-setup | |
| 2090 | '((vm . vm-visit-folder-other-frame) | |
| 2091 | (vm-imap . vm-visit-imap-folder-other-frame) | |
| 2092 | (gnus . org-gnus-no-new-news) | |
| 2093 | (file . find-file-other-window) | |
| 2094 | (wl . wl-other-frame)) | |
| 2095 | "Setup the frame configuration for following links. | |
| 2096 | When following a link with Emacs, it may often be useful to display | |
| 2097 | this link in another window or frame. This variable can be used to | |
| 2098 | set this up for the different types of links. | |
| 2099 | For VM, use any of | |
| 2100 | `vm-visit-folder' | |
| 2101 | `vm-visit-folder-other-window' | |
| 2102 | `vm-visit-folder-other-frame' | |
| 2103 | For Gnus, use any of | |
| 2104 | `gnus' | |
| 2105 | `gnus-other-frame' | |
| 2106 | `org-gnus-no-new-news' | |
| 2107 | For FILE, use any of | |
| 2108 | `find-file' | |
| 2109 | `find-file-other-window' | |
| 2110 | `find-file-other-frame' | |
| 2111 | For Wanderlust use any of | |
| 2112 | `wl' | |
| 2113 | `wl-other-frame' | |
| 2114 | For the calendar, use the variable `calendar-setup'. | |
| 2115 | For BBDB, it is currently only possible to display the matches in | |
| 2116 | another window." | |
| 2117 | :group 'org-link-follow | |
| 2118 | :type '(list | |
| 2119 | (cons (const vm) | |
| 2120 | (choice | |
| 2121 | (const vm-visit-folder) | |
| 2122 | (const vm-visit-folder-other-window) | |
| 2123 | (const vm-visit-folder-other-frame))) | |
| 2124 | (cons (const vm-imap) | |
| 2125 | (choice | |
| 2126 | (const vm-visit-imap-folder) | |
| 2127 | (const vm-visit-imap-folder-other-window) | |
| 2128 | (const vm-visit-imap-folder-other-frame))) | |
| 2129 | (cons (const gnus) | |
| 2130 | (choice | |
| 2131 | (const gnus) | |
| 2132 | (const gnus-other-frame) | |
| 2133 | (const org-gnus-no-new-news))) | |
| 2134 | (cons (const file) | |
| 2135 | (choice | |
| 2136 | (const find-file) | |
| 2137 | (const find-file-other-window) | |
| 2138 | (const find-file-other-frame))) | |
| 2139 | (cons (const wl) | |
| 2140 | (choice | |
| 2141 | (const wl) | |
| 2142 | (const wl-other-frame))))) | |
| 2143 | ||
| 2144 | (defcustom org-display-internal-link-with-indirect-buffer nil | |
| 2145 | "Non-nil means use indirect buffer to display infile links. | |
| 2146 | Activating internal links (from one location in a file to another location | |
| 2147 | in the same file) normally just jumps to the location. When the link is | |
| 2148 | activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \ | |
| 2149 | is displayed in | |
| 2150 | another window. When this option is set, the other window actually displays | |
| 2151 | an indirect buffer clone of the current buffer, to avoid any visibility | |
| 2152 | changes to the current buffer." | |
| 2153 | :group 'org-link-follow | |
| 2154 | :type 'boolean) | |
| 2155 | ||
| 2156 | (defcustom org-open-non-existing-files nil | |
| 2157 | "Non-nil means `org-open-file' will open non-existing files. | |
| 2158 | When nil, an error will be generated. | |
| 2159 | This variable applies only to external applications because they | |
| 2160 | might choke on non-existing files. If the link is to a file that | |
| 2161 | will be opened in Emacs, the variable is ignored." | |
| 2162 | :group 'org-link-follow | |
| 2163 | :type 'boolean) | |
| 2164 | ||
| 2165 | (defcustom org-open-directory-means-index-dot-org nil | |
| 2166 | "Non-nil means a link to a directory really means to index.org. | |
| 2167 | When nil, following a directory link will run dired or open a finder/explorer | |
| 2168 | window on that directory." | |
| 2169 | :group 'org-link-follow | |
| 2170 | :type 'boolean) | |
| 2171 | ||
| 2172 | (defcustom org-confirm-shell-link-function 'yes-or-no-p | |
| 2173 | "Non-nil means ask for confirmation before executing shell links. | |
| 2174 | Shell links can be dangerous: just think about a link | |
| 2175 | ||
| 2176 | [[shell:rm -rf ~/*][Google Search]] | |
| 2177 | ||
| 2178 | This link would show up in your Org document as \"Google Search\", | |
| 2179 | but really it would remove your entire home directory. | |
| 2180 | Therefore we advise against setting this variable to nil. | |
| 2181 | Just change it to `y-or-n-p' if you want to confirm with a | |
| 2182 | single keystroke rather than having to type \"yes\"." | |
| 2183 | :group 'org-link-follow | |
| 2184 | :type '(choice | |
| 2185 | (const :tag "with yes-or-no (safer)" yes-or-no-p) | |
| 2186 | (const :tag "with y-or-n (faster)" y-or-n-p) | |
| 2187 | (const :tag "no confirmation (dangerous)" nil))) | |
| 2188 | (put 'org-confirm-shell-link-function | |
| 2189 | 'safe-local-variable | |
| 2190 | (lambda (x) (member x '(yes-or-no-p y-or-n-p)))) | |
| 2191 | ||
| 2192 | (defcustom org-confirm-shell-link-not-regexp "" | |
| 2193 | "A regexp to skip confirmation for shell links." | |
| 2194 | :group 'org-link-follow | |
| 2195 | :version "24.1" | |
| 2196 | :type 'regexp) | |
| 2197 | ||
| 2198 | (defcustom org-confirm-elisp-link-function 'yes-or-no-p | |
| 2199 | "Non-nil means ask for confirmation before executing Emacs Lisp links. | |
| 2200 | Elisp links can be dangerous: just think about a link | |
| 2201 | ||
| 2202 | [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] | |
| 2203 | ||
| 2204 | This link would show up in your Org document as \"Google Search\", | |
| 2205 | but really it would remove your entire home directory. | |
| 2206 | Therefore we advise against setting this variable to nil. | |
| 2207 | Just change it to `y-or-n-p' if you want to confirm with a | |
| 2208 | single keystroke rather than having to type \"yes\"." | |
| 2209 | :group 'org-link-follow | |
| 2210 | :type '(choice | |
| 2211 | (const :tag "with yes-or-no (safer)" yes-or-no-p) | |
| 2212 | (const :tag "with y-or-n (faster)" y-or-n-p) | |
| 2213 | (const :tag "no confirmation (dangerous)" nil))) | |
| 2214 | (put 'org-confirm-shell-link-function | |
| 2215 | 'safe-local-variable | |
| 2216 | (lambda (x) (member x '(yes-or-no-p y-or-n-p)))) | |
| 2217 | ||
| 2218 | (defcustom org-confirm-elisp-link-not-regexp "" | |
| 2219 | "A regexp to skip confirmation for Elisp links." | |
| 2220 | :group 'org-link-follow | |
| 2221 | :version "24.1" | |
| 2222 | :type 'regexp) | |
| 2223 | ||
| 2224 | (defconst org-file-apps-defaults-gnu | |
| 2225 | '((remote . emacs) | |
| 2226 | (system . mailcap) | |
| 2227 | (t . mailcap)) | |
| 2228 | "Default file applications on a UNIX or GNU/Linux system. | |
| 2229 | See `org-file-apps'.") | |
| 2230 | ||
| 2231 | (defconst org-file-apps-defaults-macosx | |
| 2232 | '((remote . emacs) | |
| 2233 | (system . "open %s") | |
| 2234 | ("ps.gz" . "gv %s") | |
| 2235 | ("eps.gz" . "gv %s") | |
| 2236 | ("dvi" . "xdvi %s") | |
| 2237 | ("fig" . "xfig %s") | |
| 2238 | (t . "open %s")) | |
| 2239 | "Default file applications on a macOS system. | |
| 2240 | The system \"open\" is known as a default, but we use X11 applications | |
| 2241 | for some files for which the OS does not have a good default. | |
| 2242 | See `org-file-apps'.") | |
| 2243 | ||
| 2244 | (defconst org-file-apps-defaults-windowsnt | |
| 2245 | (list '(remote . emacs) | |
| 2246 | (cons 'system (lambda (file _path) | |
| 2247 | (with-no-warnings (w32-shell-execute "open" file)))) | |
| 2248 | (cons t (lambda (file _path) | |
| 2249 | (with-no-warnings (w32-shell-execute "open" file))))) | |
| 2250 | "Default file applications on a Windows NT system. | |
| 2251 | The system \"open\" is used for most files. | |
| 2252 | See `org-file-apps'.") | |
| 2253 | ||
| 2254 | (defcustom org-file-apps | |
| 2255 | '((auto-mode . emacs) | |
| 2256 | ("\\.mm\\'" . default) | |
| 2257 | ("\\.x?html?\\'" . default) | |
| 2258 | ("\\.pdf\\'" . default)) | |
| 2259 | "External applications for opening `file:path' items in a document. | |
| 2260 | \\<org-mode-map>\ | |
| 2261 | ||
| 2262 | Org mode uses system defaults for different file types, but | |
| 2263 | you can use this variable to set the application for a given file | |
| 2264 | extension. The entries in this list are cons cells where the car identifies | |
| 2265 | files and the cdr the corresponding command. | |
| 2266 | ||
| 2267 | Possible values for the file identifier are: | |
| 2268 | ||
| 2269 | \"string\" A string as a file identifier can be interpreted in different | |
| 2270 | ways, depending on its contents: | |
| 2271 | ||
| 2272 | - Alphanumeric characters only: | |
| 2273 | Match links with this file extension. | |
| 2274 | Example: (\"pdf\" . \"evince %s\") | |
| 2275 | to open PDFs with evince. | |
| 2276 | ||
| 2277 | - Regular expression: Match links where the | |
| 2278 | filename matches the regexp. If you want to | |
| 2279 | use groups here, use shy groups. | |
| 2280 | ||
| 2281 | Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\") | |
| 2282 | (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\") | |
| 2283 | to open *.html and *.xhtml with firefox. | |
| 2284 | ||
| 2285 | - Regular expression which contains (non-shy) groups: | |
| 2286 | Match links where the whole link, including \"::\", and | |
| 2287 | anything after that, matches the regexp. | |
| 2288 | In a custom command string, %1, %2, etc. are replaced with | |
| 2289 | the parts of the link that were matched by the groups. | |
| 2290 | For backwards compatibility, if a command string is given | |
| 2291 | that does not use any of the group matches, this case is | |
| 2292 | handled identically to the second one (i.e. match against | |
| 2293 | file name only). | |
| 2294 | In a custom function, you can access the group matches with | |
| 2295 | (match-string n link). | |
| 2296 | ||
| 2297 | Example: (\"\\\\.pdf::\\\\([0-9]+\\\\)\\\\\\='\" . \ | |
| 2298 | \"evince -p %1 %s\") | |
| 2299 | to open [[file:document.pdf::5]] with evince at page 5. | |
| 2300 | ||
| 2301 | `directory' Matches a directory | |
| 2302 | `remote' Matches a remote file, accessible through tramp or efs. | |
| 2303 | Remote files most likely should be visited through Emacs | |
| 2304 | because external applications cannot handle such paths. | |
| 2305 | `auto-mode' Matches files that are matched by any entry in `auto-mode-alist', | |
| 2306 | so all files Emacs knows how to handle. Using this with | |
| 2307 | command `emacs' will open most files in Emacs. Beware that this | |
| 2308 | will also open html files inside Emacs, unless you add | |
| 2309 | (\"html\" . default) to the list as well. | |
| 2310 | `system' The system command to open files, like `open' on Windows | |
| 2311 | and macOS, and mailcap under GNU/Linux. This is the command | |
| 2312 | that will be selected if you call `org-open-at-point' with a | |
| 2313 | double prefix argument (`\\[universal-argument] \ | |
| 2314 | \\[universal-argument] \\[org-open-at-point]'). | |
| 2315 | t Default for files not matched by any of the other options. | |
| 2316 | ||
| 2317 | Possible values for the command are: | |
| 2318 | ||
| 2319 | `emacs' The file will be visited by the current Emacs process. | |
| 2320 | `default' Use the default application for this file type, which is the | |
| 2321 | association for t in the list, most likely in the system-specific | |
| 2322 | part. This can be used to overrule an unwanted setting in the | |
| 2323 | system-specific variable. | |
| 2324 | `system' Use the system command for opening files, like \"open\". | |
| 2325 | This command is specified by the entry whose car is `system'. | |
| 2326 | Most likely, the system-specific version of this variable | |
| 2327 | does define this command, but you can overrule/replace it | |
| 2328 | here. | |
| 2329 | `mailcap' Use command specified in the mailcaps. | |
| 2330 | string A command to be executed by a shell; %s will be replaced | |
| 2331 | by the path to the file. | |
| 2332 | function A Lisp function, which will be called with two arguments: | |
| 2333 | the file path and the original link string, without the | |
| 2334 | \"file:\" prefix. | |
| 2335 | ||
| 2336 | For more examples, see the system specific constants | |
| 2337 | `org-file-apps-defaults-macosx' | |
| 2338 | `org-file-apps-defaults-windowsnt' | |
| 2339 | `org-file-apps-defaults-gnu'." | |
| 2340 | :group 'org-link-follow | |
| 2341 | :type '(repeat | |
| 2342 | (cons (choice :value "" | |
| 2343 | (string :tag "Extension") | |
| 2344 | (const :tag "System command to open files" system) | |
| 2345 | (const :tag "Default for unrecognized files" t) | |
| 2346 | (const :tag "Remote file" remote) | |
| 2347 | (const :tag "Links to a directory" directory) | |
| 2348 | (const :tag "Any files that have Emacs modes" | |
| 2349 | auto-mode)) | |
| 2350 | (choice :value "" | |
| 2351 | (const :tag "Visit with Emacs" emacs) | |
| 2352 | (const :tag "Use default" default) | |
| 2353 | (const :tag "Use the system command" system) | |
| 2354 | (string :tag "Command") | |
| 2355 | (function :tag "Function"))))) | |
| 2356 | ||
| 2357 | (defcustom org-doi-server-url "http://dx.doi.org/" | |
| 2358 | "The URL of the DOI server." | |
| 2359 | :type 'string | |
| 2360 | :version "24.3" | |
| 2361 | :group 'org-link-follow) | |
| 2362 | ||
| 2363 | (defgroup org-refile nil | |
| 2364 | "Options concerning refiling entries in Org mode." | |
| 2365 | :tag "Org Refile" | |
| 2366 | :group 'org) | |
| 2367 | ||
| 2368 | (defcustom org-directory "~/org" | |
| 2369 | "Directory with Org files. | |
| 2370 | This is just a default location to look for Org files. There is no need | |
| 2371 | at all to put your files into this directory. It is used in the | |
| 2372 | following situations: | |
| 2373 | ||
| 2374 | 1. When a capture template specifies a target file that is not an | |
| 2375 | absolute path. The path will then be interpreted relative to | |
| 2376 | `org-directory' | |
| 2377 | 2. When the value of variable `org-agenda-files' is a single file, any | |
| 2378 | relative paths in this file will be taken as relative to | |
| 2379 | `org-directory'." | |
| 2380 | :group 'org-refile | |
| 2381 | :group 'org-capture | |
| 2382 | :type 'directory) | |
| 2383 | ||
| 2384 | (defcustom org-default-notes-file (convert-standard-filename "~/.notes") | |
| 2385 | "Default target for storing notes. | |
| 2386 | Used as a fall back file for org-capture.el, for templates that | |
| 2387 | do not specify a target file." | |
| 2388 | :group 'org-refile | |
| 2389 | :group 'org-capture | |
| 2390 | :type 'file) | |
| 2391 | ||
| 2392 | (defcustom org-goto-interface 'outline | |
| 2393 | "The default interface to be used for `org-goto'. | |
| 2394 | Allowed values are: | |
| 2395 | outline The interface shows an outline of the relevant file | |
| 2396 | and the correct heading is found by moving through | |
| 2397 | the outline or by searching with incremental search. | |
| 2398 | outline-path-completion Headlines in the current buffer are offered via | |
| 2399 | completion. This is the interface also used by | |
| 2400 | the refile command." | |
| 2401 | :group 'org-refile | |
| 2402 | :type '(choice | |
| 2403 | (const :tag "Outline" outline) | |
| 2404 | (const :tag "Outline-path-completion" outline-path-completion))) | |
| 2405 | ||
| 2406 | (defcustom org-goto-max-level 5 | |
| 2407 | "Maximum target level when running `org-goto' with refile interface." | |
| 2408 | :group 'org-refile | |
| 2409 | :type 'integer) | |
| 2410 | ||
| 2411 | (defcustom org-reverse-note-order nil | |
| 2412 | "Non-nil means store new notes at the beginning of a file or entry. | |
| 2413 | When nil, new notes will be filed to the end of a file or entry. | |
| 2414 | This can also be a list with cons cells of regular expressions that | |
| 2415 | are matched against file names, and values." | |
| 2416 | :group 'org-capture | |
| 2417 | :group 'org-refile | |
| 2418 | :type '(choice | |
| 2419 | (const :tag "Reverse always" t) | |
| 2420 | (const :tag "Reverse never" nil) | |
| 2421 | (repeat :tag "By file name regexp" | |
| 2422 | (cons regexp boolean)))) | |
| 2423 | ||
| 2424 | (defcustom org-log-refile nil | |
| 2425 | "Information to record when a task is refiled. | |
| 2426 | ||
| 2427 | Possible values are: | |
| 2428 | ||
| 2429 | nil Don't add anything | |
| 2430 | time Add a time stamp to the task | |
| 2431 | note Prompt for a note and add it with template `org-log-note-headings' | |
| 2432 | ||
| 2433 | This option can also be set with on a per-file-basis with | |
| 2434 | ||
| 2435 | #+STARTUP: nologrefile | |
| 2436 | #+STARTUP: logrefile | |
| 2437 | #+STARTUP: lognoterefile | |
| 2438 | ||
| 2439 | You can have local logging settings for a subtree by setting the LOGGING | |
| 2440 | property to one or more of these keywords. | |
| 2441 | ||
| 2442 | When bulk-refiling from the agenda, the value `note' is forbidden and | |
| 2443 | will temporarily be changed to `time'." | |
| 2444 | :group 'org-refile | |
| 2445 | :group 'org-progress | |
| 2446 | :version "24.1" | |
| 2447 | :type '(choice | |
| 2448 | (const :tag "No logging" nil) | |
| 2449 | (const :tag "Record timestamp" time) | |
| 2450 | (const :tag "Record timestamp with note." note))) | |
| 2451 | ||
| 2452 | (defcustom org-refile-targets nil | |
| 2453 | "Targets for refiling entries with `\\[org-refile]'. | |
| 2454 | This is a list of cons cells. Each cell contains: | |
| 2455 | - a specification of the files to be considered, either a list of files, | |
| 2456 | or a symbol whose function or variable value will be used to retrieve | |
| 2457 | a file name or a list of file names. If you use `org-agenda-files' for | |
| 2458 | that, all agenda files will be scanned for targets. Nil means consider | |
| 2459 | headings in the current buffer. | |
| 2460 | - A specification of how to find candidate refile targets. This may be | |
| 2461 | any of: | |
| 2462 | - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. | |
| 2463 | This tag has to be present in all target headlines, inheritance will | |
| 2464 | not be considered. | |
| 2465 | - a cons cell (:todo . \"KEYWORD\") to identify refile targets by | |
| 2466 | todo keyword. | |
| 2467 | - a cons cell (:regexp . \"REGEXP\") with a regular expression matching | |
| 2468 | headlines that are refiling targets. | |
| 2469 | - a cons cell (:level . N). Any headline of level N is considered a target. | |
| 2470 | Note that, when `org-odd-levels-only' is set, level corresponds to | |
| 2471 | order in hierarchy, not to the number of stars. | |
| 2472 | - a cons cell (:maxlevel . N). Any headline with level <= N is a target. | |
| 2473 | Note that, when `org-odd-levels-only' is set, level corresponds to | |
| 2474 | order in hierarchy, not to the number of stars. | |
| 2475 | ||
| 2476 | Each element of this list generates a set of possible targets. | |
| 2477 | The union of these sets is presented (with completion) to | |
| 2478 | the user by `org-refile'. | |
| 2479 | ||
| 2480 | You can set the variable `org-refile-target-verify-function' to a function | |
| 2481 | to verify each headline found by the simple criteria above. | |
| 2482 | ||
| 2483 | When this variable is nil, all top-level headlines in the current buffer | |
| 2484 | are used, equivalent to the value `((nil . (:level . 1))'." | |
| 2485 | :group 'org-refile | |
| 2486 | :type '(repeat | |
| 2487 | (cons | |
| 2488 | (choice :value org-agenda-files | |
| 2489 | (const :tag "All agenda files" org-agenda-files) | |
| 2490 | (const :tag "Current buffer" nil) | |
| 2491 | (function) (variable) (file)) | |
| 2492 | (choice :tag "Identify target headline by" | |
| 2493 | (cons :tag "Specific tag" (const :value :tag) (string)) | |
| 2494 | (cons :tag "TODO keyword" (const :value :todo) (string)) | |
| 2495 | (cons :tag "Regular expression" (const :value :regexp) (regexp)) | |
| 2496 | (cons :tag "Level number" (const :value :level) (integer)) | |
| 2497 | (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) | |
| 2498 | ||
| 2499 | (defcustom org-refile-target-verify-function nil | |
| 2500 | "Function to verify if the headline at point should be a refile target. | |
| 2501 | The function will be called without arguments, with point at the | |
| 2502 | beginning of the headline. It should return t and leave point | |
| 2503 | where it is if the headline is a valid target for refiling. | |
| 2504 | ||
| 2505 | If the target should not be selected, the function must return nil. | |
| 2506 | In addition to this, it may move point to a place from where the search | |
| 2507 | should be continued. For example, the function may decide that the entire | |
| 2508 | subtree of the current entry should be excluded and move point to the end | |
| 2509 | of the subtree." | |
| 2510 | :group 'org-refile | |
| 2511 | :type '(choice | |
| 2512 | (const nil) | |
| 2513 | (function))) | |
| 2514 | ||
| 2515 | (defcustom org-refile-use-cache nil | |
| 2516 | "Non-nil means cache refile targets to speed up the process. | |
| 2517 | \\<org-mode-map>\ | |
| 2518 | The cache for a particular file will be updated automatically when | |
| 2519 | the buffer has been killed, or when any of the marker used for flagging | |
| 2520 | refile targets no longer points at a live buffer. | |
| 2521 | If you have added new entries to a buffer that might themselves be targets, | |
| 2522 | you need to clear the cache manually by pressing `C-0 \\[org-refile]' or, | |
| 2523 | if you find that easier, \ | |
| 2524 | `\\[universal-argument] \\[universal-argument] \\[universal-argument] \ | |
| 2525 | \\[org-refile]'." | |
| 2526 | :group 'org-refile | |
| 2527 | :version "24.1" | |
| 2528 | :type 'boolean) | |
| 2529 | ||
| 2530 | (defcustom org-refile-use-outline-path nil | |
| 2531 | "Non-nil means provide refile targets as paths. | |
| 2532 | So a level 3 headline will be available as level1/level2/level3. | |
| 2533 | ||
| 2534 | When the value is `file', also include the file name (without directory) | |
| 2535 | into the path. In this case, you can also stop the completion after | |
| 2536 | the file name, to get entries inserted as top level in the file. | |
| 2537 | ||
| 2538 | When `full-file-path', include the full file path. | |
| 2539 | ||
| 2540 | When `buffer-name', use the buffer name." | |
| 2541 | :group 'org-refile | |
| 2542 | :type '(choice | |
| 2543 | (const :tag "Not" nil) | |
| 2544 | (const :tag "Yes" t) | |
| 2545 | (const :tag "Start with file name" file) | |
| 2546 | (const :tag "Start with full file path" full-file-path) | |
| 2547 | (const :tag "Start with buffer name" buffer-name))) | |
| 2548 | ||
| 2549 | (defcustom org-outline-path-complete-in-steps t | |
| 2550 | "Non-nil means complete the outline path in hierarchical steps. | |
| 2551 | When Org uses the refile interface to select an outline path (see | |
| 2552 | `org-refile-use-outline-path'), the completion of the path can be | |
| 2553 | done in a single go, or it can be done in steps down the headline | |
| 2554 | hierarchy. Going in steps is probably the best if you do not use | |
| 2555 | a special completion package like `ido' or `icicles'. However, | |
| 2556 | when using these packages, going in one step can be very fast, | |
| 2557 | while still showing the whole path to the entry." | |
| 2558 | :group 'org-refile | |
| 2559 | :type 'boolean) | |
| 2560 | ||
| 2561 | (defcustom org-refile-allow-creating-parent-nodes nil | |
| 2562 | "Non-nil means allow the creation of new nodes as refile targets. | |
| 2563 | New nodes are then created by adding \"/new node name\" to the completion | |
| 2564 | of an existing node. When the value of this variable is `confirm', | |
| 2565 | new node creation must be confirmed by the user (recommended). | |
| 2566 | When nil, the completion must match an existing entry. | |
| 2567 | ||
| 2568 | Note that, if the new heading is not seen by the criteria | |
| 2569 | listed in `org-refile-targets', multiple instances of the same | |
| 2570 | heading would be created by trying again to file under the new | |
| 2571 | heading." | |
| 2572 | :group 'org-refile | |
| 2573 | :type '(choice | |
| 2574 | (const :tag "Never" nil) | |
| 2575 | (const :tag "Always" t) | |
| 2576 | (const :tag "Prompt for confirmation" confirm))) | |
| 2577 | ||
| 2578 | (defcustom org-refile-active-region-within-subtree nil | |
| 2579 | "Non-nil means also refile active region within a subtree. | |
| 2580 | ||
| 2581 | By default `org-refile' doesn't allow refiling regions if they | |
| 2582 | don't contain a set of subtrees, but it might be convenient to | |
| 2583 | do so sometimes: in that case, the first line of the region is | |
| 2584 | converted to a headline before refiling." | |
| 2585 | :group 'org-refile | |
| 2586 | :version "24.1" | |
| 2587 | :type 'boolean) | |
| 2588 | ||
| 2589 | (defgroup org-todo nil | |
| 2590 | "Options concerning TODO items in Org mode." | |
| 2591 | :tag "Org TODO" | |
| 2592 | :group 'org) | |
| 2593 | ||
| 2594 | (defgroup org-progress nil | |
| 2595 | "Options concerning Progress logging in Org mode." | |
| 2596 | :tag "Org Progress" | |
| 2597 | :group 'org-time) | |
| 2598 | ||
| 2599 | (defvar org-todo-interpretation-widgets | |
| 2600 | '((:tag "Sequence (cycling hits every state)" sequence) | |
| 2601 | (:tag "Type (cycling directly to DONE)" type)) | |
| 2602 | "The available interpretation symbols for customizing `org-todo-keywords'. | |
| 2603 | Interested libraries should add to this list.") | |
| 2604 | ||
| 2605 | (defcustom org-todo-keywords '((sequence "TODO" "DONE")) | |
| 2606 | "List of TODO entry keyword sequences and their interpretation. | |
| 2607 | \\<org-mode-map>This is a list of sequences. | |
| 2608 | ||
| 2609 | Each sequence starts with a symbol, either `sequence' or `type', | |
| 2610 | indicating if the keywords should be interpreted as a sequence of | |
| 2611 | action steps, or as different types of TODO items. The first | |
| 2612 | keywords are states requiring action - these states will select a headline | |
| 2613 | for inclusion into the global TODO list Org produces. If one of the | |
| 2614 | \"keywords\" is the vertical bar, \"|\", the remaining keywords | |
| 2615 | signify that no further action is necessary. If \"|\" is not found, | |
| 2616 | the last keyword is treated as the only DONE state of the sequence. | |
| 2617 | ||
| 2618 | The command `\\[org-todo]' cycles an entry through these states, and one | |
| 2619 | additional state where no keyword is present. For details about this | |
| 2620 | cycling, see the manual. | |
| 2621 | ||
| 2622 | TODO keywords and interpretation can also be set on a per-file basis with | |
| 2623 | the special #+SEQ_TODO and #+TYP_TODO lines. | |
| 2624 | ||
| 2625 | Each keyword can optionally specify a character for fast state selection | |
| 2626 | \(in combination with the variable `org-use-fast-todo-selection') | |
| 2627 | and specifiers for state change logging, using the same syntax that | |
| 2628 | is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that | |
| 2629 | the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" | |
| 2630 | indicates to record a time stamp each time this state is selected. | |
| 2631 | ||
| 2632 | Each keyword may also specify if a timestamp or a note should be | |
| 2633 | recorded when entering or leaving the state, by adding additional | |
| 2634 | characters in the parenthesis after the keyword. This looks like this: | |
| 2635 | \"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to | |
| 2636 | record only the time of the state change. With X and Y being either | |
| 2637 | \"@\" or \"!\", \"X/Y\" means use X when entering the state, and use | |
| 2638 | Y when leaving the state if and only if the *target* state does not | |
| 2639 | define X. You may omit any of the fast-selection key or X or /Y, | |
| 2640 | so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid. | |
| 2641 | ||
| 2642 | For backward compatibility, this variable may also be just a list | |
| 2643 | of keywords. In this case the interpretation (sequence or type) will be | |
| 2644 | taken from the (otherwise obsolete) variable `org-todo-interpretation'." | |
| 2645 | :group 'org-todo | |
| 2646 | :group 'org-keywords | |
| 2647 | :type '(choice | |
| 2648 | (repeat :tag "Old syntax, just keywords" | |
| 2649 | (string :tag "Keyword")) | |
| 2650 | (repeat :tag "New syntax" | |
| 2651 | (cons | |
| 2652 | (choice | |
| 2653 | :tag "Interpretation" | |
| 2654 | ;;Quick and dirty way to see | |
| 2655 | ;;`org-todo-interpretations'. This takes the | |
| 2656 | ;;place of item arguments | |
| 2657 | :convert-widget | |
| 2658 | (lambda (widget) | |
| 2659 | (widget-put widget | |
| 2660 | :args (mapcar | |
| 2661 | (lambda (x) | |
| 2662 | (widget-convert | |
| 2663 | (cons 'const x))) | |
| 2664 | org-todo-interpretation-widgets)) | |
| 2665 | widget)) | |
| 2666 | (repeat | |
| 2667 | (string :tag "Keyword")))))) | |
| 2668 | ||
| 2669 | (defvar-local org-todo-keywords-1 nil | |
| 2670 | "All TODO and DONE keywords active in a buffer.") | |
| 2671 | (defvar org-todo-keywords-for-agenda nil) | |
| 2672 | (defvar org-done-keywords-for-agenda nil) | |
| 2673 | (defvar org-todo-keyword-alist-for-agenda nil) | |
| 2674 | (defvar org-tag-alist-for-agenda nil | |
| 2675 | "Alist of all tags from all agenda files.") | |
| 2676 | (defvar org-tag-groups-alist-for-agenda nil | |
| 2677 | "Alist of all groups tags from all current agenda files.") | |
| 2678 | (defvar-local org-tag-groups-alist nil) | |
| 2679 | (defvar org-agenda-contributing-files nil) | |
| 2680 | (defvar-local org-current-tag-alist nil | |
| 2681 | "Alist of all tag groups in current buffer. | |
| 2682 | This variable takes into consideration `org-tag-alist', | |
| 2683 | `org-tag-persistent-alist' and TAGS keywords in the buffer.") | |
| 2684 | (defvar-local org-not-done-keywords nil) | |
| 2685 | (defvar-local org-done-keywords nil) | |
| 2686 | (defvar-local org-todo-heads nil) | |
| 2687 | (defvar-local org-todo-sets nil) | |
| 2688 | (defvar-local org-todo-log-states nil) | |
| 2689 | (defvar-local org-todo-kwd-alist nil) | |
| 2690 | (defvar-local org-todo-key-alist nil) | |
| 2691 | (defvar-local org-todo-key-trigger nil) | |
| 2692 | ||
| 2693 | (defcustom org-todo-interpretation 'sequence | |
| 2694 | "Controls how TODO keywords are interpreted. | |
| 2695 | This variable is in principle obsolete and is only used for | |
| 2696 | backward compatibility, if the interpretation of todo keywords is | |
| 2697 | not given already in `org-todo-keywords'. See that variable for | |
| 2698 | more information." | |
| 2699 | :group 'org-todo | |
| 2700 | :group 'org-keywords | |
| 2701 | :type '(choice (const sequence) | |
| 2702 | (const type))) | |
| 2703 | ||
| 2704 | (defcustom org-use-fast-todo-selection t | |
| 2705 | "\\<org-mode-map>\ | |
| 2706 | Non-nil means use the fast todo selection scheme with `\\[org-todo]'. | |
| 2707 | This variable describes if and under what circumstances the cycling | |
| 2708 | mechanism for TODO keywords will be replaced by a single-key, direct | |
| 2709 | selection scheme. | |
| 2710 | ||
| 2711 | When nil, fast selection is never used. | |
| 2712 | ||
| 2713 | When the symbol `prefix', it will be used when `org-todo' is called | |
| 2714 | with a prefix argument, i.e. `\\[universal-argument] \\[org-todo]' \ | |
| 2715 | in an Org buffer, and | |
| 2716 | `\\[universal-argument] t' in an agenda buffer. | |
| 2717 | ||
| 2718 | When t, fast selection is used by default. In this case, the prefix | |
| 2719 | argument forces cycling instead. | |
| 2720 | ||
| 2721 | In all cases, the special interface is only used if access keys have | |
| 2722 | actually been assigned by the user, i.e. if keywords in the configuration | |
| 2723 | are followed by a letter in parenthesis, like TODO(t)." | |
| 2724 | :group 'org-todo | |
| 2725 | :type '(choice | |
| 2726 | (const :tag "Never" nil) | |
| 2727 | (const :tag "By default" t) | |
| 2728 | (const :tag "Only with C-u C-c C-t" prefix))) | |
| 2729 | ||
| 2730 | (defcustom org-provide-todo-statistics t | |
| 2731 | "Non-nil means update todo statistics after insert and toggle. | |
| 2732 | ALL-HEADLINES means update todo statistics by including headlines | |
| 2733 | with no TODO keyword as well, counting them as not done. | |
| 2734 | A list of TODO keywords means the same, but skip keywords that are | |
| 2735 | not in this list. | |
| 2736 | When set to a list of two lists, the first list contains keywords | |
| 2737 | to consider as TODO keywords, the second list contains keywords | |
| 2738 | to consider as DONE keywords. | |
| 2739 | ||
| 2740 | When this is set, todo statistics is updated in the parent of the | |
| 2741 | current entry each time a todo state is changed." | |
| 2742 | :group 'org-todo | |
| 2743 | :type '(choice | |
| 2744 | (const :tag "Yes, only for TODO entries" t) | |
| 2745 | (const :tag "Yes, including all entries" all-headlines) | |
| 2746 | (repeat :tag "Yes, for TODOs in this list" | |
| 2747 | (string :tag "TODO keyword")) | |
| 2748 | (list :tag "Yes, for TODOs and DONEs in these lists" | |
| 2749 | (repeat (string :tag "TODO keyword")) | |
| 2750 | (repeat (string :tag "DONE keyword"))) | |
| 2751 | (other :tag "No TODO statistics" nil))) | |
| 2752 | ||
| 2753 | (defcustom org-hierarchical-todo-statistics t | |
| 2754 | "Non-nil means TODO statistics covers just direct children. | |
| 2755 | When nil, all entries in the subtree are considered. | |
| 2756 | This has only an effect if `org-provide-todo-statistics' is set. | |
| 2757 | To set this to nil for only a single subtree, use a COOKIE_DATA | |
| 2758 | property and include the word \"recursive\" into the value." | |
| 2759 | :group 'org-todo | |
| 2760 | :type 'boolean) | |
| 2761 | ||
| 2762 | (defcustom org-after-todo-state-change-hook nil | |
| 2763 | "Hook which is run after the state of a TODO item was changed. | |
| 2764 | The new state (a string with a TODO keyword, or nil) is available in the | |
| 2765 | Lisp variable `org-state'." | |
| 2766 | :group 'org-todo | |
| 2767 | :type 'hook) | |
| 2768 | ||
| 2769 | (defvar org-blocker-hook nil | |
| 2770 | "Hook for functions that are allowed to block a state change. | |
| 2771 | ||
| 2772 | Functions in this hook should not modify the buffer. | |
| 2773 | Each function gets as its single argument a property list, | |
| 2774 | see `org-trigger-hook' for more information about this list. | |
| 2775 | ||
| 2776 | If any of the functions in this hook returns nil, the state change | |
| 2777 | is blocked.") | |
| 2778 | ||
| 2779 | (defvar org-trigger-hook nil | |
| 2780 | "Hook for functions that are triggered by a state change. | |
| 2781 | ||
| 2782 | Each function gets as its single argument a property list with at | |
| 2783 | least the following elements: | |
| 2784 | ||
| 2785 | (:type type-of-change :position pos-at-entry-start | |
| 2786 | :from old-state :to new-state) | |
| 2787 | ||
| 2788 | Depending on the type, more properties may be present. | |
| 2789 | ||
| 2790 | This mechanism is currently implemented for: | |
| 2791 | ||
| 2792 | TODO state changes | |
| 2793 | ------------------ | |
| 2794 | :type todo-state-change | |
| 2795 | :from previous state (keyword as a string), or nil, or a symbol | |
| 2796 | `todo' or `done', to indicate the general type of state. | |
| 2797 | :to new state, like in :from") | |
| 2798 | ||
| 2799 | (defcustom org-enforce-todo-dependencies nil | |
| 2800 | "Non-nil means undone TODO entries will block switching the parent to DONE. | |
| 2801 | Also, if a parent has an :ORDERED: property, switching an entry to DONE will | |
| 2802 | be blocked if any prior sibling is not yet done. | |
| 2803 | Finally, if the parent is blocked because of ordered siblings of its own, | |
| 2804 | the child will also be blocked." | |
| 2805 | :set (lambda (var val) | |
| 2806 | (set var val) | |
| 2807 | (if val | |
| 2808 | (add-hook 'org-blocker-hook | |
| 2809 | 'org-block-todo-from-children-or-siblings-or-parent) | |
| 2810 | (remove-hook 'org-blocker-hook | |
| 2811 | 'org-block-todo-from-children-or-siblings-or-parent))) | |
| 2812 | :group 'org-todo | |
| 2813 | :type 'boolean) | |
| 2814 | ||
| 2815 | (defcustom org-enforce-todo-checkbox-dependencies nil | |
| 2816 | "Non-nil means unchecked boxes will block switching the parent to DONE. | |
| 2817 | When this is nil, checkboxes have no influence on switching TODO states. | |
| 2818 | When non-nil, you first need to check off all check boxes before the TODO | |
| 2819 | entry can be switched to DONE. | |
| 2820 | This variable needs to be set before org.el is loaded, and you need to | |
| 2821 | restart Emacs after a change to make the change effective. The only way | |
| 2822 | to change is while Emacs is running is through the customize interface." | |
| 2823 | :set (lambda (var val) | |
| 2824 | (set var val) | |
| 2825 | (if val | |
| 2826 | (add-hook 'org-blocker-hook | |
| 2827 | 'org-block-todo-from-checkboxes) | |
| 2828 | (remove-hook 'org-blocker-hook | |
| 2829 | 'org-block-todo-from-checkboxes))) | |
| 2830 | :group 'org-todo | |
| 2831 | :type 'boolean) | |
| 2832 | ||
| 2833 | (defcustom org-treat-insert-todo-heading-as-state-change nil | |
| 2834 | "Non-nil means inserting a TODO heading is treated as state change. | |
| 2835 | So when the command `\\[org-insert-todo-heading]' is used, state change | |
| 2836 | logging will apply if appropriate. When nil, the new TODO item will | |
| 2837 | be inserted directly, and no logging will take place." | |
| 2838 | :group 'org-todo | |
| 2839 | :type 'boolean) | |
| 2840 | ||
| 2841 | (defcustom org-treat-S-cursor-todo-selection-as-state-change t | |
| 2842 | "Non-nil means switching TODO states with S-cursor counts as state change. | |
| 2843 | This is the default behavior. However, setting this to nil allows a | |
| 2844 | convenient way to select a TODO state and bypass any logging associated | |
| 2845 | with that." | |
| 2846 | :group 'org-todo | |
| 2847 | :type 'boolean) | |
| 2848 | ||
| 2849 | (defcustom org-todo-state-tags-triggers nil | |
| 2850 | "Tag changes that should be triggered by TODO state changes. | |
| 2851 | This is a list. Each entry is | |
| 2852 | ||
| 2853 | (state-change (tag . flag) .......) | |
| 2854 | ||
| 2855 | State-change can be a string with a state, and empty string to indicate the | |
| 2856 | state that has no TODO keyword, or it can be one of the symbols `todo' | |
| 2857 | or `done', meaning any not-done or done state, respectively." | |
| 2858 | :group 'org-todo | |
| 2859 | :group 'org-tags | |
| 2860 | :type '(repeat | |
| 2861 | (cons (choice :tag "When changing to" | |
| 2862 | (const :tag "Not-done state" todo) | |
| 2863 | (const :tag "Done state" done) | |
| 2864 | (string :tag "State")) | |
| 2865 | (repeat | |
| 2866 | (cons :tag "Tag action" | |
| 2867 | (string :tag "Tag") | |
| 2868 | (choice (const :tag "Add" t) (const :tag "Remove" nil))))))) | |
| 2869 | ||
| 2870 | (defcustom org-log-done nil | |
| 2871 | "Information to record when a task moves to the DONE state. | |
| 2872 | ||
| 2873 | Possible values are: | |
| 2874 | ||
| 2875 | nil Don't add anything, just change the keyword | |
| 2876 | time Add a time stamp to the task | |
| 2877 | note Prompt for a note and add it with template `org-log-note-headings' | |
| 2878 | ||
| 2879 | This option can also be set with on a per-file-basis with | |
| 2880 | ||
| 2881 | #+STARTUP: nologdone | |
| 2882 | #+STARTUP: logdone | |
| 2883 | #+STARTUP: lognotedone | |
| 2884 | ||
| 2885 | You can have local logging settings for a subtree by setting the LOGGING | |
| 2886 | property to one or more of these keywords." | |
| 2887 | :group 'org-todo | |
| 2888 | :group 'org-progress | |
| 2889 | :type '(choice | |
| 2890 | (const :tag "No logging" nil) | |
| 2891 | (const :tag "Record CLOSED timestamp" time) | |
| 2892 | (const :tag "Record CLOSED timestamp with note." note))) | |
| 2893 | ||
| 2894 | ;; Normalize old uses of org-log-done. | |
| 2895 | (cond | |
| 2896 | ((eq org-log-done t) (setq org-log-done 'time)) | |
| 2897 | ((and (listp org-log-done) (memq 'done org-log-done)) | |
| 2898 | (setq org-log-done 'note))) | |
| 2899 | ||
| 2900 | (defcustom org-log-reschedule nil | |
| 2901 | "Information to record when the scheduling date of a tasks is modified. | |
| 2902 | ||
| 2903 | Possible values are: | |
| 2904 | ||
| 2905 | nil Don't add anything, just change the date | |
| 2906 | time Add a time stamp to the task | |
| 2907 | note Prompt for a note and add it with template `org-log-note-headings' | |
| 2908 | ||
| 2909 | This option can also be set with on a per-file-basis with | |
| 2910 | ||
| 2911 | #+STARTUP: nologreschedule | |
| 2912 | #+STARTUP: logreschedule | |
| 2913 | #+STARTUP: lognotereschedule" | |
| 2914 | :group 'org-todo | |
| 2915 | :group 'org-progress | |
| 2916 | :type '(choice | |
| 2917 | (const :tag "No logging" nil) | |
| 2918 | (const :tag "Record timestamp" time) | |
| 2919 | (const :tag "Record timestamp with note." note))) | |
| 2920 | ||
| 2921 | (defcustom org-log-redeadline nil | |
| 2922 | "Information to record when the deadline date of a tasks is modified. | |
| 2923 | ||
| 2924 | Possible values are: | |
| 2925 | ||
| 2926 | nil Don't add anything, just change the date | |
| 2927 | time Add a time stamp to the task | |
| 2928 | note Prompt for a note and add it with template `org-log-note-headings' | |
| 2929 | ||
| 2930 | This option can also be set with on a per-file-basis with | |
| 2931 | ||
| 2932 | #+STARTUP: nologredeadline | |
| 2933 | #+STARTUP: logredeadline | |
| 2934 | #+STARTUP: lognoteredeadline | |
| 2935 | ||
| 2936 | You can have local logging settings for a subtree by setting the LOGGING | |
| 2937 | property to one or more of these keywords." | |
| 2938 | :group 'org-todo | |
| 2939 | :group 'org-progress | |
| 2940 | :type '(choice | |
| 2941 | (const :tag "No logging" nil) | |
| 2942 | (const :tag "Record timestamp" time) | |
| 2943 | (const :tag "Record timestamp with note." note))) | |
| 2944 | ||
| 2945 | (defcustom org-log-note-clock-out nil | |
| 2946 | "Non-nil means record a note when clocking out of an item. | |
| 2947 | This can also be configured on a per-file basis by adding one of | |
| 2948 | the following lines anywhere in the buffer: | |
| 2949 | ||
| 2950 | #+STARTUP: lognoteclock-out | |
| 2951 | #+STARTUP: nolognoteclock-out" | |
| 2952 | :group 'org-todo | |
| 2953 | :group 'org-progress | |
| 2954 | :type 'boolean) | |
| 2955 | ||
| 2956 | (defcustom org-log-done-with-time t | |
| 2957 | "Non-nil means the CLOSED time stamp will contain date and time. | |
| 2958 | When nil, only the date will be recorded." | |
| 2959 | :group 'org-progress | |
| 2960 | :type 'boolean) | |
| 2961 | ||
| 2962 | (defcustom org-log-note-headings | |
| 2963 | '((done . "CLOSING NOTE %t") | |
| 2964 | (state . "State %-12s from %-12S %t") | |
| 2965 | (note . "Note taken on %t") | |
| 2966 | (reschedule . "Rescheduled from %S on %t") | |
| 2967 | (delschedule . "Not scheduled, was %S on %t") | |
| 2968 | (redeadline . "New deadline from %S on %t") | |
| 2969 | (deldeadline . "Removed deadline, was %S on %t") | |
| 2970 | (refile . "Refiled on %t") | |
| 2971 | (clock-out . "")) | |
| 2972 | "Headings for notes added to entries. | |
| 2973 | ||
| 2974 | The value is an alist, with the car being a symbol indicating the | |
| 2975 | note context, and the cdr is the heading to be used. The heading | |
| 2976 | may also be the empty string. The following placeholders can be | |
| 2977 | used: | |
| 2978 | ||
| 2979 | %t a time stamp. | |
| 2980 | %T an active time stamp instead the default inactive one | |
| 2981 | %d a short-format time stamp. | |
| 2982 | %D an active short-format time stamp. | |
| 2983 | %s the new TODO state or time stamp (inactive), in double quotes. | |
| 2984 | %S the old TODO state or time stamp (inactive), in double quotes. | |
| 2985 | %u the user name. | |
| 2986 | %U full user name. | |
| 2987 | ||
| 2988 | In fact, it is not a good idea to change the `state' entry, | |
| 2989 | because Agenda Log mode depends on the format of these entries." | |
| 2990 | :group 'org-todo | |
| 2991 | :group 'org-progress | |
| 2992 | :type '(list :greedy t | |
| 2993 | (cons (const :tag "Heading when closing an item" done) string) | |
| 2994 | (cons (const :tag | |
| 2995 | "Heading when changing todo state (todo sequence only)" | |
| 2996 | state) string) | |
| 2997 | (cons (const :tag "Heading when just taking a note" note) string) | |
| 2998 | (cons (const :tag "Heading when rescheduling" reschedule) string) | |
| 2999 | (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) | |
| 3000 | (cons (const :tag "Heading when changing deadline" redeadline) string) | |
| 3001 | (cons (const :tag "Heading when deleting a deadline" deldeadline) string) | |
| 3002 | (cons (const :tag "Heading when refiling" refile) string) | |
| 3003 | (cons (const :tag "Heading when clocking out" clock-out) string))) | |
| 3004 | ||
| 3005 | (unless (assq 'note org-log-note-headings) | |
| 3006 | (push '(note . "%t") org-log-note-headings)) | |
| 3007 | ||
| 3008 | (defcustom org-log-into-drawer nil | |
| 3009 | "Non-nil means insert state change notes and time stamps into a drawer. | |
| 3010 | When nil, state changes notes will be inserted after the headline and | |
| 3011 | any scheduling and clock lines, but not inside a drawer. | |
| 3012 | ||
| 3013 | The value of this variable should be the name of the drawer to use. | |
| 3014 | LOGBOOK is proposed as the default drawer for this purpose, you can | |
| 3015 | also set this to a string to define the drawer of your choice. | |
| 3016 | ||
| 3017 | A value of t is also allowed, representing \"LOGBOOK\". | |
| 3018 | ||
| 3019 | A value of t or nil can also be set with on a per-file-basis with | |
| 3020 | ||
| 3021 | #+STARTUP: logdrawer | |
| 3022 | #+STARTUP: nologdrawer | |
| 3023 | ||
| 3024 | If this variable is set, `org-log-state-notes-insert-after-drawers' | |
| 3025 | will be ignored. | |
| 3026 | ||
| 3027 | You can set the property LOG_INTO_DRAWER to overrule this setting for | |
| 3028 | a subtree. | |
| 3029 | ||
| 3030 | Do not check directly this variable in a Lisp program. Call | |
| 3031 | function `org-log-into-drawer' instead." | |
| 3032 | :group 'org-todo | |
| 3033 | :group 'org-progress | |
| 3034 | :type '(choice | |
| 3035 | (const :tag "Not into a drawer" nil) | |
| 3036 | (const :tag "LOGBOOK" t) | |
| 3037 | (string :tag "Other"))) | |
| 3038 | ||
| 3039 | (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) | |
| 3040 | ||
| 3041 | (defun org-log-into-drawer () | |
| 3042 | "Name of the log drawer, as a string, or nil. | |
| 3043 | This is the value of `org-log-into-drawer'. However, if the | |
| 3044 | current entry has or inherits a LOG_INTO_DRAWER property, it will | |
| 3045 | be used instead of the default value." | |
| 3046 | (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t))) | |
| 3047 | (cond ((equal p "nil") nil) | |
| 3048 | ((equal p "t") "LOGBOOK") | |
| 3049 | ((stringp p) p) | |
| 3050 | (p "LOGBOOK") | |
| 3051 | ((stringp org-log-into-drawer) org-log-into-drawer) | |
| 3052 | (org-log-into-drawer "LOGBOOK")))) | |
| 3053 | ||
| 3054 | (defcustom org-log-state-notes-insert-after-drawers nil | |
| 3055 | "Non-nil means insert state change notes after any drawers in entry. | |
| 3056 | Only the drawers that *immediately* follow the headline and the | |
| 3057 | deadline/scheduled line are skipped. | |
| 3058 | When nil, insert notes right after the heading and perhaps the line | |
| 3059 | with deadline/scheduling if present. | |
| 3060 | ||
| 3061 | This variable will have no effect if `org-log-into-drawer' is | |
| 3062 | set." | |
| 3063 | :group 'org-todo | |
| 3064 | :group 'org-progress | |
| 3065 | :type 'boolean) | |
| 3066 | ||
| 3067 | (defcustom org-log-states-order-reversed t | |
| 3068 | "Non-nil means the latest state note will be directly after heading. | |
| 3069 | When nil, the state change notes will be ordered according to time. | |
| 3070 | ||
| 3071 | This option can also be set with on a per-file-basis with | |
| 3072 | ||
| 3073 | #+STARTUP: logstatesreversed | |
| 3074 | #+STARTUP: nologstatesreversed" | |
| 3075 | :group 'org-todo | |
| 3076 | :group 'org-progress | |
| 3077 | :type 'boolean) | |
| 3078 | ||
| 3079 | (defcustom org-todo-repeat-to-state nil | |
| 3080 | "The TODO state to which a repeater should return the repeating task. | |
| 3081 | By default this is the first task in a TODO sequence, or the previous state | |
| 3082 | in a TODO_TYP set. But you can specify another task here. | |
| 3083 | alternatively, set the :REPEAT_TO_STATE: property of the entry." | |
| 3084 | :group 'org-todo | |
| 3085 | :version "24.1" | |
| 3086 | :type '(choice (const :tag "Head of sequence" nil) | |
| 3087 | (string :tag "Specific state"))) | |
| 3088 | ||
| 3089 | (defcustom org-log-repeat 'time | |
| 3090 | "Non-nil means record moving through the DONE state when triggering repeat. | |
| 3091 | An auto-repeating task is immediately switched back to TODO when | |
| 3092 | marked DONE. If you are not logging state changes (by adding \"@\" | |
| 3093 | or \"!\" to the TODO keyword definition), or set `org-log-done' to | |
| 3094 | record a closing note, there will be no record of the task moving | |
| 3095 | through DONE. This variable forces taking a note anyway. | |
| 3096 | ||
| 3097 | nil Don't force a record | |
| 3098 | time Record a time stamp | |
| 3099 | note Prompt for a note and add it with template `org-log-note-headings' | |
| 3100 | ||
| 3101 | This option can also be set with on a per-file-basis with | |
| 3102 | ||
| 3103 | #+STARTUP: nologrepeat | |
| 3104 | #+STARTUP: logrepeat | |
| 3105 | #+STARTUP: lognoterepeat | |
| 3106 | ||
| 3107 | You can have local logging settings for a subtree by setting the LOGGING | |
| 3108 | property to one or more of these keywords." | |
| 3109 | :group 'org-todo | |
| 3110 | :group 'org-progress | |
| 3111 | :type '(choice | |
| 3112 | (const :tag "Don't force a record" nil) | |
| 3113 | (const :tag "Force recording the DONE state" time) | |
| 3114 | (const :tag "Force recording a note with the DONE state" note))) | |
| 3115 | ||
| 3116 | ||
| 3117 | (defgroup org-priorities nil | |
| 3118 | "Priorities in Org mode." | |
| 3119 | :tag "Org Priorities" | |
| 3120 | :group 'org-todo) | |
| 3121 | ||
| 3122 | (defcustom org-enable-priority-commands t | |
| 3123 | "Non-nil means priority commands are active. | |
| 3124 | When nil, these commands will be disabled, so that you never accidentally | |
| 3125 | set a priority." | |
| 3126 | :group 'org-priorities | |
| 3127 | :type 'boolean) | |
| 3128 | ||
| 3129 | (defcustom org-highest-priority ?A | |
| 3130 | "The highest priority of TODO items. A character like ?A, ?B etc. | |
| 3131 | Must have a smaller ASCII number than `org-lowest-priority'." | |
| 3132 | :group 'org-priorities | |
| 3133 | :type 'character) | |
| 3134 | ||
| 3135 | (defcustom org-lowest-priority ?C | |
| 3136 | "The lowest priority of TODO items. A character like ?A, ?B etc. | |
| 3137 | Must have a larger ASCII number than `org-highest-priority'." | |
| 3138 | :group 'org-priorities | |
| 3139 | :type 'character) | |
| 3140 | ||
| 3141 | (defcustom org-default-priority ?B | |
| 3142 | "The default priority of TODO items. | |
| 3143 | This is the priority an item gets if no explicit priority is given. | |
| 3144 | When starting to cycle on an empty priority the first step in the cycle | |
| 3145 | depends on `org-priority-start-cycle-with-default'. The resulting first | |
| 3146 | step priority must not exceed the range from `org-highest-priority' to | |
| 3147 | `org-lowest-priority' which means that `org-default-priority' has to be | |
| 3148 | in this range exclusive or inclusive the range boundaries. Else the | |
| 3149 | first step refuses to set the default and the second will fall back | |
| 3150 | to (depending on the command used) the highest or lowest priority." | |
| 3151 | :group 'org-priorities | |
| 3152 | :type 'character) | |
| 3153 | ||
| 3154 | (defcustom org-priority-start-cycle-with-default t | |
| 3155 | "Non-nil means start with default priority when starting to cycle. | |
| 3156 | When this is nil, the first step in the cycle will be (depending on the | |
| 3157 | command used) one higher or lower than the default priority. | |
| 3158 | See also `org-default-priority'." | |
| 3159 | :group 'org-priorities | |
| 3160 | :type 'boolean) | |
| 3161 | ||
| 3162 | (defcustom org-get-priority-function nil | |
| 3163 | "Function to extract the priority from a string. | |
| 3164 | The string is normally the headline. If this is nil Org computes the | |
| 3165 | priority from the priority cookie like [#A] in the headline. It returns | |
| 3166 | an integer, increasing by 1000 for each priority level. | |
| 3167 | The user can set a different function here, which should take a string | |
| 3168 | as an argument and return the numeric priority." | |
| 3169 | :group 'org-priorities | |
| 3170 | :version "24.1" | |
| 3171 | :type '(choice | |
| 3172 | (const nil) | |
| 3173 | (function))) | |
| 3174 | ||
| 3175 | (defgroup org-time nil | |
| 3176 | "Options concerning time stamps and deadlines in Org mode." | |
| 3177 | :tag "Org Time" | |
| 3178 | :group 'org) | |
| 3179 | ||
| 3180 | (defcustom org-time-stamp-rounding-minutes '(0 5) | |
| 3181 | "Number of minutes to round time stamps to. | |
| 3182 | \\<org-mode-map>\ | |
| 3183 | These are two values, the first applies when first creating a time stamp. | |
| 3184 | The second applies when changing it with the commands `S-up' and `S-down'. | |
| 3185 | When changing the time stamp, this means that it will change in steps | |
| 3186 | of N minutes, as given by the second value. | |
| 3187 | ||
| 3188 | When a setting is 0 or 1, insert the time unmodified. Useful rounding | |
| 3189 | numbers should be factors of 60, so for example 5, 10, 15. | |
| 3190 | ||
| 3191 | When this is larger than 1, you can still force an exact time stamp by using | |
| 3192 | a double prefix argument to a time stamp command like \ | |
| 3193 | `\\[org-time-stamp]' or `\\[org-time-stamp-inactive], | |
| 3194 | and by using a prefix arg to `S-up/down' to specify the exact number | |
| 3195 | of minutes to shift." | |
| 3196 | :group 'org-time | |
| 3197 | :get (lambda (var) ; Make sure both elements are there | |
| 3198 | (if (integerp (default-value var)) | |
| 3199 | (list (default-value var) 5) | |
| 3200 | (default-value var))) | |
| 3201 | :type '(list | |
| 3202 | (integer :tag "when inserting times") | |
| 3203 | (integer :tag "when modifying times"))) | |
| 3204 | ||
| 3205 | ;; Normalize old customizations of this variable. | |
| 3206 | (when (integerp org-time-stamp-rounding-minutes) | |
| 3207 | (setq org-time-stamp-rounding-minutes | |
| 3208 | (list org-time-stamp-rounding-minutes | |
| 3209 | org-time-stamp-rounding-minutes))) | |
| 3210 | ||
| 3211 | (defcustom org-display-custom-times nil | |
| 3212 | "Non-nil means overlay custom formats over all time stamps. | |
| 3213 | The formats are defined through the variable `org-time-stamp-custom-formats'. | |
| 3214 | To turn this on on a per-file basis, insert anywhere in the file: | |
| 3215 | #+STARTUP: customtime" | |
| 3216 | :group 'org-time | |
| 3217 | :set 'set-default | |
| 3218 | :type 'sexp) | |
| 3219 | (make-variable-buffer-local 'org-display-custom-times) | |
| 3220 | ||
| 3221 | (defcustom org-time-stamp-custom-formats | |
| 3222 | '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american | |
| 3223 | "Custom formats for time stamps. See `format-time-string' for the syntax. | |
| 3224 | These are overlaid over the default ISO format if the variable | |
| 3225 | `org-display-custom-times' is set. Time like %H:%M should be at the | |
| 3226 | end of the second format. The custom formats are also honored by export | |
| 3227 | commands, if custom time display is turned on at the time of export." | |
| 3228 | :group 'org-time | |
| 3229 | :type 'sexp) | |
| 3230 | ||
| 3231 | (defun org-time-stamp-format (&optional long inactive) | |
| 3232 | "Get the right format for a time string." | |
| 3233 | (let ((f (if long (cdr org-time-stamp-formats) | |
| 3234 | (car org-time-stamp-formats)))) | |
| 3235 | (if inactive | |
| 3236 | (concat "[" (substring f 1 -1) "]") | |
| 3237 | f))) | |
| 3238 | ||
| 3239 | (defcustom org-deadline-warning-days 14 | |
| 3240 | "Number of days before expiration during which a deadline becomes active. | |
| 3241 | This variable governs the display in sparse trees and in the agenda. | |
| 3242 | When 0 or negative, it means use this number (the absolute value of it) | |
| 3243 | even if a deadline has a different individual lead time specified. | |
| 3244 | ||
| 3245 | Custom commands can set this variable in the options section." | |
| 3246 | :group 'org-time | |
| 3247 | :group 'org-agenda-daily/weekly | |
| 3248 | :type 'integer) | |
| 3249 | ||
| 3250 | (defcustom org-scheduled-delay-days 0 | |
| 3251 | "Number of days before a scheduled item becomes active. | |
| 3252 | This variable governs the display in sparse trees and in the agenda. | |
| 3253 | The default value (i.e. 0) means: don't delay scheduled item. | |
| 3254 | When negative, it means use this number (the absolute value of it) | |
| 3255 | even if a scheduled item has a different individual delay time | |
| 3256 | specified. | |
| 3257 | ||
| 3258 | Custom commands can set this variable in the options section." | |
| 3259 | :group 'org-time | |
| 3260 | :group 'org-agenda-daily/weekly | |
| 3261 | :version "24.4" | |
| 3262 | :package-version '(Org . "8.0") | |
| 3263 | :type 'integer) | |
| 3264 | ||
| 3265 | (defcustom org-read-date-prefer-future t | |
| 3266 | "Non-nil means assume future for incomplete date input from user. | |
| 3267 | This affects the following situations: | |
| 3268 | 1. The user gives a month but not a year. | |
| 3269 | For example, if it is April and you enter \"feb 2\", this will be read | |
| 3270 | as Feb 2, *next* year. \"May 5\", however, will be this year. | |
| 3271 | 2. The user gives a day, but no month. | |
| 3272 | For example, if today is the 15th, and you enter \"3\", Org will read | |
| 3273 | this as the third of *next* month. However, if you enter \"17\", | |
| 3274 | it will be considered as *this* month. | |
| 3275 | ||
| 3276 | If you set this variable to the symbol `time', then also the following | |
| 3277 | will work: | |
| 3278 | ||
| 3279 | 3. If the user gives a time. | |
| 3280 | If the time is before now, it will be interpreted as tomorrow. | |
| 3281 | ||
| 3282 | Currently none of this works for ISO week specifications. | |
| 3283 | ||
| 3284 | When this option is nil, the current day, month and year will always be | |
| 3285 | used as defaults. | |
| 3286 | ||
| 3287 | See also `org-agenda-jump-prefer-future'." | |
| 3288 | :group 'org-time | |
| 3289 | :type '(choice | |
| 3290 | (const :tag "Never" nil) | |
| 3291 | (const :tag "Check month and day" t) | |
| 3292 | (const :tag "Check month, day, and time" time))) | |
| 3293 | ||
| 3294 | (defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future | |
| 3295 | "Should the agenda jump command prefer the future for incomplete dates? | |
| 3296 | The default is to do the same as configured in `org-read-date-prefer-future'. | |
| 3297 | But you can also set a deviating value here. | |
| 3298 | This may t or nil, or the symbol `org-read-date-prefer-future'." | |
| 3299 | :group 'org-agenda | |
| 3300 | :group 'org-time | |
| 3301 | :version "24.1" | |
| 3302 | :type '(choice | |
| 3303 | (const :tag "Use org-read-date-prefer-future" | |
| 3304 | org-read-date-prefer-future) | |
| 3305 | (const :tag "Never" nil) | |
| 3306 | (const :tag "Always" t))) | |
| 3307 | ||
| 3308 | (defcustom org-read-date-force-compatible-dates t | |
| 3309 | "Should date/time prompt force dates that are guaranteed to work in Emacs? | |
| 3310 | ||
| 3311 | Depending on the system Emacs is running on, certain dates cannot | |
| 3312 | be represented with the type used internally to represent time. | |
| 3313 | Dates between 1970-1-1 and 2038-1-1 can always be represented | |
| 3314 | correctly. Some systems allow for earlier dates, some for later, | |
| 3315 | some for both. One way to find out it to insert any date into an | |
| 3316 | Org buffer, putting the cursor on the year and hitting S-up and | |
| 3317 | S-down to test the range. | |
| 3318 | ||
| 3319 | When this variable is set to t, the date/time prompt will not let | |
| 3320 | you specify dates outside the 1970-2037 range, so it is certain that | |
| 3321 | these dates will work in whatever version of Emacs you are | |
| 3322 | running, and also that you can move a file from one Emacs implementation | |
| 3323 | to another. WHenever Org is forcing the year for you, it will display | |
| 3324 | a message and beep. | |
| 3325 | ||
| 3326 | When this variable is nil, Org will check if the date is | |
| 3327 | representable in the specific Emacs implementation you are using. | |
| 3328 | If not, it will force a year, usually the current year, and beep | |
| 3329 | to remind you. Currently this setting is not recommended because | |
| 3330 | the likelihood that you will open your Org files in an Emacs that | |
| 3331 | has limited date range is not negligible. | |
| 3332 | ||
| 3333 | A workaround for this problem is to use diary sexp dates for time | |
| 3334 | stamps outside of this range." | |
| 3335 | :group 'org-time | |
| 3336 | :version "24.1" | |
| 3337 | :type 'boolean) | |
| 3338 | ||
| 3339 | (defcustom org-read-date-display-live t | |
| 3340 | "Non-nil means display current interpretation of date prompt live. | |
| 3341 | This display will be in an overlay, in the minibuffer." | |
| 3342 | :group 'org-time | |
| 3343 | :type 'boolean) | |
| 3344 | ||
| 3345 | (defcustom org-read-date-popup-calendar t | |
| 3346 | "Non-nil means pop up a calendar when prompting for a date. | |
| 3347 | In the calendar, the date can be selected with mouse-1. However, the | |
| 3348 | minibuffer will also be active, and you can simply enter the date as well. | |
| 3349 | When nil, only the minibuffer will be available." | |
| 3350 | :group 'org-time | |
| 3351 | :type 'boolean) | |
| 3352 | (defvaralias 'org-popup-calendar-for-date-prompt | |
| 3353 | 'org-read-date-popup-calendar) | |
| 3354 | ||
| 3355 | (defcustom org-extend-today-until 0 | |
| 3356 | "The hour when your day really ends. Must be an integer. | |
| 3357 | This has influence for the following applications: | |
| 3358 | - When switching the agenda to \"today\". It it is still earlier than | |
| 3359 | the time given here, the day recognized as TODAY is actually yesterday. | |
| 3360 | - When a date is read from the user and it is still before the time given | |
| 3361 | here, the current date and time will be assumed to be yesterday, 23:59. | |
| 3362 | Also, timestamps inserted in capture templates follow this rule. | |
| 3363 | ||
| 3364 | IMPORTANT: This is a feature whose implementation is and likely will | |
| 3365 | remain incomplete. Really, it is only here because past midnight seems to | |
| 3366 | be the favorite working time of John Wiegley :-)" | |
| 3367 | :group 'org-time | |
| 3368 | :type 'integer) | |
| 3369 | ||
| 3370 | (defcustom org-use-effective-time nil | |
| 3371 | "If non-nil, consider `org-extend-today-until' when creating timestamps. | |
| 3372 | For example, if `org-extend-today-until' is 8, and it's 4am, then the | |
| 3373 | \"effective time\" of any timestamps between midnight and 8am will be | |
| 3374 | 23:59 of the previous day." | |
| 3375 | :group 'org-time | |
| 3376 | :version "24.1" | |
| 3377 | :type 'boolean) | |
| 3378 | ||
| 3379 | (defcustom org-use-last-clock-out-time-as-effective-time nil | |
| 3380 | "When non-nil, use the last clock out time for `org-todo'. | |
| 3381 | Note that this option has precedence over the combined use of | |
| 3382 | `org-use-effective-time' and `org-extend-today-until'." | |
| 3383 | :group 'org-time | |
| 3384 | :version "24.4" | |
| 3385 | :package-version '(Org . "8.0") | |
| 3386 | :type 'boolean) | |
| 3387 | ||
| 3388 | (defcustom org-edit-timestamp-down-means-later nil | |
| 3389 | "Non-nil means S-down will increase the time in a time stamp. | |
| 3390 | When nil, S-up will increase." | |
| 3391 | :group 'org-time | |
| 3392 | :type 'boolean) | |
| 3393 | ||
| 3394 | (defcustom org-calendar-follow-timestamp-change t | |
| 3395 | "Non-nil means make the calendar window follow timestamp changes. | |
| 3396 | When a timestamp is modified and the calendar window is visible, it will be | |
| 3397 | moved to the new date." | |
| 3398 | :group 'org-time | |
| 3399 | :type 'boolean) | |
| 3400 | ||
| 3401 | (defgroup org-tags nil | |
| 3402 | "Options concerning tags in Org mode." | |
| 3403 | :tag "Org Tags" | |
| 3404 | :group 'org) | |
| 3405 | ||
| 3406 | (defcustom org-tag-alist nil | |
| 3407 | "Default tags available in Org files. | |
| 3408 | ||
| 3409 | The value of this variable is an alist. Associations either: | |
| 3410 | ||
| 3411 | (TAG) | |
| 3412 | (TAG . SELECT) | |
| 3413 | (SPECIAL) | |
| 3414 | ||
| 3415 | where TAG is a tag as a string, SELECT is character, used to | |
| 3416 | select that tag through the fast tag selection interface, and | |
| 3417 | SPECIAL is one of the following keywords: `:startgroup', | |
| 3418 | `:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or | |
| 3419 | `:newline'. These keywords are used to define a hierarchy of | |
| 3420 | tags. See manual for details. | |
| 3421 | ||
| 3422 | When this variable is nil, Org mode bases tag input on what is | |
| 3423 | already in the buffer. The value can be overridden locally by | |
| 3424 | using a TAGS keyword, e.g., | |
| 3425 | ||
| 3426 | #+TAGS: tag1 tag2 | |
| 3427 | ||
| 3428 | See also `org-tag-persistent-alist' to sidestep this behavior." | |
| 3429 | :group 'org-tags | |
| 3430 | :type '(repeat | |
| 3431 | (choice | |
| 3432 | (cons :tag "Tag with key" | |
| 3433 | (string :tag "Tag name") | |
| 3434 | (character :tag "Access char")) | |
| 3435 | (list :tag "Tag" (string :tag "Tag name")) | |
| 3436 | (const :tag "Start radio group" (:startgroup)) | |
| 3437 | (const :tag "Start tag group, non distinct" (:startgrouptag)) | |
| 3438 | (const :tag "Group tags delimiter" (:grouptags)) | |
| 3439 | (const :tag "End radio group" (:endgroup)) | |
| 3440 | (const :tag "End tag group, non distinct" (:endgrouptag)) | |
| 3441 | (const :tag "New line" (:newline))))) | |
| 3442 | ||
| 3443 | (defcustom org-tag-persistent-alist nil | |
| 3444 | "Tags always available in Org files. | |
| 3445 | ||
| 3446 | The value of this variable is an alist. Associations either: | |
| 3447 | ||
| 3448 | (TAG) | |
| 3449 | (TAG . SELECT) | |
| 3450 | (SPECIAL) | |
| 3451 | ||
| 3452 | where TAG is a tag as a string, SELECT is a character, used to | |
| 3453 | select that tag through the fast tag selection interface, and | |
| 3454 | SPECIAL is one of the following keywords: `:startgroup', | |
| 3455 | `:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or | |
| 3456 | `:newline'. These keywords are used to define a hierarchy of | |
| 3457 | tags. See manual for details. | |
| 3458 | ||
| 3459 | Unlike to `org-tag-alist', tags defined in this variable do not | |
| 3460 | depend on a local TAGS keyword. Instead, to disable these tags | |
| 3461 | on a per-file basis, insert anywhere in the file: | |
| 3462 | ||
| 3463 | #+STARTUP: noptag" | |
| 3464 | :group 'org-tags | |
| 3465 | :type '(repeat | |
| 3466 | (choice | |
| 3467 | (cons :tag "Tag with key" | |
| 3468 | (string :tag "Tag name") | |
| 3469 | (character :tag "Access char")) | |
| 3470 | (list :tag "Tag" (string :tag "Tag name")) | |
| 3471 | (const :tag "Start radio group" (:startgroup)) | |
| 3472 | (const :tag "Start tag group, non distinct" (:startgrouptag)) | |
| 3473 | (const :tag "Group tags delimiter" (:grouptags)) | |
| 3474 | (const :tag "End radio group" (:endgroup)) | |
| 3475 | (const :tag "End tag group, non distinct" (:endgrouptag)) | |
| 3476 | (const :tag "New line" (:newline))))) | |
| 3477 | ||
| 3478 | (defcustom org-complete-tags-always-offer-all-agenda-tags nil | |
| 3479 | "If non-nil, always offer completion for all tags of all agenda files. | |
| 3480 | Instead of customizing this variable directly, you might want to | |
| 3481 | set it locally for capture buffers, because there no list of | |
| 3482 | tags in that file can be created dynamically (there are none). | |
| 3483 | ||
| 3484 | (add-hook \\='org-capture-mode-hook | |
| 3485 | (lambda () | |
| 3486 | (setq-local org-complete-tags-always-offer-all-agenda-tags t)))" | |
| 3487 | :group 'org-tags | |
| 3488 | :version "24.1" | |
| 3489 | :type 'boolean) | |
| 3490 | ||
| 3491 | (defvar org-file-tags nil | |
| 3492 | "List of tags that can be inherited by all entries in the file. | |
| 3493 | The tags will be inherited if the variable `org-use-tag-inheritance' | |
| 3494 | says they should be. | |
| 3495 | This variable is populated from #+FILETAGS lines.") | |
| 3496 | ||
| 3497 | (defcustom org-use-fast-tag-selection 'auto | |
| 3498 | "Non-nil means use fast tag selection scheme. | |
| 3499 | This is a special interface to select and deselect tags with single keys. | |
| 3500 | When nil, fast selection is never used. | |
| 3501 | When the symbol `auto', fast selection is used if and only if selection | |
| 3502 | characters for tags have been configured, either through the variable | |
| 3503 | `org-tag-alist' or through a #+TAGS line in the buffer. | |
| 3504 | When t, fast selection is always used and selection keys are assigned | |
| 3505 | automatically if necessary." | |
| 3506 | :group 'org-tags | |
| 3507 | :type '(choice | |
| 3508 | (const :tag "Always" t) | |
| 3509 | (const :tag "Never" nil) | |
| 3510 | (const :tag "When selection characters are configured" auto))) | |
| 3511 | ||
| 3512 | (defcustom org-fast-tag-selection-single-key nil | |
| 3513 | "Non-nil means fast tag selection exits after first change. | |
| 3514 | When nil, you have to press RET to exit it. | |
| 3515 | During fast tag selection, you can toggle this flag with `C-c'. | |
| 3516 | This variable can also have the value `expert'. In this case, the window | |
| 3517 | displaying the tags menu is not even shown, until you press C-c again." | |
| 3518 | :group 'org-tags | |
| 3519 | :type '(choice | |
| 3520 | (const :tag "No" nil) | |
| 3521 | (const :tag "Yes" t) | |
| 3522 | (const :tag "Expert" expert))) | |
| 3523 | ||
| 3524 | (defvar org-fast-tag-selection-include-todo nil | |
| 3525 | "Non-nil means fast tags selection interface will also offer TODO states. | |
| 3526 | This is an undocumented feature, you should not rely on it.") | |
| 3527 | ||
| 3528 | (defcustom org-tags-column -77 | |
| 3529 | "The column to which tags should be indented in a headline. | |
| 3530 | If this number is positive, it specifies the column. If it is negative, | |
| 3531 | it means that the tags should be flushright to that column. For example, | |
| 3532 | -80 works well for a normal 80 character screen. | |
| 3533 | When 0, place tags directly after headline text, with only one space in | |
| 3534 | between." | |
| 3535 | :group 'org-tags | |
| 3536 | :type 'integer) | |
| 3537 | ||
| 3538 | (defcustom org-auto-align-tags t | |
| 3539 | "Non-nil keeps tags aligned when modifying headlines. | |
| 3540 | Some operations (i.e. demoting) change the length of a headline and | |
| 3541 | therefore shift the tags around. With this option turned on, after | |
| 3542 | each such operation the tags are again aligned to `org-tags-column'." | |
| 3543 | :group 'org-tags | |
| 3544 | :type 'boolean) | |
| 3545 | ||
| 3546 | (defcustom org-use-tag-inheritance t | |
| 3547 | "Non-nil means tags in levels apply also for sublevels. | |
| 3548 | When nil, only the tags directly given in a specific line apply there. | |
| 3549 | This may also be a list of tags that should be inherited, or a regexp that | |
| 3550 | matches tags that should be inherited. Additional control is possible | |
| 3551 | with the variable `org-tags-exclude-from-inheritance' which gives an | |
| 3552 | explicit list of tags to be excluded from inheritance, even if the value of | |
| 3553 | `org-use-tag-inheritance' would select it for inheritance. | |
| 3554 | ||
| 3555 | If this option is t, a match early-on in a tree can lead to a large | |
| 3556 | number of matches in the subtree when constructing the agenda or creating | |
| 3557 | a sparse tree. If you only want to see the first match in a tree during | |
| 3558 | a search, check out the variable `org-tags-match-list-sublevels'." | |
| 3559 | :group 'org-tags | |
| 3560 | :type '(choice | |
| 3561 | (const :tag "Not" nil) | |
| 3562 | (const :tag "Always" t) | |
| 3563 | (repeat :tag "Specific tags" (string :tag "Tag")) | |
| 3564 | (regexp :tag "Tags matched by regexp"))) | |
| 3565 | ||
| 3566 | (defcustom org-tags-exclude-from-inheritance nil | |
| 3567 | "List of tags that should never be inherited. | |
| 3568 | This is a way to exclude a few tags from inheritance. For way to do | |
| 3569 | the opposite, to actively allow inheritance for selected tags, | |
| 3570 | see the variable `org-use-tag-inheritance'." | |
| 3571 | :group 'org-tags | |
| 3572 | :type '(repeat (string :tag "Tag"))) | |
| 3573 | ||
| 3574 | (defun org-tag-inherit-p (tag) | |
| 3575 | "Check if TAG is one that should be inherited." | |
| 3576 | (cond | |
| 3577 | ((member tag org-tags-exclude-from-inheritance) nil) | |
| 3578 | ((eq org-use-tag-inheritance t) t) | |
| 3579 | ((not org-use-tag-inheritance) nil) | |
| 3580 | ((stringp org-use-tag-inheritance) | |
| 3581 | (string-match org-use-tag-inheritance tag)) | |
| 3582 | ((listp org-use-tag-inheritance) | |
| 3583 | (member tag org-use-tag-inheritance)) | |
| 3584 | (t (error "Invalid setting of `org-use-tag-inheritance'")))) | |
| 3585 | ||
| 3586 | (defcustom org-tags-match-list-sublevels t | |
| 3587 | "Non-nil means list also sublevels of headlines matching a search. | |
| 3588 | This variable applies to tags/property searches, and also to stuck | |
| 3589 | projects because this search is based on a tags match as well. | |
| 3590 | ||
| 3591 | When set to the symbol `indented', sublevels are indented with | |
| 3592 | leading dots. | |
| 3593 | ||
| 3594 | Because of tag inheritance (see variable `org-use-tag-inheritance'), | |
| 3595 | the sublevels of a headline matching a tag search often also match | |
| 3596 | the same search. Listing all of them can create very long lists. | |
| 3597 | Setting this variable to nil causes subtrees of a match to be skipped. | |
| 3598 | ||
| 3599 | This variable is semi-obsolete and probably should always be true. It | |
| 3600 | is better to limit inheritance to certain tags using the variables | |
| 3601 | `org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'." | |
| 3602 | :group 'org-tags | |
| 3603 | :type '(choice | |
| 3604 | (const :tag "No, don't list them" nil) | |
| 3605 | (const :tag "Yes, do list them" t) | |
| 3606 | (const :tag "List them, indented with leading dots" indented))) | |
| 3607 | ||
| 3608 | (defcustom org-tags-sort-function nil | |
| 3609 | "When set, tags are sorted using this function as a comparator." | |
| 3610 | :group 'org-tags | |
| 3611 | :type '(choice | |
| 3612 | (const :tag "No sorting" nil) | |
| 3613 | (const :tag "Alphabetical" string<) | |
| 3614 | (const :tag "Reverse alphabetical" string>) | |
| 3615 | (function :tag "Custom function" nil))) | |
| 3616 | ||
| 3617 | (defvar org-tags-history nil | |
| 3618 | "History of minibuffer reads for tags.") | |
| 3619 | (defvar org-last-tags-completion-table nil | |
| 3620 | "The last used completion table for tags.") | |
| 3621 | (defvar org-after-tags-change-hook nil | |
| 3622 | "Hook that is run after the tags in a line have changed.") | |
| 3623 | ||
| 3624 | (defgroup org-properties nil | |
| 3625 | "Options concerning properties in Org mode." | |
| 3626 | :tag "Org Properties" | |
| 3627 | :group 'org) | |
| 3628 | ||
| 3629 | (defcustom org-property-format "%-10s %s" | |
| 3630 | "How property key/value pairs should be formatted by `indent-line'. | |
| 3631 | When `indent-line' hits a property definition, it will format the line | |
| 3632 | according to this format, mainly to make sure that the values are | |
| 3633 | lined-up with respect to each other." | |
| 3634 | :group 'org-properties | |
| 3635 | :type 'string) | |
| 3636 | ||
| 3637 | (defcustom org-properties-postprocess-alist nil | |
| 3638 | "Alist of properties and functions to adjust inserted values. | |
| 3639 | Elements of this alist must be of the form | |
| 3640 | ||
| 3641 | ([string] [function]) | |
| 3642 | ||
| 3643 | where [string] must be a property name and [function] must be a | |
| 3644 | lambda expression: this lambda expression must take one argument, | |
| 3645 | the value to adjust, and return the new value as a string. | |
| 3646 | ||
| 3647 | For example, this element will allow the property \"Remaining\" | |
| 3648 | to be updated wrt the relation between the \"Effort\" property | |
| 3649 | and the clock summary: | |
| 3650 | ||
| 3651 | ((\"Remaining\" (lambda(value) | |
| 3652 | (let ((clocksum (org-clock-sum-current-item)) | |
| 3653 | (effort (org-duration-to-minutes | |
| 3654 | (org-entry-get (point) \"Effort\")))) | |
| 3655 | (org-minutes-to-clocksum-string (- effort clocksum))))))" | |
| 3656 | :group 'org-properties | |
| 3657 | :version "24.1" | |
| 3658 | :type '(alist :key-type (string :tag "Property") | |
| 3659 | :value-type (function :tag "Function"))) | |
| 3660 | ||
| 3661 | (defcustom org-use-property-inheritance nil | |
| 3662 | "Non-nil means properties apply also for sublevels. | |
| 3663 | ||
| 3664 | This setting is chiefly used during property searches. Turning it on can | |
| 3665 | cause significant overhead when doing a search, which is why it is not | |
| 3666 | on by default. | |
| 3667 | ||
| 3668 | When nil, only the properties directly given in the current entry count. | |
| 3669 | When t, every property is inherited. The value may also be a list of | |
| 3670 | properties that should have inheritance, or a regular expression matching | |
| 3671 | properties that should be inherited. | |
| 3672 | ||
| 3673 | However, note that some special properties use inheritance under special | |
| 3674 | circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, | |
| 3675 | and the properties ending in \"_ALL\" when they are used as descriptor | |
| 3676 | for valid values of a property. | |
| 3677 | ||
| 3678 | Note for programmers: | |
| 3679 | When querying an entry with `org-entry-get', you can control if inheritance | |
| 3680 | should be used. By default, `org-entry-get' looks only at the local | |
| 3681 | properties. You can request inheritance by setting the inherit argument | |
| 3682 | to t (to force inheritance) or to `selective' (to respect the setting | |
| 3683 | in this variable)." | |
| 3684 | :group 'org-properties | |
| 3685 | :type '(choice | |
| 3686 | (const :tag "Not" nil) | |
| 3687 | (const :tag "Always" t) | |
| 3688 | (repeat :tag "Specific properties" (string :tag "Property")) | |
| 3689 | (regexp :tag "Properties matched by regexp"))) | |
| 3690 | ||
| 3691 | (defun org-property-inherit-p (property) | |
| 3692 | "Return a non-nil value if PROPERTY should be inherited." | |
| 3693 | (cond | |
| 3694 | ((eq org-use-property-inheritance t) t) | |
| 3695 | ((not org-use-property-inheritance) nil) | |
| 3696 | ((stringp org-use-property-inheritance) | |
| 3697 | (string-match org-use-property-inheritance property)) | |
| 3698 | ((listp org-use-property-inheritance) | |
| 3699 | (member-ignore-case property org-use-property-inheritance)) | |
| 3700 | (t (error "Invalid setting of `org-use-property-inheritance'")))) | |
| 3701 | ||
| 3702 | (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" | |
| 3703 | "The default column format, if no other format has been defined. | |
| 3704 | This variable can be set on the per-file basis by inserting a line | |
| 3705 | ||
| 3706 | #+COLUMNS: %25ITEM ....." | |
| 3707 | :group 'org-properties | |
| 3708 | :type 'string) | |
| 3709 | ||
| 3710 | (defcustom org-columns-ellipses ".." | |
| 3711 | "The ellipses to be used when a field in column view is truncated. | |
| 3712 | When this is the empty string, as many characters as possible are shown, | |
| 3713 | but then there will be no visual indication that the field has been truncated. | |
| 3714 | When this is a string of length N, the last N characters of a truncated | |
| 3715 | field are replaced by this string. If the column is narrower than the | |
| 3716 | ellipses string, only part of the ellipses string will be shown." | |
| 3717 | :group 'org-properties | |
| 3718 | :type 'string) | |
| 3719 | ||
| 3720 | (defconst org-global-properties-fixed | |
| 3721 | '(("VISIBILITY_ALL" . "folded children content all") | |
| 3722 | ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto")) | |
| 3723 | "List of property/value pairs that can be inherited by any entry. | |
| 3724 | ||
| 3725 | These are fixed values, for the preset properties. The user variable | |
| 3726 | that can be used to add to this list is `org-global-properties'. | |
| 3727 | ||
| 3728 | The entries in this list are cons cells where the car is a property | |
| 3729 | name and cdr is a string with the value. If the value represents | |
| 3730 | multiple items like an \"_ALL\" property, separate the items by | |
| 3731 | spaces.") | |
| 3732 | ||
| 3733 | (defcustom org-global-properties nil | |
| 3734 | "List of property/value pairs that can be inherited by any entry. | |
| 3735 | ||
| 3736 | This list will be combined with the constant `org-global-properties-fixed'. | |
| 3737 | ||
| 3738 | The entries in this list are cons cells where the car is a property | |
| 3739 | name and cdr is a string with the value. | |
| 3740 | ||
| 3741 | You can set buffer-local values for the same purpose in the variable | |
| 3742 | `org-file-properties' this by adding lines like | |
| 3743 | ||
| 3744 | #+PROPERTY: NAME VALUE" | |
| 3745 | :group 'org-properties | |
| 3746 | :type '(repeat | |
| 3747 | (cons (string :tag "Property") | |
| 3748 | (string :tag "Value")))) | |
| 3749 | ||
| 3750 | (defvar-local org-file-properties nil | |
| 3751 | "List of property/value pairs that can be inherited by any entry. | |
| 3752 | Valid for the current buffer. | |
| 3753 | This variable is populated from #+PROPERTY lines.") | |
| 3754 | ||
| 3755 | (defgroup org-agenda nil | |
| 3756 | "Options concerning agenda views in Org mode." | |
| 3757 | :tag "Org Agenda" | |
| 3758 | :group 'org) | |
| 3759 | ||
| 3760 | (defvar-local org-category nil | |
| 3761 | "Variable used by Org files to set a category for agenda display. | |
| 3762 | Such files should use a file variable to set it, for example | |
| 3763 | ||
| 3764 | # -*- mode: org; org-category: \"ELisp\" | |
| 3765 | ||
| 3766 | or contain a special line | |
| 3767 | ||
| 3768 | #+CATEGORY: ELisp | |
| 3769 | ||
| 3770 | If the file does not specify a category, then file's base name | |
| 3771 | is used instead.") | |
| 3772 | (put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x)))) | |
| 3773 | ||
| 3774 | (defcustom org-agenda-files nil | |
| 3775 | "The files to be used for agenda display. | |
| 3776 | ||
| 3777 | If an entry is a directory, all files in that directory that are matched | |
| 3778 | by `org-agenda-file-regexp' will be part of the file list. | |
| 3779 | ||
| 3780 | If the value of the variable is not a list but a single file name, then | |
| 3781 | the list of agenda files is actually stored and maintained in that file, | |
| 3782 | one agenda file per line. In this file paths can be given relative to | |
| 3783 | `org-directory'. Tilde expansion and environment variable substitution | |
| 3784 | are also made. | |
| 3785 | ||
| 3786 | Entries may be added to this list with `\\[org-agenda-file-to-front]' | |
| 3787 | and removed with `\\[org-remove-file]'." | |
| 3788 | :group 'org-agenda | |
| 3789 | :type '(choice | |
| 3790 | (repeat :tag "List of files and directories" file) | |
| 3791 | (file :tag "Store list in a file\n" :value "~/.agenda_files"))) | |
| 3792 | ||
| 3793 | (defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'" | |
| 3794 | "Regular expression to match files for `org-agenda-files'. | |
| 3795 | If any element in the list in that variable contains a directory instead | |
| 3796 | of a normal file, all files in that directory that are matched by this | |
| 3797 | regular expression will be included." | |
| 3798 | :group 'org-agenda | |
| 3799 | :type 'regexp) | |
| 3800 | ||
| 3801 | (defcustom org-agenda-text-search-extra-files nil | |
| 3802 | "List of extra files to be searched by text search commands. | |
| 3803 | These files will be searched in addition to the agenda files by the | |
| 3804 | commands `org-search-view' (`\\[org-agenda] s') \ | |
| 3805 | and `org-occur-in-agenda-files'. | |
| 3806 | Note that these files will only be searched for text search commands, | |
| 3807 | not for the other agenda views like todo lists, tag searches or the weekly | |
| 3808 | agenda. This variable is intended to list notes and possibly archive files | |
| 3809 | that should also be searched by these two commands. | |
| 3810 | In fact, if the first element in the list is the symbol `agenda-archives', | |
| 3811 | then all archive files of all agenda files will be added to the search | |
| 3812 | scope." | |
| 3813 | :group 'org-agenda | |
| 3814 | :type '(set :greedy t | |
| 3815 | (const :tag "Agenda Archives" agenda-archives) | |
| 3816 | (repeat :inline t (file)))) | |
| 3817 | ||
| 3818 | (defvaralias 'org-agenda-multi-occur-extra-files | |
| 3819 | 'org-agenda-text-search-extra-files) | |
| 3820 | ||
| 3821 | (defcustom org-agenda-skip-unavailable-files nil | |
| 3822 | "Non-nil means to just skip non-reachable files in `org-agenda-files'. | |
| 3823 | A nil value means to remove them, after a query, from the list." | |
| 3824 | :group 'org-agenda | |
| 3825 | :type 'boolean) | |
| 3826 | ||
| 3827 | (defcustom org-calendar-to-agenda-key [?c] | |
| 3828 | "The key to be installed in `calendar-mode-map' for switching to the agenda. | |
| 3829 | The command `org-calendar-goto-agenda' will be bound to this key. The | |
| 3830 | default is the character `c' because then `c' can be used to switch back and | |
| 3831 | forth between agenda and calendar." | |
| 3832 | :group 'org-agenda | |
| 3833 | :type 'sexp) | |
| 3834 | ||
| 3835 | (defcustom org-calendar-insert-diary-entry-key [?i] | |
| 3836 | "The key to be installed in `calendar-mode-map' for adding diary entries. | |
| 3837 | This option is irrelevant until `org-agenda-diary-file' has been configured | |
| 3838 | to point to an Org file. When that is the case, the command | |
| 3839 | `org-agenda-diary-entry' will be bound to the key given here, by default | |
| 3840 | `i'. In the calendar, `i' normally adds entries to `diary-file'. So | |
| 3841 | if you want to continue doing this, you need to change this to a different | |
| 3842 | key." | |
| 3843 | :group 'org-agenda | |
| 3844 | :type 'sexp) | |
| 3845 | ||
| 3846 | (defcustom org-agenda-diary-file 'diary-file | |
| 3847 | "File to which to add new entries with the `i' key in agenda and calendar. | |
| 3848 | When this is the symbol `diary-file', the functionality in the Emacs | |
| 3849 | calendar will be used to add entries to the `diary-file'. But when this | |
| 3850 | points to a file, `org-agenda-diary-entry' will be used instead." | |
| 3851 | :group 'org-agenda | |
| 3852 | :type '(choice | |
| 3853 | (const :tag "The standard Emacs diary file" diary-file) | |
| 3854 | (file :tag "Special Org file diary entries"))) | |
| 3855 | ||
| 3856 | (eval-after-load "calendar" | |
| 3857 | '(progn | |
| 3858 | (org-defkey calendar-mode-map org-calendar-to-agenda-key | |
| 3859 | 'org-calendar-goto-agenda) | |
| 3860 | (add-hook 'calendar-mode-hook | |
| 3861 | (lambda () | |
| 3862 | (unless (eq org-agenda-diary-file 'diary-file) | |
| 3863 | (define-key calendar-mode-map | |
| 3864 | org-calendar-insert-diary-entry-key | |
| 3865 | 'org-agenda-diary-entry)))))) | |
| 3866 | ||
| 3867 | (defgroup org-latex nil | |
| 3868 | "Options for embedding LaTeX code into Org mode." | |
| 3869 | :tag "Org LaTeX" | |
| 3870 | :group 'org) | |
| 3871 | ||
| 3872 | (defcustom org-format-latex-options | |
| 3873 | '(:foreground default :background default :scale 1.0 | |
| 3874 | :html-foreground "Black" :html-background "Transparent" | |
| 3875 | :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) | |
| 3876 | "Options for creating images from LaTeX fragments. | |
| 3877 | This is a property list with the following properties: | |
| 3878 | :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". | |
| 3879 | `default' means use the foreground of the default face. | |
| 3880 | `auto' means use the foreground from the text face. | |
| 3881 | :background the background color, or \"Transparent\". | |
| 3882 | `default' means use the background of the default face. | |
| 3883 | `auto' means use the background from the text face. | |
| 3884 | :scale a scaling factor for the size of the images, to get more pixels | |
| 3885 | :html-foreground, :html-background, :html-scale | |
| 3886 | the same numbers for HTML export. | |
| 3887 | :matchers a list indicating which matchers should be used to | |
| 3888 | find LaTeX fragments. Valid members of this list are: | |
| 3889 | \"begin\" find environments | |
| 3890 | \"$1\" find single characters surrounded by $.$ | |
| 3891 | \"$\" find math expressions surrounded by $...$ | |
| 3892 | \"$$\" find math expressions surrounded by $$....$$ | |
| 3893 | \"\\(\" find math expressions surrounded by \\(...\\) | |
| 3894 | \"\\=\\[\" find math expressions surrounded by \\=\\[...\\]" | |
| 3895 | :group 'org-latex | |
| 3896 | :type 'plist) | |
| 3897 | ||
| 3898 | (defcustom org-format-latex-signal-error t | |
| 3899 | "Non-nil means signal an error when image creation of LaTeX snippets fails. | |
| 3900 | When nil, just push out a message." | |
| 3901 | :group 'org-latex | |
| 3902 | :version "24.1" | |
| 3903 | :type 'boolean) | |
| 3904 | ||
| 3905 | (defcustom org-latex-to-mathml-jar-file nil | |
| 3906 | "Value of\"%j\" in `org-latex-to-mathml-convert-command'. | |
| 3907 | Use this to specify additional executable file say a jar file. | |
| 3908 | ||
| 3909 | When using MathToWeb as the converter, specify the full-path to | |
| 3910 | your mathtoweb.jar file." | |
| 3911 | :group 'org-latex | |
| 3912 | :version "24.1" | |
| 3913 | :type '(choice | |
| 3914 | (const :tag "None" nil) | |
| 3915 | (file :tag "JAR file" :must-match t))) | |
| 3916 | ||
| 3917 | (defcustom org-latex-to-mathml-convert-command nil | |
| 3918 | "Command to convert LaTeX fragments to MathML. | |
| 3919 | Replace format-specifiers in the command as noted below and use | |
| 3920 | `shell-command' to convert LaTeX to MathML. | |
| 3921 | %j: Executable file in fully expanded form as specified by | |
| 3922 | `org-latex-to-mathml-jar-file'. | |
| 3923 | %I: Input LaTeX file in fully expanded form. | |
| 3924 | %i: The latex fragment to be converted. | |
| 3925 | %o: Output MathML file. | |
| 3926 | ||
| 3927 | This command is used by `org-create-math-formula'. | |
| 3928 | ||
| 3929 | When using MathToWeb as the converter, set this option to | |
| 3930 | \"java -jar %j -unicode -force -df %o %I\". | |
| 3931 | ||
| 3932 | When using LaTeXML set this option to | |
| 3933 | \"latexmlmath \"%i\" --presentationmathml=%o\"." | |
| 3934 | :group 'org-latex | |
| 3935 | :version "24.1" | |
| 3936 | :type '(choice | |
| 3937 | (const :tag "None" nil) | |
| 3938 | (string :tag "\nShell command"))) | |
| 3939 | ||
| 3940 | (defcustom org-preview-latex-default-process 'dvipng | |
| 3941 | "The default process to convert LaTeX fragments to image files. | |
| 3942 | All available processes and theirs documents can be found in | |
| 3943 | `org-preview-latex-process-alist', which see." | |
| 3944 | :group 'org-latex | |
| 3945 | :version "26.1" | |
| 3946 | :package-version '(Org . "9.0") | |
| 3947 | :type 'symbol) | |
| 3948 | ||
| 3949 | (defcustom org-preview-latex-process-alist | |
| 3950 | '((dvipng | |
| 3951 | :programs ("latex" "dvipng") | |
| 3952 | :description "dvi > png" | |
| 3953 | :message "you need to install the programs: latex and dvipng." | |
| 3954 | :image-input-type "dvi" | |
| 3955 | :image-output-type "png" | |
| 3956 | :image-size-adjust (1.0 . 1.0) | |
| 3957 | :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f") | |
| 3958 | :image-converter ("dvipng -fg %F -bg %B -D %D -T tight -o %O %f")) | |
| 3959 | (dvisvgm | |
| 3960 | :programs ("latex" "dvisvgm") | |
| 3961 | :description "dvi > svg" | |
| 3962 | :message "you need to install the programs: latex and dvisvgm." | |
| 3963 | :use-xcolor t | |
| 3964 | :image-input-type "dvi" | |
| 3965 | :image-output-type "svg" | |
| 3966 | :image-size-adjust (1.7 . 1.5) | |
| 3967 | :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f") | |
| 3968 | :image-converter ("dvisvgm %f -n -b min -c %S -o %O")) | |
| 3969 | (imagemagick | |
| 3970 | :programs ("latex" "convert") | |
| 3971 | :description "pdf > png" | |
| 3972 | :message "you need to install the programs: latex and imagemagick." | |
| 3973 | :use-xcolor t | |
| 3974 | :image-input-type "pdf" | |
| 3975 | :image-output-type "png" | |
| 3976 | :image-size-adjust (1.0 . 1.0) | |
| 3977 | :latex-compiler ("pdflatex -interaction nonstopmode -output-directory %o %f") | |
| 3978 | :image-converter | |
| 3979 | ("convert -density %D -trim -antialias %f -quality 100 %O"))) | |
| 3980 | "Definitions of external processes for LaTeX previewing. | |
| 3981 | Org mode can use some external commands to generate TeX snippet's images for | |
| 3982 | previewing or inserting into HTML files, e.g., \"dvipng\". This variable tells | |
| 3983 | `org-create-formula-image' how to call them. | |
| 3984 | ||
| 3985 | The value is an alist with the pattern (NAME . PROPERTIES). NAME is a symbol. | |
| 3986 | PROPERTIES accepts the following attributes: | |
| 3987 | ||
| 3988 | :programs list of strings, required programs. | |
| 3989 | :description string, describe the process. | |
| 3990 | :message string, message it when required programs cannot be found. | |
| 3991 | :image-input-type string, input file type of image converter (e.g., \"dvi\"). | |
| 3992 | :image-output-type string, output file type of image converter (e.g., \"png\"). | |
| 3993 | :use-xcolor boolean, when non-nil, LaTeX \"xcolor\" macro is used to | |
| 3994 | deal with background and foreground color of image. | |
| 3995 | Otherwise, dvipng style background and foreground color | |
| 3996 | format are generated. You may then refer to them in | |
| 3997 | command options with \"%F\" and \"%B\". | |
| 3998 | :image-size-adjust cons of numbers, the car element is used to adjust LaTeX | |
| 3999 | image size showed in buffer and the cdr element is for | |
| 4000 | HTML file. This option is only useful for process | |
| 4001 | developers, users should use variable | |
| 4002 | `org-format-latex-options' instead. | |
| 4003 | :post-clean list of strings, files matched are to be cleaned up once | |
| 4004 | the image is generated. When nil, the files with \".dvi\", | |
| 4005 | \".xdv\", \".pdf\", \".tex\", \".aux\", \".log\", \".svg\", | |
| 4006 | \".png\", \".jpg\", \".jpeg\" or \".out\" extension will | |
| 4007 | be cleaned up. | |
| 4008 | :latex-header list of strings, the LaTeX header of the snippet file. | |
| 4009 | When nil, the fallback value is used instead, which is | |
| 4010 | controlled by `org-format-latex-header', | |
| 4011 | `org-latex-default-packages-alist' and | |
| 4012 | `org-latex-packages-alist', which see. | |
| 4013 | :latex-compiler list of LaTeX commands, as strings. Each of them is given | |
| 4014 | to the shell. Place-holders \"%t\", \"%b\" and \"%o\" are | |
| 4015 | replaced with values defined below. | |
| 4016 | :image-converter list of image converter commands strings. Each of them is | |
| 4017 | given to the shell and supports any of the following | |
| 4018 | place-holders defined below. | |
| 4019 | ||
| 4020 | Place-holders used by `:image-converter' and `:latex-compiler': | |
| 4021 | ||
| 4022 | %f input file name | |
| 4023 | %b base name of input file | |
| 4024 | %o base directory of input file | |
| 4025 | %O absolute output file name | |
| 4026 | ||
| 4027 | Place-holders only used by `:image-converter': | |
| 4028 | ||
| 4029 | %F foreground of image | |
| 4030 | %B background of image | |
| 4031 | %D dpi, which is used to adjust image size by some processing commands. | |
| 4032 | %S the image size scale ratio, which is used to adjust image size by some | |
| 4033 | processing commands." | |
| 4034 | :group 'org-latex | |
| 4035 | :version "26.1" | |
| 4036 | :package-version '(Org . "9.0") | |
| 4037 | :type '(alist :tag "LaTeX to image backends" | |
| 4038 | :value-type (plist))) | |
| 4039 | ||
| 4040 | (defcustom org-preview-latex-image-directory "ltximg/" | |
| 4041 | "Path to store latex preview images. | |
| 4042 | A relative path here creates many directories relative to the | |
| 4043 | processed Org files paths. An absolute path puts all preview | |
| 4044 | images at the same place." | |
| 4045 | :group 'org-latex | |
| 4046 | :version "26.1" | |
| 4047 | :package-version '(Org . "9.0") | |
| 4048 | :type 'string) | |
| 4049 | ||
| 4050 | (defun org-format-latex-mathml-available-p () | |
| 4051 | "Return t if `org-latex-to-mathml-convert-command' is usable." | |
| 4052 | (save-match-data | |
| 4053 | (when (and (boundp 'org-latex-to-mathml-convert-command) | |
| 4054 | org-latex-to-mathml-convert-command) | |
| 4055 | (let ((executable (car (split-string | |
| 4056 | org-latex-to-mathml-convert-command)))) | |
| 4057 | (when (executable-find executable) | |
| 4058 | (if (string-match | |
| 4059 | "%j" org-latex-to-mathml-convert-command) | |
| 4060 | (file-readable-p org-latex-to-mathml-jar-file) | |
| 4061 | t)))))) | |
| 4062 | ||
| 4063 | (defcustom org-format-latex-header "\\documentclass{article} | |
| 4064 | \\usepackage[usenames]{color} | |
| 4065 | \[PACKAGES] | |
| 4066 | \[DEFAULT-PACKAGES] | |
| 4067 | \\pagestyle{empty} % do not remove | |
| 4068 | % The settings below are copied from fullpage.sty | |
| 4069 | \\setlength{\\textwidth}{\\paperwidth} | |
| 4070 | \\addtolength{\\textwidth}{-3cm} | |
| 4071 | \\setlength{\\oddsidemargin}{1.5cm} | |
| 4072 | \\addtolength{\\oddsidemargin}{-2.54cm} | |
| 4073 | \\setlength{\\evensidemargin}{\\oddsidemargin} | |
| 4074 | \\setlength{\\textheight}{\\paperheight} | |
| 4075 | \\addtolength{\\textheight}{-\\headheight} | |
| 4076 | \\addtolength{\\textheight}{-\\headsep} | |
| 4077 | \\addtolength{\\textheight}{-\\footskip} | |
| 4078 | \\addtolength{\\textheight}{-3cm} | |
| 4079 | \\setlength{\\topmargin}{1.5cm} | |
| 4080 | \\addtolength{\\topmargin}{-2.54cm}" | |
| 4081 | "The document header used for processing LaTeX fragments. | |
| 4082 | It is imperative that this header make sure that no page number | |
| 4083 | appears on the page. The package defined in the variables | |
| 4084 | `org-latex-default-packages-alist' and `org-latex-packages-alist' | |
| 4085 | will either replace the placeholder \"[PACKAGES]\" in this | |
| 4086 | header, or they will be appended." | |
| 4087 | :group 'org-latex | |
| 4088 | :type 'string) | |
| 4089 | ||
| 4090 | (defun org-set-packages-alist (var val) | |
| 4091 | "Set the packages alist and make sure it has 3 elements per entry." | |
| 4092 | (set var (mapcar (lambda (x) | |
| 4093 | (if (and (consp x) (= (length x) 2)) | |
| 4094 | (list (car x) (nth 1 x) t) | |
| 4095 | x)) | |
| 4096 | val))) | |
| 4097 | ||
| 4098 | (defun org-get-packages-alist (var) | |
| 4099 | "Get the packages alist and make sure it has 3 elements per entry." | |
| 4100 | (mapcar (lambda (x) | |
| 4101 | (if (and (consp x) (= (length x) 2)) | |
| 4102 | (list (car x) (nth 1 x) t) | |
| 4103 | x)) | |
| 4104 | (default-value var))) | |
| 4105 | ||
| 4106 | (defcustom org-latex-default-packages-alist | |
| 4107 | '(("AUTO" "inputenc" t ("pdflatex")) | |
| 4108 | ("T1" "fontenc" t ("pdflatex")) | |
| 4109 | ("" "graphicx" t) | |
| 4110 | ("" "grffile" t) | |
| 4111 | ("" "longtable" nil) | |
| 4112 | ("" "wrapfig" nil) | |
| 4113 | ("" "rotating" nil) | |
| 4114 | ("normalem" "ulem" t) | |
| 4115 | ("" "amsmath" t) | |
| 4116 | ("" "textcomp" t) | |
| 4117 | ("" "amssymb" t) | |
| 4118 | ("" "capt-of" nil) | |
| 4119 | ("" "hyperref" nil)) | |
| 4120 | "Alist of default packages to be inserted in the header. | |
| 4121 | ||
| 4122 | Change this only if one of the packages here causes an | |
| 4123 | incompatibility with another package you are using. | |
| 4124 | ||
| 4125 | The packages in this list are needed by one part or another of | |
| 4126 | Org mode to function properly: | |
| 4127 | ||
| 4128 | - inputenc, fontenc: for basic font and character selection | |
| 4129 | - graphicx: for including images | |
| 4130 | - grffile: allow periods and spaces in graphics file names | |
| 4131 | - longtable: For multipage tables | |
| 4132 | - wrapfig: for figure placement | |
| 4133 | - rotating: for sideways figures and tables | |
| 4134 | - ulem: for underline and strike-through | |
| 4135 | - amsmath: for subscript and superscript and math environments | |
| 4136 | - textcomp, amssymb: for various symbols used | |
| 4137 | for interpreting the entities in `org-entities'. You can skip | |
| 4138 | some of these packages if you don't use any of their symbols. | |
| 4139 | - capt-of: for captions outside of floats | |
| 4140 | - hyperref: for cross references | |
| 4141 | ||
| 4142 | Therefore you should not modify this variable unless you know | |
| 4143 | what you are doing. The one reason to change it anyway is that | |
| 4144 | you might be loading some other package that conflicts with one | |
| 4145 | of the default packages. Each element is either a cell or | |
| 4146 | a string. | |
| 4147 | ||
| 4148 | A cell is of the format | |
| 4149 | ||
| 4150 | (\"options\" \"package\" SNIPPET-FLAG COMPILERS) | |
| 4151 | ||
| 4152 | If SNIPPET-FLAG is non-nil, the package also needs to be included | |
| 4153 | when compiling LaTeX snippets into images for inclusion into | |
| 4154 | non-LaTeX output. COMPILERS is a list of compilers that should | |
| 4155 | include the package, see `org-latex-compiler'. If the document | |
| 4156 | compiler is not in the list, and the list is non-nil, the package | |
| 4157 | will not be inserted in the final document. | |
| 4158 | ||
| 4159 | A string will be inserted as-is in the header of the document." | |
| 4160 | :group 'org-latex | |
| 4161 | :group 'org-export-latex | |
| 4162 | :set 'org-set-packages-alist | |
| 4163 | :get 'org-get-packages-alist | |
| 4164 | :version "26.1" | |
| 4165 | :package-version '(Org . "8.3") | |
| 4166 | :type '(repeat | |
| 4167 | (choice | |
| 4168 | (list :tag "options/package pair" | |
| 4169 | (string :tag "options") | |
| 4170 | (string :tag "package") | |
| 4171 | (boolean :tag "Snippet") | |
| 4172 | (choice | |
| 4173 | (const :tag "For all compilers" nil) | |
| 4174 | (repeat :tag "Allowed compiler" string))) | |
| 4175 | (string :tag "A line of LaTeX")))) | |
| 4176 | ||
| 4177 | (defcustom org-latex-packages-alist nil | |
| 4178 | "Alist of packages to be inserted in every LaTeX header. | |
| 4179 | ||
| 4180 | These will be inserted after `org-latex-default-packages-alist'. | |
| 4181 | Each element is either a cell or a string. | |
| 4182 | ||
| 4183 | A cell is of the format: | |
| 4184 | ||
| 4185 | (\"options\" \"package\" SNIPPET-FLAG) | |
| 4186 | ||
| 4187 | SNIPPET-FLAG, when non-nil, indicates that this package is also | |
| 4188 | needed when turning LaTeX snippets into images for inclusion into | |
| 4189 | non-LaTeX output. | |
| 4190 | ||
| 4191 | A string will be inserted as-is in the header of the document. | |
| 4192 | ||
| 4193 | Make sure that you only list packages here which: | |
| 4194 | ||
| 4195 | - you want in every file; | |
| 4196 | - do not conflict with the setup in `org-format-latex-header'; | |
| 4197 | - do not conflict with the default packages in | |
| 4198 | `org-latex-default-packages-alist'." | |
| 4199 | :group 'org-latex | |
| 4200 | :group 'org-export-latex | |
| 4201 | :set 'org-set-packages-alist | |
| 4202 | :get 'org-get-packages-alist | |
| 4203 | :type '(repeat | |
| 4204 | (choice | |
| 4205 | (list :tag "options/package pair" | |
| 4206 | (string :tag "options") | |
| 4207 | (string :tag "package") | |
| 4208 | (boolean :tag "Snippet")) | |
| 4209 | (string :tag "A line of LaTeX")))) | |
| 4210 | ||
| 4211 | (defgroup org-appearance nil | |
| 4212 | "Settings for Org mode appearance." | |
| 4213 | :tag "Org Appearance" | |
| 4214 | :group 'org) | |
| 4215 | ||
| 4216 | (defcustom org-level-color-stars-only nil | |
| 4217 | "Non-nil means fontify only the stars in each headline. | |
| 4218 | When nil, the entire headline is fontified. | |
| 4219 | Changing it requires restart of `font-lock-mode' to become effective | |
| 4220 | also in regions already fontified." | |
| 4221 | :group 'org-appearance | |
| 4222 | :type 'boolean) | |
| 4223 | ||
| 4224 | (defcustom org-hide-leading-stars nil | |
| 4225 | "Non-nil means hide the first N-1 stars in a headline. | |
| 4226 | This works by using the face `org-hide' for these stars. This | |
| 4227 | face is white for a light background, and black for a dark | |
| 4228 | background. You may have to customize the face `org-hide' to | |
| 4229 | make this work. | |
| 4230 | Changing it requires restart of `font-lock-mode' to become effective | |
| 4231 | also in regions already fontified. | |
| 4232 | You may also set this on a per-file basis by adding one of the following | |
| 4233 | lines to the buffer: | |
| 4234 | ||
| 4235 | #+STARTUP: hidestars | |
| 4236 | #+STARTUP: showstars" | |
| 4237 | :group 'org-appearance | |
| 4238 | :type 'boolean) | |
| 4239 | ||
| 4240 | (defcustom org-hidden-keywords nil | |
| 4241 | "List of symbols corresponding to keywords to be hidden in the Org buffer. | |
| 4242 | For example, a value \\='(title) for this list makes the document's title | |
| 4243 | appear in the buffer without the initial \"#+TITLE:\" part." | |
| 4244 | :group 'org-appearance | |
| 4245 | :version "24.1" | |
| 4246 | :type '(set (const :tag "#+AUTHOR" author) | |
| 4247 | (const :tag "#+DATE" date) | |
| 4248 | (const :tag "#+EMAIL" email) | |
| 4249 | (const :tag "#+TITLE" title))) | |
| 4250 | ||
| 4251 | (defcustom org-custom-properties nil | |
| 4252 | "List of properties (as strings) with a special meaning. | |
| 4253 | The default use of these custom properties is to let the user | |
| 4254 | hide them with `org-toggle-custom-properties-visibility'." | |
| 4255 | :group 'org-properties | |
| 4256 | :group 'org-appearance | |
| 4257 | :version "24.3" | |
| 4258 | :type '(repeat (string :tag "Property Name"))) | |
| 4259 | ||
| 4260 | (defcustom org-fontify-done-headline nil | |
| 4261 | "Non-nil means change the face of a headline if it is marked DONE. | |
| 4262 | Normally, only the TODO/DONE keyword indicates the state of a headline. | |
| 4263 | When this is non-nil, the headline after the keyword is set to the | |
| 4264 | `org-headline-done' as an additional indication." | |
| 4265 | :group 'org-appearance | |
| 4266 | :type 'boolean) | |
| 4267 | ||
| 4268 | (defcustom org-fontify-emphasized-text t | |
| 4269 | "Non-nil means fontify *bold*, /italic/ and _underlined_ text. | |
| 4270 | Changing this variable requires a restart of Emacs to take effect." | |
| 4271 | :group 'org-appearance | |
| 4272 | :type 'boolean) | |
| 4273 | ||
| 4274 | (defcustom org-fontify-whole-heading-line nil | |
| 4275 | "Non-nil means fontify the whole line for headings. | |
| 4276 | This is useful when setting a background color for the | |
| 4277 | org-level-* faces." | |
| 4278 | :group 'org-appearance | |
| 4279 | :type 'boolean) | |
| 4280 | ||
| 4281 | (defcustom org-highlight-latex-and-related nil | |
| 4282 | "Non-nil means highlight LaTeX related syntax in the buffer. | |
| 4283 | When non nil, the value should be a list containing any of the | |
| 4284 | following symbols: | |
| 4285 | `latex' Highlight LaTeX snippets and environments. | |
| 4286 | `script' Highlight subscript and superscript. | |
| 4287 | `entities' Highlight entities." | |
| 4288 | :group 'org-appearance | |
| 4289 | :version "24.4" | |
| 4290 | :package-version '(Org . "8.0") | |
| 4291 | :type '(choice | |
| 4292 | (const :tag "No highlighting" nil) | |
| 4293 | (set :greedy t :tag "Highlight" | |
| 4294 | (const :tag "LaTeX snippets and environments" latex) | |
| 4295 | (const :tag "Subscript and superscript" script) | |
| 4296 | (const :tag "Entities" entities)))) | |
| 4297 | ||
| 4298 | (defcustom org-hide-emphasis-markers nil | |
| 4299 | "Non-nil mean font-lock should hide the emphasis marker characters." | |
| 4300 | :group 'org-appearance | |
| 4301 | :type 'boolean) | |
| 4302 | ||
| 4303 | (defcustom org-hide-macro-markers nil | |
| 4304 | "Non-nil mean font-lock should hide the brackets marking macro calls." | |
| 4305 | :group 'org-appearance | |
| 4306 | :type 'boolean) | |
| 4307 | ||
| 4308 | (defcustom org-pretty-entities nil | |
| 4309 | "Non-nil means show entities as UTF8 characters. | |
| 4310 | When nil, the \\name form remains in the buffer." | |
| 4311 | :group 'org-appearance | |
| 4312 | :version "24.1" | |
| 4313 | :type 'boolean) | |
| 4314 | ||
| 4315 | (defcustom org-pretty-entities-include-sub-superscripts t | |
| 4316 | "Non-nil means, pretty entity display includes formatting sub/superscripts." | |
| 4317 | :group 'org-appearance | |
| 4318 | :version "24.1" | |
| 4319 | :type 'boolean) | |
| 4320 | ||
| 4321 | (defvar org-emph-re nil | |
| 4322 | "Regular expression for matching emphasis. | |
| 4323 | After a match, the match groups contain these elements: | |
| 4324 | 0 The match of the full regular expression, including the characters | |
| 4325 | before and after the proper match | |
| 4326 | 1 The character before the proper match, or empty at beginning of line | |
| 4327 | 2 The proper match, including the leading and trailing markers | |
| 4328 | 3 The leading marker like * or /, indicating the type of highlighting | |
| 4329 | 4 The text between the emphasis markers, not including the markers | |
| 4330 | 5 The character after the match, empty at the end of a line") | |
| 4331 | ||
| 4332 | (defvar org-verbatim-re nil | |
| 4333 | "Regular expression for matching verbatim text.") | |
| 4334 | ||
| 4335 | (defvar org-emphasis-regexp-components) ; defined just below | |
| 4336 | (defvar org-emphasis-alist) ; defined just below | |
| 4337 | (defun org-set-emph-re (var val) | |
| 4338 | "Set variable and compute the emphasis regular expression." | |
| 4339 | (set var val) | |
| 4340 | (when (and (boundp 'org-emphasis-alist) | |
| 4341 | (boundp 'org-emphasis-regexp-components) | |
| 4342 | org-emphasis-alist org-emphasis-regexp-components) | |
| 4343 | (pcase-let* | |
| 4344 | ((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components) | |
| 4345 | (body (if (<= nl 0) body | |
| 4346 | (format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl))) | |
| 4347 | (template | |
| 4348 | (format (concat "\\([%s]\\|^\\)" ;before markers | |
| 4349 | "\\(\\([%%s]\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)" | |
| 4350 | "\\([%s]\\|$\\)") ;after markers | |
| 4351 | pre border border body border post))) | |
| 4352 | (setq org-emph-re (format template "*/_+")) | |
| 4353 | (setq org-verbatim-re (format template "=~"))))) | |
| 4354 | ||
| 4355 | ;; This used to be a defcustom (Org <8.0) but allowing the users to | |
| 4356 | ;; set this option proved cumbersome. See this message/thread: | |
| 4357 | ;; http://article.gmane.org/gmane.emacs.orgmode/68681 | |
| 4358 | (defvar org-emphasis-regexp-components | |
| 4359 | '("- \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1) | |
| 4360 | "Components used to build the regular expression for emphasis. | |
| 4361 | This is a list with five entries. Terminology: In an emphasis string | |
| 4362 | like \" *strong word* \", we call the initial space PREMATCH, the final | |
| 4363 | space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters | |
| 4364 | and \"trong wor\" is the body. The different components in this variable | |
| 4365 | specify what is allowed/forbidden in each part: | |
| 4366 | ||
| 4367 | pre Chars allowed as prematch. Beginning of line will be allowed too. | |
| 4368 | post Chars allowed as postmatch. End of line will be allowed too. | |
| 4369 | border The chars *forbidden* as border characters. | |
| 4370 | body-regexp A regexp like \".\" to match a body character. Don't use | |
| 4371 | non-shy groups here, and don't allow newline here. | |
| 4372 | newline The maximum number of newlines allowed in an emphasis exp. | |
| 4373 | ||
| 4374 | You need to reload Org or to restart Emacs after customizing this.") | |
| 4375 | ||
| 4376 | (defcustom org-emphasis-alist | |
| 4377 | '(("*" bold) | |
| 4378 | ("/" italic) | |
| 4379 | ("_" underline) | |
| 4380 | ("=" org-verbatim verbatim) | |
| 4381 | ("~" org-code verbatim) | |
| 4382 | ("+" (:strike-through t))) | |
| 4383 | "Alist of characters and faces to emphasize text. | |
| 4384 | Text starting and ending with a special character will be emphasized, | |
| 4385 | for example *bold*, _underlined_ and /italic/. This variable sets the | |
| 4386 | marker characters and the face to be used by font-lock for highlighting | |
| 4387 | in Org buffers. | |
| 4388 | ||
| 4389 | You need to reload Org or to restart Emacs after customizing this." | |
| 4390 | :group 'org-appearance | |
| 4391 | :set 'org-set-emph-re | |
| 4392 | :version "24.4" | |
| 4393 | :package-version '(Org . "8.0") | |
| 4394 | :type '(repeat | |
| 4395 | (list | |
| 4396 | (string :tag "Marker character") | |
| 4397 | (choice | |
| 4398 | (face :tag "Font-lock-face") | |
| 4399 | (plist :tag "Face property list")) | |
| 4400 | (option (const verbatim))))) | |
| 4401 | ||
| 4402 | (defvar org-protecting-blocks '("src" "example" "export") | |
| 4403 | "Blocks that contain text that is quoted, i.e. not processed as Org syntax. | |
| 4404 | This is needed for font-lock setup.") | |
| 4405 | ||
| 4406 | ;;; Functions and variables from their packages | |
| 4407 | ;; Declared here to avoid compiler warnings | |
| 4408 | (defvar mark-active) | |
| 4409 | ||
| 4410 | ;; Various packages | |
| 4411 | (declare-function calc-eval "calc" (str &optional separator &rest args)) | |
| 4412 | (declare-function calendar-forward-day "cal-move" (arg)) | |
| 4413 | (declare-function calendar-goto-date "cal-move" (date)) | |
| 4414 | (declare-function calendar-goto-today "cal-move" ()) | |
| 4415 | (declare-function calendar-iso-from-absolute "cal-iso" (date)) | |
| 4416 | (declare-function calendar-iso-to-absolute "cal-iso" (date)) | |
| 4417 | (declare-function cdlatex-compute-tables "ext:cdlatex" ()) | |
| 4418 | (declare-function cdlatex-tab "ext:cdlatex" ()) | |
| 4419 | (declare-function dired-get-filename | |
| 4420 | "dired" | |
| 4421 | (&optional localp no-error-if-not-filep)) | |
| 4422 | (declare-function iswitchb-read-buffer | |
| 4423 | "iswitchb" | |
| 4424 | (prompt &optional | |
| 4425 | default require-match _predicate start matches-set)) | |
| 4426 | (declare-function org-agenda-change-all-lines | |
| 4427 | "org-agenda" | |
| 4428 | (newhead hdmarker &optional fixface just-this)) | |
| 4429 | (declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item | |
| 4430 | "org-agenda" | |
| 4431 | (&optional end)) | |
| 4432 | (declare-function org-agenda-copy-local-variable "org-agenda" (var)) | |
| 4433 | (declare-function org-agenda-format-item | |
| 4434 | "org-agenda" | |
| 4435 | (extra txt &optional level category tags dotime | |
| 4436 | remove-re habitp)) | |
| 4437 | (declare-function org-agenda-maybe-redo "org-agenda" ()) | |
| 4438 | (declare-function org-agenda-new-marker "org-agenda" (&optional pos)) | |
| 4439 | (declare-function org-agenda-save-markers-for-cut-and-paste | |
| 4440 | "org-agenda" | |
| 4441 | (beg end)) | |
| 4442 | (declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) | |
| 4443 | (declare-function org-agenda-skip "org-agenda" ()) | |
| 4444 | (declare-function org-attach-reveal "org-attach" (&optional if-exists)) | |
| 4445 | (declare-function org-gnus-follow-link "org-gnus" (&optional group article)) | |
| 4446 | (declare-function org-indent-mode "org-indent" (&optional arg)) | |
| 4447 | (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) | |
| 4448 | (declare-function org-inlinetask-goto-end "org-inlinetask" ()) | |
| 4449 | (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) | |
| 4450 | (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) | |
| 4451 | (declare-function orgtbl-send-table "org-table" (&optional maybe)) | |
| 4452 | (declare-function parse-time-string "parse-time" (string)) | |
| 4453 | (declare-function speedbar-line-directory "speedbar" (&optional depth)) | |
| 4454 | ||
| 4455 | (defvar align-mode-rules-list) | |
| 4456 | (defvar calc-embedded-close-formula) | |
| 4457 | (defvar calc-embedded-open-formula) | |
| 4458 | (defvar calc-embedded-open-mode) | |
| 4459 | (defvar font-lock-unfontify-region-function) | |
| 4460 | (defvar iswitchb-temp-buflist) | |
| 4461 | (defvar org-agenda-tags-todo-honor-ignore-options) | |
| 4462 | (defvar remember-data-file) | |
| 4463 | (defvar texmathp-why) | |
| 4464 | ||
| 4465 | ;;;###autoload | |
| 4466 | (defun turn-on-orgtbl () | |
| 4467 | "Unconditionally turn on `orgtbl-mode'." | |
| 4468 | (require 'org-table) | |
| 4469 | (orgtbl-mode 1)) | |
| 4470 | ||
| 4471 | (defun org-at-table-p (&optional table-type) | |
| 4472 | "Non-nil if the cursor is inside an Org table. | |
| 4473 | If TABLE-TYPE is non-nil, also check for table.el-type tables." | |
| 4474 | (and (org-match-line (if table-type "[ \t]*[|+]" "[ \t]*|")) | |
| 4475 | (or (not (derived-mode-p 'org-mode)) | |
| 4476 | (let ((e (org-element-lineage (org-element-at-point) '(table) t))) | |
| 4477 | (and e (or table-type | |
| 4478 | (eq 'org (org-element-property :type e)))))))) | |
| 4479 | ||
| 4480 | (defun org-at-table.el-p () | |
| 4481 | "Non-nil when point is at a table.el table." | |
| 4482 | (and (org-match-line "[ \t]*[|+]") | |
| 4483 | (let ((element (org-element-at-point))) | |
| 4484 | (and (eq (org-element-type element) 'table) | |
| 4485 | (eq (org-element-property :type element) 'table.el))))) | |
| 4486 | ||
| 4487 | (defun org-at-table-hline-p () | |
| 4488 | "Non-nil when point is inside a hline in a table. | |
| 4489 | Assume point is already in a table." | |
| 4490 | (org-match-line org-table-hline-regexp)) | |
| 4491 | ||
| 4492 | (defun org-table-map-tables (function &optional quietly) | |
| 4493 | "Apply FUNCTION to the start of all tables in the buffer." | |
| 4494 | (org-with-wide-buffer | |
| 4495 | (goto-char (point-min)) | |
| 4496 | (while (re-search-forward org-table-any-line-regexp nil t) | |
| 4497 | (unless quietly | |
| 4498 | (message "Mapping tables: %d%%" | |
| 4499 | (floor (* 100.0 (point)) (buffer-size)))) | |
| 4500 | (beginning-of-line 1) | |
| 4501 | (when (and (looking-at org-table-line-regexp) | |
| 4502 | ;; Exclude tables in src/example/verbatim/clocktable blocks | |
| 4503 | (not (org-in-block-p '("src" "example" "verbatim" "clocktable")))) | |
| 4504 | (save-excursion (funcall function)) | |
| 4505 | (or (looking-at org-table-line-regexp) | |
| 4506 | (forward-char 1))) | |
| 4507 | (re-search-forward org-table-any-border-regexp nil 1))) | |
| 4508 | (unless quietly (message "Mapping tables: done"))) | |
| 4509 | ||
| 4510 | (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) | |
| 4511 | (declare-function org-clock-update-mode-line "org-clock" ()) | |
| 4512 | (declare-function org-resolve-clocks "org-clock" | |
| 4513 | (&optional also-non-dangling-p prompt last-valid)) | |
| 4514 | ||
| 4515 | (defun org-at-TBLFM-p (&optional pos) | |
| 4516 | "Non-nil when point (or POS) is in #+TBLFM line." | |
| 4517 | (save-excursion | |
| 4518 | (goto-char (or pos (point))) | |
| 4519 | (beginning-of-line) | |
| 4520 | (and (let ((case-fold-search t)) (looking-at org-TBLFM-regexp)) | |
| 4521 | (eq (org-element-type (org-element-at-point)) 'table)))) | |
| 4522 | ||
| 4523 | (defvar org-clock-start-time) | |
| 4524 | (defvar org-clock-marker (make-marker) | |
| 4525 | "Marker recording the last clock-in.") | |
| 4526 | (defvar org-clock-hd-marker (make-marker) | |
| 4527 | "Marker recording the last clock-in, but the headline position.") | |
| 4528 | (defvar org-clock-heading "" | |
| 4529 | "The heading of the current clock entry.") | |
| 4530 | (defun org-clock-is-active () | |
| 4531 | "Return the buffer where the clock is currently running. | |
| 4532 | Return nil if no clock is running." | |
| 4533 | (marker-buffer org-clock-marker)) | |
| 4534 | ||
| 4535 | (defun org-check-running-clock () | |
| 4536 | "Check if the current buffer contains the running clock. | |
| 4537 | If yes, offer to stop it and to save the buffer with the changes." | |
| 4538 | (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) | |
| 4539 | (y-or-n-p (format "Clock-out in buffer %s before killing it? " | |
| 4540 | (buffer-name)))) | |
| 4541 | (org-clock-out) | |
| 4542 | (when (y-or-n-p "Save changed buffer?") | |
| 4543 | (save-buffer)))) | |
| 4544 | ||
| 4545 | (defun org-clocktable-try-shift (dir n) | |
| 4546 | "Check if this line starts a clock table, if yes, shift the time block." | |
| 4547 | (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>") | |
| 4548 | (org-clocktable-shift dir n))) | |
| 4549 | ||
| 4550 | ;;;###autoload | |
| 4551 | (defun org-clock-persistence-insinuate () | |
| 4552 | "Set up hooks for clock persistence." | |
| 4553 | (require 'org-clock) | |
| 4554 | (add-hook 'org-mode-hook 'org-clock-load) | |
| 4555 | (add-hook 'kill-emacs-hook 'org-clock-save)) | |
| 4556 | ||
| 4557 | (defgroup org-archive nil | |
| 4558 | "Options concerning archiving in Org mode." | |
| 4559 | :tag "Org Archive" | |
| 4560 | :group 'org-structure) | |
| 4561 | ||
| 4562 | (defcustom org-archive-location "%s_archive::" | |
| 4563 | "The location where subtrees should be archived. | |
| 4564 | ||
| 4565 | The value of this variable is a string, consisting of two parts, | |
| 4566 | separated by a double-colon. The first part is a filename and | |
| 4567 | the second part is a headline. | |
| 4568 | ||
| 4569 | When the filename is omitted, archiving happens in the same file. | |
| 4570 | %s in the filename will be replaced by the current file | |
| 4571 | name (without the directory part). Archiving to a different file | |
| 4572 | is useful to keep archived entries from contributing to the | |
| 4573 | Org Agenda. | |
| 4574 | ||
| 4575 | The archived entries will be filed as subtrees of the specified | |
| 4576 | headline. When the headline is omitted, the subtrees are simply | |
| 4577 | filed away at the end of the file, as top-level entries. Also in | |
| 4578 | the heading you can use %s to represent the file name, this can be | |
| 4579 | useful when using the same archive for a number of different files. | |
| 4580 | ||
| 4581 | Here are a few examples: | |
| 4582 | \"%s_archive::\" | |
| 4583 | If the current file is Projects.org, archive in file | |
| 4584 | Projects.org_archive, as top-level trees. This is the default. | |
| 4585 | ||
| 4586 | \"::* Archived Tasks\" | |
| 4587 | Archive in the current file, under the top-level headline | |
| 4588 | \"* Archived Tasks\". | |
| 4589 | ||
| 4590 | \"~/org/archive.org::\" | |
| 4591 | Archive in file ~/org/archive.org (absolute path), as top-level trees. | |
| 4592 | ||
| 4593 | \"~/org/archive.org::* From %s\" | |
| 4594 | Archive in file ~/org/archive.org (absolute path), under headlines | |
| 4595 | \"From FILENAME\" where file name is the current file name. | |
| 4596 | ||
| 4597 | \"~/org/datetree.org::datetree/* Finished Tasks\" | |
| 4598 | The \"datetree/\" string is special, signifying to archive | |
| 4599 | items to the datetree. Items are placed in either the CLOSED | |
| 4600 | date of the item, or the current date if there is no CLOSED date. | |
| 4601 | The heading will be a subentry to the current date. There doesn't | |
| 4602 | need to be a heading, but there always needs to be a slash after | |
| 4603 | datetree. For example, to store archived items directly in the | |
| 4604 | datetree, use \"~/org/datetree.org::datetree/\". | |
| 4605 | ||
| 4606 | \"basement::** Finished Tasks\" | |
| 4607 | Archive in file ./basement (relative path), as level 3 trees | |
| 4608 | below the level 2 heading \"** Finished Tasks\". | |
| 4609 | ||
| 4610 | You may set this option on a per-file basis by adding to the buffer a | |
| 4611 | line like | |
| 4612 | ||
| 4613 | #+ARCHIVE: basement::** Finished Tasks | |
| 4614 | ||
| 4615 | You may also define it locally for a subtree by setting an ARCHIVE property | |
| 4616 | in the entry. If such a property is found in an entry, or anywhere up | |
| 4617 | the hierarchy, it will be used." | |
| 4618 | :group 'org-archive | |
| 4619 | :type 'string) | |
| 4620 | ||
| 4621 | (defcustom org-agenda-skip-archived-trees t | |
| 4622 | "Non-nil means the agenda will skip any items located in archived trees. | |
| 4623 | An archived tree is a tree marked with the tag ARCHIVE. The use of this | |
| 4624 | variable is no longer recommended, you should leave it at the value t. | |
| 4625 | Instead, use the key `v' to cycle the archives-mode in the agenda." | |
| 4626 | :group 'org-archive | |
| 4627 | :group 'org-agenda-skip | |
| 4628 | :type 'boolean) | |
| 4629 | ||
| 4630 | (defcustom org-columns-skip-archived-trees t | |
| 4631 | "Non-nil means ignore archived trees when creating column view." | |
| 4632 | :group 'org-archive | |
| 4633 | :group 'org-properties | |
| 4634 | :type 'boolean) | |
| 4635 | ||
| 4636 | (defcustom org-cycle-open-archived-trees nil | |
| 4637 | "Non-nil means `org-cycle' will open archived trees. | |
| 4638 | An archived tree is a tree marked with the tag ARCHIVE. | |
| 4639 | When nil, archived trees will stay folded. You can still open them with | |
| 4640 | normal outline commands like `show-all', but not with the cycling commands." | |
| 4641 | :group 'org-archive | |
| 4642 | :group 'org-cycle | |
| 4643 | :type 'boolean) | |
| 4644 | ||
| 4645 | (defcustom org-sparse-tree-open-archived-trees nil | |
| 4646 | "Non-nil means sparse tree construction shows matches in archived trees. | |
| 4647 | When nil, matches in these trees are highlighted, but the trees are kept in | |
| 4648 | collapsed state." | |
| 4649 | :group 'org-archive | |
| 4650 | :group 'org-sparse-trees | |
| 4651 | :type 'boolean) | |
| 4652 | ||
| 4653 | (defcustom org-sparse-tree-default-date-type nil | |
| 4654 | "The default date type when building a sparse tree. | |
| 4655 | When this is nil, a date is a scheduled or a deadline timestamp. | |
| 4656 | Otherwise, these types are allowed: | |
| 4657 | ||
| 4658 | all: all timestamps | |
| 4659 | active: only active timestamps (<...>) | |
| 4660 | inactive: only inactive timestamps ([...]) | |
| 4661 | scheduled: only scheduled timestamps | |
| 4662 | deadline: only deadline timestamps" | |
| 4663 | :type '(choice (const :tag "Scheduled or deadline" nil) | |
| 4664 | (const :tag "All timestamps" all) | |
| 4665 | (const :tag "Only active timestamps" active) | |
| 4666 | (const :tag "Only inactive timestamps" inactive) | |
| 4667 | (const :tag "Only scheduled timestamps" scheduled) | |
| 4668 | (const :tag "Only deadline timestamps" deadline) | |
| 4669 | (const :tag "Only closed timestamps" closed)) | |
| 4670 | :version "26.1" | |
| 4671 | :package-version '(Org . "8.3") | |
| 4672 | :group 'org-sparse-trees) | |
| 4673 | ||
| 4674 | (defun org-cycle-hide-archived-subtrees (state) | |
| 4675 | "Re-hide all archived subtrees after a visibility state change. | |
| 4676 | STATE should be one of the symbols listed in the docstring of | |
| 4677 | `org-cycle-hook'." | |
| 4678 | (when (and (not org-cycle-open-archived-trees) | |
| 4679 | (not (memq state '(overview folded)))) | |
| 4680 | (save-excursion | |
| 4681 | (let* ((globalp (memq state '(contents all))) | |
| 4682 | (beg (if globalp (point-min) (point))) | |
| 4683 | (end (if globalp (point-max) (org-end-of-subtree t)))) | |
| 4684 | (org-hide-archived-subtrees beg end) | |
| 4685 | (goto-char beg) | |
| 4686 | (when (looking-at-p (concat ".*:" org-archive-tag ":")) | |
| 4687 | (message "%s" (substitute-command-keys | |
| 4688 | "Subtree is archived and stays closed. Use \ | |
| 4689 | `\\[org-force-cycle-archived]' to cycle it anyway."))))))) | |
| 4690 | ||
| 4691 | (defun org-force-cycle-archived () | |
| 4692 | "Cycle subtree even if it is archived." | |
| 4693 | (interactive) | |
| 4694 | (setq this-command 'org-cycle) | |
| 4695 | (let ((org-cycle-open-archived-trees t)) | |
| 4696 | (call-interactively 'org-cycle))) | |
| 4697 | ||
| 4698 | (defun org-hide-archived-subtrees (beg end) | |
| 4699 | "Re-hide all archived subtrees after a visibility state change." | |
| 4700 | (org-with-wide-buffer | |
| 4701 | (let ((case-fold-search nil) | |
| 4702 | (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":"))) | |
| 4703 | (goto-char beg) | |
| 4704 | ;; Include headline point is currently on. | |
| 4705 | (beginning-of-line) | |
| 4706 | (while (and (< (point) end) (re-search-forward re end t)) | |
| 4707 | (when (member org-archive-tag (org-get-tags)) | |
| 4708 | (org-flag-subtree t) | |
| 4709 | (org-end-of-subtree t)))))) | |
| 4710 | ||
| 4711 | (declare-function outline-end-of-heading "outline" ()) | |
| 4712 | (declare-function outline-flag-region "outline" (from to flag)) | |
| 4713 | (defun org-flag-subtree (flag) | |
| 4714 | (save-excursion | |
| 4715 | (org-back-to-heading t) | |
| 4716 | (outline-end-of-heading) | |
| 4717 | (outline-flag-region (point) | |
| 4718 | (progn (org-end-of-subtree t) (point)) | |
| 4719 | flag))) | |
| 4720 | ||
| 4721 | (defalias 'org-advertized-archive-subtree 'org-archive-subtree) | |
| 4722 | ||
| 4723 | ;; Declare Column View Code | |
| 4724 | ||
| 4725 | (declare-function org-columns-get-format-and-top-level "org-colview" ()) | |
| 4726 | (declare-function org-columns-compute "org-colview" (property)) | |
| 4727 | ||
| 4728 | ;; Declare ID code | |
| 4729 | ||
| 4730 | (declare-function org-id-store-link "org-id") | |
| 4731 | (declare-function org-id-locations-load "org-id") | |
| 4732 | (declare-function org-id-locations-save "org-id") | |
| 4733 | (defvar org-id-track-globally) | |
| 4734 | ||
| 4735 | ;;; Variables for pre-computed regular expressions, all buffer local | |
| 4736 | ||
| 4737 | (defvar-local org-todo-regexp nil | |
| 4738 | "Matches any of the TODO state keywords. | |
| 4739 | Since TODO keywords are case-sensitive, `case-fold-search' is | |
| 4740 | expected to be bound to nil when matching against this regexp.") | |
| 4741 | ||
| 4742 | (defvar-local org-not-done-regexp nil | |
| 4743 | "Matches any of the TODO state keywords except the last one. | |
| 4744 | Since TODO keywords are case-sensitive, `case-fold-search' is | |
| 4745 | expected to be bound to nil when matching against this regexp.") | |
| 4746 | ||
| 4747 | (defvar-local org-not-done-heading-regexp nil | |
| 4748 | "Matches a TODO headline that is not done. | |
| 4749 | Since TODO keywords are case-sensitive, `case-fold-search' is | |
| 4750 | expected to be bound to nil when matching against this regexp.") | |
| 4751 | ||
| 4752 | (defvar-local org-todo-line-regexp nil | |
| 4753 | "Matches a headline and puts TODO state into group 2 if present. | |
| 4754 | Since TODO keywords are case-sensitive, `case-fold-search' is | |
| 4755 | expected to be bound to nil when matching against this regexp.") | |
| 4756 | ||
| 4757 | (defvar-local org-complex-heading-regexp nil | |
| 4758 | "Matches a headline and puts everything into groups: | |
| 4759 | ||
| 4760 | group 1: Stars | |
| 4761 | group 2: The TODO keyword, maybe | |
| 4762 | group 3: Priority cookie | |
| 4763 | group 4: True headline | |
| 4764 | group 5: Tags | |
| 4765 | ||
| 4766 | Since TODO keywords are case-sensitive, `case-fold-search' is | |
| 4767 | expected to be bound to nil when matching against this regexp.") | |
| 4768 | ||
| 4769 | (defvar-local org-complex-heading-regexp-format nil | |
| 4770 | "Printf format to make regexp to match an exact headline. | |
| 4771 | This regexp will match the headline of any node which has the | |
| 4772 | exact headline text that is put into the format, but may have any | |
| 4773 | TODO state, priority and tags.") | |
| 4774 | ||
| 4775 | (defvar-local org-todo-line-tags-regexp nil | |
| 4776 | "Matches a headline and puts TODO state into group 2 if present. | |
| 4777 | Also put tags into group 4 if tags are present.") | |
| 4778 | ||
| 4779 | (defconst org-plain-time-of-day-regexp | |
| 4780 | (concat | |
| 4781 | "\\(\\<[012]?[0-9]" | |
| 4782 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
| 4783 | "\\(--?" | |
| 4784 | "\\(\\<[012]?[0-9]" | |
| 4785 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
| 4786 | "\\)?") | |
| 4787 | "Regular expression to match a plain time or time range. | |
| 4788 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
| 4789 | groups carry important information: | |
| 4790 | 0 the full match | |
| 4791 | 1 the first time, range or not | |
| 4792 | 8 the second time, if it is a range.") | |
| 4793 | ||
| 4794 | (defconst org-plain-time-extension-regexp | |
| 4795 | (concat | |
| 4796 | "\\(\\<[012]?[0-9]" | |
| 4797 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
| 4798 | "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?") | |
| 4799 | "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40. | |
| 4800 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
| 4801 | groups carry important information: | |
| 4802 | 0 the full match | |
| 4803 | 7 hours of duration | |
| 4804 | 9 minutes of duration") | |
| 4805 | ||
| 4806 | (defconst org-stamp-time-of-day-regexp | |
| 4807 | (concat | |
| 4808 | "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)" | |
| 4809 | "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>" | |
| 4810 | "\\(--?" | |
| 4811 | "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") | |
| 4812 | "Regular expression to match a timestamp time or time range. | |
| 4813 | After a match, the following groups carry important information: | |
| 4814 | 0 the full match | |
| 4815 | 1 date plus weekday, for back referencing to make sure both times are on the same day | |
| 4816 | 2 the first time, range or not | |
| 4817 | 4 the second time, if it is a range.") | |
| 4818 | ||
| 4819 | (defconst org-startup-options | |
| 4820 | '(("fold" org-startup-folded t) | |
| 4821 | ("overview" org-startup-folded t) | |
| 4822 | ("nofold" org-startup-folded nil) | |
| 4823 | ("showall" org-startup-folded nil) | |
| 4824 | ("showeverything" org-startup-folded showeverything) | |
| 4825 | ("content" org-startup-folded content) | |
| 4826 | ("indent" org-startup-indented t) | |
| 4827 | ("noindent" org-startup-indented nil) | |
| 4828 | ("hidestars" org-hide-leading-stars t) | |
| 4829 | ("showstars" org-hide-leading-stars nil) | |
| 4830 | ("odd" org-odd-levels-only t) | |
| 4831 | ("oddeven" org-odd-levels-only nil) | |
| 4832 | ("align" org-startup-align-all-tables t) | |
| 4833 | ("noalign" org-startup-align-all-tables nil) | |
| 4834 | ("inlineimages" org-startup-with-inline-images t) | |
| 4835 | ("noinlineimages" org-startup-with-inline-images nil) | |
| 4836 | ("latexpreview" org-startup-with-latex-preview t) | |
| 4837 | ("nolatexpreview" org-startup-with-latex-preview nil) | |
| 4838 | ("customtime" org-display-custom-times t) | |
| 4839 | ("logdone" org-log-done time) | |
| 4840 | ("lognotedone" org-log-done note) | |
| 4841 | ("nologdone" org-log-done nil) | |
| 4842 | ("lognoteclock-out" org-log-note-clock-out t) | |
| 4843 | ("nolognoteclock-out" org-log-note-clock-out nil) | |
| 4844 | ("logrepeat" org-log-repeat state) | |
| 4845 | ("lognoterepeat" org-log-repeat note) | |
| 4846 | ("logdrawer" org-log-into-drawer t) | |
| 4847 | ("nologdrawer" org-log-into-drawer nil) | |
| 4848 | ("logstatesreversed" org-log-states-order-reversed t) | |
| 4849 | ("nologstatesreversed" org-log-states-order-reversed nil) | |
| 4850 | ("nologrepeat" org-log-repeat nil) | |
| 4851 | ("logreschedule" org-log-reschedule time) | |
| 4852 | ("lognotereschedule" org-log-reschedule note) | |
| 4853 | ("nologreschedule" org-log-reschedule nil) | |
| 4854 | ("logredeadline" org-log-redeadline time) | |
| 4855 | ("lognoteredeadline" org-log-redeadline note) | |
| 4856 | ("nologredeadline" org-log-redeadline nil) | |
| 4857 | ("logrefile" org-log-refile time) | |
| 4858 | ("lognoterefile" org-log-refile note) | |
| 4859 | ("nologrefile" org-log-refile nil) | |
| 4860 | ("fninline" org-footnote-define-inline t) | |
| 4861 | ("nofninline" org-footnote-define-inline nil) | |
| 4862 | ("fnlocal" org-footnote-section nil) | |
| 4863 | ("fnauto" org-footnote-auto-label t) | |
| 4864 | ("fnprompt" org-footnote-auto-label nil) | |
| 4865 | ("fnconfirm" org-footnote-auto-label confirm) | |
| 4866 | ("fnplain" org-footnote-auto-label plain) | |
| 4867 | ("fnadjust" org-footnote-auto-adjust t) | |
| 4868 | ("nofnadjust" org-footnote-auto-adjust nil) | |
| 4869 | ("constcgs" constants-unit-system cgs) | |
| 4870 | ("constSI" constants-unit-system SI) | |
| 4871 | ("noptag" org-tag-persistent-alist nil) | |
| 4872 | ("hideblocks" org-hide-block-startup t) | |
| 4873 | ("nohideblocks" org-hide-block-startup nil) | |
| 4874 | ("beamer" org-startup-with-beamer-mode t) | |
| 4875 | ("entitiespretty" org-pretty-entities t) | |
| 4876 | ("entitiesplain" org-pretty-entities nil)) | |
| 4877 | "Variable associated with STARTUP options for Org. | |
| 4878 | Each element is a list of three items: the startup options (as written | |
| 4879 | in the #+STARTUP line), the corresponding variable, and the value to set | |
| 4880 | this variable to if the option is found. An optional forth element PUSH | |
| 4881 | means to push this value onto the list in the variable.") | |
| 4882 | ||
| 4883 | (defcustom org-group-tags t | |
| 4884 | "When non-nil (the default), use group tags. | |
| 4885 | This can be turned on/off through `org-toggle-tags-groups'." | |
| 4886 | :group 'org-tags | |
| 4887 | :group 'org-startup | |
| 4888 | :type 'boolean) | |
| 4889 | ||
| 4890 | (defvar org-inhibit-startup nil) ; Dynamically-scoped param. | |
| 4891 | ||
| 4892 | (defun org-toggle-tags-groups () | |
| 4893 | "Toggle support for group tags. | |
| 4894 | Support for group tags is controlled by the option | |
| 4895 | `org-group-tags', which is non-nil by default." | |
| 4896 | (interactive) | |
| 4897 | (setq org-group-tags (not org-group-tags)) | |
| 4898 | (cond ((and (derived-mode-p 'org-agenda-mode) | |
| 4899 | org-group-tags) | |
| 4900 | (org-agenda-redo)) | |
| 4901 | ((derived-mode-p 'org-mode) | |
| 4902 | (let ((org-inhibit-startup t)) (org-mode)))) | |
| 4903 | (message "Groups tags support has been turned %s" | |
| 4904 | (if org-group-tags "on" "off"))) | |
| 4905 | ||
| 4906 | (defun org--tag-add-to-alist (alist1 alist2) | |
| 4907 | "Merge tags from ALIST1 into ALIST2. | |
| 4908 | ||
| 4909 | Duplicates tags outside a group are removed. Keywords and order | |
| 4910 | are preserved. | |
| 4911 | ||
| 4912 | The function assumes ALIST1 and ALIST2 are proper tag alists. | |
| 4913 | See `org-tag-alist' for their structure." | |
| 4914 | (cond | |
| 4915 | ((null alist2) alist1) | |
| 4916 | ((null alist1) alist2) | |
| 4917 | (t | |
| 4918 | (let ((to-add nil) | |
| 4919 | (group-flag nil)) | |
| 4920 | (dolist (tag-pair alist1) | |
| 4921 | (pcase tag-pair | |
| 4922 | (`(,(or :startgrouptag :startgroup)) | |
| 4923 | (setq group-flag t) | |
| 4924 | (push tag-pair to-add)) | |
| 4925 | (`(,(or :endgrouptag :endgroup)) | |
| 4926 | (setq group-flag nil) | |
| 4927 | (push tag-pair to-add)) | |
| 4928 | (`(,(or :grouptags :newline)) | |
| 4929 | (push tag-pair to-add)) | |
| 4930 | (`(,tag . ,_) | |
| 4931 | ;; Remove duplicates from ALIST1, unless they are in | |
| 4932 | ;; a group. Indeed, it makes sense to have a tag appear in | |
| 4933 | ;; multiple groups. | |
| 4934 | (when (or group-flag (not (assoc tag alist2))) | |
| 4935 | (push tag-pair to-add))) | |
| 4936 | (_ (error "Invalid association in tag alist: %S" tag-pair)))) | |
| 4937 | ;; Preserve order of ALIST1. | |
| 4938 | (append (nreverse to-add) alist2))))) | |
| 4939 | ||
| 4940 | (defun org-set-regexps-and-options (&optional tags-only) | |
| 4941 | "Precompute regular expressions used in the current buffer. | |
| 4942 | When optional argument TAGS-ONLY is non-nil, only compute tags | |
| 4943 | related expressions." | |
| 4944 | (when (derived-mode-p 'org-mode) | |
| 4945 | (let ((alist (org--setup-collect-keywords | |
| 4946 | (org-make-options-regexp | |
| 4947 | (append '("FILETAGS" "TAGS" "SETUPFILE") | |
| 4948 | (and (not tags-only) | |
| 4949 | '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS" | |
| 4950 | "LINK" "OPTIONS" "PRIORITIES" "PROPERTY" | |
| 4951 | "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO"))))))) | |
| 4952 | ;; Startup options. Get this early since it does change | |
| 4953 | ;; behavior for other options (e.g., tags). | |
| 4954 | (let ((startup (cdr (assq 'startup alist)))) | |
| 4955 | (dolist (option startup) | |
| 4956 | (let ((entry (assoc-string option org-startup-options t))) | |
| 4957 | (when entry | |
| 4958 | (let ((var (nth 1 entry)) | |
| 4959 | (val (nth 2 entry))) | |
| 4960 | (if (not (nth 3 entry)) (set (make-local-variable var) val) | |
| 4961 | (unless (listp (symbol-value var)) | |
| 4962 | (set (make-local-variable var) nil)) | |
| 4963 | (add-to-list var val))))))) | |
| 4964 | (setq-local org-file-tags | |
| 4965 | (mapcar #'org-add-prop-inherited | |
| 4966 | (cdr (assq 'filetags alist)))) | |
| 4967 | (setq org-current-tag-alist | |
| 4968 | (org--tag-add-to-alist | |
| 4969 | org-tag-persistent-alist | |
| 4970 | (let ((tags (cdr (assq 'tags alist)))) | |
| 4971 | (if tags (org-tag-string-to-alist tags) | |
| 4972 | org-tag-alist)))) | |
| 4973 | (setq org-tag-groups-alist | |
| 4974 | (org-tag-alist-to-groups org-current-tag-alist)) | |
| 4975 | (unless tags-only | |
| 4976 | ;; File properties. | |
| 4977 | (setq-local org-file-properties (cdr (assq 'property alist))) | |
| 4978 | ;; Archive location. | |
| 4979 | (let ((archive (cdr (assq 'archive alist)))) | |
| 4980 | (when archive (setq-local org-archive-location archive))) | |
| 4981 | ;; Category. | |
| 4982 | (let ((cat (org-string-nw-p (cdr (assq 'category alist))))) | |
| 4983 | (when cat | |
| 4984 | (setq-local org-category (intern cat)) | |
| 4985 | (setq-local org-file-properties | |
| 4986 | (org--update-property-plist | |
| 4987 | "CATEGORY" cat org-file-properties)))) | |
| 4988 | ;; Columns. | |
| 4989 | (let ((column (cdr (assq 'columns alist)))) | |
| 4990 | (when column (setq-local org-columns-default-format column))) | |
| 4991 | ;; Constants. | |
| 4992 | (setq org-table-formula-constants-local (cdr (assq 'constants alist))) | |
| 4993 | ;; Link abbreviations. | |
| 4994 | (let ((links (cdr (assq 'link alist)))) | |
| 4995 | (when links (setq org-link-abbrev-alist-local (nreverse links)))) | |
| 4996 | ;; Priorities. | |
| 4997 | (let ((priorities (cdr (assq 'priorities alist)))) | |
| 4998 | (when priorities | |
| 4999 | (setq-local org-highest-priority (nth 0 priorities)) | |
| 5000 | (setq-local org-lowest-priority (nth 1 priorities)) | |
| 5001 | (setq-local org-default-priority (nth 2 priorities)))) | |
| 5002 | ;; Scripts. | |
| 5003 | (let ((scripts (assq 'scripts alist))) | |
| 5004 | (when scripts | |
| 5005 | (setq-local org-use-sub-superscripts (cdr scripts)))) | |
| 5006 | ;; TODO keywords. | |
| 5007 | (setq-local org-todo-kwd-alist nil) | |
| 5008 | (setq-local org-todo-key-alist nil) | |
| 5009 | (setq-local org-todo-key-trigger nil) | |
| 5010 | (setq-local org-todo-keywords-1 nil) | |
| 5011 | (setq-local org-done-keywords nil) | |
| 5012 | (setq-local org-todo-heads nil) | |
| 5013 | (setq-local org-todo-sets nil) | |
| 5014 | (setq-local org-todo-log-states nil) | |
| 5015 | (let ((todo-sequences | |
| 5016 | (or (nreverse (cdr (assq 'todo alist))) | |
| 5017 | (let ((d (default-value 'org-todo-keywords))) | |
| 5018 | (if (not (stringp (car d))) d | |
| 5019 | ;; XXX: Backward compatibility code. | |
| 5020 | (list (cons org-todo-interpretation d))))))) | |
| 5021 | (dolist (sequence todo-sequences) | |
| 5022 | (let* ((sequence (or (run-hook-with-args-until-success | |
| 5023 | 'org-todo-setup-filter-hook sequence) | |
| 5024 | sequence)) | |
| 5025 | (sequence-type (car sequence)) | |
| 5026 | (keywords (cdr sequence)) | |
| 5027 | (sep (member "|" keywords)) | |
| 5028 | names alist) | |
| 5029 | (dolist (k (remove "|" keywords)) | |
| 5030 | (unless (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" | |
| 5031 | k) | |
| 5032 | (error "Invalid TODO keyword %s" k)) | |
| 5033 | (let ((name (match-string 1 k)) | |
| 5034 | (key (match-string 2 k)) | |
| 5035 | (log (org-extract-log-state-settings k))) | |
| 5036 | (push name names) | |
| 5037 | (push (cons name (and key (string-to-char key))) alist) | |
| 5038 | (when log (push log org-todo-log-states)))) | |
| 5039 | (let* ((names (nreverse names)) | |
| 5040 | (done (if sep (org-remove-keyword-keys (cdr sep)) | |
| 5041 | (last names))) | |
| 5042 | (head (car names)) | |
| 5043 | (tail (list sequence-type head (car done) (org-last done)))) | |
| 5044 | (add-to-list 'org-todo-heads head 'append) | |
| 5045 | (push names org-todo-sets) | |
| 5046 | (setq org-done-keywords (append org-done-keywords done nil)) | |
| 5047 | (setq org-todo-keywords-1 (append org-todo-keywords-1 names nil)) | |
| 5048 | (setq org-todo-key-alist | |
| 5049 | (append org-todo-key-alist | |
| 5050 | (and alist | |
| 5051 | (append '((:startgroup)) | |
| 5052 | (nreverse alist) | |
| 5053 | '((:endgroup)))))) | |
| 5054 | (dolist (k names) (push (cons k tail) org-todo-kwd-alist)))))) | |
| 5055 | (setq org-todo-sets (nreverse org-todo-sets) | |
| 5056 | org-todo-kwd-alist (nreverse org-todo-kwd-alist) | |
| 5057 | org-todo-key-trigger (delq nil (mapcar #'cdr org-todo-key-alist)) | |
| 5058 | org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)) | |
| 5059 | ;; Compute the regular expressions and other local variables. | |
| 5060 | ;; Using `org-outline-regexp-bol' would complicate them much, | |
| 5061 | ;; because of the fixed white space at the end of that string. | |
| 5062 | (unless org-done-keywords | |
| 5063 | (setq org-done-keywords | |
| 5064 | (and org-todo-keywords-1 (last org-todo-keywords-1)))) | |
| 5065 | (setq org-not-done-keywords | |
| 5066 | (org-delete-all org-done-keywords | |
| 5067 | (copy-sequence org-todo-keywords-1)) | |
| 5068 | org-todo-regexp (regexp-opt org-todo-keywords-1 t) | |
| 5069 | org-not-done-regexp (regexp-opt org-not-done-keywords t) | |
| 5070 | org-not-done-heading-regexp | |
| 5071 | (format org-heading-keyword-regexp-format org-not-done-regexp) | |
| 5072 | org-todo-line-regexp | |
| 5073 | (format org-heading-keyword-maybe-regexp-format org-todo-regexp) | |
| 5074 | org-complex-heading-regexp | |
| 5075 | (concat "^\\(\\*+\\)" | |
| 5076 | "\\(?: +" org-todo-regexp "\\)?" | |
| 5077 | "\\(?: +\\(\\[#.\\]\\)\\)?" | |
| 5078 | "\\(?: +\\(.*?\\)\\)??" | |
| 5079 | "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?" | |
| 5080 | "[ \t]*$") | |
| 5081 | org-complex-heading-regexp-format | |
| 5082 | (concat "^\\(\\*+\\)" | |
| 5083 | "\\(?: +" org-todo-regexp "\\)?" | |
| 5084 | "\\(?: +\\(\\[#.\\]\\)\\)?" | |
| 5085 | "\\(?: +" | |
| 5086 | ;; Stats cookies can be stuck to body. | |
| 5087 | "\\(?:\\[[0-9%%/]+\\] *\\)*" | |
| 5088 | "\\(%s\\)" | |
| 5089 | "\\(?: *\\[[0-9%%/]+\\]\\)*" | |
| 5090 | "\\)" | |
| 5091 | "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?" | |
| 5092 | "[ \t]*$") | |
| 5093 | org-todo-line-tags-regexp | |
| 5094 | (concat "^\\(\\*+\\)" | |
| 5095 | "\\(?: +" org-todo-regexp "\\)?" | |
| 5096 | "\\(?: +\\(.*?\\)\\)??" | |
| 5097 | "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?" | |
| 5098 | "[ \t]*$")) | |
| 5099 | (org-compute-latex-and-related-regexp))))) | |
| 5100 | ||
| 5101 | (defun org--setup-collect-keywords (regexp &optional files alist) | |
| 5102 | "Return setup keywords values as an alist. | |
| 5103 | ||
| 5104 | REGEXP matches a subset of setup keywords. FILES is a list of | |
| 5105 | file names already visited. It is used to avoid circular setup | |
| 5106 | files. ALIST, when non-nil, is the alist computed so far. | |
| 5107 | ||
| 5108 | Return value contains the following keys: `archive', `category', | |
| 5109 | `columns', `constants', `filetags', `link', `priorities', | |
| 5110 | `property', `scripts', `startup', `tags' and `todo'." | |
| 5111 | (org-with-wide-buffer | |
| 5112 | (goto-char (point-min)) | |
| 5113 | (let ((case-fold-search t)) | |
| 5114 | (while (re-search-forward regexp nil t) | |
| 5115 | (let ((element (org-element-at-point))) | |
| 5116 | (when (eq (org-element-type element) 'keyword) | |
| 5117 | (let ((key (org-element-property :key element)) | |
| 5118 | (value (org-element-property :value element))) | |
| 5119 | (cond | |
| 5120 | ((equal key "ARCHIVE") | |
| 5121 | (when (org-string-nw-p value) | |
| 5122 | (push (cons 'archive value) alist))) | |
| 5123 | ((equal key "CATEGORY") (push (cons 'category value) alist)) | |
| 5124 | ((equal key "COLUMNS") (push (cons 'columns value) alist)) | |
| 5125 | ((equal key "CONSTANTS") | |
| 5126 | (let* ((constants (assq 'constants alist)) | |
| 5127 | (store (cdr constants))) | |
| 5128 | (dolist (pair (split-string value)) | |
| 5129 | (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" | |
| 5130 | pair) | |
| 5131 | (let* ((name (match-string 1 pair)) | |
| 5132 | (value (match-string 2 pair)) | |
| 5133 | (old (assoc name store))) | |
| 5134 | (if old (setcdr old value) | |
| 5135 | (push (cons name value) store))))) | |
| 5136 | (if constants (setcdr constants store) | |
| 5137 | (push (cons 'constants store) alist)))) | |
| 5138 | ((equal key "FILETAGS") | |
| 5139 | (when (org-string-nw-p value) | |
| 5140 | (let ((old (assq 'filetags alist)) | |
| 5141 | (new (apply #'nconc | |
| 5142 | (mapcar (lambda (x) (org-split-string x ":")) | |
| 5143 | (split-string value))))) | |
| 5144 | (if old (setcdr old (append new (cdr old))) | |
| 5145 | (push (cons 'filetags new) alist))))) | |
| 5146 | ((equal key "LINK") | |
| 5147 | (when (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value) | |
| 5148 | (let ((links (assq 'link alist)) | |
| 5149 | (pair (cons (match-string-no-properties 1 value) | |
| 5150 | (match-string-no-properties 2 value)))) | |
| 5151 | (if links (push pair (cdr links)) | |
| 5152 | (push (list 'link pair) alist))))) | |
| 5153 | ((equal key "OPTIONS") | |
| 5154 | (when (and (org-string-nw-p value) | |
| 5155 | (string-match "\\^:\\(t\\|nil\\|{}\\)" value)) | |
| 5156 | (push (cons 'scripts (read (match-string 1 value))) alist))) | |
| 5157 | ((equal key "PRIORITIES") | |
| 5158 | (push (cons 'priorities | |
| 5159 | (let ((prio (split-string value))) | |
| 5160 | (if (< (length prio) 3) '(?A ?C ?B) | |
| 5161 | (mapcar #'string-to-char prio)))) | |
| 5162 | alist)) | |
| 5163 | ((equal key "PROPERTY") | |
| 5164 | (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value) | |
| 5165 | (let* ((property (assq 'property alist)) | |
| 5166 | (value (org--update-property-plist | |
| 5167 | (match-string-no-properties 1 value) | |
| 5168 | (match-string-no-properties 2 value) | |
| 5169 | (cdr property)))) | |
| 5170 | (if property (setcdr property value) | |
| 5171 | (push (cons 'property value) alist))))) | |
| 5172 | ((equal key "STARTUP") | |
| 5173 | (let ((startup (assq 'startup alist))) | |
| 5174 | (if startup | |
| 5175 | (setcdr startup | |
| 5176 | (append (cdr startup) (split-string value))) | |
| 5177 | (push (cons 'startup (split-string value)) alist)))) | |
| 5178 | ((equal key "TAGS") | |
| 5179 | (let ((tag-cell (assq 'tags alist))) | |
| 5180 | (if tag-cell | |
| 5181 | (setcdr tag-cell (concat (cdr tag-cell) "\n" value)) | |
| 5182 | (push (cons 'tags value) alist)))) | |
| 5183 | ((member key '("TODO" "SEQ_TODO" "TYP_TODO")) | |
| 5184 | (let ((todo (assq 'todo alist)) | |
| 5185 | (value (cons (if (equal key "TYP_TODO") 'type 'sequence) | |
| 5186 | (split-string value)))) | |
| 5187 | (if todo (push value (cdr todo)) | |
| 5188 | (push (list 'todo value) alist)))) | |
| 5189 | ((equal key "SETUPFILE") | |
| 5190 | (unless buffer-read-only ; Do not check in Gnus messages. | |
| 5191 | (let ((f (and (org-string-nw-p value) | |
| 5192 | (expand-file-name | |
| 5193 | (org-unbracket-string "\"" "\"" value))))) | |
| 5194 | (when (and f (file-readable-p f) (not (member f files))) | |
| 5195 | (with-temp-buffer | |
| 5196 | (setq default-directory (file-name-directory f)) | |
| 5197 | (insert-file-contents f) | |
| 5198 | (setq alist | |
| 5199 | ;; Fake Org mode to benefit from cache | |
| 5200 | ;; without recurring needlessly. | |
| 5201 | (let ((major-mode 'org-mode)) | |
| 5202 | (org--setup-collect-keywords | |
| 5203 | regexp (cons f files) alist))))))))))))))) | |
| 5204 | alist) | |
| 5205 | ||
| 5206 | (defun org-tag-string-to-alist (s) | |
| 5207 | "Return tag alist associated to string S. | |
| 5208 | S is a value for TAGS keyword or produced with | |
| 5209 | `org-tag-alist-to-string'. Return value is an alist suitable for | |
| 5210 | `org-tag-alist' or `org-tag-persistent-alist'." | |
| 5211 | (let ((lines (mapcar #'split-string (split-string s "\n" t))) | |
| 5212 | (tag-re (concat "\\`\\([[:alnum:]_@#%]+" | |
| 5213 | "\\|{.+?}\\)" ; regular expression | |
| 5214 | "\\(?:(\\(.\\))\\)?\\'")) | |
| 5215 | alist group-flag) | |
| 5216 | (dolist (tokens lines (cdr (nreverse alist))) | |
| 5217 | (push '(:newline) alist) | |
| 5218 | (while tokens | |
| 5219 | (let ((token (pop tokens))) | |
| 5220 | (pcase token | |
| 5221 | ("{" | |
| 5222 | (push '(:startgroup) alist) | |
| 5223 | (when (equal (nth 1 tokens) ":") (setq group-flag t))) | |
| 5224 | ("}" | |
| 5225 | (push '(:endgroup) alist) | |
| 5226 | (setq group-flag nil)) | |
| 5227 | ("[" | |
| 5228 | (push '(:startgrouptag) alist) | |
| 5229 | (when (equal (nth 1 tokens) ":") (setq group-flag t))) | |
| 5230 | ("]" | |
| 5231 | (push '(:endgrouptag) alist) | |
| 5232 | (setq group-flag nil)) | |
| 5233 | (":" | |
| 5234 | (push '(:grouptags) alist)) | |
| 5235 | ((guard (string-match tag-re token)) | |
| 5236 | (let ((tag (match-string 1 token)) | |
| 5237 | (key (and (match-beginning 2) | |
| 5238 | (string-to-char (match-string 2 token))))) | |
| 5239 | ;; Push all tags in groups, no matter if they already | |
| 5240 | ;; appear somewhere else in the list. | |
| 5241 | (when (or group-flag (not (assoc tag alist))) | |
| 5242 | (push (cons tag key) alist)))))))))) | |
| 5243 | ||
| 5244 | (defun org-tag-alist-to-string (alist &optional skip-key) | |
| 5245 | "Return tag string associated to ALIST. | |
| 5246 | ||
| 5247 | ALIST is an alist, as defined in `org-tag-alist' or | |
| 5248 | `org-tag-persistent-alist', or produced with | |
| 5249 | `org-tag-string-to-alist'. | |
| 5250 | ||
| 5251 | Return value is a string suitable as a value for \"TAGS\" | |
| 5252 | keyword. | |
| 5253 | ||
| 5254 | When optional argument SKIP-KEY is non-nil, skip selection keys | |
| 5255 | next to tags." | |
| 5256 | (mapconcat (lambda (token) | |
| 5257 | (pcase token | |
| 5258 | (`(:startgroup) "{") | |
| 5259 | (`(:endgroup) "}") | |
| 5260 | (`(:startgrouptag) "[") | |
| 5261 | (`(:endgrouptag) "]") | |
| 5262 | (`(:grouptags) ":") | |
| 5263 | (`(:newline) "\\n") | |
| 5264 | ((and | |
| 5265 | (guard (not skip-key)) | |
| 5266 | `(,(and tag (pred stringp)) . ,(and key (pred characterp)))) | |
| 5267 | (format "%s(%c)" tag key)) | |
| 5268 | (`(,(and tag (pred stringp)) . ,_) tag) | |
| 5269 | (_ (user-error "Invalid tag token: %S" token)))) | |
| 5270 | alist | |
| 5271 | " ")) | |
| 5272 | ||
| 5273 | (defun org-tag-alist-to-groups (alist) | |
| 5274 | "Return group alist from tag ALIST. | |
| 5275 | ALIST is an alist, as defined in `org-tag-alist' or | |
| 5276 | `org-tag-persistent-alist', or produced with | |
| 5277 | `org-tag-string-to-alist'. Return value is an alist following | |
| 5278 | the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as | |
| 5279 | a string, summarizing TAGS, as a list of strings." | |
| 5280 | (let (groups group-status current-group) | |
| 5281 | (dolist (token alist (nreverse groups)) | |
| 5282 | (pcase token | |
| 5283 | (`(,(or :startgroup :startgrouptag)) (setq group-status t)) | |
| 5284 | (`(,(or :endgroup :endgrouptag)) | |
| 5285 | (when (eq group-status 'append) | |
| 5286 | (push (nreverse current-group) groups)) | |
| 5287 | (setq group-status nil current-group nil)) | |
| 5288 | (`(:grouptags) (setq group-status 'append)) | |
| 5289 | ((and `(,tag . ,_) (guard group-status)) | |
| 5290 | (if (eq group-status 'append) (push tag current-group) | |
| 5291 | (setq current-group (list tag)))) | |
| 5292 | (_ nil))))) | |
| 5293 | ||
| 5294 | (defvar org--file-cache (make-hash-table :test #'equal) | |
| 5295 | "Hash table to store contents of files referenced via a URL. | |
| 5296 | This is the cache of file URLs read using `org-file-contents'.") | |
| 5297 | ||
| 5298 | (defun org-reset-file-cache () | |
| 5299 | "Reset the cache of files downloaded by `org-file-contents'." | |
| 5300 | (clrhash org--file-cache)) | |
| 5301 | ||
| 5302 | (defun org-file-url-p (file) | |
| 5303 | "Non-nil if FILE is a URL." | |
| 5304 | (require 'ffap) | |
| 5305 | (string-match-p ffap-url-regexp file)) | |
| 5306 | ||
| 5307 | (defun org-file-contents (file &optional noerror nocache) | |
| 5308 | "Return the contents of FILE, as a string. | |
| 5309 | ||
| 5310 | FILE can be a file name or URL. | |
| 5311 | ||
| 5312 | If FILE is a URL, download the contents. If the URL contents are | |
| 5313 | already cached in the `org--file-cache' hash table, the download step | |
| 5314 | is skipped. | |
| 5315 | ||
| 5316 | If NOERROR is non-nil, ignore the error when unable to read the FILE | |
| 5317 | from file or URL. | |
| 5318 | ||
| 5319 | If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version | |
| 5320 | is available. This option applies only if FILE is a URL." | |
| 5321 | (let* ((is-url (org-file-url-p file)) | |
| 5322 | (cache (and is-url | |
| 5323 | (not nocache) | |
| 5324 | (gethash file org--file-cache)))) | |
| 5325 | (cond | |
| 5326 | (cache) | |
| 5327 | (is-url | |
| 5328 | (with-current-buffer (url-retrieve-synchronously file) | |
| 5329 | (goto-char (point-min)) | |
| 5330 | ;; Move point to after the url-retrieve header. | |
| 5331 | (search-forward "\n\n" nil :move) | |
| 5332 | ;; Search for the success code only in the url-retrieve header. | |
| 5333 | (if (save-excursion | |
| 5334 | (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror)) | |
| 5335 | ;; Update the cache `org--file-cache' and return contents. | |
| 5336 | (puthash file | |
| 5337 | (buffer-substring-no-properties (point) (point-max)) | |
| 5338 | org--file-cache) | |
| 5339 | (funcall (if noerror #'message #'user-error) | |
| 5340 | "Unable to fetch file from %S" | |
| 5341 | file)))) | |
| 5342 | (t | |
| 5343 | (with-temp-buffer | |
| 5344 | (condition-case nil | |
| 5345 | (progn | |
| 5346 | (insert-file-contents file) | |
| 5347 | (buffer-string)) | |
| 5348 | (file-error | |
| 5349 | (funcall (if noerror #'message #'user-error) | |
| 5350 | "Unable to read file %S" | |
| 5351 | file)))))))) | |
| 5352 | ||
| 5353 | (defun org-extract-log-state-settings (x) | |
| 5354 | "Extract the log state setting from a TODO keyword string. | |
| 5355 | This will extract info from a string like \"WAIT(w@/!)\"." | |
| 5356 | (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) | |
| 5357 | (let ((kw (match-string 1 x)) | |
| 5358 | (log1 (and (match-end 3) (match-string 3 x))) | |
| 5359 | (log2 (and (match-end 4) (match-string 4 x)))) | |
| 5360 | (and (or log1 log2) | |
| 5361 | (list kw | |
| 5362 | (and log1 (if (equal log1 "!") 'time 'note)) | |
| 5363 | (and log2 (if (equal log2 "!") 'time 'note))))))) | |
| 5364 | ||
| 5365 | (defun org-remove-keyword-keys (list) | |
| 5366 | "Remove a pair of parenthesis at the end of each string in LIST." | |
| 5367 | (mapcar (lambda (x) | |
| 5368 | (if (string-match "(.*)$" x) | |
| 5369 | (substring x 0 (match-beginning 0)) | |
| 5370 | x)) | |
| 5371 | list)) | |
| 5372 | ||
| 5373 | (defun org-assign-fast-keys (alist) | |
| 5374 | "Assign fast keys to a keyword-key alist. | |
| 5375 | Respect keys that are already there." | |
| 5376 | (let (new e (alt ?0)) | |
| 5377 | (while (setq e (pop alist)) | |
| 5378 | (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) | |
| 5379 | (cdr e)) ;; Key already assigned. | |
| 5380 | (push e new) | |
| 5381 | (let ((clist (string-to-list (downcase (car e)))) | |
| 5382 | (used (append new alist))) | |
| 5383 | (when (= (car clist) ?@) | |
| 5384 | (pop clist)) | |
| 5385 | (while (and clist (rassoc (car clist) used)) | |
| 5386 | (pop clist)) | |
| 5387 | (unless clist | |
| 5388 | (while (rassoc alt used) | |
| 5389 | (cl-incf alt))) | |
| 5390 | (push (cons (car e) (or (car clist) alt)) new)))) | |
| 5391 | (nreverse new))) | |
| 5392 | ||
| 5393 | ;;; Some variables used in various places | |
| 5394 | ||
| 5395 | (defvar org-window-configuration nil | |
| 5396 | "Used in various places to store a window configuration.") | |
| 5397 | (defvar org-selected-window nil | |
| 5398 | "Used in various places to store a window configuration.") | |
| 5399 | (defvar org-finish-function nil | |
| 5400 | "Function to be called when `C-c C-c' is used. | |
| 5401 | This is for getting out of special buffers like capture.") | |
| 5402 | (defvar org-last-state) | |
| 5403 | ||
| 5404 | ;; Defined somewhere in this file, but used before definition. | |
| 5405 | (defvar org-entities) ;; defined in org-entities.el | |
| 5406 | (defvar org-struct-menu) | |
| 5407 | (defvar org-org-menu) | |
| 5408 | (defvar org-tbl-menu) | |
| 5409 | ||
| 5410 | ;;;; Define the Org mode | |
| 5411 | ||
| 5412 | ;; We use a before-change function to check if a table might need | |
| 5413 | ;; an update. | |
| 5414 | (defvar org-table-may-need-update t | |
| 5415 | "Indicates that a table might need an update. | |
| 5416 | This variable is set by `org-before-change-function'. | |
| 5417 | `org-table-align' sets it back to nil.") | |
| 5418 | (defun org-before-change-function (_beg _end) | |
| 5419 | "Every change indicates that a table might need an update." | |
| 5420 | (setq org-table-may-need-update t)) | |
| 5421 | (defvar org-mode-map) | |
| 5422 | (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. | |
| 5423 | (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. | |
| 5424 | (defvar org-inhibit-logging nil) ; Dynamically-scoped param. | |
| 5425 | (defvar org-inhibit-blocking nil) ; Dynamically-scoped param. | |
| 5426 | (defvar org-table-buffer-is-an nil) | |
| 5427 | ||
| 5428 | (defvar bidi-paragraph-direction) | |
| 5429 | (defvar buffer-face-mode-face) | |
| 5430 | ||
| 5431 | (require 'outline) | |
| 5432 | ||
| 5433 | ;; Other stuff we need. | |
| 5434 | (require 'time-date) | |
| 5435 | (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) | |
| 5436 | (require 'easymenu) | |
| 5437 | (autoload 'easy-menu-add "easymenu") | |
| 5438 | (require 'overlay) | |
| 5439 | ||
| 5440 | ;; (require 'org-macs) moved higher up in the file before it is first used | |
| 5441 | (require 'org-entities) | |
| 5442 | ;; (require 'org-compat) moved higher up in the file before it is first used | |
| 5443 | (require 'org-faces) | |
| 5444 | (require 'org-list) | |
| 5445 | (require 'org-pcomplete) | |
| 5446 | (require 'org-src) | |
| 5447 | (require 'org-footnote) | |
| 5448 | (require 'org-macro) | |
| 5449 | ||
| 5450 | ;; babel | |
| 5451 | (require 'ob) | |
| 5452 | ||
| 5453 | ;;;###autoload | |
| 5454 | (define-derived-mode org-mode outline-mode "Org" | |
| 5455 | "Outline-based notes management and organizer, alias | |
| 5456 | \"Carsten's outline-mode for keeping track of everything.\" | |
| 5457 | ||
| 5458 | Org mode develops organizational tasks around a NOTES file which | |
| 5459 | contains information about projects as plain text. Org mode is | |
| 5460 | implemented on top of Outline mode, which is ideal to keep the content | |
| 5461 | of large files well structured. It supports ToDo items, deadlines and | |
| 5462 | time stamps, which magically appear in the diary listing of the Emacs | |
| 5463 | calendar. Tables are easily created with a built-in table editor. | |
| 5464 | Plain text URL-like links connect to websites, emails (VM), Usenet | |
| 5465 | messages (Gnus), BBDB entries, and any files related to the project. | |
| 5466 | For printing and sharing of notes, an Org file (or a part of it) | |
| 5467 | can be exported as a structured ASCII or HTML file. | |
| 5468 | ||
| 5469 | The following commands are available: | |
| 5470 | ||
| 5471 | \\{org-mode-map}" | |
| 5472 | ||
| 5473 | ;; Get rid of Outline menus, they are not needed | |
| 5474 | ;; Need to do this here because define-derived-mode sets up | |
| 5475 | ;; the keymap so late. Still, it is a waste to call this each time | |
| 5476 | ;; we switch another buffer into Org mode. | |
| 5477 | (define-key org-mode-map [menu-bar headings] 'undefined) | |
| 5478 | (define-key org-mode-map [menu-bar hide] 'undefined) | |
| 5479 | (define-key org-mode-map [menu-bar show] 'undefined) | |
| 5480 | ||
| 5481 | (org-load-modules-maybe) | |
| 5482 | (org-install-agenda-files-menu) | |
| 5483 | (when org-descriptive-links (add-to-invisibility-spec '(org-link))) | |
| 5484 | (add-to-invisibility-spec '(org-cwidth)) | |
| 5485 | (add-to-invisibility-spec '(org-hide-block . t)) | |
| 5486 | (setq-local outline-regexp org-outline-regexp) | |
| 5487 | (setq-local outline-level 'org-outline-level) | |
| 5488 | (setq bidi-paragraph-direction 'left-to-right) | |
| 5489 | (when (and (stringp org-ellipsis) (not (equal "" org-ellipsis))) | |
| 5490 | (unless org-display-table | |
| 5491 | (setq org-display-table (make-display-table))) | |
| 5492 | (set-display-table-slot | |
| 5493 | org-display-table 4 | |
| 5494 | (vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis)) | |
| 5495 | org-ellipsis))) | |
| 5496 | (setq buffer-display-table org-display-table)) | |
| 5497 | (org-set-regexps-and-options) | |
| 5498 | (org-set-font-lock-defaults) | |
| 5499 | (when (and org-tag-faces (not org-tags-special-faces-re)) | |
| 5500 | ;; tag faces set outside customize.... force initialization. | |
| 5501 | (org-set-tag-faces 'org-tag-faces org-tag-faces)) | |
| 5502 | ;; Calc embedded | |
| 5503 | (setq-local calc-embedded-open-mode "# ") | |
| 5504 | ;; Modify a few syntax entries | |
| 5505 | (modify-syntax-entry ?@ "w") | |
| 5506 | (modify-syntax-entry ?\" "\"") | |
| 5507 | (modify-syntax-entry ?\\ "_") | |
| 5508 | (modify-syntax-entry ?~ "_") | |
| 5509 | (setq-local font-lock-unfontify-region-function 'org-unfontify-region) | |
| 5510 | ;; Activate before-change-function | |
| 5511 | (setq-local org-table-may-need-update t) | |
| 5512 | (add-hook 'before-change-functions 'org-before-change-function nil 'local) | |
| 5513 | ;; Check for running clock before killing a buffer | |
| 5514 | (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) | |
| 5515 | ;; Initialize macros templates. | |
| 5516 | (org-macro-initialize-templates) | |
| 5517 | ;; Initialize radio targets. | |
| 5518 | (org-update-radio-target-regexp) | |
| 5519 | ;; Indentation. | |
| 5520 | (setq-local indent-line-function 'org-indent-line) | |
| 5521 | (setq-local indent-region-function 'org-indent-region) | |
| 5522 | ;; Filling and auto-filling. | |
| 5523 | (org-setup-filling) | |
| 5524 | ;; Comments. | |
| 5525 | (org-setup-comments-handling) | |
| 5526 | ;; Initialize cache. | |
| 5527 | (org-element-cache-reset) | |
| 5528 | ;; Beginning/end of defun | |
| 5529 | (setq-local beginning-of-defun-function 'org-backward-element) | |
| 5530 | (setq-local end-of-defun-function | |
| 5531 | (lambda () | |
| 5532 | (if (not (org-at-heading-p)) | |
| 5533 | (org-forward-element) | |
| 5534 | (org-forward-element) | |
| 5535 | (forward-char -1)))) | |
| 5536 | ;; Next error for sparse trees | |
| 5537 | (setq-local next-error-function 'org-occur-next-match) | |
| 5538 | ;; Make sure dependence stuff works reliably, even for users who set it | |
| 5539 | ;; too late :-( | |
| 5540 | (if org-enforce-todo-dependencies | |
| 5541 | (add-hook 'org-blocker-hook | |
| 5542 | 'org-block-todo-from-children-or-siblings-or-parent) | |
| 5543 | (remove-hook 'org-blocker-hook | |
| 5544 | 'org-block-todo-from-children-or-siblings-or-parent)) | |
| 5545 | (if org-enforce-todo-checkbox-dependencies | |
| 5546 | (add-hook 'org-blocker-hook | |
| 5547 | 'org-block-todo-from-checkboxes) | |
| 5548 | (remove-hook 'org-blocker-hook | |
| 5549 | 'org-block-todo-from-checkboxes)) | |
| 5550 | ||
| 5551 | ;; Align options lines | |
| 5552 | (setq-local | |
| 5553 | align-mode-rules-list | |
| 5554 | '((org-in-buffer-settings | |
| 5555 | (regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") | |
| 5556 | (modes . '(org-mode))))) | |
| 5557 | ||
| 5558 | ;; Imenu | |
| 5559 | (setq-local imenu-create-index-function 'org-imenu-get-tree) | |
| 5560 | ||
| 5561 | ;; Make isearch reveal context | |
| 5562 | (setq-local outline-isearch-open-invisible-function | |
| 5563 | (lambda (&rest _) (org-show-context 'isearch))) | |
| 5564 | ||
| 5565 | ;; Setup the pcomplete hooks | |
| 5566 | (setq-local pcomplete-command-completion-function 'org-pcomplete-initial) | |
| 5567 | (setq-local pcomplete-command-name-function 'org-command-at-point) | |
| 5568 | (setq-local pcomplete-default-completion-function 'ignore) | |
| 5569 | (setq-local pcomplete-parse-arguments-function 'org-parse-arguments) | |
| 5570 | (setq-local pcomplete-termination-string "") | |
| 5571 | (setq-local buffer-face-mode-face 'org-default) | |
| 5572 | ||
| 5573 | ;; If empty file that did not turn on Org mode automatically, make | |
| 5574 | ;; it to. | |
| 5575 | (when (and org-insert-mode-line-in-empty-file | |
| 5576 | (called-interactively-p 'any) | |
| 5577 | (= (point-min) (point-max))) | |
| 5578 | (insert "# -*- mode: org -*-\n\n")) | |
| 5579 | (unless org-inhibit-startup | |
| 5580 | (org-unmodified | |
| 5581 | (when org-startup-with-beamer-mode (org-beamer-mode)) | |
| 5582 | (when org-startup-align-all-tables | |
| 5583 | (org-table-map-tables #'org-table-align t)) | |
| 5584 | (when org-startup-with-inline-images (org-display-inline-images)) | |
| 5585 | (when org-startup-with-latex-preview (org-toggle-latex-fragment '(16))) | |
| 5586 | (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility)) | |
| 5587 | (when org-startup-truncated (setq truncate-lines t)) | |
| 5588 | (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) | |
| 5589 | (org-refresh-effort-properties))) | |
| 5590 | ;; Try to set `org-hide' face correctly. | |
| 5591 | (let ((foreground (org-find-invisible-foreground))) | |
| 5592 | (when foreground | |
| 5593 | (set-face-foreground 'org-hide foreground)))) | |
| 5594 | ||
| 5595 | ;; Update `customize-package-emacs-version-alist' | |
| 5596 | (add-to-list 'customize-package-emacs-version-alist | |
| 5597 | '(Org ("8.0" . "24.4") | |
| 5598 | ("8.1" . "24.4") | |
| 5599 | ("8.2" . "24.4") | |
| 5600 | ("8.2.7" . "24.4") | |
| 5601 | ("8.3" . "26.1") | |
| 5602 | ("9.0" . "26.1") | |
| 5603 | ("9.1" . "26.1"))) | |
| 5604 | ||
| 5605 | (defvar org-mode-transpose-word-syntax-table | |
| 5606 | (let ((st (make-syntax-table text-mode-syntax-table))) | |
| 5607 | (dolist (c org-emphasis-alist st) | |
| 5608 | (modify-syntax-entry (string-to-char (car c)) "w p" st)))) | |
| 5609 | ||
| 5610 | (when (fboundp 'abbrev-table-put) | |
| 5611 | (abbrev-table-put org-mode-abbrev-table | |
| 5612 | :parents (list text-mode-abbrev-table))) | |
| 5613 | ||
| 5614 | (defun org-find-invisible-foreground () | |
| 5615 | (let ((candidates (remove | |
| 5616 | "unspecified-bg" | |
| 5617 | (nconc | |
| 5618 | (list (face-background 'default) | |
| 5619 | (face-background 'org-default)) | |
| 5620 | (mapcar | |
| 5621 | (lambda (alist) | |
| 5622 | (when (boundp alist) | |
| 5623 | (cdr (assq 'background-color (symbol-value alist))))) | |
| 5624 | '(default-frame-alist initial-frame-alist window-system-default-frame-alist)) | |
| 5625 | (list (face-foreground 'org-hide)))))) | |
| 5626 | (car (remove nil candidates)))) | |
| 5627 | ||
| 5628 | (defun org-current-time (&optional rounding-minutes past) | |
| 5629 | "Current time, possibly rounded to ROUNDING-MINUTES. | |
| 5630 | When ROUNDING-MINUTES is not an integer, fall back on the car of | |
| 5631 | `org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure | |
| 5632 | the rounding returns a past time." | |
| 5633 | (let ((r (or (and (integerp rounding-minutes) rounding-minutes) | |
| 5634 | (car org-time-stamp-rounding-minutes))) | |
| 5635 | (time (decode-time)) res) | |
| 5636 | (if (< r 1) | |
| 5637 | (current-time) | |
| 5638 | (setq res | |
| 5639 | (apply 'encode-time | |
| 5640 | (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) | |
| 5641 | (nthcdr 2 time)))) | |
| 5642 | (if (and past (< (float-time (time-subtract (current-time) res)) 0)) | |
| 5643 | (seconds-to-time (- (float-time res) (* r 60))) | |
| 5644 | res)))) | |
| 5645 | ||
| 5646 | (defun org-today () | |
| 5647 | "Return today date, considering `org-extend-today-until'." | |
| 5648 | (time-to-days | |
| 5649 | (time-subtract (current-time) | |
| 5650 | (list 0 (* 3600 org-extend-today-until) 0)))) | |
| 5651 | ||
| 5652 | ;;;; Font-Lock stuff, including the activators | |
| 5653 | ||
| 5654 | (defvar org-mouse-map (make-sparse-keymap)) | |
| 5655 | (org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse) | |
| 5656 | (org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse) | |
| 5657 | (when org-mouse-1-follows-link | |
| 5658 | (org-defkey org-mouse-map [follow-link] 'mouse-face)) | |
| 5659 | (when org-tab-follows-link | |
| 5660 | (org-defkey org-mouse-map [(tab)] 'org-open-at-point) | |
| 5661 | (org-defkey org-mouse-map "\C-i" 'org-open-at-point)) | |
| 5662 | ||
| 5663 | (require 'font-lock) | |
| 5664 | ||
| 5665 | (defconst org-non-link-chars "]\t\n\r<>") | |
| 5666 | (defvar org-link-types-re nil | |
| 5667 | "Matches a link that has a url-like prefix like \"http:\"") | |
| 5668 | (defvar org-link-re-with-space nil | |
| 5669 | "Matches a link with spaces, optional angular brackets around it.") | |
| 5670 | (defvar org-link-re-with-space2 nil | |
| 5671 | "Matches a link with spaces, optional angular brackets around it.") | |
| 5672 | (defvar org-link-re-with-space3 nil | |
| 5673 | "Matches a link with spaces, only for internal part in bracket links.") | |
| 5674 | (defvar org-angle-link-re nil | |
| 5675 | "Matches link with angular brackets, spaces are allowed.") | |
| 5676 | (defvar org-plain-link-re nil | |
| 5677 | "Matches plain link, without spaces.") | |
| 5678 | (defvar org-bracket-link-regexp nil | |
| 5679 | "Matches a link in double brackets.") | |
| 5680 | (defvar org-bracket-link-analytic-regexp nil | |
| 5681 | "Regular expression used to analyze links. | |
| 5682 | Here is what the match groups contain after a match: | |
| 5683 | 1: http: | |
| 5684 | 2: http | |
| 5685 | 3: path | |
| 5686 | 4: [desc] | |
| 5687 | 5: desc") | |
| 5688 | (defvar org-bracket-link-analytic-regexp++ nil | |
| 5689 | "Like `org-bracket-link-analytic-regexp', but include coderef internal type.") | |
| 5690 | (defvar org-any-link-re nil | |
| 5691 | "Regular expression matching any link.") | |
| 5692 | ||
| 5693 | (defconst org-match-sexp-depth 3 | |
| 5694 | "Number of stacked braces for sub/superscript matching.") | |
| 5695 | ||
| 5696 | (defun org-create-multibrace-regexp (left right n) | |
| 5697 | "Create a regular expression which will match a balanced sexp. | |
| 5698 | Opening delimiter is LEFT, and closing delimiter is RIGHT, both given | |
| 5699 | as single character strings. | |
| 5700 | The regexp returned will match the entire expression including the | |
| 5701 | delimiters. It will also define a single group which contains the | |
| 5702 | match except for the outermost delimiters. The maximum depth of | |
| 5703 | stacked delimiters is N. Escaping delimiters is not possible." | |
| 5704 | (let* ((nothing (concat "[^" left right "]*?")) | |
| 5705 | (or "\\|") | |
| 5706 | (re nothing) | |
| 5707 | (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) | |
| 5708 | (while (> n 1) | |
| 5709 | (setq n (1- n) | |
| 5710 | re (concat re or next) | |
| 5711 | next (concat "\\(?:" nothing left next right "\\)+" nothing))) | |
| 5712 | (concat left "\\(" re "\\)" right))) | |
| 5713 | ||
| 5714 | (defconst org-match-substring-regexp | |
| 5715 | (concat | |
| 5716 | "\\(\\S-\\)\\([_^]\\)\\(" | |
| 5717 | "\\(?:" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" | |
| 5718 | "\\|" | |
| 5719 | "\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" | |
| 5720 | "\\|" | |
| 5721 | "\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)") | |
| 5722 | "The regular expression matching a sub- or superscript.") | |
| 5723 | ||
| 5724 | (defconst org-match-substring-with-braces-regexp | |
| 5725 | (concat | |
| 5726 | "\\(\\S-\\)\\([_^]\\)" | |
| 5727 | "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)") | |
| 5728 | "The regular expression matching a sub- or superscript, forcing braces.") | |
| 5729 | ||
| 5730 | (defun org-make-link-regexps () | |
| 5731 | "Update the link regular expressions. | |
| 5732 | This should be called after the variable `org-link-parameters' has changed." | |
| 5733 | (let ((types-re (regexp-opt (org-link-types) t))) | |
| 5734 | (setq org-link-types-re | |
| 5735 | (concat "\\`" types-re ":") | |
| 5736 | org-link-re-with-space | |
| 5737 | (concat "<?" types-re ":" | |
| 5738 | "\\([^" org-non-link-chars " ]" | |
| 5739 | "[^" org-non-link-chars "]*" | |
| 5740 | "[^" org-non-link-chars " ]\\)>?") | |
| 5741 | org-link-re-with-space2 | |
| 5742 | (concat "<?" types-re ":" | |
| 5743 | "\\([^" org-non-link-chars " ]" | |
| 5744 | "[^\t\n\r]*" | |
| 5745 | "[^" org-non-link-chars " ]\\)>?") | |
| 5746 | org-link-re-with-space3 | |
| 5747 | (concat "<?" types-re ":" | |
| 5748 | "\\([^" org-non-link-chars " ]" | |
| 5749 | "[^\t\n\r]*\\)") | |
| 5750 | org-angle-link-re | |
| 5751 | (format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>" | |
| 5752 | types-re) | |
| 5753 | org-plain-link-re | |
| 5754 | (concat | |
| 5755 | "\\<" types-re ":" | |
| 5756 | "\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)") | |
| 5757 | ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") | |
| 5758 | org-bracket-link-regexp | |
| 5759 | "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" | |
| 5760 | org-bracket-link-analytic-regexp | |
| 5761 | (concat | |
| 5762 | "\\[\\[" | |
| 5763 | "\\(" types-re ":\\)?" | |
| 5764 | "\\([^]]+\\)" | |
| 5765 | "\\]" | |
| 5766 | "\\(\\[" "\\([^]]+\\)" "\\]\\)?" | |
| 5767 | "\\]") | |
| 5768 | org-bracket-link-analytic-regexp++ | |
| 5769 | (concat | |
| 5770 | "\\[\\[" | |
| 5771 | "\\(" (regexp-opt (cons "coderef" (org-link-types)) t) ":\\)?" | |
| 5772 | "\\([^]]+\\)" | |
| 5773 | "\\]" | |
| 5774 | "\\(\\[" "\\([^]]+\\)" "\\]\\)?" | |
| 5775 | "\\]") | |
| 5776 | org-any-link-re | |
| 5777 | (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" | |
| 5778 | org-angle-link-re "\\)\\|\\(" | |
| 5779 | org-plain-link-re "\\)")))) | |
| 5780 | ||
| 5781 | (org-make-link-regexps) | |
| 5782 | ||
| 5783 | (defvar org-emph-face nil) | |
| 5784 | ||
| 5785 | (defun org-do-emphasis-faces (limit) | |
| 5786 | "Run through the buffer and emphasize strings." | |
| 5787 | (let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)" | |
| 5788 | (car org-emphasis-regexp-components)))) | |
| 5789 | (catch :exit | |
| 5790 | (while (re-search-forward quick-re limit t) | |
| 5791 | (let* ((marker (match-string 2)) | |
| 5792 | (verbatim? (member marker '("~" "=")))) | |
| 5793 | (when (save-excursion | |
| 5794 | (goto-char (match-beginning 0)) | |
| 5795 | (and | |
| 5796 | ;; Do not match table hlines. | |
| 5797 | (not (and (equal marker "+") | |
| 5798 | (org-match-line | |
| 5799 | "[ \t]*\\(|[-+]+|?\\|\\+[-+]+\\+\\)[ \t]*$"))) | |
| 5800 | ;; Do not match headline stars. Do not consider | |
| 5801 | ;; stars of a headline as closing marker for bold | |
| 5802 | ;; markup either. | |
| 5803 | (not (and (equal marker "*") | |
| 5804 | (save-excursion | |
| 5805 | (forward-char) | |
| 5806 | (skip-chars-backward "*") | |
| 5807 | (looking-at-p org-outline-regexp-bol)))) | |
| 5808 | ;; Match full emphasis markup regexp. | |
| 5809 | (looking-at (if verbatim? org-verbatim-re org-emph-re)) | |
| 5810 | ;; Do not span over paragraph boundaries. | |
| 5811 | (not (string-match-p org-element-paragraph-separate | |
| 5812 | (match-string 2))) | |
| 5813 | ;; Do not span over cells in table rows. | |
| 5814 | (not (and (save-match-data (org-match-line "[ \t]*|")) | |
| 5815 | (string-match-p "|" (match-string 4)))))) | |
| 5816 | (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist))) | |
| 5817 | (font-lock-prepend-text-property | |
| 5818 | (match-beginning 2) (match-end 2) 'face face) | |
| 5819 | (when verbatim? | |
| 5820 | (org-remove-flyspell-overlays-in | |
| 5821 | (match-beginning 0) (match-end 0))) | |
| 5822 | (add-text-properties (match-beginning 2) (match-end 2) | |
| 5823 | '(font-lock-multiline t org-emphasis t)) | |
| 5824 | (when org-hide-emphasis-markers | |
| 5825 | (add-text-properties (match-end 4) (match-beginning 5) | |
| 5826 | '(invisible org-link)) | |
| 5827 | (add-text-properties (match-beginning 3) (match-end 3) | |
| 5828 | '(invisible org-link))) | |
| 5829 | (throw :exit t)))))))) | |
| 5830 | ||
| 5831 | (defun org-emphasize (&optional char) | |
| 5832 | "Insert or change an emphasis, i.e. a font like bold or italic. | |
| 5833 | If there is an active region, change that region to a new emphasis. | |
| 5834 | If there is no region, just insert the marker characters and position | |
| 5835 | the cursor between them. | |
| 5836 | CHAR should be the marker character. If it is a space, it means to | |
| 5837 | remove the emphasis of the selected region. | |
| 5838 | If CHAR is not given (for example in an interactive call) it will be | |
| 5839 | prompted for." | |
| 5840 | (interactive) | |
| 5841 | (let ((erc org-emphasis-regexp-components) | |
| 5842 | (string "") beg end move s) | |
| 5843 | (if (org-region-active-p) | |
| 5844 | (setq beg (region-beginning) | |
| 5845 | end (region-end) | |
| 5846 | string (buffer-substring beg end)) | |
| 5847 | (setq move t)) | |
| 5848 | ||
| 5849 | (unless char | |
| 5850 | (message "Emphasis marker or tag: [%s]" | |
| 5851 | (mapconcat #'car org-emphasis-alist "")) | |
| 5852 | (setq char (read-char-exclusive))) | |
| 5853 | (if (equal char ?\s) | |
| 5854 | (setq s "" | |
| 5855 | move nil) | |
| 5856 | (unless (assoc (char-to-string char) org-emphasis-alist) | |
| 5857 | (user-error "No such emphasis marker: \"%c\"" char)) | |
| 5858 | (setq s (char-to-string char))) | |
| 5859 | (while (and (> (length string) 1) | |
| 5860 | (equal (substring string 0 1) (substring string -1)) | |
| 5861 | (assoc (substring string 0 1) org-emphasis-alist)) | |
| 5862 | (setq string (substring string 1 -1))) | |
| 5863 | (setq string (concat s string s)) | |
| 5864 | (when beg (delete-region beg end)) | |
| 5865 | (unless (or (bolp) | |
| 5866 | (string-match (concat "[" (nth 0 erc) "\n]") | |
| 5867 | (char-to-string (char-before (point))))) | |
| 5868 | (insert " ")) | |
| 5869 | (unless (or (eobp) | |
| 5870 | (string-match (concat "[" (nth 1 erc) "\n]") | |
| 5871 | (char-to-string (char-after (point))))) | |
| 5872 | (insert " ") (backward-char 1)) | |
| 5873 | (insert string) | |
| 5874 | (and move (backward-char 1)))) | |
| 5875 | ||
| 5876 | (defconst org-nonsticky-props | |
| 5877 | '(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link)) | |
| 5878 | ||
| 5879 | (defsubst org-rear-nonsticky-at (pos) | |
| 5880 | (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) | |
| 5881 | ||
| 5882 | (defun org-activate-links (limit) | |
| 5883 | "Add link properties to links. | |
| 5884 | This includes angle, plain, and bracket links." | |
| 5885 | (catch :exit | |
| 5886 | (while (re-search-forward org-any-link-re limit t) | |
| 5887 | (let* ((start (match-beginning 0)) | |
| 5888 | (end (match-end 0)) | |
| 5889 | (style (cond ((eq ?< (char-after start)) 'angle) | |
| 5890 | ((eq ?\[ (char-after (1+ start))) 'bracket) | |
| 5891 | (t 'plain)))) | |
| 5892 | (when (and (memq style org-highlight-links) | |
| 5893 | ;; Do not confuse plain links with tags. | |
| 5894 | (not (and (eq style 'plain) | |
| 5895 | (let ((face (get-text-property | |
| 5896 | (max (1- start) (point-min)) 'face))) | |
| 5897 | (if (consp face) (memq 'org-tag face) | |
| 5898 | (eq 'org-tag face)))))) | |
| 5899 | (let* ((link-object (save-excursion | |
| 5900 | (goto-char start) | |
| 5901 | (save-match-data (org-element-link-parser)))) | |
| 5902 | (link (org-element-property :raw-link link-object)) | |
| 5903 | (type (org-element-property :type link-object)) | |
| 5904 | (path (org-element-property :path link-object)) | |
| 5905 | (properties ;for link's visible part | |
| 5906 | (list | |
| 5907 | 'face (pcase (org-link-get-parameter type :face) | |
| 5908 | ((and (pred functionp) face) (funcall face path)) | |
| 5909 | ((and (pred facep) face) face) | |
| 5910 | ((and (pred consp) face) face) ;anonymous | |
| 5911 | (_ 'org-link)) | |
| 5912 | 'mouse-face (or (org-link-get-parameter type :mouse-face) | |
| 5913 | 'highlight) | |
| 5914 | 'keymap (or (org-link-get-parameter type :keymap) | |
| 5915 | org-mouse-map) | |
| 5916 | 'help-echo (pcase (org-link-get-parameter type :help-echo) | |
| 5917 | ((and (pred stringp) echo) echo) | |
| 5918 | ((and (pred functionp) echo) echo) | |
| 5919 | (_ (concat "LINK: " link))) | |
| 5920 | 'htmlize-link (pcase (org-link-get-parameter type | |
| 5921 | :htmlize-link) | |
| 5922 | ((and (pred functionp) f) (funcall f)) | |
| 5923 | (_ `(:uri ,link))) | |
| 5924 | 'font-lock-multiline t))) | |
| 5925 | (org-remove-flyspell-overlays-in start end) | |
| 5926 | (org-rear-nonsticky-at end) | |
| 5927 | (if (not (eq 'bracket style)) | |
| 5928 | (add-text-properties start end properties) | |
| 5929 | ;; Handle invisible parts in bracket links. | |
| 5930 | (remove-text-properties start end '(invisible nil)) | |
| 5931 | (let ((hidden | |
| 5932 | (append `(invisible | |
| 5933 | ,(or (org-link-get-parameter type :display) | |
| 5934 | 'org-link)) | |
| 5935 | properties)) | |
| 5936 | (visible-start (or (match-beginning 4) (match-beginning 2))) | |
| 5937 | (visible-end (or (match-end 4) (match-end 2)))) | |
| 5938 | (add-text-properties start visible-start hidden) | |
| 5939 | (add-text-properties visible-start visible-end properties) | |
| 5940 | (add-text-properties visible-end end hidden) | |
| 5941 | (org-rear-nonsticky-at visible-start) | |
| 5942 | (org-rear-nonsticky-at visible-end))) | |
| 5943 | (let ((f (org-link-get-parameter type :activate-func))) | |
| 5944 | (when (functionp f) | |
| 5945 | (funcall f start end path (eq style 'bracket)))) | |
| 5946 | (throw :exit t))))) ;signal success | |
| 5947 | nil)) | |
| 5948 | ||
| 5949 | (defun org-activate-code (limit) | |
| 5950 | (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) | |
| 5951 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) | |
| 5952 | (remove-text-properties (match-beginning 0) (match-end 0) | |
| 5953 | '(display t invisible t intangible t)) | |
| 5954 | t)) | |
| 5955 | ||
| 5956 | (defcustom org-src-fontify-natively t | |
| 5957 | "When non-nil, fontify code in code blocks. | |
| 5958 | See also the `org-block' face." | |
| 5959 | :type 'boolean | |
| 5960 | :version "26.1" | |
| 5961 | :package-version '(Org . "8.3") | |
| 5962 | :group 'org-appearance | |
| 5963 | :group 'org-babel) | |
| 5964 | ||
| 5965 | (defcustom org-allow-promoting-top-level-subtree nil | |
| 5966 | "When non-nil, allow promoting a top level subtree. | |
| 5967 | The leading star of the top level headline will be replaced | |
| 5968 | by a #." | |
| 5969 | :type 'boolean | |
| 5970 | :version "24.1" | |
| 5971 | :group 'org-appearance) | |
| 5972 | ||
| 5973 | (defun org-fontify-meta-lines-and-blocks (limit) | |
| 5974 | (condition-case nil | |
| 5975 | (org-fontify-meta-lines-and-blocks-1 limit) | |
| 5976 | (error (message "Org mode fontification error in %S at %d" | |
| 5977 | (current-buffer) | |
| 5978 | (line-number-at-pos))))) | |
| 5979 | ||
| 5980 | (defun org-fontify-meta-lines-and-blocks-1 (limit) | |
| 5981 | "Fontify #+ lines and blocks." | |
| 5982 | (let ((case-fold-search t)) | |
| 5983 | (when (re-search-forward | |
| 5984 | "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" | |
| 5985 | limit t) | |
| 5986 | (let ((beg (match-beginning 0)) | |
| 5987 | (block-start (match-end 0)) | |
| 5988 | (block-end nil) | |
| 5989 | (lang (match-string 7)) | |
| 5990 | (beg1 (line-beginning-position 2)) | |
| 5991 | (dc1 (downcase (match-string 2))) | |
| 5992 | (dc3 (downcase (match-string 3))) | |
| 5993 | end end1 quoting block-type) | |
| 5994 | (cond | |
| 5995 | ((and (match-end 4) (equal dc3 "+begin")) | |
| 5996 | ;; Truly a block | |
| 5997 | (setq block-type (downcase (match-string 5)) | |
| 5998 | quoting (member block-type org-protecting-blocks)) | |
| 5999 | (when (re-search-forward | |
| 6000 | (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") | |
| 6001 | nil t) ;; on purpose, we look further than LIMIT | |
| 6002 | (setq end (min (point-max) (match-end 0)) | |
| 6003 | end1 (min (point-max) (1- (match-beginning 0)))) | |
| 6004 | (setq block-end (match-beginning 0)) | |
| 6005 | (when quoting | |
| 6006 | (org-remove-flyspell-overlays-in beg1 end1) | |
| 6007 | (remove-text-properties beg end | |
| 6008 | '(display t invisible t intangible t))) | |
| 6009 | (add-text-properties | |
| 6010 | beg end '(font-lock-fontified t font-lock-multiline t)) | |
| 6011 | (add-text-properties beg beg1 '(face org-meta-line)) | |
| 6012 | (org-remove-flyspell-overlays-in beg beg1) | |
| 6013 | (add-text-properties ; For end_src | |
| 6014 | end1 (min (point-max) (1+ end)) '(face org-meta-line)) | |
| 6015 | (org-remove-flyspell-overlays-in end1 end) | |
| 6016 | (cond | |
| 6017 | ((and lang (not (string= lang "")) org-src-fontify-natively) | |
| 6018 | (org-src-font-lock-fontify-block lang block-start block-end) | |
| 6019 | (add-text-properties beg1 block-end '(src-block t))) | |
| 6020 | (quoting | |
| 6021 | (add-text-properties beg1 (min (point-max) (1+ end1)) | |
| 6022 | (list 'face | |
| 6023 | (list :inherit | |
| 6024 | (let ((face-name | |
| 6025 | (intern (format "org-block-%s" lang)))) | |
| 6026 | (append (and (facep face-name) (list face-name)) | |
| 6027 | '(org-block))))))) ; end of source block | |
| 6028 | ((not org-fontify-quote-and-verse-blocks)) | |
| 6029 | ((string= block-type "quote") | |
| 6030 | (add-face-text-property | |
| 6031 | beg1 (min (point-max) (1+ end1)) 'org-quote t)) | |
| 6032 | ((string= block-type "verse") | |
| 6033 | (add-face-text-property | |
| 6034 | beg1 (min (point-max) (1+ end1)) 'org-verse t))) | |
| 6035 | (add-text-properties beg beg1 '(face org-block-begin-line)) | |
| 6036 | (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) | |
| 6037 | '(face org-block-end-line)) | |
| 6038 | t)) | |
| 6039 | ((member dc1 '("+title:" "+author:" "+email:" "+date:")) | |
| 6040 | (org-remove-flyspell-overlays-in | |
| 6041 | (match-beginning 0) | |
| 6042 | (if (equal "+title:" dc1) (match-end 2) (match-end 0))) | |
| 6043 | (add-text-properties | |
| 6044 | beg (match-end 3) | |
| 6045 | (if (member (intern (substring dc1 1 -1)) org-hidden-keywords) | |
| 6046 | '(font-lock-fontified t invisible t) | |
| 6047 | '(font-lock-fontified t face org-document-info-keyword))) | |
| 6048 | (add-text-properties | |
| 6049 | (match-beginning 6) (min (point-max) (1+ (match-end 6))) | |
| 6050 | (if (string-equal dc1 "+title:") | |
| 6051 | '(font-lock-fontified t face org-document-title) | |
| 6052 | '(font-lock-fontified t face org-document-info)))) | |
| 6053 | ((string-prefix-p "+caption" dc1) | |
| 6054 | (org-remove-flyspell-overlays-in (match-end 2) (match-end 0)) | |
| 6055 | (remove-text-properties (match-beginning 0) (match-end 0) | |
| 6056 | '(display t invisible t intangible t)) | |
| 6057 | ;; Handle short captions. | |
| 6058 | (save-excursion | |
| 6059 | (beginning-of-line) | |
| 6060 | (looking-at "\\([ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\)[ \t]*")) | |
| 6061 | (add-text-properties (line-beginning-position) (match-end 1) | |
| 6062 | '(font-lock-fontified t face org-meta-line)) | |
| 6063 | (add-text-properties (match-end 0) (line-end-position) | |
| 6064 | '(font-lock-fontified t face org-block)) | |
| 6065 | t) | |
| 6066 | ((member dc3 '(" " "")) | |
| 6067 | (org-remove-flyspell-overlays-in beg (match-end 0)) | |
| 6068 | (add-text-properties | |
| 6069 | beg (match-end 0) | |
| 6070 | '(font-lock-fontified t face font-lock-comment-face))) | |
| 6071 | (t ;; just any other in-buffer setting, but not indented | |
| 6072 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) | |
| 6073 | (remove-text-properties (match-beginning 0) (match-end 0) | |
| 6074 | '(display t invisible t intangible t)) | |
| 6075 | (add-text-properties beg (match-end 0) | |
| 6076 | '(font-lock-fontified t face org-meta-line)) | |
| 6077 | t)))))) | |
| 6078 | ||
| 6079 | (defun org-fontify-drawers (limit) | |
| 6080 | "Fontify drawers." | |
| 6081 | (when (re-search-forward org-drawer-regexp limit t) | |
| 6082 | (add-text-properties | |
| 6083 | (match-beginning 0) (match-end 0) | |
| 6084 | '(font-lock-fontified t face org-special-keyword)) | |
| 6085 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) | |
| 6086 | t)) | |
| 6087 | ||
| 6088 | (defun org-fontify-macros (limit) | |
| 6089 | "Fontify macros." | |
| 6090 | (when (re-search-forward "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)" limit t) | |
| 6091 | (let ((begin (match-beginning 0)) | |
| 6092 | (opening-end (match-beginning 1))) | |
| 6093 | (when (and (re-search-forward "\n[ \t]*\n\\|\\(}}}\\)" limit t) | |
| 6094 | (match-string 1)) | |
| 6095 | (let ((end (match-end 1)) | |
| 6096 | (closing-start (match-beginning 1))) | |
| 6097 | (add-text-properties | |
| 6098 | begin end | |
| 6099 | '(font-lock-multiline t font-lock-fontified t face org-macro)) | |
| 6100 | (org-remove-flyspell-overlays-in begin end) | |
| 6101 | (when org-hide-macro-markers | |
| 6102 | (add-text-properties begin opening-end '(invisible t)) | |
| 6103 | (add-text-properties closing-start end '(invisible t))) | |
| 6104 | t))))) | |
| 6105 | ||
| 6106 | (defun org-activate-footnote-links (limit) | |
| 6107 | "Add text properties for footnotes." | |
| 6108 | (let ((fn (org-footnote-next-reference-or-definition limit))) | |
| 6109 | (when fn | |
| 6110 | (let* ((beg (nth 1 fn)) | |
| 6111 | (end (nth 2 fn)) | |
| 6112 | (label (car fn)) | |
| 6113 | (referencep (/= (line-beginning-position) beg))) | |
| 6114 | (when (and referencep (nth 3 fn)) | |
| 6115 | (save-excursion | |
| 6116 | (goto-char beg) | |
| 6117 | (search-forward (or label "fn:")) | |
| 6118 | (org-remove-flyspell-overlays-in beg (match-end 0)))) | |
| 6119 | (add-text-properties beg end | |
| 6120 | (list 'mouse-face 'highlight | |
| 6121 | 'keymap org-mouse-map | |
| 6122 | 'help-echo | |
| 6123 | (if referencep "Footnote reference" | |
| 6124 | "Footnote definition") | |
| 6125 | 'font-lock-fontified t | |
| 6126 | 'font-lock-multiline t | |
| 6127 | 'face 'org-footnote)))))) | |
| 6128 | ||
| 6129 | (defun org-activate-dates (limit) | |
| 6130 | "Add text properties for dates." | |
| 6131 | (when (and (re-search-forward org-tsr-regexp-both limit t) | |
| 6132 | (not (equal (char-before (match-beginning 0)) 91))) | |
| 6133 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) | |
| 6134 | (add-text-properties (match-beginning 0) (match-end 0) | |
| 6135 | (list 'mouse-face 'highlight | |
| 6136 | 'keymap org-mouse-map)) | |
| 6137 | (org-rear-nonsticky-at (match-end 0)) | |
| 6138 | (when org-display-custom-times | |
| 6139 | ;; If it's a date range, activate custom time for second date. | |
| 6140 | (when (match-end 3) | |
| 6141 | (org-display-custom-time (match-beginning 3) (match-end 3))) | |
| 6142 | (org-display-custom-time (match-beginning 1) (match-end 1))) | |
| 6143 | t)) | |
| 6144 | ||
| 6145 | (defvar-local org-target-link-regexp nil | |
| 6146 | "Regular expression matching radio targets in plain text.") | |
| 6147 | ||
| 6148 | (defconst org-target-regexp (let ((border "[^<>\n\r \t]")) | |
| 6149 | (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>" | |
| 6150 | border border border)) | |
| 6151 | "Regular expression matching a link target.") | |
| 6152 | ||
| 6153 | (defconst org-radio-target-regexp (format "<%s>" org-target-regexp) | |
| 6154 | "Regular expression matching a radio target.") | |
| 6155 | ||
| 6156 | (defconst org-any-target-regexp | |
| 6157 | (format "%s\\|%s" org-radio-target-regexp org-target-regexp) | |
| 6158 | "Regular expression matching any target.") | |
| 6159 | ||
| 6160 | (defun org-activate-target-links (limit) | |
| 6161 | "Add text properties for target matches." | |
| 6162 | (when org-target-link-regexp | |
| 6163 | (let ((case-fold-search t)) | |
| 6164 | (when (re-search-forward org-target-link-regexp limit t) | |
| 6165 | (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) | |
| 6166 | (add-text-properties (match-beginning 1) (match-end 1) | |
| 6167 | (list 'mouse-face 'highlight | |
| 6168 | 'keymap org-mouse-map | |
| 6169 | 'help-echo "Radio target link" | |
| 6170 | 'org-linked-text t)) | |
| 6171 | (org-rear-nonsticky-at (match-end 1)) | |
| 6172 | t)))) | |
| 6173 | ||
| 6174 | (defun org-update-radio-target-regexp () | |
| 6175 | "Find all radio targets in this file and update the regular expression. | |
| 6176 | Also refresh fontification if needed." | |
| 6177 | (interactive) | |
| 6178 | (let ((old-regexp org-target-link-regexp) | |
| 6179 | (before-re "\\(?:^\\|[^[:alnum:]]\\)\\(") | |
| 6180 | (after-re "\\)\\(?:$\\|[^[:alnum:]]\\)") | |
| 6181 | (targets | |
| 6182 | (org-with-wide-buffer | |
| 6183 | (goto-char (point-min)) | |
| 6184 | (let (rtn) | |
| 6185 | (while (re-search-forward org-radio-target-regexp nil t) | |
| 6186 | ;; Make sure point is really within the object. | |
| 6187 | (backward-char) | |
| 6188 | (let ((obj (org-element-context))) | |
| 6189 | (when (eq (org-element-type obj) 'radio-target) | |
| 6190 | (cl-pushnew (org-element-property :value obj) rtn | |
| 6191 | :test #'equal)))) | |
| 6192 | rtn)))) | |
| 6193 | (setq org-target-link-regexp | |
| 6194 | (and targets | |
| 6195 | (concat before-re | |
| 6196 | (mapconcat | |
| 6197 | (lambda (x) | |
| 6198 | (replace-regexp-in-string | |
| 6199 | " +" "\\s-+" (regexp-quote x) t t)) | |
| 6200 | targets | |
| 6201 | "\\|") | |
| 6202 | after-re))) | |
| 6203 | (unless (equal old-regexp org-target-link-regexp) | |
| 6204 | ;; Clean-up cache. | |
| 6205 | (let ((regexp (cond ((not old-regexp) org-target-link-regexp) | |
| 6206 | ((not org-target-link-regexp) old-regexp) | |
| 6207 | (t | |
| 6208 | (concat before-re | |
| 6209 | (mapconcat | |
| 6210 | (lambda (re) | |
| 6211 | (substring re (length before-re) | |
| 6212 | (- (length after-re)))) | |
| 6213 | (list old-regexp org-target-link-regexp) | |
| 6214 | "\\|") | |
| 6215 | after-re))))) | |
| 6216 | (org-with-wide-buffer | |
| 6217 | (goto-char (point-min)) | |
| 6218 | (while (re-search-forward regexp nil t) | |
| 6219 | (org-element-cache-refresh (match-beginning 1))))) | |
| 6220 | ;; Re fontify buffer. | |
| 6221 | (when (memq 'radio org-highlight-links) | |
| 6222 | (org-restart-font-lock))))) | |
| 6223 | ||
| 6224 | (defun org-hide-wide-columns (limit) | |
| 6225 | (let (s e) | |
| 6226 | (setq s (text-property-any (point) (or limit (point-max)) | |
| 6227 | 'org-cwidth t)) | |
| 6228 | (when s | |
| 6229 | (setq e (next-single-property-change s 'org-cwidth)) | |
| 6230 | (add-text-properties s e '(invisible org-cwidth)) | |
| 6231 | (goto-char e) | |
| 6232 | t))) | |
| 6233 | ||
| 6234 | (defvar org-latex-and-related-regexp nil | |
| 6235 | "Regular expression for highlighting LaTeX, entities and sub/superscript.") | |
| 6236 | ||
| 6237 | (defun org-compute-latex-and-related-regexp () | |
| 6238 | "Compute regular expression for LaTeX, entities and sub/superscript. | |
| 6239 | Result depends on variable `org-highlight-latex-and-related'." | |
| 6240 | (setq-local | |
| 6241 | org-latex-and-related-regexp | |
| 6242 | (let* ((re-sub | |
| 6243 | (cond ((not (memq 'script org-highlight-latex-and-related)) nil) | |
| 6244 | ((eq org-use-sub-superscripts '{}) | |
| 6245 | (list org-match-substring-with-braces-regexp)) | |
| 6246 | (org-use-sub-superscripts (list org-match-substring-regexp)))) | |
| 6247 | (re-latex | |
| 6248 | (when (memq 'latex org-highlight-latex-and-related) | |
| 6249 | (let ((matchers (plist-get org-format-latex-options :matchers))) | |
| 6250 | (delq nil | |
| 6251 | (mapcar (lambda (x) | |
| 6252 | (and (member (car x) matchers) (nth 1 x))) | |
| 6253 | org-latex-regexps))))) | |
| 6254 | (re-entities | |
| 6255 | (when (memq 'entities org-highlight-latex-and-related) | |
| 6256 | (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")))) | |
| 6257 | (mapconcat 'identity (append re-latex re-entities re-sub) "\\|")))) | |
| 6258 | ||
| 6259 | (defun org-do-latex-and-related (limit) | |
| 6260 | "Highlight LaTeX snippets and environments, entities and sub/superscript. | |
| 6261 | LIMIT bounds the search for syntax to highlight. Stop at first | |
| 6262 | highlighted object, if any. Return t if some highlighting was | |
| 6263 | done, nil otherwise." | |
| 6264 | (when (org-string-nw-p org-latex-and-related-regexp) | |
| 6265 | (catch 'found | |
| 6266 | (while (re-search-forward org-latex-and-related-regexp limit t) | |
| 6267 | (unless | |
| 6268 | (cl-some | |
| 6269 | (lambda (f) | |
| 6270 | (memq f '(org-code org-verbatim underline org-special-keyword))) | |
| 6271 | (save-excursion | |
| 6272 | (goto-char (1+ (match-beginning 0))) | |
| 6273 | (face-at-point nil t))) | |
| 6274 | (let ((offset (if (memq (char-after (1+ (match-beginning 0))) | |
| 6275 | '(?_ ?^)) | |
| 6276 | 1 | |
| 6277 | 0))) | |
| 6278 | (font-lock-prepend-text-property | |
| 6279 | (+ offset (match-beginning 0)) (match-end 0) | |
| 6280 | 'face 'org-latex-and-related) | |
| 6281 | (add-text-properties (+ offset (match-beginning 0)) (match-end 0) | |
| 6282 | '(font-lock-multiline t))) | |
| 6283 | (throw 'found t))) | |
| 6284 | nil))) | |
| 6285 | ||
| 6286 | (defun org-restart-font-lock () | |
| 6287 | "Restart `font-lock-mode', to force refontification." | |
| 6288 | (when (and (boundp 'font-lock-mode) font-lock-mode) | |
| 6289 | (font-lock-mode -1) | |
| 6290 | (font-lock-mode 1))) | |
| 6291 | ||
| 6292 | (defun org-activate-tags (limit) | |
| 6293 | (when (re-search-forward | |
| 6294 | "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" limit t) | |
| 6295 | (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) | |
| 6296 | (add-text-properties (match-beginning 1) (match-end 1) | |
| 6297 | (list 'mouse-face 'highlight | |
| 6298 | 'keymap org-mouse-map)) | |
| 6299 | (org-rear-nonsticky-at (match-end 1)) | |
| 6300 | t)) | |
| 6301 | ||
| 6302 | (defun org-outline-level () | |
| 6303 | "Compute the outline level of the heading at point. | |
| 6304 | ||
| 6305 | If this is called at a normal headline, the level is the number | |
| 6306 | of stars. Use `org-reduced-level' to remove the effect of | |
| 6307 | `org-odd-levels'. Unlike to `org-current-level', this function | |
| 6308 | takes into consideration inlinetasks." | |
| 6309 | (org-with-wide-buffer | |
| 6310 | (end-of-line) | |
| 6311 | (if (re-search-backward org-outline-regexp-bol nil t) | |
| 6312 | (1- (- (match-end 0) (match-beginning 0))) | |
| 6313 | 0))) | |
| 6314 | ||
| 6315 | (defvar org-font-lock-keywords nil) | |
| 6316 | ||
| 6317 | (defsubst org-re-property (property &optional literal allow-null value) | |
| 6318 | "Return a regexp matching a PROPERTY line. | |
| 6319 | ||
| 6320 | When optional argument LITERAL is non-nil, do not quote PROPERTY. | |
| 6321 | This is useful when PROPERTY is a regexp. When ALLOW-NULL is | |
| 6322 | non-nil, match properties even without a value. | |
| 6323 | ||
| 6324 | Match group 3 is set to the value when it exists. If there is no | |
| 6325 | value and ALLOW-NULL is non-nil, it is set to the empty string. | |
| 6326 | ||
| 6327 | With optional argument VALUE, match only property lines with | |
| 6328 | that value; in this case, ALLOW-NULL is ignored. VALUE is quoted | |
| 6329 | unless LITERAL is non-nil." | |
| 6330 | (concat | |
| 6331 | "^\\(?4:[ \t]*\\)" | |
| 6332 | (format "\\(?1::\\(?2:%s\\):\\)" | |
| 6333 | (if literal property (regexp-quote property))) | |
| 6334 | (cond (value | |
| 6335 | (format "[ \t]+\\(?3:%s\\)\\(?5:[ \t]*\\)$" | |
| 6336 | (if literal value (regexp-quote value)))) | |
| 6337 | (allow-null | |
| 6338 | "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$") | |
| 6339 | (t | |
| 6340 | "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$")))) | |
| 6341 | ||
| 6342 | (defconst org-property-re | |
| 6343 | (org-re-property "\\S-+" 'literal t) | |
| 6344 | "Regular expression matching a property line. | |
| 6345 | There are four matching groups: | |
| 6346 | 1: :PROPKEY: including the leading and trailing colon, | |
| 6347 | 2: PROPKEY without the leading and trailing colon, | |
| 6348 | 3: PROPVAL without leading or trailing spaces, | |
| 6349 | 4: the indentation of the current line, | |
| 6350 | 5: trailing whitespace.") | |
| 6351 | ||
| 6352 | (defvar org-font-lock-hook nil | |
| 6353 | "Functions to be called for special font lock stuff.") | |
| 6354 | ||
| 6355 | (defvar org-font-lock-extra-keywords nil) ;Dynamically scoped. | |
| 6356 | ||
| 6357 | (defvar org-font-lock-set-keywords-hook nil | |
| 6358 | "Functions that can manipulate `org-font-lock-extra-keywords'. | |
| 6359 | This is called after `org-font-lock-extra-keywords' is defined, but before | |
| 6360 | it is installed to be used by font lock. This can be useful if something | |
| 6361 | needs to be inserted at a specific position in the font-lock sequence.") | |
| 6362 | ||
| 6363 | (defun org-font-lock-hook (limit) | |
| 6364 | "Run `org-font-lock-hook' within LIMIT." | |
| 6365 | (run-hook-with-args 'org-font-lock-hook limit)) | |
| 6366 | ||
| 6367 | (defun org-set-font-lock-defaults () | |
| 6368 | "Set font lock defaults for the current buffer." | |
| 6369 | (let* ((em org-fontify-emphasized-text) | |
| 6370 | (lk org-highlight-links) | |
| 6371 | (org-font-lock-extra-keywords | |
| 6372 | (list | |
| 6373 | ;; Call the hook | |
| 6374 | '(org-font-lock-hook) | |
| 6375 | ;; Headlines | |
| 6376 | `(,(if org-fontify-whole-heading-line | |
| 6377 | "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)" | |
| 6378 | "^\\(\\**\\)\\(\\* \\)\\(.*\\)") | |
| 6379 | (1 (org-get-level-face 1)) | |
| 6380 | (2 (org-get-level-face 2)) | |
| 6381 | (3 (org-get-level-face 3))) | |
| 6382 | ;; Table lines | |
| 6383 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" | |
| 6384 | (1 'org-table t)) | |
| 6385 | ;; Table internals | |
| 6386 | '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) | |
| 6387 | '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) | |
| 6388 | '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) | |
| 6389 | '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t)) | |
| 6390 | ;; Drawers | |
| 6391 | '(org-fontify-drawers) | |
| 6392 | ;; Properties | |
| 6393 | (list org-property-re | |
| 6394 | '(1 'org-special-keyword t) | |
| 6395 | '(3 'org-property-value t)) | |
| 6396 | ;; Link related fontification. | |
| 6397 | '(org-activate-links) | |
| 6398 | (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) | |
| 6399 | (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t))) | |
| 6400 | (when (memq 'date lk) '(org-activate-dates (0 'org-date t))) | |
| 6401 | (when (memq 'footnote lk) '(org-activate-footnote-links)) | |
| 6402 | ;; Targets. | |
| 6403 | (list org-any-target-regexp '(0 'org-target t)) | |
| 6404 | ;; Diary sexps. | |
| 6405 | '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) | |
| 6406 | ;; Macro | |
| 6407 | '(org-fontify-macros) | |
| 6408 | '(org-hide-wide-columns (0 nil append)) | |
| 6409 | ;; TODO keyword | |
| 6410 | (list (format org-heading-keyword-regexp-format | |
| 6411 | org-todo-regexp) | |
| 6412 | '(2 (org-get-todo-face 2) t)) | |
| 6413 | ;; DONE | |
| 6414 | (if org-fontify-done-headline | |
| 6415 | (list (format org-heading-keyword-regexp-format | |
| 6416 | (concat | |
| 6417 | "\\(?:" | |
| 6418 | (mapconcat 'regexp-quote org-done-keywords "\\|") | |
| 6419 | "\\)")) | |
| 6420 | '(2 'org-headline-done t)) | |
| 6421 | nil) | |
| 6422 | ;; Priorities | |
| 6423 | '(org-font-lock-add-priority-faces) | |
| 6424 | ;; Tags | |
| 6425 | '(org-font-lock-add-tag-faces) | |
| 6426 | ;; Tags groups | |
| 6427 | (when (and org-group-tags org-tag-groups-alist) | |
| 6428 | (list (concat org-outline-regexp-bol ".+\\(:" | |
| 6429 | (regexp-opt (mapcar 'car org-tag-groups-alist)) | |
| 6430 | ":\\).*$") | |
| 6431 | '(1 'org-tag-group prepend))) | |
| 6432 | ;; Special keywords | |
| 6433 | (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) | |
| 6434 | (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) | |
| 6435 | (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) | |
| 6436 | (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) | |
| 6437 | ;; Emphasis | |
| 6438 | (when em '(org-do-emphasis-faces)) | |
| 6439 | ;; Checkboxes | |
| 6440 | '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" | |
| 6441 | 1 'org-checkbox prepend) | |
| 6442 | (when (cdr (assq 'checkbox org-list-automatic-rules)) | |
| 6443 | '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" | |
| 6444 | (0 (org-get-checkbox-statistics-face) t))) | |
| 6445 | ;; Description list items | |
| 6446 | '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)" | |
| 6447 | 1 'org-list-dt prepend) | |
| 6448 | ;; ARCHIVEd headings | |
| 6449 | (list (concat | |
| 6450 | org-outline-regexp-bol | |
| 6451 | "\\(.*:" org-archive-tag ":.*\\)") | |
| 6452 | '(1 'org-archived prepend)) | |
| 6453 | ;; Specials | |
| 6454 | '(org-do-latex-and-related) | |
| 6455 | '(org-fontify-entities) | |
| 6456 | '(org-raise-scripts) | |
| 6457 | ;; Code | |
| 6458 | '(org-activate-code (1 'org-code t)) | |
| 6459 | ;; COMMENT | |
| 6460 | (list (format | |
| 6461 | "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)" | |
| 6462 | org-todo-regexp | |
| 6463 | org-comment-string) | |
| 6464 | '(9 'org-special-keyword t)) | |
| 6465 | ;; Blocks and meta lines | |
| 6466 | '(org-fontify-meta-lines-and-blocks)))) | |
| 6467 | (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) | |
| 6468 | (run-hooks 'org-font-lock-set-keywords-hook) | |
| 6469 | ;; Now set the full font-lock-keywords | |
| 6470 | (setq-local org-font-lock-keywords org-font-lock-extra-keywords) | |
| 6471 | (setq-local font-lock-defaults | |
| 6472 | '(org-font-lock-keywords t nil nil backward-paragraph)) | |
| 6473 | (kill-local-variable 'font-lock-keywords) | |
| 6474 | nil)) | |
| 6475 | ||
| 6476 | (defun org-toggle-pretty-entities () | |
| 6477 | "Toggle the composition display of entities as UTF8 characters." | |
| 6478 | (interactive) | |
| 6479 | (setq-local org-pretty-entities (not org-pretty-entities)) | |
| 6480 | (org-restart-font-lock) | |
| 6481 | (if org-pretty-entities | |
| 6482 | (message "Entities are now displayed as UTF8 characters") | |
| 6483 | (save-restriction | |
| 6484 | (widen) | |
| 6485 | (decompose-region (point-min) (point-max)) | |
| 6486 | (message "Entities are now displayed as plain text")))) | |
| 6487 | ||
| 6488 | (defvar-local org-custom-properties-overlays nil | |
| 6489 | "List of overlays used for custom properties.") | |
| 6490 | ||
| 6491 | (defun org-toggle-custom-properties-visibility () | |
| 6492 | "Display or hide properties in `org-custom-properties'." | |
| 6493 | (interactive) | |
| 6494 | (if org-custom-properties-overlays | |
| 6495 | (progn (mapc #'delete-overlay org-custom-properties-overlays) | |
| 6496 | (setq org-custom-properties-overlays nil)) | |
| 6497 | (when org-custom-properties | |
| 6498 | (org-with-wide-buffer | |
| 6499 | (goto-char (point-min)) | |
| 6500 | (let ((regexp (org-re-property (regexp-opt org-custom-properties) t t))) | |
| 6501 | (while (re-search-forward regexp nil t) | |
| 6502 | (let ((end (cdr (save-match-data (org-get-property-block))))) | |
| 6503 | (when (and end (< (point) end)) | |
| 6504 | ;; Hide first custom property in current drawer. | |
| 6505 | (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) | |
| 6506 | (overlay-put o 'invisible t) | |
| 6507 | (overlay-put o 'org-custom-property t) | |
| 6508 | (push o org-custom-properties-overlays)) | |
| 6509 | ;; Hide additional custom properties in the same drawer. | |
| 6510 | (while (re-search-forward regexp end t) | |
| 6511 | (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) | |
| 6512 | (overlay-put o 'invisible t) | |
| 6513 | (overlay-put o 'org-custom-property t) | |
| 6514 | (push o org-custom-properties-overlays))))) | |
| 6515 | ;; Each entry is limited to a single property drawer. | |
| 6516 | (outline-next-heading))))))) | |
| 6517 | ||
| 6518 | (defun org-fontify-entities (limit) | |
| 6519 | "Find an entity to fontify." | |
| 6520 | (let (ee) | |
| 6521 | (when org-pretty-entities | |
| 6522 | (catch 'match | |
| 6523 | ;; "\_ "-family is left out on purpose. Only the first one, | |
| 6524 | ;; i.e., "\_ ", could be fontified anyway, and it would be | |
| 6525 | ;; confusing when adding a second white space character. | |
| 6526 | (while (re-search-forward | |
| 6527 | "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)" | |
| 6528 | limit t) | |
| 6529 | (when (and (not (org-at-comment-p)) | |
| 6530 | (setq ee (org-entity-get (match-string 1))) | |
| 6531 | (= (length (nth 6 ee)) 1)) | |
| 6532 | (let* ((end (if (equal (match-string 2) "{}") | |
| 6533 | (match-end 2) | |
| 6534 | (match-end 1)))) | |
| 6535 | (add-text-properties | |
| 6536 | (match-beginning 0) end | |
| 6537 | (list 'font-lock-fontified t)) | |
| 6538 | (compose-region (match-beginning 0) end | |
| 6539 | (nth 6 ee) nil) | |
| 6540 | (backward-char 1) | |
| 6541 | (throw 'match t)))) | |
| 6542 | nil)))) | |
| 6543 | ||
| 6544 | (defun org-fontify-like-in-org-mode (s &optional odd-levels) | |
| 6545 | "Fontify string S like in Org mode." | |
| 6546 | (with-temp-buffer | |
| 6547 | (insert s) | |
| 6548 | (let ((org-odd-levels-only odd-levels)) | |
| 6549 | (org-mode) | |
| 6550 | (org-font-lock-ensure) | |
| 6551 | (buffer-string)))) | |
| 6552 | ||
| 6553 | (defvar org-m nil) | |
| 6554 | (defvar org-l nil) | |
| 6555 | (defvar org-f nil) | |
| 6556 | (defun org-get-level-face (n) | |
| 6557 | "Get the right face for match N in font-lock matching of headlines." | |
| 6558 | (setq org-l (- (match-end 2) (match-beginning 1) 1)) | |
| 6559 | (when org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) | |
| 6560 | (if org-cycle-level-faces | |
| 6561 | (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) | |
| 6562 | (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) | |
| 6563 | (cond | |
| 6564 | ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) | |
| 6565 | ((eq n 2) org-f) | |
| 6566 | (t (unless org-level-color-stars-only org-f)))) | |
| 6567 | ||
| 6568 | (defun org-face-from-face-or-color (context inherit face-or-color) | |
| 6569 | "Create a face list that inherits INHERIT, but sets the foreground color. | |
| 6570 | When FACE-OR-COLOR is not a string, just return it." | |
| 6571 | (if (stringp face-or-color) | |
| 6572 | (list :inherit inherit | |
| 6573 | (cdr (assoc context org-faces-easy-properties)) | |
| 6574 | face-or-color) | |
| 6575 | face-or-color)) | |
| 6576 | ||
| 6577 | (defun org-get-todo-face (kwd) | |
| 6578 | "Get the right face for a TODO keyword KWD. | |
| 6579 | If KWD is a number, get the corresponding match group." | |
| 6580 | (when (numberp kwd) (setq kwd (match-string kwd))) | |
| 6581 | (or (org-face-from-face-or-color | |
| 6582 | 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces))) | |
| 6583 | (and (member kwd org-done-keywords) 'org-done) | |
| 6584 | 'org-todo)) | |
| 6585 | ||
| 6586 | (defun org-get-priority-face (priority) | |
| 6587 | "Get the right face for PRIORITY. | |
| 6588 | PRIORITY is a character." | |
| 6589 | (or (org-face-from-face-or-color | |
| 6590 | 'priority 'org-priority (cdr (assq priority org-priority-faces))) | |
| 6591 | 'org-priority)) | |
| 6592 | ||
| 6593 | (defun org-get-tag-face (tag) | |
| 6594 | "Get the right face for TAG. | |
| 6595 | If TAG is a number, get the corresponding match group." | |
| 6596 | (let ((tag (if (wholenump tag) (match-string tag) tag))) | |
| 6597 | (or (org-face-from-face-or-color | |
| 6598 | 'tag 'org-tag (cdr (assoc tag org-tag-faces))) | |
| 6599 | 'org-tag))) | |
| 6600 | ||
| 6601 | (defun org-font-lock-add-priority-faces (limit) | |
| 6602 | "Add the special priority faces." | |
| 6603 | (while (re-search-forward "^\\*+ .*?\\(\\[#\\(.\\)\\]\\)" limit t) | |
| 6604 | (add-text-properties | |
| 6605 | (match-beginning 1) (match-end 1) | |
| 6606 | (list 'face (org-get-priority-face (string-to-char (match-string 2))) | |
| 6607 | 'font-lock-fontified t)))) | |
| 6608 | ||
| 6609 | (defun org-font-lock-add-tag-faces (limit) | |
| 6610 | "Add the special tag faces." | |
| 6611 | (when (and org-tag-faces org-tags-special-faces-re) | |
| 6612 | (while (re-search-forward org-tags-special-faces-re limit t) | |
| 6613 | (add-text-properties (match-beginning 1) (match-end 1) | |
| 6614 | (list 'face (org-get-tag-face 1) | |
| 6615 | 'font-lock-fontified t)) | |
| 6616 | (backward-char 1)))) | |
| 6617 | ||
| 6618 | (defun org-unfontify-region (beg end &optional _maybe_loudly) | |
| 6619 | "Remove fontification and activation overlays from links." | |
| 6620 | (font-lock-default-unfontify-region beg end) | |
| 6621 | (let* ((buffer-undo-list t) | |
| 6622 | (inhibit-read-only t) (inhibit-point-motion-hooks t) | |
| 6623 | (inhibit-modification-hooks t) | |
| 6624 | deactivate-mark buffer-file-name buffer-file-truename) | |
| 6625 | (decompose-region beg end) | |
| 6626 | (remove-text-properties beg end | |
| 6627 | '(mouse-face t keymap t org-linked-text t | |
| 6628 | invisible t intangible t | |
| 6629 | org-emphasis t)) | |
| 6630 | (org-remove-font-lock-display-properties beg end))) | |
| 6631 | ||
| 6632 | (defconst org-script-display '(((raise -0.3) (height 0.7)) | |
| 6633 | ((raise 0.3) (height 0.7)) | |
| 6634 | ((raise -0.5)) | |
| 6635 | ((raise 0.5))) | |
| 6636 | "Display properties for showing superscripts and subscripts.") | |
| 6637 | ||
| 6638 | (defun org-remove-font-lock-display-properties (beg end) | |
| 6639 | "Remove specific display properties that have been added by font lock. | |
| 6640 | The will remove the raise properties that are used to show superscripts | |
| 6641 | and subscripts." | |
| 6642 | (let (next prop) | |
| 6643 | (while (< beg end) | |
| 6644 | (setq next (next-single-property-change beg 'display nil end) | |
| 6645 | prop (get-text-property beg 'display)) | |
| 6646 | (when (member prop org-script-display) | |
| 6647 | (put-text-property beg next 'display nil)) | |
| 6648 | (setq beg next)))) | |
| 6649 | ||
| 6650 | (defun org-raise-scripts (limit) | |
| 6651 | "Add raise properties to sub/superscripts." | |
| 6652 | (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts | |
| 6653 | (re-search-forward | |
| 6654 | (if (eq org-use-sub-superscripts t) | |
| 6655 | org-match-substring-regexp | |
| 6656 | org-match-substring-with-braces-regexp) | |
| 6657 | limit t)) | |
| 6658 | (let* ((pos (point)) table-p comment-p | |
| 6659 | (mpos (match-beginning 3)) | |
| 6660 | (emph-p (get-text-property mpos 'org-emphasis)) | |
| 6661 | (link-p (get-text-property mpos 'mouse-face)) | |
| 6662 | (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) | |
| 6663 | (goto-char (point-at-bol)) | |
| 6664 | (setq table-p (looking-at-p org-table-dataline-regexp) | |
| 6665 | comment-p (looking-at-p "^[ \t]*#[ +]")) | |
| 6666 | (goto-char pos) | |
| 6667 | ;; Handle a_b^c | |
| 6668 | (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) | |
| 6669 | (unless (or comment-p emph-p link-p keyw-p) | |
| 6670 | (put-text-property (match-beginning 3) (match-end 0) | |
| 6671 | 'display | |
| 6672 | (if (equal (char-after (match-beginning 2)) ?^) | |
| 6673 | (nth (if table-p 3 1) org-script-display) | |
| 6674 | (nth (if table-p 2 0) org-script-display))) | |
| 6675 | (add-text-properties (match-beginning 2) (match-end 2) | |
| 6676 | (list 'invisible t)) | |
| 6677 | (when (and (eq (char-after (match-beginning 3)) ?{) | |
| 6678 | (eq (char-before (match-end 3)) ?})) | |
| 6679 | (add-text-properties (match-beginning 3) (1+ (match-beginning 3)) | |
| 6680 | (list 'invisible t)) | |
| 6681 | (add-text-properties (1- (match-end 3)) (match-end 3) | |
| 6682 | (list 'invisible t)))) | |
| 6683 | t))) | |
| 6684 | ||
| 6685 | ;;;; Visibility cycling, including org-goto and indirect buffer | |
| 6686 | ||
| 6687 | ;;; Cycling | |
| 6688 | ||
| 6689 | (defvar-local org-cycle-global-status nil) | |
| 6690 | (put 'org-cycle-global-status 'org-state t) | |
| 6691 | (defvar-local org-cycle-subtree-status nil) | |
| 6692 | (put 'org-cycle-subtree-status 'org-state t) | |
| 6693 | ||
| 6694 | (defvar org-inlinetask-min-level) | |
| 6695 | ||
| 6696 | (defun org-unlogged-message (&rest args) | |
| 6697 | "Display a message, but avoid logging it in the *Messages* buffer." | |
| 6698 | (let ((message-log-max nil)) | |
| 6699 | (apply 'message args))) | |
| 6700 | ||
| 6701 | ;;;###autoload | |
| 6702 | (defun org-cycle (&optional arg) | |
| 6703 | "TAB-action and visibility cycling for Org mode. | |
| 6704 | ||
| 6705 | This is the command invoked in Org mode by the `TAB' key. Its main | |
| 6706 | purpose is outline visibility cycling, but it also invokes other actions | |
| 6707 | in special contexts. | |
| 6708 | ||
| 6709 | When this function is called with a `\\[universal-argument]' prefix, rotate \ | |
| 6710 | the entire | |
| 6711 | buffer through 3 states (global cycling) | |
| 6712 | 1. OVERVIEW: Show only top-level headlines. | |
| 6713 | 2. CONTENTS: Show all headlines of all levels, but no body text. | |
| 6714 | 3. SHOW ALL: Show everything. | |
| 6715 | ||
| 6716 | With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ | |
| 6717 | switch to the startup visibility, | |
| 6718 | determined by the variable `org-startup-folded', and by any VISIBILITY | |
| 6719 | properties in the buffer. | |
| 6720 | ||
| 6721 | With a `\\[universal-argument] \\[universal-argument] \ | |
| 6722 | \\[universal-argument]' prefix argument, show the entire buffer, including | |
| 6723 | any drawers. | |
| 6724 | ||
| 6725 | When inside a table, re-align the table and move to the next field. | |
| 6726 | ||
| 6727 | When point is at the beginning of a headline, rotate the subtree started | |
| 6728 | by this line through 3 different states (local cycling) | |
| 6729 | 1. FOLDED: Only the main headline is shown. | |
| 6730 | 2. CHILDREN: The main headline and the direct children are shown. | |
| 6731 | From this state, you can move to one of the children | |
| 6732 | and zoom in further. | |
| 6733 | 3. SUBTREE: Show the entire subtree, including body text. | |
| 6734 | If there is no subtree, switch directly from CHILDREN to FOLDED. | |
| 6735 | ||
| 6736 | When point is at the beginning of an empty headline and the variable | |
| 6737 | `org-cycle-level-after-item/entry-creation' is set, cycle the level | |
| 6738 | of the headline by demoting and promoting it to likely levels. This | |
| 6739 | speeds up creation document structure by pressing `TAB' once or several | |
| 6740 | times right after creating a new headline. | |
| 6741 | ||
| 6742 | When there is a numeric prefix, go up to a heading with level ARG, do | |
| 6743 | a `show-subtree' and return to the previous cursor position. If ARG | |
| 6744 | is negative, go up that many levels. | |
| 6745 | ||
| 6746 | When point is not at the beginning of a headline, execute the global | |
| 6747 | binding for `TAB', which is re-indenting the line. See the option | |
| 6748 | `org-cycle-emulate-tab' for details. | |
| 6749 | ||
| 6750 | As a special case, if point is at the beginning of the buffer and there is | |
| 6751 | no headline in line 1, this function will act as if called with prefix arg | |
| 6752 | \(`\\[universal-argument] TAB', same as `S-TAB') also when called without \ | |
| 6753 | prefix arg, but only | |
| 6754 | if the variable `org-cycle-global-at-bob' is t." | |
| 6755 | (interactive "P") | |
| 6756 | (org-load-modules-maybe) | |
| 6757 | (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) | |
| 6758 | (and org-cycle-level-after-item/entry-creation | |
| 6759 | (or (org-cycle-level) | |
| 6760 | (org-cycle-item-indentation)))) | |
| 6761 | (let* ((limit-level | |
| 6762 | (or org-cycle-max-level | |
| 6763 | (and (boundp 'org-inlinetask-min-level) | |
| 6764 | org-inlinetask-min-level | |
| 6765 | (1- org-inlinetask-min-level)))) | |
| 6766 | (nstars (and limit-level | |
| 6767 | (if org-odd-levels-only | |
| 6768 | (and limit-level (1- (* limit-level 2))) | |
| 6769 | limit-level))) | |
| 6770 | (org-outline-regexp | |
| 6771 | (if (not (derived-mode-p 'org-mode)) | |
| 6772 | outline-regexp | |
| 6773 | (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))) | |
| 6774 | (bob-special (and org-cycle-global-at-bob (not arg) (bobp) | |
| 6775 | (not (looking-at org-outline-regexp)))) | |
| 6776 | (org-cycle-hook | |
| 6777 | (if bob-special | |
| 6778 | (delq 'org-optimize-window-after-visibility-change | |
| 6779 | (copy-sequence org-cycle-hook)) | |
| 6780 | org-cycle-hook)) | |
| 6781 | (pos (point))) | |
| 6782 | ||
| 6783 | (cond | |
| 6784 | ||
| 6785 | ((equal arg '(16)) | |
| 6786 | (setq last-command 'dummy) | |
| 6787 | (org-set-startup-visibility) | |
| 6788 | (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) | |
| 6789 | ||
| 6790 | ((equal arg '(64)) | |
| 6791 | (outline-show-all) | |
| 6792 | (org-unlogged-message "Entire buffer visible, including drawers")) | |
| 6793 | ||
| 6794 | ((equal arg '(4)) (org-cycle-internal-global)) | |
| 6795 | ||
| 6796 | ;; Try hiding block at point. | |
| 6797 | ((org-hide-block-toggle-maybe)) | |
| 6798 | ||
| 6799 | ;; Try cdlatex TAB completion | |
| 6800 | ((org-try-cdlatex-tab)) | |
| 6801 | ||
| 6802 | ;; Table: enter it or move to the next field. | |
| 6803 | ((org-at-table-p 'any) | |
| 6804 | (if (org-at-table.el-p) | |
| 6805 | (message "%s" (substitute-command-keys "\\<org-mode-map>\ | |
| 6806 | Use `\\[org-edit-special]' to edit table.el tables")) | |
| 6807 | (if arg (org-table-edit-field t) | |
| 6808 | (org-table-justify-field-maybe) | |
| 6809 | (call-interactively 'org-table-next-field)))) | |
| 6810 | ||
| 6811 | ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook)) | |
| 6812 | ||
| 6813 | ;; Global cycling: delegate to `org-cycle-internal-global'. | |
| 6814 | (bob-special (org-cycle-internal-global)) | |
| 6815 | ||
| 6816 | ;; Drawers: delegate to `org-flag-drawer'. | |
| 6817 | ((save-excursion | |
| 6818 | (beginning-of-line 1) | |
| 6819 | (looking-at org-drawer-regexp)) | |
| 6820 | (org-flag-drawer ; toggle block visibility | |
| 6821 | (not (get-char-property (match-end 0) 'invisible)))) | |
| 6822 | ||
| 6823 | ;; Show-subtree, ARG levels up from here. | |
| 6824 | ((integerp arg) | |
| 6825 | (save-excursion | |
| 6826 | (org-back-to-heading) | |
| 6827 | (outline-up-heading (if (< arg 0) (- arg) | |
| 6828 | (- (funcall outline-level) arg))) | |
| 6829 | (org-show-subtree))) | |
| 6830 | ||
| 6831 | ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. | |
| 6832 | ((and (featurep 'org-inlinetask) | |
| 6833 | (org-inlinetask-at-task-p) | |
| 6834 | (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) | |
| 6835 | (org-inlinetask-toggle-visibility)) | |
| 6836 | ||
| 6837 | ;; At an item/headline: delegate to `org-cycle-internal-local'. | |
| 6838 | ((and (or (and org-cycle-include-plain-lists (org-at-item-p)) | |
| 6839 | (save-excursion (move-beginning-of-line 1) | |
| 6840 | (looking-at org-outline-regexp))) | |
| 6841 | (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) | |
| 6842 | (org-cycle-internal-local)) | |
| 6843 | ||
| 6844 | ;; From there: TAB emulation and template completion. | |
| 6845 | (buffer-read-only (org-back-to-heading)) | |
| 6846 | ||
| 6847 | ((run-hook-with-args-until-success | |
| 6848 | 'org-tab-after-check-for-cycling-hook)) | |
| 6849 | ||
| 6850 | ((org-try-structure-completion)) | |
| 6851 | ||
| 6852 | ((run-hook-with-args-until-success | |
| 6853 | 'org-tab-before-tab-emulation-hook)) | |
| 6854 | ||
| 6855 | ((and (eq org-cycle-emulate-tab 'exc-hl-bol) | |
| 6856 | (or (not (bolp)) | |
| 6857 | (not (looking-at org-outline-regexp)))) | |
| 6858 | (call-interactively (global-key-binding "\t"))) | |
| 6859 | ||
| 6860 | ((if (and (memq org-cycle-emulate-tab '(white whitestart)) | |
| 6861 | (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) | |
| 6862 | (or (and (eq org-cycle-emulate-tab 'white) | |
| 6863 | (= (match-end 0) (point-at-eol))) | |
| 6864 | (and (eq org-cycle-emulate-tab 'whitestart) | |
| 6865 | (>= (match-end 0) pos)))) | |
| 6866 | t | |
| 6867 | (eq org-cycle-emulate-tab t)) | |
| 6868 | (call-interactively (global-key-binding "\t"))) | |
| 6869 | ||
| 6870 | (t (save-excursion | |
| 6871 | (org-back-to-heading) | |
| 6872 | (org-cycle))))))) | |
| 6873 | ||
| 6874 | (defun org-cycle-internal-global () | |
| 6875 | "Do the global cycling action." | |
| 6876 | ;; Hack to avoid display of messages for .org attachments in Gnus | |
| 6877 | (let ((ga (string-match "\\*fontification" (buffer-name)))) | |
| 6878 | (cond | |
| 6879 | ((and (eq last-command this-command) | |
| 6880 | (eq org-cycle-global-status 'overview)) | |
| 6881 | ;; We just created the overview - now do table of contents | |
| 6882 | ;; This can be slow in very large buffers, so indicate action | |
| 6883 | (run-hook-with-args 'org-pre-cycle-hook 'contents) | |
| 6884 | (unless ga (org-unlogged-message "CONTENTS...")) | |
| 6885 | (org-content) | |
| 6886 | (unless ga (org-unlogged-message "CONTENTS...done")) | |
| 6887 | (setq org-cycle-global-status 'contents) | |
| 6888 | (run-hook-with-args 'org-cycle-hook 'contents)) | |
| 6889 | ||
| 6890 | ((and (eq last-command this-command) | |
| 6891 | (eq org-cycle-global-status 'contents)) | |
| 6892 | ;; We just showed the table of contents - now show everything | |
| 6893 | (run-hook-with-args 'org-pre-cycle-hook 'all) | |
| 6894 | (outline-show-all) | |
| 6895 | (unless ga (org-unlogged-message "SHOW ALL")) | |
| 6896 | (setq org-cycle-global-status 'all) | |
| 6897 | (run-hook-with-args 'org-cycle-hook 'all)) | |
| 6898 | ||
| 6899 | (t | |
| 6900 | ;; Default action: go to overview | |
| 6901 | (run-hook-with-args 'org-pre-cycle-hook 'overview) | |
| 6902 | (org-overview) | |
| 6903 | (unless ga (org-unlogged-message "OVERVIEW")) | |
| 6904 | (setq org-cycle-global-status 'overview) | |
| 6905 | (run-hook-with-args 'org-cycle-hook 'overview))))) | |
| 6906 | ||
| 6907 | (defvar org-called-with-limited-levels nil | |
| 6908 | "Non-nil when `org-with-limited-levels' is currently active.") | |
| 6909 | ||
| 6910 | (defun org-invisible-p (&optional pos) | |
| 6911 | "Non-nil if the character after POS is invisible. | |
| 6912 | If POS is nil, use `point' instead." | |
| 6913 | (get-char-property (or pos (point)) 'invisible)) | |
| 6914 | ||
| 6915 | (defun org-cycle-internal-local () | |
| 6916 | "Do the local cycling action." | |
| 6917 | (let ((goal-column 0) eoh eol eos has-children children-skipped struct) | |
| 6918 | ;; First, determine end of headline (EOH), end of subtree or item | |
| 6919 | ;; (EOS), and if item or heading has children (HAS-CHILDREN). | |
| 6920 | (save-excursion | |
| 6921 | (if (org-at-item-p) | |
| 6922 | (progn | |
| 6923 | (beginning-of-line) | |
| 6924 | (setq struct (org-list-struct)) | |
| 6925 | (setq eoh (point-at-eol)) | |
| 6926 | (setq eos (org-list-get-item-end-before-blank (point) struct)) | |
| 6927 | (setq has-children (org-list-has-child-p (point) struct))) | |
| 6928 | (org-back-to-heading) | |
| 6929 | (setq eoh (save-excursion (outline-end-of-heading) (point))) | |
| 6930 | (setq eos (save-excursion (org-end-of-subtree t t) | |
| 6931 | (when (bolp) (backward-char)) (point))) | |
| 6932 | (setq has-children | |
| 6933 | (or (save-excursion | |
| 6934 | (let ((level (funcall outline-level))) | |
| 6935 | (outline-next-heading) | |
| 6936 | (and (org-at-heading-p t) | |
| 6937 | (> (funcall outline-level) level)))) | |
| 6938 | (save-excursion | |
| 6939 | (org-list-search-forward (org-item-beginning-re) eos t))))) | |
| 6940 | ;; Determine end invisible part of buffer (EOL) | |
| 6941 | (beginning-of-line 2) | |
| 6942 | (while (and (not (eobp)) ;This is like `next-line'. | |
| 6943 | (get-char-property (1- (point)) 'invisible)) | |
| 6944 | (goto-char (next-single-char-property-change (point) 'invisible)) | |
| 6945 | (and (eolp) (beginning-of-line 2))) | |
| 6946 | (setq eol (point))) | |
| 6947 | ;; Find out what to do next and set `this-command' | |
| 6948 | (cond | |
| 6949 | ((= eos eoh) | |
| 6950 | ;; Nothing is hidden behind this heading | |
| 6951 | (unless (org-before-first-heading-p) | |
| 6952 | (run-hook-with-args 'org-pre-cycle-hook 'empty)) | |
| 6953 | (org-unlogged-message "EMPTY ENTRY") | |
| 6954 | (setq org-cycle-subtree-status nil) | |
| 6955 | (save-excursion | |
| 6956 | (goto-char eos) | |
| 6957 | (outline-next-heading) | |
| 6958 | (when (org-invisible-p) (org-flag-heading nil)))) | |
| 6959 | ((and (or (>= eol eos) | |
| 6960 | (not (string-match "\\S-" (buffer-substring eol eos)))) | |
| 6961 | (or has-children | |
| 6962 | (not (setq children-skipped | |
| 6963 | org-cycle-skip-children-state-if-no-children)))) | |
| 6964 | ;; Entire subtree is hidden in one line: children view | |
| 6965 | (unless (org-before-first-heading-p) | |
| 6966 | (run-hook-with-args 'org-pre-cycle-hook 'children)) | |
| 6967 | (if (org-at-item-p) | |
| 6968 | (org-list-set-item-visibility (point-at-bol) struct 'children) | |
| 6969 | (org-show-entry) | |
| 6970 | (org-with-limited-levels (org-show-children)) | |
| 6971 | (org-show-set-visibility 'canonical) | |
| 6972 | ;; FIXME: This slows down the func way too much. | |
| 6973 | ;; How keep drawers hidden in subtree anyway? | |
| 6974 | ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook) | |
| 6975 | ;; (org-cycle-hide-drawers 'subtree)) | |
| 6976 | ||
| 6977 | ;; Fold every list in subtree to top-level items. | |
| 6978 | (when (eq org-cycle-include-plain-lists 'integrate) | |
| 6979 | (save-excursion | |
| 6980 | (org-back-to-heading) | |
| 6981 | (while (org-list-search-forward (org-item-beginning-re) eos t) | |
| 6982 | (beginning-of-line 1) | |
| 6983 | (let* ((struct (org-list-struct)) | |
| 6984 | (prevs (org-list-prevs-alist struct)) | |
| 6985 | (end (org-list-get-bottom-point struct))) | |
| 6986 | (dolist (e (org-list-get-all-items (point) struct prevs)) | |
| 6987 | (org-list-set-item-visibility e struct 'folded)) | |
| 6988 | (goto-char (if (< end eos) end eos))))))) | |
| 6989 | (org-unlogged-message "CHILDREN") | |
| 6990 | (save-excursion | |
| 6991 | (goto-char eos) | |
| 6992 | (outline-next-heading) | |
| 6993 | (when (org-invisible-p) (org-flag-heading nil))) | |
| 6994 | (setq org-cycle-subtree-status 'children) | |
| 6995 | (unless (org-before-first-heading-p) | |
| 6996 | (run-hook-with-args 'org-cycle-hook 'children))) | |
| 6997 | ((or children-skipped | |
| 6998 | (and (eq last-command this-command) | |
| 6999 | (eq org-cycle-subtree-status 'children))) | |
| 7000 | ;; We just showed the children, or no children are there, | |
| 7001 | ;; now show everything. | |
| 7002 | (unless (org-before-first-heading-p) | |
| 7003 | (run-hook-with-args 'org-pre-cycle-hook 'subtree)) | |
| 7004 | (outline-flag-region eoh eos nil) | |
| 7005 | (org-unlogged-message | |
| 7006 | (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) | |
| 7007 | (setq org-cycle-subtree-status 'subtree) | |
| 7008 | (unless (org-before-first-heading-p) | |
| 7009 | (run-hook-with-args 'org-cycle-hook 'subtree))) | |
| 7010 | (t | |
| 7011 | ;; Default action: hide the subtree. | |
| 7012 | (run-hook-with-args 'org-pre-cycle-hook 'folded) | |
| 7013 | (outline-flag-region eoh eos t) | |
| 7014 | (org-unlogged-message "FOLDED") | |
| 7015 | (setq org-cycle-subtree-status 'folded) | |
| 7016 | (unless (org-before-first-heading-p) | |
| 7017 | (run-hook-with-args 'org-cycle-hook 'folded)))))) | |
| 7018 | ||
| 7019 | ;;;###autoload | |
| 7020 | (defun org-global-cycle (&optional arg) | |
| 7021 | "Cycle the global visibility. For details see `org-cycle'. | |
| 7022 | With `\\[universal-argument]' prefix ARG, switch to startup visibility. | |
| 7023 | With a numeric prefix, show all headlines up to that level." | |
| 7024 | (interactive "P") | |
| 7025 | (let ((org-cycle-include-plain-lists | |
| 7026 | (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil))) | |
| 7027 | (cond | |
| 7028 | ((integerp arg) | |
| 7029 | (outline-show-all) | |
| 7030 | (outline-hide-sublevels arg) | |
| 7031 | (setq org-cycle-global-status 'contents)) | |
| 7032 | ((equal arg '(4)) | |
| 7033 | (org-set-startup-visibility) | |
| 7034 | (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) | |
| 7035 | (t | |
| 7036 | (org-cycle '(4)))))) | |
| 7037 | ||
| 7038 | (defun org-set-startup-visibility () | |
| 7039 | "Set the visibility required by startup options and properties." | |
| 7040 | (cond | |
| 7041 | ((eq org-startup-folded t) | |
| 7042 | (org-overview)) | |
| 7043 | ((eq org-startup-folded 'content) | |
| 7044 | (org-content)) | |
| 7045 | ((or (eq org-startup-folded 'showeverything) | |
| 7046 | (eq org-startup-folded nil)) | |
| 7047 | (outline-show-all))) | |
| 7048 | (unless (eq org-startup-folded 'showeverything) | |
| 7049 | (when org-hide-block-startup (org-hide-block-all)) | |
| 7050 | (org-set-visibility-according-to-property 'no-cleanup) | |
| 7051 | (org-cycle-hide-archived-subtrees 'all) | |
| 7052 | (org-cycle-hide-drawers 'all) | |
| 7053 | (org-cycle-show-empty-lines t))) | |
| 7054 | ||
| 7055 | (defun org-set-visibility-according-to-property (&optional no-cleanup) | |
| 7056 | "Switch subtree visibilities according to :VISIBILITY: property." | |
| 7057 | (interactive) | |
| 7058 | (org-with-wide-buffer | |
| 7059 | (goto-char (point-min)) | |
| 7060 | (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t) | |
| 7061 | (if (not (org-at-property-p)) (outline-next-heading) | |
| 7062 | (let ((state (match-string 3))) | |
| 7063 | (save-excursion | |
| 7064 | (org-back-to-heading t) | |
| 7065 | (outline-hide-subtree) | |
| 7066 | (org-reveal)) | |
| 7067 | (cond | |
| 7068 | ((equal state "folded") | |
| 7069 | (outline-hide-subtree) | |
| 7070 | (org-end-of-subtree t t)) | |
| 7071 | ((equal state "children") | |
| 7072 | (org-show-hidden-entry) | |
| 7073 | (org-show-children)) | |
| 7074 | ((equal state "content") | |
| 7075 | (save-excursion | |
| 7076 | (save-restriction | |
| 7077 | (org-narrow-to-subtree) | |
| 7078 | (org-content))) | |
| 7079 | (org-end-of-subtree t t)) | |
| 7080 | ((member state '("all" "showall")) | |
| 7081 | (outline-show-subtree)))))) | |
| 7082 | (unless no-cleanup | |
| 7083 | (org-cycle-hide-archived-subtrees 'all) | |
| 7084 | (org-cycle-hide-drawers 'all) | |
| 7085 | (org-cycle-show-empty-lines 'all)))) | |
| 7086 | ||
| 7087 | ;; This function uses outline-regexp instead of the more fundamental | |
| 7088 | ;; org-outline-regexp so that org-cycle-global works outside of Org | |
| 7089 | ;; buffers, where outline-regexp is needed. | |
| 7090 | (defun org-overview () | |
| 7091 | "Switch to overview mode, showing only top-level headlines. | |
| 7092 | This shows all headlines with a level equal or greater than the level | |
| 7093 | of the first headline in the buffer. This is important, because if the | |
| 7094 | first headline is not level one, then (hide-sublevels 1) gives confusing | |
| 7095 | results." | |
| 7096 | (interactive) | |
| 7097 | (save-excursion | |
| 7098 | (let ((level | |
| 7099 | (save-excursion | |
| 7100 | (goto-char (point-min)) | |
| 7101 | (when (re-search-forward (concat "^" outline-regexp) nil t) | |
| 7102 | (goto-char (match-beginning 0)) | |
| 7103 | (funcall outline-level))))) | |
| 7104 | (and level (outline-hide-sublevels level))))) | |
| 7105 | ||
| 7106 | (defun org-content (&optional arg) | |
| 7107 | "Show all headlines in the buffer, like a table of contents. | |
| 7108 | With numerical argument N, show content up to level N." | |
| 7109 | (interactive "P") | |
| 7110 | (org-overview) | |
| 7111 | (save-excursion | |
| 7112 | ;; Visit all headings and show their offspring | |
| 7113 | (and (integerp arg) (org-overview)) | |
| 7114 | (goto-char (point-max)) | |
| 7115 | (catch 'exit | |
| 7116 | (while (and (progn (condition-case nil | |
| 7117 | (outline-previous-visible-heading 1) | |
| 7118 | (error (goto-char (point-min)))) | |
| 7119 | t) | |
| 7120 | (looking-at org-outline-regexp)) | |
| 7121 | (if (integerp arg) | |
| 7122 | (org-show-children (1- arg)) | |
| 7123 | (outline-show-branches)) | |
| 7124 | (when (bobp) (throw 'exit nil)))))) | |
| 7125 | ||
| 7126 | (defun org-optimize-window-after-visibility-change (state) | |
| 7127 | "Adjust the window after a change in outline visibility. | |
| 7128 | This function is the default value of the hook `org-cycle-hook'." | |
| 7129 | (when (get-buffer-window (current-buffer)) | |
| 7130 | (cond | |
| 7131 | ((eq state 'content) nil) | |
| 7132 | ((eq state 'all) nil) | |
| 7133 | ((eq state 'folded) nil) | |
| 7134 | ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) | |
| 7135 | ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) | |
| 7136 | ||
| 7137 | (defun org-remove-empty-overlays-at (pos) | |
| 7138 | "Remove outline overlays that do not contain non-white stuff." | |
| 7139 | (dolist (o (overlays-at pos)) | |
| 7140 | (and (eq 'outline (overlay-get o 'invisible)) | |
| 7141 | (not (string-match "\\S-" (buffer-substring (overlay-start o) | |
| 7142 | (overlay-end o)))) | |
| 7143 | (delete-overlay o)))) | |
| 7144 | ||
| 7145 | (defun org-clean-visibility-after-subtree-move () | |
| 7146 | "Fix visibility issues after moving a subtree." | |
| 7147 | ;; First, find a reasonable region to look at: | |
| 7148 | ;; Start two siblings above, end three below | |
| 7149 | (let* ((beg (save-excursion | |
| 7150 | (and (org-get-last-sibling) | |
| 7151 | (org-get-last-sibling)) | |
| 7152 | (point))) | |
| 7153 | (end (save-excursion | |
| 7154 | (and (org-get-next-sibling) | |
| 7155 | (org-get-next-sibling) | |
| 7156 | (org-get-next-sibling)) | |
| 7157 | (if (org-at-heading-p) | |
| 7158 | (point-at-eol) | |
| 7159 | (point)))) | |
| 7160 | (level (looking-at "\\*+")) | |
| 7161 | (re (when level (concat "^" (regexp-quote (match-string 0)) " ")))) | |
| 7162 | (save-excursion | |
| 7163 | (save-restriction | |
| 7164 | (narrow-to-region beg end) | |
| 7165 | (when re | |
| 7166 | ;; Properly fold already folded siblings | |
| 7167 | (goto-char (point-min)) | |
| 7168 | (while (re-search-forward re nil t) | |
| 7169 | (when (and (not (org-invisible-p)) | |
| 7170 | (save-excursion | |
| 7171 | (goto-char (point-at-eol)) (org-invisible-p))) | |
| 7172 | (outline-hide-entry)))) | |
| 7173 | (org-cycle-show-empty-lines 'overview) | |
| 7174 | (org-cycle-hide-drawers 'overview))))) | |
| 7175 | ||
| 7176 | (defun org-cycle-show-empty-lines (state) | |
| 7177 | "Show empty lines above all visible headlines. | |
| 7178 | The region to be covered depends on STATE when called through | |
| 7179 | `org-cycle-hook'. Lisp program can use t for STATE to get the | |
| 7180 | entire buffer covered. Note that an empty line is only shown if there | |
| 7181 | are at least `org-cycle-separator-lines' empty lines before the headline." | |
| 7182 | (when (/= org-cycle-separator-lines 0) | |
| 7183 | (save-excursion | |
| 7184 | (let* ((n (abs org-cycle-separator-lines)) | |
| 7185 | (re (cond | |
| 7186 | ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") | |
| 7187 | ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") | |
| 7188 | (t (let ((ns (number-to-string (- n 2)))) | |
| 7189 | (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" | |
| 7190 | "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) | |
| 7191 | beg end) | |
| 7192 | (cond | |
| 7193 | ((memq state '(overview contents t)) | |
| 7194 | (setq beg (point-min) end (point-max))) | |
| 7195 | ((memq state '(children folded)) | |
| 7196 | (setq beg (point) | |
| 7197 | end (progn (org-end-of-subtree t t) | |
| 7198 | (line-beginning-position 2))))) | |
| 7199 | (when beg | |
| 7200 | (goto-char beg) | |
| 7201 | (while (re-search-forward re end t) | |
| 7202 | (unless (get-char-property (match-end 1) 'invisible) | |
| 7203 | (let ((e (match-end 1)) | |
| 7204 | (b (if (>= org-cycle-separator-lines 0) | |
| 7205 | (match-beginning 1) | |
| 7206 | (save-excursion | |
| 7207 | (goto-char (match-beginning 0)) | |
| 7208 | (skip-chars-backward " \t\n") | |
| 7209 | (line-end-position))))) | |
| 7210 | (outline-flag-region b e nil)))))))) | |
| 7211 | ;; Never hide empty lines at the end of the file. | |
| 7212 | (save-excursion | |
| 7213 | (goto-char (point-max)) | |
| 7214 | (outline-previous-heading) | |
| 7215 | (outline-end-of-heading) | |
| 7216 | (when (and (looking-at "[ \t\n]+") | |
| 7217 | (= (match-end 0) (point-max))) | |
| 7218 | (outline-flag-region (point) (match-end 0) nil)))) | |
| 7219 | ||
| 7220 | (defun org-show-empty-lines-in-parent () | |
| 7221 | "Move to the parent and re-show empty lines before visible headlines." | |
| 7222 | (save-excursion | |
| 7223 | (let ((context (if (org-up-heading-safe) 'children 'overview))) | |
| 7224 | (org-cycle-show-empty-lines context)))) | |
| 7225 | ||
| 7226 | (defun org-files-list () | |
| 7227 | "Return `org-agenda-files' list, plus all open Org files. | |
| 7228 | This is useful for operations that need to scan all of a user's | |
| 7229 | open and agenda-wise Org files." | |
| 7230 | (let ((files (mapcar #'expand-file-name (org-agenda-files)))) | |
| 7231 | (dolist (buf (buffer-list)) | |
| 7232 | (with-current-buffer buf | |
| 7233 | (when (and (derived-mode-p 'org-mode) (buffer-file-name)) | |
| 7234 | (cl-pushnew (expand-file-name (buffer-file-name)) files | |
| 7235 | :test #'equal)))) | |
| 7236 | files)) | |
| 7237 | ||
| 7238 | (defsubst org-entry-beginning-position () | |
| 7239 | "Return the beginning position of the current entry." | |
| 7240 | (save-excursion (org-back-to-heading t) (point))) | |
| 7241 | ||
| 7242 | (defsubst org-entry-end-position () | |
| 7243 | "Return the end position of the current entry." | |
| 7244 | (save-excursion (outline-next-heading) (point))) | |
| 7245 | ||
| 7246 | (defun org-cycle-hide-drawers (state &optional exceptions) | |
| 7247 | "Re-hide all drawers after a visibility state change. | |
| 7248 | STATE should be one of the symbols listed in the docstring of | |
| 7249 | `org-cycle-hook'. When non-nil, optional argument EXCEPTIONS is | |
| 7250 | a list of strings specifying which drawers should not be hidden." | |
| 7251 | (when (and (derived-mode-p 'org-mode) | |
| 7252 | (not (memq state '(overview folded contents)))) | |
| 7253 | (save-excursion | |
| 7254 | (let* ((globalp (eq state 'all)) | |
| 7255 | (beg (if globalp (point-min) (point))) | |
| 7256 | (end (if globalp (point-max) | |
| 7257 | (if (eq state 'children) | |
| 7258 | (save-excursion (outline-next-heading) (point)) | |
| 7259 | (org-end-of-subtree t))))) | |
| 7260 | (goto-char beg) | |
| 7261 | (while (re-search-forward org-drawer-regexp (max end (point)) t) | |
| 7262 | (unless (member-ignore-case (match-string 1) exceptions) | |
| 7263 | (let ((drawer (org-element-at-point))) | |
| 7264 | (when (memq (org-element-type drawer) '(drawer property-drawer)) | |
| 7265 | (org-flag-drawer t drawer) | |
| 7266 | ;; Make sure to skip drawer entirely or we might flag | |
| 7267 | ;; it another time when matching its ending line with | |
| 7268 | ;; `org-drawer-regexp'. | |
| 7269 | (goto-char (org-element-property :end drawer)))))))))) | |
| 7270 | ||
| 7271 | (defun org-flag-drawer (flag &optional element) | |
| 7272 | "When FLAG is non-nil, hide the drawer we are at. | |
| 7273 | Otherwise make it visible. When optional argument ELEMENT is | |
| 7274 | a parsed drawer, as returned by `org-element-at-point', hide or | |
| 7275 | show that drawer instead." | |
| 7276 | (let ((drawer (or element | |
| 7277 | (and (save-excursion | |
| 7278 | (beginning-of-line) | |
| 7279 | (looking-at-p org-drawer-regexp)) | |
| 7280 | (org-element-at-point))))) | |
| 7281 | (when (memq (org-element-type drawer) '(drawer property-drawer)) | |
| 7282 | (let ((post (org-element-property :post-affiliated drawer))) | |
| 7283 | (save-excursion | |
| 7284 | (outline-flag-region | |
| 7285 | (progn (goto-char post) (line-end-position)) | |
| 7286 | (progn (goto-char (org-element-property :end drawer)) | |
| 7287 | (skip-chars-backward " \r\t\n") | |
| 7288 | (line-end-position)) | |
| 7289 | flag)) | |
| 7290 | ;; When the drawer is hidden away, make sure point lies in | |
| 7291 | ;; a visible part of the buffer. | |
| 7292 | (when (and flag (> (line-beginning-position) post)) | |
| 7293 | (goto-char post)))))) | |
| 7294 | ||
| 7295 | (defun org-subtree-end-visible-p () | |
| 7296 | "Is the end of the current subtree visible?" | |
| 7297 | (pos-visible-in-window-p | |
| 7298 | (save-excursion (org-end-of-subtree t) (point)))) | |
| 7299 | ||
| 7300 | (defun org-first-headline-recenter () | |
| 7301 | "Move cursor to the first headline and recenter the headline." | |
| 7302 | (let ((window (get-buffer-window))) | |
| 7303 | (when window | |
| 7304 | (goto-char (point-min)) | |
| 7305 | (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t) | |
| 7306 | (set-window-start window (line-beginning-position)))))) | |
| 7307 | ||
| 7308 | ;;; Saving and restoring visibility | |
| 7309 | ||
| 7310 | (defun org-outline-overlay-data (&optional use-markers) | |
| 7311 | "Return a list of the locations of all outline overlays. | |
| 7312 | These are overlays with the `invisible' property value `outline'. | |
| 7313 | The return value is a list of cons cells, with start and stop | |
| 7314 | positions for each overlay. | |
| 7315 | If USE-MARKERS is set, return the positions as markers." | |
| 7316 | (let (beg end) | |
| 7317 | (org-with-wide-buffer | |
| 7318 | (delq nil | |
| 7319 | (mapcar (lambda (o) | |
| 7320 | (when (eq (overlay-get o 'invisible) 'outline) | |
| 7321 | (setq beg (overlay-start o) | |
| 7322 | end (overlay-end o)) | |
| 7323 | (and beg end (> end beg) | |
| 7324 | (if use-markers | |
| 7325 | (cons (copy-marker beg) | |
| 7326 | (copy-marker end t)) | |
| 7327 | (cons beg end))))) | |
| 7328 | (overlays-in (point-min) (point-max))))))) | |
| 7329 | ||
| 7330 | (defun org-set-outline-overlay-data (data) | |
| 7331 | "Create visibility overlays for all positions in DATA. | |
| 7332 | DATA should have been made by `org-outline-overlay-data'." | |
| 7333 | (org-with-wide-buffer | |
| 7334 | (outline-show-all) | |
| 7335 | (dolist (c data) (outline-flag-region (car c) (cdr c) t)))) | |
| 7336 | ||
| 7337 | ;;; Folding of blocks | |
| 7338 | ||
| 7339 | (defvar-local org-hide-block-overlays nil | |
| 7340 | "Overlays hiding blocks.") | |
| 7341 | ||
| 7342 | (defun org-block-map (function &optional start end) | |
| 7343 | "Call FUNCTION at the head of all source blocks in the current buffer. | |
| 7344 | Optional arguments START and END can be used to limit the range." | |
| 7345 | (let ((start (or start (point-min))) | |
| 7346 | (end (or end (point-max)))) | |
| 7347 | (save-excursion | |
| 7348 | (goto-char start) | |
| 7349 | (while (and (< (point) end) (re-search-forward org-block-regexp end t)) | |
| 7350 | (save-excursion | |
| 7351 | (save-match-data | |
| 7352 | (goto-char (match-beginning 0)) | |
| 7353 | (funcall function))))))) | |
| 7354 | ||
| 7355 | (defun org-hide-block-toggle-all () | |
| 7356 | "Toggle the visibility of all blocks in the current buffer." | |
| 7357 | (org-block-map 'org-hide-block-toggle)) | |
| 7358 | ||
| 7359 | (defun org-hide-block-all () | |
| 7360 | "Fold all blocks in the current buffer." | |
| 7361 | (interactive) | |
| 7362 | (org-show-block-all) | |
| 7363 | (org-block-map 'org-hide-block-toggle-maybe)) | |
| 7364 | ||
| 7365 | (defun org-show-block-all () | |
| 7366 | "Unfold all blocks in the current buffer." | |
| 7367 | (interactive) | |
| 7368 | (mapc #'delete-overlay org-hide-block-overlays) | |
| 7369 | (setq org-hide-block-overlays nil)) | |
| 7370 | ||
| 7371 | (defun org-hide-block-toggle-maybe () | |
| 7372 | "Toggle visibility of block at point. | |
| 7373 | Unlike to `org-hide-block-toggle', this function does not throw | |
| 7374 | an error. Return a non-nil value when toggling is successful." | |
| 7375 | (interactive) | |
| 7376 | (ignore-errors (org-hide-block-toggle))) | |
| 7377 | ||
| 7378 | (defun org-hide-block-toggle (&optional force) | |
| 7379 | "Toggle the visibility of the current block. | |
| 7380 | When optional argument FORCE is `off', make block visible. If it | |
| 7381 | is non-nil, hide it unconditionally. Throw an error when not at | |
| 7382 | a block. Return a non-nil value when toggling is successful." | |
| 7383 | (interactive) | |
| 7384 | (let ((element (org-element-at-point))) | |
| 7385 | (unless (memq (org-element-type element) | |
| 7386 | '(center-block comment-block dynamic-block example-block | |
| 7387 | export-block quote-block special-block | |
| 7388 | src-block verse-block)) | |
| 7389 | (user-error "Not at a block")) | |
| 7390 | (let* ((start (save-excursion | |
| 7391 | (goto-char (org-element-property :post-affiliated element)) | |
| 7392 | (line-end-position))) | |
| 7393 | (end (save-excursion | |
| 7394 | (goto-char (org-element-property :end element)) | |
| 7395 | (skip-chars-backward " \r\t\n") | |
| 7396 | (line-end-position))) | |
| 7397 | (overlays (overlays-at start))) | |
| 7398 | (cond | |
| 7399 | ;; Do nothing when not before or at the block opening line or | |
| 7400 | ;; at the block closing line. | |
| 7401 | ((let ((eol (line-end-position))) (and (> eol start) (/= eol end))) nil) | |
| 7402 | ((and (not (eq force 'off)) | |
| 7403 | (not (memq t (mapcar | |
| 7404 | (lambda (o) | |
| 7405 | (eq (overlay-get o 'invisible) 'org-hide-block)) | |
| 7406 | overlays)))) | |
| 7407 | (let ((ov (make-overlay start end))) | |
| 7408 | (overlay-put ov 'invisible 'org-hide-block) | |
| 7409 | ;; Make the block accessible to `isearch'. | |
| 7410 | (overlay-put | |
| 7411 | ov 'isearch-open-invisible | |
| 7412 | (lambda (ov) | |
| 7413 | (when (memq ov org-hide-block-overlays) | |
| 7414 | (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) | |
| 7415 | (when (eq (overlay-get ov 'invisible) 'org-hide-block) | |
| 7416 | (delete-overlay ov)))) | |
| 7417 | (push ov org-hide-block-overlays) | |
| 7418 | ;; When the block is hidden away, make sure point is left in | |
| 7419 | ;; a visible part of the buffer. | |
| 7420 | (when (> (line-beginning-position) start) | |
| 7421 | (goto-char start) | |
| 7422 | (beginning-of-line)) | |
| 7423 | ;; Signal successful toggling. | |
| 7424 | t)) | |
| 7425 | ((or (not force) (eq force 'off)) | |
| 7426 | (dolist (ov overlays t) | |
| 7427 | (when (memq ov org-hide-block-overlays) | |
| 7428 | (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) | |
| 7429 | (when (eq (overlay-get ov 'invisible) 'org-hide-block) | |
| 7430 | (delete-overlay ov)))))))) | |
| 7431 | ||
| 7432 | ;; Remove overlays when changing major mode | |
| 7433 | (add-hook 'org-mode-hook | |
| 7434 | (lambda () (add-hook 'change-major-mode-hook | |
| 7435 | 'org-show-block-all 'append 'local))) | |
| 7436 | ||
| 7437 | ;;; Org-goto | |
| 7438 | ||
| 7439 | (defvar org-goto-window-configuration nil) | |
| 7440 | (defvar org-goto-marker nil) | |
| 7441 | (defvar org-goto-map) | |
| 7442 | (defun org-goto-map () | |
| 7443 | "Set the keymap `org-goto'." | |
| 7444 | (setq org-goto-map | |
| 7445 | (let ((map (make-sparse-keymap))) | |
| 7446 | (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command | |
| 7447 | mouse-drag-region universal-argument org-occur))) | |
| 7448 | (dolist (cmd cmds) | |
| 7449 | (substitute-key-definition cmd cmd map global-map))) | |
| 7450 | (suppress-keymap map) | |
| 7451 | (org-defkey map "\C-m" 'org-goto-ret) | |
| 7452 | (org-defkey map [(return)] 'org-goto-ret) | |
| 7453 | (org-defkey map [(left)] 'org-goto-left) | |
| 7454 | (org-defkey map [(right)] 'org-goto-right) | |
| 7455 | (org-defkey map [(control ?g)] 'org-goto-quit) | |
| 7456 | (org-defkey map "\C-i" 'org-cycle) | |
| 7457 | (org-defkey map [(tab)] 'org-cycle) | |
| 7458 | (org-defkey map [(down)] 'outline-next-visible-heading) | |
| 7459 | (org-defkey map [(up)] 'outline-previous-visible-heading) | |
| 7460 | (if org-goto-auto-isearch | |
| 7461 | (if (fboundp 'define-key-after) | |
| 7462 | (define-key-after map [t] 'org-goto-local-auto-isearch) | |
| 7463 | nil) | |
| 7464 | (org-defkey map "q" 'org-goto-quit) | |
| 7465 | (org-defkey map "n" 'outline-next-visible-heading) | |
| 7466 | (org-defkey map "p" 'outline-previous-visible-heading) | |
| 7467 | (org-defkey map "f" 'outline-forward-same-level) | |
| 7468 | (org-defkey map "b" 'outline-backward-same-level) | |
| 7469 | (org-defkey map "u" 'outline-up-heading)) | |
| 7470 | (org-defkey map "/" 'org-occur) | |
| 7471 | (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) | |
| 7472 | (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) | |
| 7473 | (org-defkey map "\C-c\C-f" 'outline-forward-same-level) | |
| 7474 | (org-defkey map "\C-c\C-b" 'outline-backward-same-level) | |
| 7475 | (org-defkey map "\C-c\C-u" 'outline-up-heading) | |
| 7476 | map))) | |
| 7477 | ||
| 7478 | (defconst org-goto-help | |
| 7479 | "Browse buffer copy, to find location or copy text.%s | |
| 7480 | RET=jump to location C-g=quit and return to previous location | |
| 7481 | \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") | |
| 7482 | ||
| 7483 | (defvar org-goto-start-pos) ; dynamically scoped parameter | |
| 7484 | ||
| 7485 | (defun org-goto (&optional alternative-interface) | |
| 7486 | "Look up a different location in the current file, keeping current visibility. | |
| 7487 | ||
| 7488 | When you want look-up or go to a different location in a | |
| 7489 | document, the fastest way is often to fold the entire buffer and | |
| 7490 | then dive into the tree. This method has the disadvantage, that | |
| 7491 | the previous location will be folded, which may not be what you | |
| 7492 | want. | |
| 7493 | ||
| 7494 | This command works around this by showing a copy of the current | |
| 7495 | buffer in an indirect buffer, in overview mode. You can dive | |
| 7496 | into the tree in that copy, use org-occur and incremental search | |
| 7497 | to find a location. When pressing RET or `Q', the command | |
| 7498 | returns to the original buffer in which the visibility is still | |
| 7499 | unchanged. After RET it will also jump to the location selected | |
| 7500 | in the indirect buffer and expose the headline hierarchy above. | |
| 7501 | ||
| 7502 | With a prefix argument, use the alternative interface: e.g., if | |
| 7503 | `org-goto-interface' is `outline' use `outline-path-completion'." | |
| 7504 | (interactive "P") | |
| 7505 | (org-goto-map) | |
| 7506 | (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) | |
| 7507 | (org-refile-use-outline-path t) | |
| 7508 | (org-refile-target-verify-function nil) | |
| 7509 | (interface | |
| 7510 | (if (not alternative-interface) | |
| 7511 | org-goto-interface | |
| 7512 | (if (eq org-goto-interface 'outline) | |
| 7513 | 'outline-path-completion | |
| 7514 | 'outline))) | |
| 7515 | (org-goto-start-pos (point)) | |
| 7516 | (selected-point | |
| 7517 | (if (eq interface 'outline) | |
| 7518 | (car (org-get-location (current-buffer) org-goto-help)) | |
| 7519 | (let ((pa (org-refile-get-location "Goto"))) | |
| 7520 | (org-refile-check-position pa) | |
| 7521 | (nth 3 pa))))) | |
| 7522 | (if selected-point | |
| 7523 | (progn | |
| 7524 | (org-mark-ring-push org-goto-start-pos) | |
| 7525 | (goto-char selected-point) | |
| 7526 | (when (or (org-invisible-p) (org-invisible-p2)) | |
| 7527 | (org-show-context 'org-goto))) | |
| 7528 | (message "Quit")))) | |
| 7529 | ||
| 7530 | (defvar org-goto-selected-point nil) ; dynamically scoped parameter | |
| 7531 | (defvar org-goto-exit-command nil) ; dynamically scoped parameter | |
| 7532 | (defvar org-goto-local-auto-isearch-map) ; defined below | |
| 7533 | ||
| 7534 | (defun org-get-location (_buf help) | |
| 7535 | "Let the user select a location in current buffer. | |
| 7536 | This function uses a recursive edit. It returns the selected position | |
| 7537 | or nil." | |
| 7538 | (org-no-popups | |
| 7539 | (let ((isearch-mode-map org-goto-local-auto-isearch-map) | |
| 7540 | (isearch-hide-immediately nil) | |
| 7541 | (isearch-search-fun-function | |
| 7542 | (lambda () 'org-goto-local-search-headings)) | |
| 7543 | (org-goto-selected-point org-goto-exit-command)) | |
| 7544 | (save-excursion | |
| 7545 | (save-window-excursion | |
| 7546 | (delete-other-windows) | |
| 7547 | (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) | |
| 7548 | (pop-to-buffer-same-window | |
| 7549 | (condition-case nil | |
| 7550 | (make-indirect-buffer (current-buffer) "*org-goto*") | |
| 7551 | (error (make-indirect-buffer (current-buffer) "*org-goto*")))) | |
| 7552 | (with-output-to-temp-buffer "*Org Help*" | |
| 7553 | (princ (format help (if org-goto-auto-isearch | |
| 7554 | " Just type for auto-isearch." | |
| 7555 | " n/p/f/b/u to navigate, q to quit.")))) | |
| 7556 | (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) | |
| 7557 | (setq buffer-read-only nil) | |
| 7558 | (let ((org-startup-truncated t) | |
| 7559 | (org-startup-folded nil) | |
| 7560 | (org-startup-align-all-tables nil)) | |
| 7561 | (org-mode) | |
| 7562 | (org-overview)) | |
| 7563 | (setq buffer-read-only t) | |
| 7564 | (if (and (boundp 'org-goto-start-pos) | |
| 7565 | (integer-or-marker-p org-goto-start-pos)) | |
| 7566 | (progn (goto-char org-goto-start-pos) | |
| 7567 | (when (org-invisible-p) | |
| 7568 | (org-show-set-visibility 'lineage))) | |
| 7569 | (goto-char (point-min))) | |
| 7570 | (let (org-special-ctrl-a/e) (org-beginning-of-line)) | |
| 7571 | (message "Select location and press RET") | |
| 7572 | (use-local-map org-goto-map) | |
| 7573 | (recursive-edit))) | |
| 7574 | (kill-buffer "*org-goto*") | |
| 7575 | (cons org-goto-selected-point org-goto-exit-command)))) | |
| 7576 | ||
| 7577 | (defvar org-goto-local-auto-isearch-map (make-sparse-keymap)) | |
| 7578 | (set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) | |
| 7579 | ;; `isearch-other-control-char' was removed in Emacs 24.4. | |
| 7580 | (if (fboundp 'isearch-other-control-char) | |
| 7581 | (progn | |
| 7582 | (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) | |
| 7583 | (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)) | |
| 7584 | (define-key org-goto-local-auto-isearch-map "\C-i" nil) | |
| 7585 | (define-key org-goto-local-auto-isearch-map "\C-m" nil) | |
| 7586 | (define-key org-goto-local-auto-isearch-map [return] nil)) | |
| 7587 | ||
| 7588 | (defun org-goto-local-search-headings (string bound noerror) | |
| 7589 | "Search and make sure that any matches are in headlines." | |
| 7590 | (catch 'return | |
| 7591 | (while (if isearch-forward | |
| 7592 | (search-forward string bound noerror) | |
| 7593 | (search-backward string bound noerror)) | |
| 7594 | (when (save-match-data | |
| 7595 | (and (save-excursion | |
| 7596 | (beginning-of-line) | |
| 7597 | (looking-at org-complex-heading-regexp)) | |
| 7598 | (or (not (match-beginning 5)) | |
| 7599 | (< (point) (match-beginning 5))))) | |
| 7600 | (throw 'return (point)))))) | |
| 7601 | ||
| 7602 | (defun org-goto-local-auto-isearch () | |
| 7603 | "Start isearch." | |
| 7604 | (interactive) | |
| 7605 | (goto-char (point-min)) | |
| 7606 | (let ((keys (this-command-keys))) | |
| 7607 | (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) | |
| 7608 | (isearch-mode t) | |
| 7609 | (isearch-process-search-char (string-to-char keys))))) | |
| 7610 | ||
| 7611 | (defun org-goto-ret (&optional _arg) | |
| 7612 | "Finish `org-goto' by going to the new location." | |
| 7613 | (interactive "P") | |
| 7614 | (setq org-goto-selected-point (point)) | |
| 7615 | (setq org-goto-exit-command 'return) | |
| 7616 | (throw 'exit nil)) | |
| 7617 | ||
| 7618 | (defun org-goto-left () | |
| 7619 | "Finish `org-goto' by going to the new location." | |
| 7620 | (interactive) | |
| 7621 | (if (org-at-heading-p) | |
| 7622 | (progn | |
| 7623 | (beginning-of-line 1) | |
| 7624 | (setq org-goto-selected-point (point) | |
| 7625 | org-goto-exit-command 'left) | |
| 7626 | (throw 'exit nil)) | |
| 7627 | (user-error "Not on a heading"))) | |
| 7628 | ||
| 7629 | (defun org-goto-right () | |
| 7630 | "Finish `org-goto' by going to the new location." | |
| 7631 | (interactive) | |
| 7632 | (if (org-at-heading-p) | |
| 7633 | (progn | |
| 7634 | (setq org-goto-selected-point (point) | |
| 7635 | org-goto-exit-command 'right) | |
| 7636 | (throw 'exit nil)) | |
| 7637 | (user-error "Not on a heading"))) | |
| 7638 | ||
| 7639 | (defun org-goto-quit () | |
| 7640 | "Finish `org-goto' without cursor motion." | |
| 7641 | (interactive) | |
| 7642 | (setq org-goto-selected-point nil) | |
| 7643 | (setq org-goto-exit-command 'quit) | |
| 7644 | (throw 'exit nil)) | |
| 7645 | ||
| 7646 | ;;; Indirect buffer display of subtrees | |
| 7647 | ||
| 7648 | (defvar org-indirect-dedicated-frame nil | |
| 7649 | "This is the frame being used for indirect tree display.") | |
| 7650 | (defvar org-last-indirect-buffer nil) | |
| 7651 | ||
| 7652 | (defun org-tree-to-indirect-buffer (&optional arg) | |
| 7653 | "Create indirect buffer and narrow it to current subtree. | |
| 7654 | ||
| 7655 | With a numerical prefix ARG, go up to this level and then take that tree. | |
| 7656 | If ARG is negative, go up that many levels. | |
| 7657 | ||
| 7658 | If `org-indirect-buffer-display' is not `new-frame', the command removes the | |
| 7659 | indirect buffer previously made with this command, to avoid proliferation of | |
| 7660 | indirect buffers. However, when you call the command with a \ | |
| 7661 | `\\[universal-argument]' prefix, or | |
| 7662 | when `org-indirect-buffer-display' is `new-frame', the last buffer is kept | |
| 7663 | so that you can work with several indirect buffers at the same time. If | |
| 7664 | `org-indirect-buffer-display' is `dedicated-frame', the \ | |
| 7665 | `\\[universal-argument]' prefix also | |
| 7666 | requests that a new frame be made for the new buffer, so that the dedicated | |
| 7667 | frame is not changed." | |
| 7668 | (interactive "P") | |
| 7669 | (let ((cbuf (current-buffer)) | |
| 7670 | (cwin (selected-window)) | |
| 7671 | (pos (point)) | |
| 7672 | beg end level heading ibuf) | |
| 7673 | (save-excursion | |
| 7674 | (org-back-to-heading t) | |
| 7675 | (when (numberp arg) | |
| 7676 | (setq level (org-outline-level)) | |
| 7677 | (when (< arg 0) (setq arg (+ level arg))) | |
| 7678 | (while (> (setq level (org-outline-level)) arg) | |
| 7679 | (org-up-heading-safe))) | |
| 7680 | (setq beg (point) | |
| 7681 | heading (org-get-heading 'no-tags)) | |
| 7682 | (org-end-of-subtree t t) | |
| 7683 | (when (org-at-heading-p) (backward-char 1)) | |
| 7684 | (setq end (point))) | |
| 7685 | (when (and (buffer-live-p org-last-indirect-buffer) | |
| 7686 | (not (eq org-indirect-buffer-display 'new-frame)) | |
| 7687 | (not arg)) | |
| 7688 | (kill-buffer org-last-indirect-buffer)) | |
| 7689 | (setq ibuf (org-get-indirect-buffer cbuf heading) | |
| 7690 | org-last-indirect-buffer ibuf) | |
| 7691 | (cond | |
| 7692 | ((or (eq org-indirect-buffer-display 'new-frame) | |
| 7693 | (and arg (eq org-indirect-buffer-display 'dedicated-frame))) | |
| 7694 | (select-frame (make-frame)) | |
| 7695 | (delete-other-windows) | |
| 7696 | (pop-to-buffer-same-window ibuf) | |
| 7697 | (org-set-frame-title heading)) | |
| 7698 | ((eq org-indirect-buffer-display 'dedicated-frame) | |
| 7699 | (raise-frame | |
| 7700 | (select-frame (or (and org-indirect-dedicated-frame | |
| 7701 | (frame-live-p org-indirect-dedicated-frame) | |
| 7702 | org-indirect-dedicated-frame) | |
| 7703 | (setq org-indirect-dedicated-frame (make-frame))))) | |
| 7704 | (delete-other-windows) | |
| 7705 | (pop-to-buffer-same-window ibuf) | |
| 7706 | (org-set-frame-title (concat "Indirect: " heading))) | |
| 7707 | ((eq org-indirect-buffer-display 'current-window) | |
| 7708 | (pop-to-buffer-same-window ibuf)) | |
| 7709 | ((eq org-indirect-buffer-display 'other-window) | |
| 7710 | (pop-to-buffer ibuf)) | |
| 7711 | (t (error "Invalid value"))) | |
| 7712 | (narrow-to-region beg end) | |
| 7713 | (outline-show-all) | |
| 7714 | (goto-char pos) | |
| 7715 | (run-hook-with-args 'org-cycle-hook 'all) | |
| 7716 | (and (window-live-p cwin) (select-window cwin)))) | |
| 7717 | ||
| 7718 | (defun org-get-indirect-buffer (&optional buffer heading) | |
| 7719 | (setq buffer (or buffer (current-buffer))) | |
| 7720 | (let ((n 1) (base (buffer-name buffer)) bname) | |
| 7721 | (while (buffer-live-p | |
| 7722 | (get-buffer | |
| 7723 | (setq bname | |
| 7724 | (concat base "-" | |
| 7725 | (if heading (concat heading "-" (number-to-string n)) | |
| 7726 | (number-to-string n)))))) | |
| 7727 | (setq n (1+ n))) | |
| 7728 | (condition-case nil | |
| 7729 | (make-indirect-buffer buffer bname 'clone) | |
| 7730 | (error (make-indirect-buffer buffer bname))))) | |
| 7731 | ||
| 7732 | (defun org-set-frame-title (title) | |
| 7733 | "Set the title of the current frame to the string TITLE." | |
| 7734 | (modify-frame-parameters (selected-frame) (list (cons 'name title)))) | |
| 7735 | ||
| 7736 | ;;;; Structure editing | |
| 7737 | ||
| 7738 | ;;; Inserting headlines | |
| 7739 | ||
| 7740 | (defun org--line-empty-p (n) | |
| 7741 | "Is the Nth next line empty? | |
| 7742 | ||
| 7743 | Counts the current line as N = 1 and the previous line as N = 0; | |
| 7744 | see `beginning-of-line'." | |
| 7745 | (save-excursion | |
| 7746 | (and (not (bobp)) | |
| 7747 | (or (beginning-of-line n) t) | |
| 7748 | (save-match-data | |
| 7749 | (looking-at "[ \t]*$"))))) | |
| 7750 | ||
| 7751 | (defun org-previous-line-empty-p () | |
| 7752 | "Is the previous line a blank line? | |
| 7753 | When NEXT is non-nil, check the next line instead." | |
| 7754 | (org--line-empty-p 0)) | |
| 7755 | ||
| 7756 | (defun org-next-line-empty-p () | |
| 7757 | "Is the previous line a blank line? | |
| 7758 | When NEXT is non-nil, check the next line instead." | |
| 7759 | (org--line-empty-p 2)) | |
| 7760 | ||
| 7761 | (defun org--blank-before-heading-p (&optional parent) | |
| 7762 | "Non-nil when an empty line should precede a new heading here. | |
| 7763 | When optional argument PARENT is non-nil, consider parent | |
| 7764 | headline instead of current one." | |
| 7765 | (pcase (assq 'heading org-blank-before-new-entry) | |
| 7766 | (`(heading . auto) | |
| 7767 | (save-excursion | |
| 7768 | (org-with-limited-levels | |
| 7769 | (unless (and (org-before-first-heading-p) | |
| 7770 | (not (outline-next-heading))) | |
| 7771 | (org-back-to-heading t) | |
| 7772 | (when parent (org-up-heading-safe)) | |
| 7773 | (cond ((not (bobp)) | |
| 7774 | (org-previous-line-empty-p)) | |
| 7775 | ((outline-next-heading) | |
| 7776 | (org-previous-line-empty-p)) | |
| 7777 | ;; Ignore trailing spaces on last buffer line. | |
| 7778 | ((progn (skip-chars-backward " \t") (bolp)) | |
| 7779 | (org-previous-line-empty-p)) | |
| 7780 | (t nil)))))) | |
| 7781 | (`(heading . ,value) value) | |
| 7782 | (_ nil))) | |
| 7783 | ||
| 7784 | (defun org-insert-heading (&optional arg invisible-ok top) | |
| 7785 | "Insert a new heading or an item with the same depth at point. | |
| 7786 | ||
| 7787 | If point is at the beginning of a heading, insert a new heading | |
| 7788 | or a new headline above the current one. When at the beginning | |
| 7789 | of a regular line of text, turn it into a heading. | |
| 7790 | ||
| 7791 | If point is in the middle of a line, split it and create a new | |
| 7792 | headline with the text in the current line after point (see | |
| 7793 | `org-M-RET-may-split-line' on how to modify this behavior). As | |
| 7794 | a special case, on a headline, splitting can only happen on the | |
| 7795 | title itself. E.g., this excludes breaking stars or tags. | |
| 7796 | ||
| 7797 | With a `\\[universal-argument]' prefix, set \ | |
| 7798 | `org-insert-heading-respect-content' to | |
| 7799 | a non-nil value for the duration of the command. This forces the | |
| 7800 | insertion of a heading after the current subtree, independently | |
| 7801 | on the location of point. | |
| 7802 | ||
| 7803 | With a `\\[universal-argument] \\[universal-argument]' prefix, \ | |
| 7804 | insert the heading at the end of the tree | |
| 7805 | above the current heading. For example, if point is within a | |
| 7806 | 2nd-level heading, then it will insert a 2nd-level heading at | |
| 7807 | the end of the 1st-level parent subtree. | |
| 7808 | ||
| 7809 | When INVISIBLE-OK is set, stop at invisible headlines when going | |
| 7810 | back. This is important for non-interactive uses of the | |
| 7811 | command. | |
| 7812 | ||
| 7813 | When optional argument TOP is non-nil, insert a level 1 heading, | |
| 7814 | unconditionally." | |
| 7815 | (interactive "P") | |
| 7816 | (let* ((blank? (org--blank-before-heading-p (equal arg '(16)))) | |
| 7817 | (level (org-current-level)) | |
| 7818 | (stars (make-string (if (and level (not top)) level 1) ?*))) | |
| 7819 | (cond | |
| 7820 | ((or org-insert-heading-respect-content | |
| 7821 | (member arg '((4) (16))) | |
| 7822 | (and (not invisible-ok) | |
| 7823 | (invisible-p (max (1- (point)) (point-min))))) | |
| 7824 | ;; Position point at the location of insertion. | |
| 7825 | (if (not level) ;before first headline | |
| 7826 | (org-with-limited-levels (outline-next-heading)) | |
| 7827 | ;; Make sure we end up on a visible headline if INVISIBLE-OK | |
| 7828 | ;; is nil. | |
| 7829 | (org-with-limited-levels (org-back-to-heading invisible-ok)) | |
| 7830 | (cond ((equal arg '(16)) | |
| 7831 | (org-up-heading-safe) | |
| 7832 | (org-end-of-subtree t t)) | |
| 7833 | (t | |
| 7834 | (org-end-of-subtree t t)))) | |
| 7835 | (unless (bolp) (insert "\n")) ;ensure final newline | |
| 7836 | (unless (and blank? (org-previous-line-empty-p)) | |
| 7837 | (org-N-empty-lines-before-current (if blank? 1 0))) | |
| 7838 | (insert stars " \n") | |
| 7839 | (forward-char -1)) | |
| 7840 | ;; At a headline... | |
| 7841 | ((org-at-heading-p) | |
| 7842 | (cond ((bolp) | |
| 7843 | (when blank? (save-excursion (insert "\n"))) | |
| 7844 | (save-excursion (insert stars " \n")) | |
| 7845 | (unless (and blank? (org-previous-line-empty-p)) | |
| 7846 | (org-N-empty-lines-before-current (if blank? 1 0))) | |
| 7847 | (end-of-line)) | |
| 7848 | ((and (org-get-alist-option org-M-RET-may-split-line 'headline) | |
| 7849 | (org-match-line org-complex-heading-regexp) | |
| 7850 | (org-pos-in-match-range (point) 4)) | |
| 7851 | ;; Grab the text that should moved to the new headline. | |
| 7852 | ;; Preserve tags. | |
| 7853 | (let ((split (delete-and-extract-region (point) (match-end 4)))) | |
| 7854 | (if (looking-at "[ \t]*$") (replace-match "") | |
| 7855 | (org-set-tags nil t)) | |
| 7856 | (end-of-line) | |
| 7857 | (when blank? (insert "\n")) | |
| 7858 | (insert "\n" stars " ") | |
| 7859 | (when (org-string-nw-p split) (insert split)) | |
| 7860 | (when (eobp) (save-excursion (insert "\n"))))) | |
| 7861 | (t | |
| 7862 | (end-of-line) | |
| 7863 | (when blank? (insert "\n")) | |
| 7864 | (insert "\n" stars " ") | |
| 7865 | (when (eobp) (save-excursion (insert "\n")))))) | |
| 7866 | ;; On regular text, turn line into a headline or split, if | |
| 7867 | ;; appropriate. | |
| 7868 | ((bolp) | |
| 7869 | (insert stars " ") | |
| 7870 | (unless (and blank? (org-previous-line-empty-p)) | |
| 7871 | (org-N-empty-lines-before-current (if blank? 1 0)))) | |
| 7872 | (t | |
| 7873 | (unless (org-get-alist-option org-M-RET-may-split-line 'headline) | |
| 7874 | (end-of-line)) | |
| 7875 | (insert "\n" stars " ") | |
| 7876 | (unless (and blank? (org-previous-line-empty-p)) | |
| 7877 | (org-N-empty-lines-before-current (if blank? 1 0)))))) | |
| 7878 | (run-hooks 'org-insert-heading-hook)) | |
| 7879 | ||
| 7880 | (defun org-N-empty-lines-before-current (n) | |
| 7881 | "Make the number of empty lines before current exactly N. | |
| 7882 | So this will delete or add empty lines." | |
| 7883 | (let ((column (current-column))) | |
| 7884 | (beginning-of-line) | |
| 7885 | (unless (bobp) | |
| 7886 | (let ((start (save-excursion | |
| 7887 | (skip-chars-backward " \r\t\n") | |
| 7888 | (line-end-position)))) | |
| 7889 | (delete-region start (line-end-position 0)))) | |
| 7890 | (insert (make-string n ?\n)) | |
| 7891 | (move-to-column column))) | |
| 7892 | ||
| 7893 | (defun org-get-heading (&optional no-tags no-todo no-priority no-comment) | |
| 7894 | "Return the heading of the current entry, without the stars. | |
| 7895 | When NO-TAGS is non-nil, don't include tags. | |
| 7896 | When NO-TODO is non-nil, don't include TODO keywords. | |
| 7897 | When NO-PRIORITY is non-nil, don't include priority cookie. | |
| 7898 | When NO-COMMENT is non-nil, don't include COMMENT string." | |
| 7899 | (save-excursion | |
| 7900 | (org-back-to-heading t) | |
| 7901 | (let ((case-fold-search nil)) | |
| 7902 | (looking-at org-complex-heading-regexp) | |
| 7903 | (let ((todo (and (not no-todo) (match-string 2))) | |
| 7904 | (priority (and (not no-priority) (match-string 3))) | |
| 7905 | (headline (pcase (match-string 4) | |
| 7906 | (`nil "") | |
| 7907 | ((and (guard no-comment) h) | |
| 7908 | (replace-regexp-in-string | |
| 7909 | (eval-when-compile | |
| 7910 | (format "\\`%s[ \t]+" org-comment-string)) | |
| 7911 | "" h)) | |
| 7912 | (h h))) | |
| 7913 | (tags (and (not no-tags) (match-string 5)))) | |
| 7914 | (mapconcat #'identity | |
| 7915 | (delq nil (list todo priority headline tags)) | |
| 7916 | " "))))) | |
| 7917 | ||
| 7918 | (defvar orgstruct-mode) ; defined below | |
| 7919 | ||
| 7920 | (defun org-heading-components () | |
| 7921 | "Return the components of the current heading. | |
| 7922 | This is a list with the following elements: | |
| 7923 | - the level as an integer | |
| 7924 | - the reduced level, different if `org-odd-levels-only' is set. | |
| 7925 | - the TODO keyword, or nil | |
| 7926 | - the priority character, like ?A, or nil if no priority is given | |
| 7927 | - the headline text itself, or the tags string if no headline text | |
| 7928 | - the tags string, or nil." | |
| 7929 | (save-excursion | |
| 7930 | (org-back-to-heading t) | |
| 7931 | (when (let (case-fold-search) | |
| 7932 | (looking-at | |
| 7933 | (if orgstruct-mode | |
| 7934 | org-heading-regexp | |
| 7935 | org-complex-heading-regexp))) | |
| 7936 | (if orgstruct-mode | |
| 7937 | (list (length (match-string 1)) | |
| 7938 | (org-reduced-level (length (match-string 1))) | |
| 7939 | nil | |
| 7940 | nil | |
| 7941 | (match-string 2) | |
| 7942 | nil) | |
| 7943 | (list (length (match-string 1)) | |
| 7944 | (org-reduced-level (length (match-string 1))) | |
| 7945 | (match-string-no-properties 2) | |
| 7946 | (and (match-end 3) (aref (match-string 3) 2)) | |
| 7947 | (match-string-no-properties 4) | |
| 7948 | (match-string-no-properties 5)))))) | |
| 7949 | ||
| 7950 | (defun org-get-entry () | |
| 7951 | "Get the entry text, after heading, entire subtree." | |
| 7952 | (save-excursion | |
| 7953 | (org-back-to-heading t) | |
| 7954 | (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) | |
| 7955 | ||
| 7956 | (defun org-edit-headline (&optional heading) | |
| 7957 | "Edit the current headline. | |
| 7958 | Set it to HEADING when provided." | |
| 7959 | (interactive) | |
| 7960 | (org-with-wide-buffer | |
| 7961 | (org-back-to-heading t) | |
| 7962 | (let ((case-fold-search nil)) | |
| 7963 | (when (looking-at org-complex-heading-regexp) | |
| 7964 | (let* ((old (match-string-no-properties 4)) | |
| 7965 | (new (save-match-data | |
| 7966 | (org-trim (or heading (read-string "Edit: " old)))))) | |
| 7967 | (unless (equal old new) | |
| 7968 | (if old (replace-match new t t nil 4) | |
| 7969 | (goto-char (or (match-end 3) (match-end 2) (match-end 1))) | |
| 7970 | (insert " " new)) | |
| 7971 | (org-set-tags nil t) | |
| 7972 | (when (looking-at "[ \t]*$") (replace-match "")))))))) | |
| 7973 | ||
| 7974 | (defun org-insert-heading-after-current () | |
| 7975 | "Insert a new heading with same level as current, after current subtree." | |
| 7976 | (interactive) | |
| 7977 | (org-back-to-heading) | |
| 7978 | (org-insert-heading) | |
| 7979 | (org-move-subtree-down) | |
| 7980 | (end-of-line 1)) | |
| 7981 | ||
| 7982 | (defun org-insert-heading-respect-content (&optional invisible-ok) | |
| 7983 | "Insert heading with `org-insert-heading-respect-content' set to t." | |
| 7984 | (interactive) | |
| 7985 | (org-insert-heading '(4) invisible-ok)) | |
| 7986 | ||
| 7987 | (defun org-insert-todo-heading-respect-content (&optional force-state) | |
| 7988 | "Insert TODO heading with `org-insert-heading-respect-content' set to t." | |
| 7989 | (interactive) | |
| 7990 | (org-insert-todo-heading force-state '(4))) | |
| 7991 | ||
| 7992 | (defun org-insert-todo-heading (arg &optional force-heading) | |
| 7993 | "Insert a new heading with the same level and TODO state as current heading. | |
| 7994 | ||
| 7995 | If the heading has no TODO state, or if the state is DONE, use | |
| 7996 | the first state (TODO by default). Also with one prefix arg, | |
| 7997 | force first state. With two prefix args, force inserting at the | |
| 7998 | end of the parent subtree. | |
| 7999 | ||
| 8000 | When called at a plain list item, insert a new item with an | |
| 8001 | unchecked check box." | |
| 8002 | (interactive "P") | |
| 8003 | (when (or force-heading (not (org-insert-item 'checkbox))) | |
| 8004 | (org-insert-heading (or (and (equal arg '(16)) '(16)) | |
| 8005 | force-heading)) | |
| 8006 | (save-excursion | |
| 8007 | (org-forward-heading-same-level -1) | |
| 8008 | (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))) | |
| 8009 | (let* ((new-mark-x | |
| 8010 | (if (or (equal arg '(4)) | |
| 8011 | (not (match-beginning 2)) | |
| 8012 | (member (match-string 2) org-done-keywords)) | |
| 8013 | (car org-todo-keywords-1) | |
| 8014 | (match-string 2))) | |
| 8015 | (new-mark | |
| 8016 | (or | |
| 8017 | (run-hook-with-args-until-success | |
| 8018 | 'org-todo-get-default-hook new-mark-x nil) | |
| 8019 | new-mark-x))) | |
| 8020 | (beginning-of-line 1) | |
| 8021 | (and (looking-at org-outline-regexp) (goto-char (match-end 0)) | |
| 8022 | (if org-treat-insert-todo-heading-as-state-change | |
| 8023 | (org-todo new-mark) | |
| 8024 | (insert new-mark " ")))) | |
| 8025 | (when org-provide-todo-statistics | |
| 8026 | (org-update-parent-todo-statistics)))) | |
| 8027 | ||
| 8028 | (defun org-insert-subheading (arg) | |
| 8029 | "Insert a new subheading and demote it. | |
| 8030 | Works for outline headings and for plain lists alike." | |
| 8031 | (interactive "P") | |
| 8032 | (org-insert-heading arg) | |
| 8033 | (cond | |
| 8034 | ((org-at-heading-p) (org-do-demote)) | |
| 8035 | ((org-at-item-p) (org-indent-item)))) | |
| 8036 | ||
| 8037 | (defun org-insert-todo-subheading (arg) | |
| 8038 | "Insert a new subheading with TODO keyword or checkbox and demote it. | |
| 8039 | Works for outline headings and for plain lists alike." | |
| 8040 | (interactive "P") | |
| 8041 | (org-insert-todo-heading arg) | |
| 8042 | (cond | |
| 8043 | ((org-at-heading-p) (org-do-demote)) | |
| 8044 | ((org-at-item-p) (org-indent-item)))) | |
| 8045 | ||
| 8046 | ;;; Promotion and Demotion | |
| 8047 | ||
| 8048 | (defvar org-after-demote-entry-hook nil | |
| 8049 | "Hook run after an entry has been demoted. | |
| 8050 | The cursor will be at the beginning of the entry. | |
| 8051 | When a subtree is being demoted, the hook will be called for each node.") | |
| 8052 | ||
| 8053 | (defvar org-after-promote-entry-hook nil | |
| 8054 | "Hook run after an entry has been promoted. | |
| 8055 | The cursor will be at the beginning of the entry. | |
| 8056 | When a subtree is being promoted, the hook will be called for each node.") | |
| 8057 | ||
| 8058 | (defun org-promote-subtree () | |
| 8059 | "Promote the entire subtree. | |
| 8060 | See also `org-promote'." | |
| 8061 | (interactive) | |
| 8062 | (save-excursion | |
| 8063 | (org-with-limited-levels (org-map-tree 'org-promote))) | |
| 8064 | (org-fix-position-after-promote)) | |
| 8065 | ||
| 8066 | (defun org-demote-subtree () | |
| 8067 | "Demote the entire subtree. | |
| 8068 | See `org-demote' and `org-promote'." | |
| 8069 | (interactive) | |
| 8070 | (save-excursion | |
| 8071 | (org-with-limited-levels (org-map-tree 'org-demote))) | |
| 8072 | (org-fix-position-after-promote)) | |
| 8073 | ||
| 8074 | (defun org-do-promote () | |
| 8075 | "Promote the current heading higher up the tree. | |
| 8076 | If the region is active in `transient-mark-mode', promote all | |
| 8077 | headings in the region." | |
| 8078 | (interactive) | |
| 8079 | (save-excursion | |
| 8080 | (if (org-region-active-p) | |
| 8081 | (org-map-region 'org-promote (region-beginning) (region-end)) | |
| 8082 | (org-promote))) | |
| 8083 | (org-fix-position-after-promote)) | |
| 8084 | ||
| 8085 | (defun org-do-demote () | |
| 8086 | "Demote the current heading lower down the tree. | |
| 8087 | If the region is active in `transient-mark-mode', demote all | |
| 8088 | headings in the region." | |
| 8089 | (interactive) | |
| 8090 | (save-excursion | |
| 8091 | (if (org-region-active-p) | |
| 8092 | (org-map-region 'org-demote (region-beginning) (region-end)) | |
| 8093 | (org-demote))) | |
| 8094 | (org-fix-position-after-promote)) | |
| 8095 | ||
| 8096 | (defun org-fix-position-after-promote () | |
| 8097 | "Fix cursor position and indentation after demoting/promoting." | |
| 8098 | (let ((pos (point))) | |
| 8099 | (when (save-excursion | |
| 8100 | (beginning-of-line) | |
| 8101 | (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) | |
| 8102 | (or (eq pos (match-end 1)) (eq pos (match-end 2)))) | |
| 8103 | (cond ((eobp) (insert " ")) | |
| 8104 | ((eolp) (insert " ")) | |
| 8105 | ((equal (char-after) ?\s) (forward-char 1)))))) | |
| 8106 | ||
| 8107 | (defun org-current-level () | |
| 8108 | "Return the level of the current entry, or nil if before the first headline. | |
| 8109 | The level is the number of stars at the beginning of the | |
| 8110 | headline. Use `org-reduced-level' to remove the effect of | |
| 8111 | `org-odd-levels'. Unlike to `org-outline-level', this function | |
| 8112 | ignores inlinetasks." | |
| 8113 | (let ((level (org-with-limited-levels (org-outline-level)))) | |
| 8114 | (and (> level 0) level))) | |
| 8115 | ||
| 8116 | (defun org-get-previous-line-level () | |
| 8117 | "Return the outline depth of the last headline before the current line. | |
| 8118 | Returns 0 for the first headline in the buffer, and nil if before the | |
| 8119 | first headline." | |
| 8120 | (and (org-current-level) | |
| 8121 | (or (and (/= (line-beginning-position) (point-min)) | |
| 8122 | (save-excursion (beginning-of-line 0) (org-current-level))) | |
| 8123 | 0))) | |
| 8124 | ||
| 8125 | (defun org-reduced-level (l) | |
| 8126 | "Compute the effective level of a heading. | |
| 8127 | This takes into account the setting of `org-odd-levels-only'." | |
| 8128 | (cond | |
| 8129 | ((zerop l) 0) | |
| 8130 | (org-odd-levels-only (1+ (floor (/ l 2)))) | |
| 8131 | (t l))) | |
| 8132 | ||
| 8133 | (defun org-level-increment () | |
| 8134 | "Return the number of stars that will be added or removed at a | |
| 8135 | time to headlines when structure editing, based on the value of | |
| 8136 | `org-odd-levels-only'." | |
| 8137 | (if org-odd-levels-only 2 1)) | |
| 8138 | ||
| 8139 | (defun org-get-valid-level (level &optional change) | |
| 8140 | "Rectify a level change under the influence of `org-odd-levels-only'. | |
| 8141 | LEVEL is a current level, CHANGE is by how much the level should | |
| 8142 | be modified. Even if CHANGE is nil, LEVEL may be returned | |
| 8143 | modified because even level numbers will become the next higher | |
| 8144 | odd number. Returns values greater than 0." | |
| 8145 | (if org-odd-levels-only | |
| 8146 | (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) | |
| 8147 | ((> change 0) (1+ (* 2 (/ (+ (1- level) (* 2 change)) 2)))) | |
| 8148 | ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) | |
| 8149 | (max 1 (+ level (or change 0))))) | |
| 8150 | ||
| 8151 | (defun org-promote () | |
| 8152 | "Promote the current heading higher up the tree." | |
| 8153 | (org-with-wide-buffer | |
| 8154 | (org-back-to-heading t) | |
| 8155 | (let* ((after-change-functions (remq 'flyspell-after-change-function | |
| 8156 | after-change-functions)) | |
| 8157 | (level (save-match-data (funcall outline-level))) | |
| 8158 | (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) | |
| 8159 | (diff (abs (- level (length up-head) -1)))) | |
| 8160 | (cond | |
| 8161 | ((and (= level 1) org-allow-promoting-top-level-subtree) | |
| 8162 | (replace-match "# " nil t)) | |
| 8163 | ((= level 1) | |
| 8164 | (user-error "Cannot promote to level 0. UNDO to recover if necessary")) | |
| 8165 | (t (replace-match up-head nil t))) | |
| 8166 | (unless (= level 1) | |
| 8167 | (when org-auto-align-tags (org-set-tags nil 'ignore-column)) | |
| 8168 | (when org-adapt-indentation (org-fixup-indentation (- diff)))) | |
| 8169 | (run-hooks 'org-after-promote-entry-hook)))) | |
| 8170 | ||
| 8171 | (defun org-demote () | |
| 8172 | "Demote the current heading lower down the tree." | |
| 8173 | (org-with-wide-buffer | |
| 8174 | (org-back-to-heading t) | |
| 8175 | (let* ((after-change-functions (remq 'flyspell-after-change-function | |
| 8176 | after-change-functions)) | |
| 8177 | (level (save-match-data (funcall outline-level))) | |
| 8178 | (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) | |
| 8179 | (diff (abs (- level (length down-head) -1)))) | |
| 8180 | (replace-match down-head nil t) | |
| 8181 | (when org-auto-align-tags (org-set-tags nil 'ignore-column)) | |
| 8182 | (when org-adapt-indentation (org-fixup-indentation diff)) | |
| 8183 | (run-hooks 'org-after-demote-entry-hook)))) | |
| 8184 | ||
| 8185 | (defun org-cycle-level () | |
| 8186 | "Cycle the level of an empty headline through possible states. | |
| 8187 | This goes first to child, then to parent, level, then up the hierarchy. | |
| 8188 | After top level, it switches back to sibling level." | |
| 8189 | (interactive) | |
| 8190 | (let ((org-adapt-indentation nil)) | |
| 8191 | (when (org-point-at-end-of-empty-headline) | |
| 8192 | (setq this-command 'org-cycle-level) ; Only needed for caching | |
| 8193 | (let ((cur-level (org-current-level)) | |
| 8194 | (prev-level (org-get-previous-line-level))) | |
| 8195 | (cond | |
| 8196 | ;; If first headline in file, promote to top-level. | |
| 8197 | ((= prev-level 0) | |
| 8198 | (cl-loop repeat (/ (- cur-level 1) (org-level-increment)) | |
| 8199 | do (org-do-promote))) | |
| 8200 | ;; If same level as prev, demote one. | |
| 8201 | ((= prev-level cur-level) | |
| 8202 | (org-do-demote)) | |
| 8203 | ;; If parent is top-level, promote to top level if not already. | |
| 8204 | ((= prev-level 1) | |
| 8205 | (cl-loop repeat (/ (- cur-level 1) (org-level-increment)) | |
| 8206 | do (org-do-promote))) | |
| 8207 | ;; If top-level, return to prev-level. | |
| 8208 | ((= cur-level 1) | |
| 8209 | (cl-loop repeat (/ (- prev-level 1) (org-level-increment)) | |
| 8210 | do (org-do-demote))) | |
| 8211 | ;; If less than prev-level, promote one. | |
| 8212 | ((< cur-level prev-level) | |
| 8213 | (org-do-promote)) | |
| 8214 | ;; If deeper than prev-level, promote until higher than | |
| 8215 | ;; prev-level. | |
| 8216 | ((> cur-level prev-level) | |
| 8217 | (cl-loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment))) | |
| 8218 | do (org-do-promote)))) | |
| 8219 | t)))) | |
| 8220 | ||
| 8221 | (defun org-map-tree (fun) | |
| 8222 | "Call FUN for every heading underneath the current one." | |
| 8223 | (org-back-to-heading t) | |
| 8224 | (let ((level (funcall outline-level))) | |
| 8225 | (save-excursion | |
| 8226 | (funcall fun) | |
| 8227 | (while (and (progn | |
| 8228 | (outline-next-heading) | |
| 8229 | (> (funcall outline-level) level)) | |
| 8230 | (not (eobp))) | |
| 8231 | (funcall fun))))) | |
| 8232 | ||
| 8233 | (defun org-map-region (fun beg end) | |
| 8234 | "Call FUN for every heading between BEG and END." | |
| 8235 | (let ((org-ignore-region t)) | |
| 8236 | (save-excursion | |
| 8237 | (setq end (copy-marker end)) | |
| 8238 | (goto-char beg) | |
| 8239 | (when (and (re-search-forward org-outline-regexp-bol nil t) | |
| 8240 | (< (point) end)) | |
| 8241 | (funcall fun)) | |
| 8242 | (while (and (progn | |
| 8243 | (outline-next-heading) | |
| 8244 | (< (point) end)) | |
| 8245 | (not (eobp))) | |
| 8246 | (funcall fun))))) | |
| 8247 | ||
| 8248 | (defun org-fixup-indentation (diff) | |
| 8249 | "Change the indentation in the current entry by DIFF. | |
| 8250 | ||
| 8251 | DIFF is an integer. Indentation is done according to the | |
| 8252 | following rules: | |
| 8253 | ||
| 8254 | - Planning information and property drawers are always indented | |
| 8255 | according to the new level of the headline; | |
| 8256 | ||
| 8257 | - Footnote definitions and their contents are ignored; | |
| 8258 | ||
| 8259 | - Inlinetasks' boundaries are not shifted; | |
| 8260 | ||
| 8261 | - Empty lines are ignored; | |
| 8262 | ||
| 8263 | - Other lines' indentation are shifted by DIFF columns, unless | |
| 8264 | it would introduce a structural change in the document, in | |
| 8265 | which case no shifting is done at all. | |
| 8266 | ||
| 8267 | Assume point is at a heading or an inlinetask beginning." | |
| 8268 | (org-with-wide-buffer | |
| 8269 | (narrow-to-region (line-beginning-position) | |
| 8270 | (save-excursion | |
| 8271 | (if (org-with-limited-levels (org-at-heading-p)) | |
| 8272 | (org-with-limited-levels (outline-next-heading)) | |
| 8273 | (org-inlinetask-goto-end)) | |
| 8274 | (point))) | |
| 8275 | (forward-line) | |
| 8276 | ;; Indent properly planning info and property drawer. | |
| 8277 | (when (looking-at-p org-planning-line-re) | |
| 8278 | (org-indent-line) | |
| 8279 | (forward-line)) | |
| 8280 | (when (looking-at org-property-drawer-re) | |
| 8281 | (goto-char (match-end 0)) | |
| 8282 | (forward-line) | |
| 8283 | (save-excursion (org-indent-region (match-beginning 0) (match-end 0)))) | |
| 8284 | (catch 'no-shift | |
| 8285 | (when (zerop diff) (throw 'no-shift nil)) | |
| 8286 | ;; If DIFF is negative, first check if a shift is possible at all | |
| 8287 | ;; (e.g., it doesn't break structure). This can only happen if | |
| 8288 | ;; some contents are not properly indented. | |
| 8289 | (let ((case-fold-search t)) | |
| 8290 | (when (< diff 0) | |
| 8291 | (let ((diff (- diff)) | |
| 8292 | (forbidden-re (concat org-outline-regexp | |
| 8293 | "\\|" | |
| 8294 | (substring org-footnote-definition-re 1)))) | |
| 8295 | (save-excursion | |
| 8296 | (while (not (eobp)) | |
| 8297 | (cond | |
| 8298 | ((looking-at-p "[ \t]*$") (forward-line)) | |
| 8299 | ((and (looking-at-p org-footnote-definition-re) | |
| 8300 | (let ((e (org-element-at-point))) | |
| 8301 | (and (eq (org-element-type e) 'footnote-definition) | |
| 8302 | (goto-char (org-element-property :end e)))))) | |
| 8303 | ((looking-at-p org-outline-regexp) (forward-line)) | |
| 8304 | ;; Give up if shifting would move before column 0 or | |
| 8305 | ;; if it would introduce a headline or a footnote | |
| 8306 | ;; definition. | |
| 8307 | (t | |
| 8308 | (skip-chars-forward " \t") | |
| 8309 | (let ((ind (current-column))) | |
| 8310 | (when (or (< ind diff) | |
| 8311 | (and (= ind diff) (looking-at-p forbidden-re))) | |
| 8312 | (throw 'no-shift nil))) | |
| 8313 | ;; Ignore contents of example blocks and source | |
| 8314 | ;; blocks if their indentation is meant to be | |
| 8315 | ;; preserved. Jump to block's closing line. | |
| 8316 | (beginning-of-line) | |
| 8317 | (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") | |
| 8318 | (let ((e (org-element-at-point))) | |
| 8319 | (and (memq (org-element-type e) | |
| 8320 | '(example-block src-block)) | |
| 8321 | (or org-src-preserve-indentation | |
| 8322 | (org-element-property :preserve-indent e)) | |
| 8323 | (goto-char (org-element-property :end e)) | |
| 8324 | (progn (skip-chars-backward " \r\t\n") | |
| 8325 | (beginning-of-line) | |
| 8326 | t)))) | |
| 8327 | (forward-line)))))))) | |
| 8328 | ;; Shift lines but footnote definitions, inlinetasks boundaries | |
| 8329 | ;; by DIFF. Also skip contents of source or example blocks | |
| 8330 | ;; when indentation is meant to be preserved. | |
| 8331 | (while (not (eobp)) | |
| 8332 | (cond | |
| 8333 | ((and (looking-at-p org-footnote-definition-re) | |
| 8334 | (let ((e (org-element-at-point))) | |
| 8335 | (and (eq (org-element-type e) 'footnote-definition) | |
| 8336 | (goto-char (org-element-property :end e)))))) | |
| 8337 | ((looking-at-p org-outline-regexp) (forward-line)) | |
| 8338 | ((looking-at-p "[ \t]*$") (forward-line)) | |
| 8339 | (t | |
| 8340 | (indent-line-to (+ (org-get-indentation) diff)) | |
| 8341 | (beginning-of-line) | |
| 8342 | (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") | |
| 8343 | (let ((e (org-element-at-point))) | |
| 8344 | (and (memq (org-element-type e) | |
| 8345 | '(example-block src-block)) | |
| 8346 | (or org-src-preserve-indentation | |
| 8347 | (org-element-property :preserve-indent e)) | |
| 8348 | (goto-char (org-element-property :end e)) | |
| 8349 | (progn (skip-chars-backward " \r\t\n") | |
| 8350 | (beginning-of-line) | |
| 8351 | t)))) | |
| 8352 | (forward-line))))))))) | |
| 8353 | ||
| 8354 | (defun org-convert-to-odd-levels () | |
| 8355 | "Convert an Org file with all levels allowed to one with odd levels. | |
| 8356 | This will leave level 1 alone, convert level 2 to level 3, level 3 to | |
| 8357 | level 5 etc." | |
| 8358 | (interactive) | |
| 8359 | (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") | |
| 8360 | (let ((outline-level 'org-outline-level) | |
| 8361 | (org-odd-levels-only nil) n) | |
| 8362 | (save-excursion | |
| 8363 | (goto-char (point-min)) | |
| 8364 | (while (re-search-forward "^\\*\\*+ " nil t) | |
| 8365 | (setq n (- (length (match-string 0)) 2)) | |
| 8366 | (while (>= (setq n (1- n)) 0) | |
| 8367 | (org-demote)) | |
| 8368 | (end-of-line 1)))))) | |
| 8369 | ||
| 8370 | (defun org-convert-to-oddeven-levels () | |
| 8371 | "Convert an Org file with only odd levels to one with odd/even levels. | |
| 8372 | This promotes level 3 to level 2, level 5 to level 3 etc. If the | |
| 8373 | file contains a section with an even level, conversion would | |
| 8374 | destroy the structure of the file. An error is signaled in this | |
| 8375 | case." | |
| 8376 | (interactive) | |
| 8377 | (goto-char (point-min)) | |
| 8378 | ;; First check if there are no even levels | |
| 8379 | (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) | |
| 8380 | (org-show-set-visibility 'canonical) | |
| 8381 | (error "Not all levels are odd in this file. Conversion not possible")) | |
| 8382 | (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") | |
| 8383 | (let ((outline-regexp org-outline-regexp) | |
| 8384 | (outline-level 'org-outline-level) | |
| 8385 | (org-odd-levels-only nil) n) | |
| 8386 | (save-excursion | |
| 8387 | (goto-char (point-min)) | |
| 8388 | (while (re-search-forward "^\\*\\*+ " nil t) | |
| 8389 | (setq n (/ (1- (length (match-string 0))) 2)) | |
| 8390 | (while (>= (setq n (1- n)) 0) | |
| 8391 | (org-promote)) | |
| 8392 | (end-of-line 1)))))) | |
| 8393 | ||
| 8394 | (defun org-tr-level (n) | |
| 8395 | "Make N odd if required." | |
| 8396 | (if org-odd-levels-only (1+ (/ n 2)) n)) | |
| 8397 | ||
| 8398 | ;;; Vertical tree motion, cutting and pasting of subtrees | |
| 8399 | ||
| 8400 | (defun org-move-subtree-up (&optional arg) | |
| 8401 | "Move the current subtree up past ARG headlines of the same level." | |
| 8402 | (interactive "p") | |
| 8403 | (org-move-subtree-down (- (prefix-numeric-value arg)))) | |
| 8404 | ||
| 8405 | (defun org-move-subtree-down (&optional arg) | |
| 8406 | "Move the current subtree down past ARG headlines of the same level." | |
| 8407 | (interactive "p") | |
| 8408 | (setq arg (prefix-numeric-value arg)) | |
| 8409 | (let ((movfunc (if (> arg 0) 'org-get-next-sibling | |
| 8410 | 'org-get-last-sibling)) | |
| 8411 | (ins-point (make-marker)) | |
| 8412 | (cnt (abs arg)) | |
| 8413 | (col (current-column)) | |
| 8414 | beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) | |
| 8415 | ;; Select the tree | |
| 8416 | (org-back-to-heading) | |
| 8417 | (setq beg0 (point)) | |
| 8418 | (save-excursion | |
| 8419 | (setq ne-beg (org-back-over-empty-lines)) | |
| 8420 | (setq beg (point))) | |
| 8421 | (save-match-data | |
| 8422 | (save-excursion (outline-end-of-heading) | |
| 8423 | (setq folded (org-invisible-p))) | |
| 8424 | (progn (org-end-of-subtree nil t) | |
| 8425 | (unless (eobp) (backward-char)))) | |
| 8426 | (outline-next-heading) | |
| 8427 | (setq ne-end (org-back-over-empty-lines)) | |
| 8428 | (setq end (point)) | |
| 8429 | (goto-char beg0) | |
| 8430 | (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg)) | |
| 8431 | ;; include less whitespace | |
| 8432 | (save-excursion | |
| 8433 | (goto-char beg) | |
| 8434 | (forward-line (- ne-beg ne-end)) | |
| 8435 | (setq beg (point)))) | |
| 8436 | ;; Find insertion point, with error handling | |
| 8437 | (while (> cnt 0) | |
| 8438 | (or (and (funcall movfunc) (looking-at org-outline-regexp)) | |
| 8439 | (progn (goto-char beg0) | |
| 8440 | (user-error "Cannot move past superior level or buffer limit"))) | |
| 8441 | (setq cnt (1- cnt))) | |
| 8442 | (when (> arg 0) | |
| 8443 | ;; Moving forward - still need to move over subtree | |
| 8444 | (org-end-of-subtree t t) | |
| 8445 | (save-excursion | |
| 8446 | (org-back-over-empty-lines) | |
| 8447 | (or (bolp) (newline)))) | |
| 8448 | (setq ne-ins (org-back-over-empty-lines)) | |
| 8449 | (move-marker ins-point (point)) | |
| 8450 | (setq txt (buffer-substring beg end)) | |
| 8451 | (org-save-markers-in-region beg end) | |
| 8452 | (delete-region beg end) | |
| 8453 | (org-remove-empty-overlays-at beg) | |
| 8454 | (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil)) | |
| 8455 | (or (bobp) (outline-flag-region (1- (point)) (point) nil)) | |
| 8456 | (and (not (bolp)) (looking-at "\n") (forward-char 1)) | |
| 8457 | (let ((bbb (point))) | |
| 8458 | (insert-before-markers txt) | |
| 8459 | (org-reinstall-markers-in-region bbb) | |
| 8460 | (move-marker ins-point bbb)) | |
| 8461 | (or (bolp) (insert "\n")) | |
| 8462 | (setq ins-end (point)) | |
| 8463 | (goto-char ins-point) | |
| 8464 | (org-skip-whitespace) | |
| 8465 | (when (and (< arg 0) | |
| 8466 | (org-first-sibling-p) | |
| 8467 | (> ne-ins ne-beg)) | |
| 8468 | ;; Move whitespace back to beginning | |
| 8469 | (save-excursion | |
| 8470 | (goto-char ins-end) | |
| 8471 | (let ((kill-whole-line t)) | |
| 8472 | (kill-line (- ne-ins ne-beg)) (point))) | |
| 8473 | (insert (make-string (- ne-ins ne-beg) ?\n))) | |
| 8474 | (move-marker ins-point nil) | |
| 8475 | (if folded | |
| 8476 | (outline-hide-subtree) | |
| 8477 | (org-show-entry) | |
| 8478 | (org-show-children) | |
| 8479 | (org-cycle-hide-drawers 'children)) | |
| 8480 | (org-clean-visibility-after-subtree-move) | |
| 8481 | ;; move back to the initial column we were at | |
| 8482 | (move-to-column col))) | |
| 8483 | ||
| 8484 | (defvar org-subtree-clip "" | |
| 8485 | "Clipboard for cut and paste of subtrees. | |
| 8486 | This is actually only a copy of the kill, because we use the normal kill | |
| 8487 | ring. We need it to check if the kill was created by `org-copy-subtree'.") | |
| 8488 | ||
| 8489 | (defvar org-subtree-clip-folded nil | |
| 8490 | "Was the last copied subtree folded? | |
| 8491 | This is used to fold the tree back after pasting.") | |
| 8492 | ||
| 8493 | (defun org-cut-subtree (&optional n) | |
| 8494 | "Cut the current subtree into the clipboard. | |
| 8495 | With prefix arg N, cut this many sequential subtrees. | |
| 8496 | This is a short-hand for marking the subtree and then cutting it." | |
| 8497 | (interactive "p") | |
| 8498 | (org-copy-subtree n 'cut)) | |
| 8499 | ||
| 8500 | (defun org-copy-subtree (&optional n cut force-store-markers nosubtrees) | |
| 8501 | "Copy the current subtree into the clipboard. | |
| 8502 | With prefix arg N, copy this many sequential subtrees. | |
| 8503 | This is a short-hand for marking the subtree and then copying it. | |
| 8504 | If CUT is non-nil, actually cut the subtree. | |
| 8505 | If FORCE-STORE-MARKERS is non-nil, store the relative locations | |
| 8506 | of some markers in the region, even if CUT is non-nil. This is | |
| 8507 | useful if the caller implements cut-and-paste as copy-then-paste-then-cut." | |
| 8508 | (interactive "p") | |
| 8509 | (let (beg end folded (beg0 (point))) | |
| 8510 | (if (called-interactively-p 'any) | |
| 8511 | (org-back-to-heading nil) ; take what looks like a subtree | |
| 8512 | (org-back-to-heading t)) ; take what is really there | |
| 8513 | (setq beg (point)) | |
| 8514 | (skip-chars-forward " \t\r\n") | |
| 8515 | (save-match-data | |
| 8516 | (if nosubtrees | |
| 8517 | (outline-next-heading) | |
| 8518 | (save-excursion (outline-end-of-heading) | |
| 8519 | (setq folded (org-invisible-p))) | |
| 8520 | (ignore-errors (org-forward-heading-same-level (1- n) t)) | |
| 8521 | (org-end-of-subtree t t))) | |
| 8522 | ;; Include the end of an inlinetask | |
| 8523 | (when (and (featurep 'org-inlinetask) | |
| 8524 | (looking-at-p (concat (org-inlinetask-outline-regexp) | |
| 8525 | "END[ \t]*$"))) | |
| 8526 | (end-of-line)) | |
| 8527 | (setq end (point)) | |
| 8528 | (goto-char beg0) | |
| 8529 | (when (> end beg) | |
| 8530 | (setq org-subtree-clip-folded folded) | |
| 8531 | (when (or cut force-store-markers) | |
| 8532 | (org-save-markers-in-region beg end)) | |
| 8533 | (if cut (kill-region beg end) (copy-region-as-kill beg end)) | |
| 8534 | (setq org-subtree-clip (current-kill 0)) | |
| 8535 | (message "%s: Subtree(s) with %d characters" | |
| 8536 | (if cut "Cut" "Copied") | |
| 8537 | (length org-subtree-clip))))) | |
| 8538 | ||
| 8539 | (defun org-paste-subtree (&optional level tree for-yank remove) | |
| 8540 | "Paste the clipboard as a subtree, with modification of headline level. | |
| 8541 | The entire subtree is promoted or demoted in order to match a new headline | |
| 8542 | level. | |
| 8543 | ||
| 8544 | If the cursor is at the beginning of a headline, the same level as | |
| 8545 | that headline is used to paste the tree. | |
| 8546 | ||
| 8547 | If not, the new level is derived from the *visible* headings | |
| 8548 | before and after the insertion point, and taken to be the inferior headline | |
| 8549 | level of the two. So if the previous visible heading is level 3 and the | |
| 8550 | next is level 4 (or vice versa), level 4 will be used for insertion. | |
| 8551 | This makes sure that the subtree remains an independent subtree and does | |
| 8552 | not swallow low level entries. | |
| 8553 | ||
| 8554 | You can also force a different level, either by using a numeric prefix | |
| 8555 | argument, or by inserting the heading marker by hand. For example, if the | |
| 8556 | cursor is after \"*****\", then the tree will be shifted to level 5. | |
| 8557 | ||
| 8558 | If optional TREE is given, use this text instead of the kill ring. | |
| 8559 | ||
| 8560 | When FOR-YANK is set, this is called by `org-yank'. In this case, do not | |
| 8561 | move back over whitespace before inserting, and move point to the end of | |
| 8562 | the inserted text when done. | |
| 8563 | ||
| 8564 | When REMOVE is non-nil, remove the subtree from the clipboard." | |
| 8565 | (interactive "P") | |
| 8566 | (setq tree (or tree (and kill-ring (current-kill 0)))) | |
| 8567 | (unless (org-kill-is-subtree-p tree) | |
| 8568 | (user-error "%s" | |
| 8569 | (substitute-command-keys | |
| 8570 | "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) | |
| 8571 | (org-with-limited-levels | |
| 8572 | (let* ((visp (not (org-invisible-p))) | |
| 8573 | (txt tree) | |
| 8574 | (old-level (if (string-match org-outline-regexp-bol txt) | |
| 8575 | (- (match-end 0) (match-beginning 0) 1) | |
| 8576 | -1)) | |
| 8577 | (force-level (cond (level (prefix-numeric-value level)) | |
| 8578 | ((and (looking-at "[ \t]*$") | |
| 8579 | (string-match | |
| 8580 | "^\\*+$" (buffer-substring | |
| 8581 | (point-at-bol) (point)))) | |
| 8582 | (- (match-end 0) (match-beginning 0))) | |
| 8583 | ((and (bolp) | |
| 8584 | (looking-at org-outline-regexp)) | |
| 8585 | (- (match-end 0) (point) 1)))) | |
| 8586 | (previous-level (save-excursion | |
| 8587 | (condition-case nil | |
| 8588 | (progn | |
| 8589 | (outline-previous-visible-heading 1) | |
| 8590 | (if (looking-at org-outline-regexp-bol) | |
| 8591 | (- (match-end 0) (match-beginning 0) 1) | |
| 8592 | 1)) | |
| 8593 | (error 1)))) | |
| 8594 | (next-level (save-excursion | |
| 8595 | (condition-case nil | |
| 8596 | (progn | |
| 8597 | (or (looking-at org-outline-regexp) | |
| 8598 | (outline-next-visible-heading 1)) | |
| 8599 | (if (looking-at org-outline-regexp-bol) | |
| 8600 | (- (match-end 0) (match-beginning 0) 1) | |
| 8601 | 1)) | |
| 8602 | (error 1)))) | |
| 8603 | (new-level (or force-level (max previous-level next-level))) | |
| 8604 | (shift (if (or (= old-level -1) | |
| 8605 | (= new-level -1) | |
| 8606 | (= old-level new-level)) | |
| 8607 | 0 | |
| 8608 | (- new-level old-level))) | |
| 8609 | (delta (if (> shift 0) -1 1)) | |
| 8610 | (func (if (> shift 0) 'org-demote 'org-promote)) | |
| 8611 | (org-odd-levels-only nil) | |
| 8612 | beg end newend) | |
| 8613 | ;; Remove the forced level indicator | |
| 8614 | (when force-level | |
| 8615 | (delete-region (point-at-bol) (point))) | |
| 8616 | ;; Paste | |
| 8617 | (beginning-of-line (if (bolp) 1 2)) | |
| 8618 | (setq beg (point)) | |
| 8619 | (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) | |
| 8620 | (insert-before-markers txt) | |
| 8621 | (unless (string-suffix-p "\n" txt) (insert "\n")) | |
| 8622 | (setq newend (point)) | |
| 8623 | (org-reinstall-markers-in-region beg) | |
| 8624 | (setq end (point)) | |
| 8625 | (goto-char beg) | |
| 8626 | (skip-chars-forward " \t\n\r") | |
| 8627 | (setq beg (point)) | |
| 8628 | (when (and (org-invisible-p) visp) | |
| 8629 | (save-excursion (outline-show-heading))) | |
| 8630 | ;; Shift if necessary | |
| 8631 | (unless (= shift 0) | |
| 8632 | (save-restriction | |
| 8633 | (narrow-to-region beg end) | |
| 8634 | (while (not (= shift 0)) | |
| 8635 | (org-map-region func (point-min) (point-max)) | |
| 8636 | (setq shift (+ delta shift))) | |
| 8637 | (goto-char (point-min)) | |
| 8638 | (setq newend (point-max)))) | |
| 8639 | (when (or (called-interactively-p 'interactive) for-yank) | |
| 8640 | (message "Clipboard pasted as level %d subtree" new-level)) | |
| 8641 | (when (and (not for-yank) ; in this case, org-yank will decide about folding | |
| 8642 | kill-ring | |
| 8643 | (eq org-subtree-clip (current-kill 0)) | |
| 8644 | org-subtree-clip-folded) | |
| 8645 | ;; The tree was folded before it was killed/copied | |
| 8646 | (outline-hide-subtree)) | |
| 8647 | (and for-yank (goto-char newend)) | |
| 8648 | (and remove (setq kill-ring (cdr kill-ring)))))) | |
| 8649 | ||
| 8650 | (defun org-kill-is-subtree-p (&optional txt) | |
| 8651 | "Check if the current kill is an outline subtree, or a set of trees. | |
| 8652 | Returns nil if kill does not start with a headline, or if the first | |
| 8653 | headline level is not the largest headline level in the tree. | |
| 8654 | So this will actually accept several entries of equal levels as well, | |
| 8655 | which is OK for `org-paste-subtree'. | |
| 8656 | If optional TXT is given, check this string instead of the current kill." | |
| 8657 | (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) | |
| 8658 | (re (org-get-limited-outline-regexp)) | |
| 8659 | (^re (concat "^" re)) | |
| 8660 | (start-level (and kill | |
| 8661 | (string-match | |
| 8662 | (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)") | |
| 8663 | kill) | |
| 8664 | (- (match-end 2) (match-beginning 2) 1))) | |
| 8665 | (start (1+ (or (match-beginning 2) -1)))) | |
| 8666 | (if (not start-level) | |
| 8667 | (progn | |
| 8668 | nil) ;; does not even start with a heading | |
| 8669 | (catch 'exit | |
| 8670 | (while (setq start (string-match ^re kill (1+ start))) | |
| 8671 | (when (< (- (match-end 0) (match-beginning 0) 1) start-level) | |
| 8672 | (throw 'exit nil))) | |
| 8673 | t)))) | |
| 8674 | ||
| 8675 | (defvar org-markers-to-move nil | |
| 8676 | "Markers that should be moved with a cut-and-paste operation. | |
| 8677 | Those markers are stored together with their positions relative to | |
| 8678 | the start of the region.") | |
| 8679 | ||
| 8680 | (defun org-save-markers-in-region (beg end) | |
| 8681 | "Check markers in region. | |
| 8682 | If these markers are between BEG and END, record their position relative | |
| 8683 | to BEG, so that after moving the block of text, we can put the markers back | |
| 8684 | into place. | |
| 8685 | This function gets called just before an entry or tree gets cut from the | |
| 8686 | buffer. After re-insertion, `org-reinstall-markers-in-region' must be | |
| 8687 | called immediately, to move the markers with the entries." | |
| 8688 | (setq org-markers-to-move nil) | |
| 8689 | (when (featurep 'org-clock) | |
| 8690 | (org-clock-save-markers-for-cut-and-paste beg end)) | |
| 8691 | (when (featurep 'org-agenda) | |
| 8692 | (org-agenda-save-markers-for-cut-and-paste beg end))) | |
| 8693 | ||
| 8694 | (defun org-check-and-save-marker (marker beg end) | |
| 8695 | "Check if MARKER is between BEG and END. | |
| 8696 | If yes, remember the marker and the distance to BEG." | |
| 8697 | (when (and (marker-buffer marker) | |
| 8698 | (equal (marker-buffer marker) (current-buffer)) | |
| 8699 | (>= marker beg) (< marker end)) | |
| 8700 | (push (cons marker (- marker beg)) org-markers-to-move))) | |
| 8701 | ||
| 8702 | (defun org-reinstall-markers-in-region (beg) | |
| 8703 | "Move all remembered markers to their position relative to BEG." | |
| 8704 | (dolist (x org-markers-to-move) | |
| 8705 | (move-marker (car x) (+ beg (cdr x)))) | |
| 8706 | (setq org-markers-to-move nil)) | |
| 8707 | ||
| 8708 | (defun org-narrow-to-subtree () | |
| 8709 | "Narrow buffer to the current subtree." | |
| 8710 | (interactive) | |
| 8711 | (save-excursion | |
| 8712 | (save-match-data | |
| 8713 | (org-with-limited-levels | |
| 8714 | (narrow-to-region | |
| 8715 | (progn (org-back-to-heading t) (point)) | |
| 8716 | (progn (org-end-of-subtree t t) | |
| 8717 | (when (and (org-at-heading-p) (not (eobp))) (backward-char 1)) | |
| 8718 | (point))))))) | |
| 8719 | ||
| 8720 | (defun org-narrow-to-block () | |
| 8721 | "Narrow buffer to the current block." | |
| 8722 | (interactive) | |
| 8723 | (let* ((case-fold-search t) | |
| 8724 | (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*" | |
| 8725 | "^[ \t]*#\\+end_.*"))) | |
| 8726 | (if blockp | |
| 8727 | (narrow-to-region (car blockp) (cdr blockp)) | |
| 8728 | (user-error "Not in a block")))) | |
| 8729 | ||
| 8730 | (defun org-clone-subtree-with-time-shift (n &optional shift) | |
| 8731 | "Clone the task (subtree) at point N times. | |
| 8732 | The clones will be inserted as siblings. | |
| 8733 | ||
| 8734 | In interactive use, the user will be prompted for the number of | |
| 8735 | clones to be produced. If the entry has a timestamp, the user | |
| 8736 | will also be prompted for a time shift, which may be a repeater | |
| 8737 | as used in time stamps, for example `+3d'. To disable this, | |
| 8738 | you can call the function with a universal prefix argument. | |
| 8739 | ||
| 8740 | When a valid repeater is given and the entry contains any time | |
| 8741 | stamps, the clones will become a sequence in time, with time | |
| 8742 | stamps in the subtree shifted for each clone produced. If SHIFT | |
| 8743 | is nil or the empty string, time stamps will be left alone. The | |
| 8744 | ID property of the original subtree is removed. | |
| 8745 | ||
| 8746 | In each clone, all the CLOCK entries will be removed. This | |
| 8747 | prevents Org from considering that the clocked times overlap. | |
| 8748 | ||
| 8749 | If the original subtree did contain time stamps with a repeater, | |
| 8750 | the following will happen: | |
| 8751 | - the repeater will be removed in each clone | |
| 8752 | - an additional clone will be produced, with the current, unshifted | |
| 8753 | date(s) in the entry. | |
| 8754 | - the original entry will be placed *after* all the clones, with | |
| 8755 | repeater intact. | |
| 8756 | - the start days in the repeater in the original entry will be shifted | |
| 8757 | to past the last clone. | |
| 8758 | In this way you can spell out a number of instances of a repeating task, | |
| 8759 | and still retain the repeater to cover future instances of the task. | |
| 8760 | ||
| 8761 | As described above, N+1 clones are produced when the original | |
| 8762 | subtree has a repeater. Setting N to 0, then, can be used to | |
| 8763 | remove the repeater from a subtree and create a shifted clone | |
| 8764 | with the original repeater." | |
| 8765 | (interactive "nNumber of clones to produce: ") | |
| 8766 | (unless (wholenump n) (user-error "Invalid number of replications %s" n)) | |
| 8767 | (when (org-before-first-heading-p) (user-error "No subtree to clone")) | |
| 8768 | (let* ((beg (save-excursion (org-back-to-heading t) (point))) | |
| 8769 | (end-of-tree (save-excursion (org-end-of-subtree t t) (point))) | |
| 8770 | (shift | |
| 8771 | (or shift | |
| 8772 | (if (and (not (equal current-prefix-arg '(4))) | |
| 8773 | (save-excursion | |
| 8774 | (goto-char beg) | |
| 8775 | (re-search-forward org-ts-regexp-both end-of-tree t))) | |
| 8776 | (read-from-minibuffer | |
| 8777 | "Date shift per clone (e.g. +1w, empty to copy unchanged): ") | |
| 8778 | ""))) ;No time shift | |
| 8779 | (doshift | |
| 8780 | (and (org-string-nw-p shift) | |
| 8781 | (or (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'" | |
| 8782 | shift) | |
| 8783 | (user-error "Invalid shift specification %s" shift))))) | |
| 8784 | (goto-char end-of-tree) | |
| 8785 | (unless (bolp) (insert "\n")) | |
| 8786 | (let* ((end (point)) | |
| 8787 | (template (buffer-substring beg end)) | |
| 8788 | (shift-n (and doshift (string-to-number (match-string 1 shift)))) | |
| 8789 | (shift-what (pcase (and doshift (match-string 2 shift)) | |
| 8790 | (`nil nil) | |
| 8791 | ("d" 'day) | |
| 8792 | ("w" (setq shift-n (* 7 shift-n)) 'day) | |
| 8793 | ("m" 'month) | |
| 8794 | ("y" 'year) | |
| 8795 | (_ (error "Unsupported time unit")))) | |
| 8796 | (nmin 1) | |
| 8797 | (nmax n) | |
| 8798 | (n-no-remove -1) | |
| 8799 | (idprop (org-entry-get nil "ID"))) | |
| 8800 | (when (and doshift | |
| 8801 | (string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" | |
| 8802 | template)) | |
| 8803 | (delete-region beg end) | |
| 8804 | (setq end beg) | |
| 8805 | (setq nmin 0) | |
| 8806 | (setq nmax (1+ nmax)) | |
| 8807 | (setq n-no-remove nmax)) | |
| 8808 | (goto-char end) | |
| 8809 | (cl-loop for n from nmin to nmax do | |
| 8810 | (insert | |
| 8811 | ;; Prepare clone. | |
| 8812 | (with-temp-buffer | |
| 8813 | (insert template) | |
| 8814 | (org-mode) | |
| 8815 | (goto-char (point-min)) | |
| 8816 | (org-show-subtree) | |
| 8817 | (and idprop (if org-clone-delete-id | |
| 8818 | (org-entry-delete nil "ID") | |
| 8819 | (org-id-get-create t))) | |
| 8820 | (unless (= n 0) | |
| 8821 | (while (re-search-forward org-clock-line-re nil t) | |
| 8822 | (delete-region (line-beginning-position) | |
| 8823 | (line-beginning-position 2))) | |
| 8824 | (goto-char (point-min)) | |
| 8825 | (while (re-search-forward org-drawer-regexp nil t) | |
| 8826 | (org-remove-empty-drawer-at (point)))) | |
| 8827 | (goto-char (point-min)) | |
| 8828 | (when doshift | |
| 8829 | (while (re-search-forward org-ts-regexp-both nil t) | |
| 8830 | (org-timestamp-change (* n shift-n) shift-what)) | |
| 8831 | (unless (= n n-no-remove) | |
| 8832 | (goto-char (point-min)) | |
| 8833 | (while (re-search-forward org-ts-regexp nil t) | |
| 8834 | (save-excursion | |
| 8835 | (goto-char (match-beginning 0)) | |
| 8836 | (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") | |
| 8837 | (delete-region (match-beginning 1) (match-end 1))))))) | |
| 8838 | (buffer-string))))) | |
| 8839 | (goto-char beg))) | |
| 8840 | ||
| 8841 | ;;; Outline Sorting | |
| 8842 | ||
| 8843 | (defun org-sort (&optional with-case) | |
| 8844 | "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'. | |
| 8845 | Optional argument WITH-CASE means sort case-sensitively." | |
| 8846 | (interactive "P") | |
| 8847 | (org-call-with-arg | |
| 8848 | (cond ((org-at-table-p) #'org-table-sort-lines) | |
| 8849 | ((org-at-item-p) #'org-sort-list) | |
| 8850 | (t #'org-sort-entries)) | |
| 8851 | with-case)) | |
| 8852 | ||
| 8853 | (defun org-sort-remove-invisible (s) | |
| 8854 | "Remove invisible part of links and emphasis markers from string S." | |
| 8855 | (remove-text-properties 0 (length s) org-rm-props s) | |
| 8856 | (replace-regexp-in-string | |
| 8857 | org-verbatim-re (lambda (m) (format "%s " (match-string 4 m))) | |
| 8858 | (replace-regexp-in-string | |
| 8859 | org-emph-re (lambda (m) (format " %s " (match-string 4 m))) | |
| 8860 | (org-link-display-format s) | |
| 8861 | t t) t t)) | |
| 8862 | ||
| 8863 | (defvar org-priority-regexp) ; defined later in the file | |
| 8864 | ||
| 8865 | (defvar org-after-sorting-entries-or-items-hook nil | |
| 8866 | "Hook that is run after a bunch of entries or items have been sorted. | |
| 8867 | When children are sorted, the cursor is in the parent line when this | |
| 8868 | hook gets called. When a region or a plain list is sorted, the cursor | |
| 8869 | will be in the first entry of the sorted region/list.") | |
| 8870 | ||
| 8871 | (defun org-sort-entries | |
| 8872 | (&optional with-case sorting-type getkey-func compare-func property | |
| 8873 | interactive?) | |
| 8874 | "Sort entries on a certain level of an outline tree. | |
| 8875 | If there is an active region, the entries in the region are sorted. | |
| 8876 | Else, if the cursor is before the first entry, sort the top-level items. | |
| 8877 | Else, the children of the entry at point are sorted. | |
| 8878 | ||
| 8879 | Sorting can be alphabetically, numerically, by date/time as given by | |
| 8880 | a time stamp, by a property, by priority order, or by a custom function. | |
| 8881 | ||
| 8882 | The command prompts for the sorting type unless it has been given to the | |
| 8883 | function through the SORTING-TYPE argument, which needs to be a character, | |
| 8884 | \(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F ?k ?K). Here is | |
| 8885 | the precise meaning of each character: | |
| 8886 | ||
| 8887 | a Alphabetically, ignoring the TODO keyword and the priority, if any. | |
| 8888 | c By creation time, which is assumed to be the first inactive time stamp | |
| 8889 | at the beginning of a line. | |
| 8890 | d By deadline date/time. | |
| 8891 | k By clocking time. | |
| 8892 | n Numerically, by converting the beginning of the entry/item to a number. | |
| 8893 | o By order of TODO keywords. | |
| 8894 | p By priority according to the cookie. | |
| 8895 | r By the value of a property. | |
| 8896 | s By scheduled date/time. | |
| 8897 | t By date/time, either the first active time stamp in the entry, or, if | |
| 8898 | none exist, by the first inactive one. | |
| 8899 | ||
| 8900 | Capital letters will reverse the sort order. | |
| 8901 | ||
| 8902 | If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be | |
| 8903 | called with point at the beginning of the record. It must return a | |
| 8904 | value that is compatible with COMPARE-FUNC, the function used to | |
| 8905 | compare entries. | |
| 8906 | ||
| 8907 | Comparing entries ignores case by default. However, with an optional argument | |
| 8908 | WITH-CASE, the sorting considers case as well. | |
| 8909 | ||
| 8910 | Sorting is done against the visible part of the headlines, it ignores hidden | |
| 8911 | links. | |
| 8912 | ||
| 8913 | When sorting is done, call `org-after-sorting-entries-or-items-hook'. | |
| 8914 | ||
| 8915 | A non-nil value for INTERACTIVE? is used to signal that this | |
| 8916 | function is being called interactively." | |
| 8917 | (interactive (list current-prefix-arg nil nil nil nil t)) | |
| 8918 | (let ((case-func (if with-case 'identity 'downcase)) | |
| 8919 | start beg end stars re re2 | |
| 8920 | txt what tmp) | |
| 8921 | ;; Find beginning and end of region to sort | |
| 8922 | (cond | |
| 8923 | ((org-region-active-p) | |
| 8924 | ;; we will sort the region | |
| 8925 | (setq end (region-end) | |
| 8926 | what "region") | |
| 8927 | (goto-char (region-beginning)) | |
| 8928 | (unless (org-at-heading-p) (outline-next-heading)) | |
| 8929 | (setq start (point))) | |
| 8930 | ((or (org-at-heading-p) | |
| 8931 | (ignore-errors (progn (org-back-to-heading) t))) | |
| 8932 | ;; we will sort the children of the current headline | |
| 8933 | (org-back-to-heading) | |
| 8934 | (setq start (point) | |
| 8935 | end (progn (org-end-of-subtree t t) | |
| 8936 | (or (bolp) (insert "\n")) | |
| 8937 | (when (>= (org-back-over-empty-lines) 1) | |
| 8938 | (forward-line 1)) | |
| 8939 | (point)) | |
| 8940 | what "children") | |
| 8941 | (goto-char start) | |
| 8942 | (outline-show-subtree) | |
| 8943 | (outline-next-heading)) | |
| 8944 | (t | |
| 8945 | ;; we will sort the top-level entries in this file | |
| 8946 | (goto-char (point-min)) | |
| 8947 | (or (org-at-heading-p) (outline-next-heading)) | |
| 8948 | (setq start (point)) | |
| 8949 | (goto-char (point-max)) | |
| 8950 | (beginning-of-line 1) | |
| 8951 | (when (looking-at ".*?\\S-") | |
| 8952 | ;; File ends in a non-white line | |
| 8953 | (end-of-line 1) | |
| 8954 | (insert "\n")) | |
| 8955 | (setq end (point-max)) | |
| 8956 | (setq what "top-level") | |
| 8957 | (goto-char start) | |
| 8958 | (outline-show-all))) | |
| 8959 | ||
| 8960 | (setq beg (point)) | |
| 8961 | (when (>= beg end) (goto-char start) (user-error "Nothing to sort")) | |
| 8962 | ||
| 8963 | (looking-at "\\(\\*+\\)") | |
| 8964 | (setq stars (match-string 1) | |
| 8965 | re (concat "^" (regexp-quote stars) " +") | |
| 8966 | re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]") | |
| 8967 | txt (buffer-substring beg end)) | |
| 8968 | (unless (equal (substring txt -1) "\n") (setq txt (concat txt "\n"))) | |
| 8969 | (when (and (not (equal stars "*")) (string-match re2 txt)) | |
| 8970 | (user-error "Region to sort contains a level above the first entry")) | |
| 8971 | ||
| 8972 | (unless sorting-type | |
| 8973 | (message | |
| 8974 | "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc | |
| 8975 | [t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing | |
| 8976 | A/N/P/R/O/F/T/S/D/C/K means reversed:" | |
| 8977 | what) | |
| 8978 | (setq sorting-type (read-char-exclusive))) | |
| 8979 | ||
| 8980 | (unless getkey-func | |
| 8981 | (and (= (downcase sorting-type) ?f) | |
| 8982 | (setq getkey-func | |
| 8983 | (or (and interactive? | |
| 8984 | (org-read-function | |
| 8985 | "Function for extracting keys: ")) | |
| 8986 | (error "Missing key extractor"))))) | |
| 8987 | ||
| 8988 | (and (= (downcase sorting-type) ?r) | |
| 8989 | (not property) | |
| 8990 | (setq property | |
| 8991 | (completing-read "Property: " | |
| 8992 | (mapcar #'list (org-buffer-property-keys t)) | |
| 8993 | nil t))) | |
| 8994 | ||
| 8995 | (when (member sorting-type '(?k ?K)) (org-clock-sum)) | |
| 8996 | (message "Sorting entries...") | |
| 8997 | ||
| 8998 | (save-restriction | |
| 8999 | (narrow-to-region start end) | |
| 9000 | (let ((restore-clock? | |
| 9001 | ;; The clock marker is lost when using `sort-subr'; mark | |
| 9002 | ;; the clock with temporary `:org-clock-marker-backup' | |
| 9003 | ;; text property. | |
| 9004 | (when (and (eq (org-clock-is-active) (current-buffer)) | |
| 9005 | (<= start (marker-position org-clock-marker)) | |
| 9006 | (>= end (marker-position org-clock-marker))) | |
| 9007 | (org-with-silent-modifications | |
| 9008 | (put-text-property (1- org-clock-marker) org-clock-marker | |
| 9009 | :org-clock-marker-backup t)) | |
| 9010 | t)) | |
| 9011 | (dcst (downcase sorting-type)) | |
| 9012 | (case-fold-search nil) | |
| 9013 | (now (current-time))) | |
| 9014 | (sort-subr | |
| 9015 | (/= dcst sorting-type) | |
| 9016 | ;; This function moves to the beginning character of the "record" to | |
| 9017 | ;; be sorted. | |
| 9018 | (lambda nil | |
| 9019 | (if (re-search-forward re nil t) | |
| 9020 | (goto-char (match-beginning 0)) | |
| 9021 | (goto-char (point-max)))) | |
| 9022 | ;; This function moves to the last character of the "record" being | |
| 9023 | ;; sorted. | |
| 9024 | (lambda nil | |
| 9025 | (save-match-data | |
| 9026 | (condition-case nil | |
| 9027 | (outline-forward-same-level 1) | |
| 9028 | (error | |
| 9029 | (goto-char (point-max)))))) | |
| 9030 | ;; This function returns the value that gets sorted against. | |
| 9031 | (lambda nil | |
| 9032 | (cond | |
| 9033 | ((= dcst ?n) | |
| 9034 | (if (looking-at org-complex-heading-regexp) | |
| 9035 | (string-to-number (org-sort-remove-invisible (match-string 4))) | |
| 9036 | nil)) | |
| 9037 | ((= dcst ?a) | |
| 9038 | (if (looking-at org-complex-heading-regexp) | |
| 9039 | (funcall case-func (org-sort-remove-invisible (match-string 4))) | |
| 9040 | nil)) | |
| 9041 | ((= dcst ?k) | |
| 9042 | (or (get-text-property (point) :org-clock-minutes) 0)) | |
| 9043 | ((= dcst ?t) | |
| 9044 | (let ((end (save-excursion (outline-next-heading) (point)))) | |
| 9045 | (if (or (re-search-forward org-ts-regexp end t) | |
| 9046 | (re-search-forward org-ts-regexp-both end t)) | |
| 9047 | (org-time-string-to-seconds (match-string 0)) | |
| 9048 | (float-time now)))) | |
| 9049 | ((= dcst ?c) | |
| 9050 | (let ((end (save-excursion (outline-next-heading) (point)))) | |
| 9051 | (if (re-search-forward | |
| 9052 | (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") | |
| 9053 | end t) | |
| 9054 | (org-time-string-to-seconds (match-string 0)) | |
| 9055 | (float-time now)))) | |
| 9056 | ((= dcst ?s) | |
| 9057 | (let ((end (save-excursion (outline-next-heading) (point)))) | |
| 9058 | (if (re-search-forward org-scheduled-time-regexp end t) | |
| 9059 | (org-time-string-to-seconds (match-string 1)) | |
| 9060 | (float-time now)))) | |
| 9061 | ((= dcst ?d) | |
| 9062 | (let ((end (save-excursion (outline-next-heading) (point)))) | |
| 9063 | (if (re-search-forward org-deadline-time-regexp end t) | |
| 9064 | (org-time-string-to-seconds (match-string 1)) | |
| 9065 | (float-time now)))) | |
| 9066 | ((= dcst ?p) | |
| 9067 | (if (re-search-forward org-priority-regexp (point-at-eol) t) | |
| 9068 | (string-to-char (match-string 2)) | |
| 9069 | org-default-priority)) | |
| 9070 | ((= dcst ?r) | |
| 9071 | (or (org-entry-get nil property) "")) | |
| 9072 | ((= dcst ?o) | |
| 9073 | (when (looking-at org-complex-heading-regexp) | |
| 9074 | (let* ((m (match-string 2)) | |
| 9075 | (s (if (member m org-done-keywords) '- '+))) | |
| 9076 | (- 99 (funcall s (length (member m org-todo-keywords-1))))))) | |
| 9077 | ((= dcst ?f) | |
| 9078 | (if getkey-func | |
| 9079 | (progn | |
| 9080 | (setq tmp (funcall getkey-func)) | |
| 9081 | (when (stringp tmp) (setq tmp (funcall case-func tmp))) | |
| 9082 | tmp) | |
| 9083 | (error "Invalid key function `%s'" getkey-func))) | |
| 9084 | (t (error "Invalid sorting type `%c'" sorting-type)))) | |
| 9085 | nil | |
| 9086 | (cond | |
| 9087 | ((= dcst ?a) 'string<) | |
| 9088 | ((= dcst ?f) | |
| 9089 | (or compare-func | |
| 9090 | (and interactive? | |
| 9091 | (org-read-function | |
| 9092 | (concat "Function for comparing keys " | |
| 9093 | "(empty for default `sort-subr' predicate): ") | |
| 9094 | 'allow-empty)))) | |
| 9095 | ((member dcst '(?p ?t ?s ?d ?c ?k)) '<))) | |
| 9096 | (when restore-clock? | |
| 9097 | (move-marker org-clock-marker | |
| 9098 | (1+ (next-single-property-change | |
| 9099 | start :org-clock-marker-backup))) | |
| 9100 | (remove-text-properties (1- org-clock-marker) org-clock-marker | |
| 9101 | '(:org-clock-marker-backup t))))) | |
| 9102 | (run-hooks 'org-after-sorting-entries-or-items-hook) | |
| 9103 | (message "Sorting entries...done"))) | |
| 9104 | ||
| 9105 | ;;; The orgstruct minor mode | |
| 9106 | ||
| 9107 | ;; Define a minor mode which can be used in other modes in order to | |
| 9108 | ;; integrate the Org mode structure editing commands. | |
| 9109 | ||
| 9110 | ;; This is really a hack, because the Org mode structure commands use | |
| 9111 | ;; keys which normally belong to the major mode. Here is how it | |
| 9112 | ;; works: The minor mode defines all the keys necessary to operate the | |
| 9113 | ;; structure commands, but wraps the commands into a function which | |
| 9114 | ;; tests if the cursor is currently at a headline or a plain list | |
| 9115 | ;; item. If that is the case, the structure command is used, | |
| 9116 | ;; temporarily setting many Org mode variables like regular | |
| 9117 | ;; expressions for filling etc. However, when any of those keys is | |
| 9118 | ;; used at a different location, function uses `key-binding' to look | |
| 9119 | ;; up if the key has an associated command in another currently active | |
| 9120 | ;; keymap (minor modes, major mode, global), and executes that | |
| 9121 | ;; command. There might be problems if any of the keys is otherwise | |
| 9122 | ;; used as a prefix key. | |
| 9123 | ||
| 9124 | (defcustom orgstruct-heading-prefix-regexp "" | |
| 9125 | "Regexp that matches the custom prefix of Org headlines in | |
| 9126 | orgstruct(++)-mode." | |
| 9127 | :group 'org | |
| 9128 | :version "26.1" | |
| 9129 | :package-version '(Org . "8.3") | |
| 9130 | :type 'regexp) | |
| 9131 | ;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) | |
| 9132 | ||
| 9133 | (defcustom orgstruct-setup-hook nil | |
| 9134 | "Hook run after orgstruct-mode-map is filled." | |
| 9135 | :group 'org | |
| 9136 | :version "24.4" | |
| 9137 | :package-version '(Org . "8.0") | |
| 9138 | :type 'hook) | |
| 9139 | ||
| 9140 | (defvar orgstruct-initialized nil) | |
| 9141 | ||
| 9142 | (defvar org-local-vars nil | |
| 9143 | "List of local variables, for use by `orgstruct-mode'.") | |
| 9144 | ||
| 9145 | ;;;###autoload | |
| 9146 | (define-minor-mode orgstruct-mode | |
| 9147 | "Toggle the minor mode `orgstruct-mode'. | |
| 9148 | This mode is for using Org mode structure commands in other | |
| 9149 | modes. The following keys behave as if Org mode were active, if | |
| 9150 | the cursor is on a headline, or on a plain list item (both as | |
| 9151 | defined by Org mode)." | |
| 9152 | nil " OrgStruct" (make-sparse-keymap) | |
| 9153 | (funcall (if orgstruct-mode | |
| 9154 | 'add-to-invisibility-spec | |
| 9155 | 'remove-from-invisibility-spec) | |
| 9156 | '(outline . t)) | |
| 9157 | (when orgstruct-mode | |
| 9158 | (org-load-modules-maybe) | |
| 9159 | (unless orgstruct-initialized | |
| 9160 | (orgstruct-setup) | |
| 9161 | (setq orgstruct-initialized t)))) | |
| 9162 | ||
| 9163 | ;;;###autoload | |
| 9164 | (defun turn-on-orgstruct () | |
| 9165 | "Unconditionally turn on `orgstruct-mode'." | |
| 9166 | (orgstruct-mode 1)) | |
| 9167 | ||
| 9168 | (defvar-local orgstruct-is-++ nil | |
| 9169 | "Is `orgstruct-mode' in ++ version in the current-buffer?") | |
| 9170 | (defvar-local org-fb-vars nil) | |
| 9171 | (defun orgstruct++-mode (&optional arg) | |
| 9172 | "Toggle `orgstruct-mode', the enhanced version of it. | |
| 9173 | In addition to setting orgstruct-mode, this also exports all | |
| 9174 | indentation and autofilling variables from Org mode into the | |
| 9175 | buffer. It will also recognize item context in multiline items." | |
| 9176 | (interactive "P") | |
| 9177 | (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) | |
| 9178 | (if (< arg 1) | |
| 9179 | (progn (orgstruct-mode -1) | |
| 9180 | (dolist (v org-fb-vars) | |
| 9181 | (set (make-local-variable (car v)) | |
| 9182 | (if (eq (car-safe (cadr v)) 'quote) | |
| 9183 | (cl-cadadr v) | |
| 9184 | (nth 1 v))))) | |
| 9185 | (orgstruct-mode 1) | |
| 9186 | (setq org-fb-vars nil) | |
| 9187 | (unless org-local-vars | |
| 9188 | (setq org-local-vars (org-get-local-variables))) | |
| 9189 | (let (var val) | |
| 9190 | (dolist (x org-local-vars) | |
| 9191 | (when (string-match | |
| 9192 | "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\ | |
| 9193 | \\|fill-prefix\\|indent-\\)" | |
| 9194 | (symbol-name (car x))) | |
| 9195 | (setq var (car x) val (nth 1 x)) | |
| 9196 | (push (list var `(quote ,(eval var))) org-fb-vars) | |
| 9197 | (set (make-local-variable var) | |
| 9198 | (if (eq (car-safe val) 'quote) (nth 1 val) val)))) | |
| 9199 | (setq-local orgstruct-is-++ t)))) | |
| 9200 | ||
| 9201 | ;;;###autoload | |
| 9202 | (defun turn-on-orgstruct++ () | |
| 9203 | "Unconditionally turn on `orgstruct++-mode'." | |
| 9204 | (orgstruct++-mode 1)) | |
| 9205 | ||
| 9206 | (defun orgstruct-error () | |
| 9207 | "Error when there is no default binding for a structure key." | |
| 9208 | (interactive) | |
| 9209 | (funcall (if (fboundp 'user-error) | |
| 9210 | 'user-error | |
| 9211 | 'error) | |
| 9212 | "This key has no function outside structure elements")) | |
| 9213 | ||
| 9214 | (defun orgstruct-setup () | |
| 9215 | "Setup orgstruct keymap." | |
| 9216 | (dolist (cell '((org-demote . t) | |
| 9217 | (org-metaleft . t) | |
| 9218 | (org-metaright . t) | |
| 9219 | (org-promote . t) | |
| 9220 | (org-shiftmetaleft . t) | |
| 9221 | (org-shiftmetaright . t) | |
| 9222 | org-backward-element | |
| 9223 | org-backward-heading-same-level | |
| 9224 | org-ctrl-c-ret | |
| 9225 | org-ctrl-c-minus | |
| 9226 | org-ctrl-c-star | |
| 9227 | org-cycle | |
| 9228 | org-force-cycle-archived | |
| 9229 | org-forward-heading-same-level | |
| 9230 | org-insert-heading | |
| 9231 | org-insert-heading-respect-content | |
| 9232 | org-kill-note-or-show-branches | |
| 9233 | org-mark-subtree | |
| 9234 | org-meta-return | |
| 9235 | org-metadown | |
| 9236 | org-metaup | |
| 9237 | org-narrow-to-subtree | |
| 9238 | org-promote-subtree | |
| 9239 | org-reveal | |
| 9240 | org-shiftdown | |
| 9241 | org-shiftleft | |
| 9242 | org-shiftmetadown | |
| 9243 | org-shiftmetaup | |
| 9244 | org-shiftright | |
| 9245 | org-shifttab | |
| 9246 | org-shifttab | |
| 9247 | org-shiftup | |
| 9248 | org-show-children | |
| 9249 | org-show-subtree | |
| 9250 | org-sort | |
| 9251 | org-up-element | |
| 9252 | outline-demote | |
| 9253 | outline-next-visible-heading | |
| 9254 | outline-previous-visible-heading | |
| 9255 | outline-promote | |
| 9256 | outline-up-heading)) | |
| 9257 | (let ((f (or (car-safe cell) cell)) | |
| 9258 | (disable-when-heading-prefix (cdr-safe cell))) | |
| 9259 | (when (fboundp f) | |
| 9260 | (let ((new-bindings)) | |
| 9261 | (dolist (binding (nconc (where-is-internal f org-mode-map) | |
| 9262 | (where-is-internal f outline-mode-map))) | |
| 9263 | (push binding new-bindings) | |
| 9264 | ;; TODO use local-function-key-map | |
| 9265 | (dolist (rep '(("<tab>" . "TAB") | |
| 9266 | ("<return>" . "RET") | |
| 9267 | ("<escape>" . "ESC") | |
| 9268 | ("<delete>" . "DEL"))) | |
| 9269 | (setq binding (read-kbd-macro | |
| 9270 | (let ((case-fold-search)) | |
| 9271 | (replace-regexp-in-string | |
| 9272 | (regexp-quote (cdr rep)) | |
| 9273 | (car rep) | |
| 9274 | (key-description binding))))) | |
| 9275 | (cl-pushnew binding new-bindings :test 'equal))) | |
| 9276 | (dolist (binding new-bindings) | |
| 9277 | (let ((key (lookup-key orgstruct-mode-map binding))) | |
| 9278 | (when (or (not key) (numberp key)) | |
| 9279 | (ignore-errors | |
| 9280 | (org-defkey orgstruct-mode-map | |
| 9281 | binding | |
| 9282 | (orgstruct-make-binding | |
| 9283 | f binding disable-when-heading-prefix)))))))))) | |
| 9284 | (run-hooks 'orgstruct-setup-hook)) | |
| 9285 | ||
| 9286 | (defun orgstruct-make-binding (fun key disable-when-heading-prefix) | |
| 9287 | "Create a function for binding in the structure minor mode. | |
| 9288 | FUN is the command to call inside a table. KEY is the key that | |
| 9289 | should be checked in for a command to execute outside of tables. | |
| 9290 | Non-nil `disable-when-heading-prefix' means to disable the command | |
| 9291 | if `orgstruct-heading-prefix-regexp' is not empty." | |
| 9292 | (let ((name (concat "orgstruct-hijacker-" (symbol-name fun)))) | |
| 9293 | (let ((nname name) | |
| 9294 | (i 0)) | |
| 9295 | (while (fboundp (intern nname)) | |
| 9296 | (setq nname (format "%s-%d" name (setq i (1+ i))))) | |
| 9297 | (setq name (intern nname))) | |
| 9298 | (eval | |
| 9299 | (let ((bindings '((org-heading-regexp | |
| 9300 | (concat "^" | |
| 9301 | orgstruct-heading-prefix-regexp | |
| 9302 | "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$")) | |
| 9303 | (org-outline-regexp | |
| 9304 | (concat orgstruct-heading-prefix-regexp "\\*+ ")) | |
| 9305 | (org-outline-regexp-bol | |
| 9306 | (concat "^" org-outline-regexp)) | |
| 9307 | (outline-regexp org-outline-regexp) | |
| 9308 | (outline-heading-end-regexp "\n") | |
| 9309 | (outline-level 'org-outline-level) | |
| 9310 | (outline-heading-alist)))) | |
| 9311 | `(defun ,name (arg) | |
| 9312 | ,(concat "In Structure, run `" (symbol-name fun) "'.\n" | |
| 9313 | "Outside of structure, run the binding of `" | |
| 9314 | (key-description key) "'." | |
| 9315 | (when disable-when-heading-prefix | |
| 9316 | (concat | |
| 9317 | "\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n" | |
| 9318 | "back to the default binding due to limitations of Org's implementation of\n" | |
| 9319 | "`" (symbol-name fun) "'."))) | |
| 9320 | (interactive "p") | |
| 9321 | (let* ((disable | |
| 9322 | ,(and disable-when-heading-prefix | |
| 9323 | '(not (string= orgstruct-heading-prefix-regexp "")))) | |
| 9324 | (fallback | |
| 9325 | (or disable | |
| 9326 | (not | |
| 9327 | (let* ,bindings | |
| 9328 | (org-context-p 'headline 'item | |
| 9329 | ,(when (memq fun | |
| 9330 | '(org-insert-heading | |
| 9331 | org-insert-heading-respect-content | |
| 9332 | org-meta-return)) | |
| 9333 | '(when orgstruct-is-++ | |
| 9334 | 'item-body)))))))) | |
| 9335 | (if fallback | |
| 9336 | (let* ((orgstruct-mode) | |
| 9337 | (binding | |
| 9338 | (let ((key ,key)) | |
| 9339 | (catch 'exit | |
| 9340 | (dolist | |
| 9341 | (rep | |
| 9342 | '(nil | |
| 9343 | ("<\\([^>]*\\)tab>" . "\\1TAB") | |
| 9344 | ("<\\([^>]*\\)return>" . "\\1RET") | |
| 9345 | ("<\\([^>]*\\)escape>" . "\\1ESC") | |
| 9346 | ("<\\([^>]*\\)delete>" . "\\1DEL")) | |
| 9347 | nil) | |
| 9348 | (when rep | |
| 9349 | (setq key (read-kbd-macro | |
| 9350 | (let ((case-fold-search)) | |
| 9351 | (replace-regexp-in-string | |
| 9352 | (car rep) | |
| 9353 | (cdr rep) | |
| 9354 | (key-description key)))))) | |
| 9355 | (when (key-binding key) | |
| 9356 | (throw 'exit (key-binding key)))))))) | |
| 9357 | (if (keymapp binding) | |
| 9358 | (org-set-transient-map binding) | |
| 9359 | (let ((func (or binding | |
| 9360 | (unless disable | |
| 9361 | 'orgstruct-error)))) | |
| 9362 | (when func | |
| 9363 | (call-interactively func))))) | |
| 9364 | (org-run-like-in-org-mode | |
| 9365 | (lambda () | |
| 9366 | (interactive) | |
| 9367 | (let* ,bindings | |
| 9368 | (call-interactively ',fun))))))))) | |
| 9369 | name)) | |
| 9370 | ||
| 9371 | (defun org-contextualize-keys (alist contexts) | |
| 9372 | "Return valid elements in ALIST depending on CONTEXTS. | |
| 9373 | ||
| 9374 | `org-agenda-custom-commands' or `org-capture-templates' are the | |
| 9375 | values used for ALIST, and `org-agenda-custom-commands-contexts' | |
| 9376 | or `org-capture-templates-contexts' are the associated contexts | |
| 9377 | definitions." | |
| 9378 | (let ((contexts | |
| 9379 | ;; normalize contexts | |
| 9380 | (mapcar | |
| 9381 | (lambda(c) (cond ((listp (cadr c)) | |
| 9382 | (list (car c) (car c) (nth 1 c))) | |
| 9383 | ((string= "" (cadr c)) | |
| 9384 | (list (car c) (car c) (nth 2 c))) | |
| 9385 | (t c))) | |
| 9386 | contexts)) | |
| 9387 | (a alist) r s) | |
| 9388 | ;; loop over all commands or templates | |
| 9389 | (dolist (c a) | |
| 9390 | (let (vrules repl) | |
| 9391 | (cond | |
| 9392 | ((not (assoc (car c) contexts)) | |
| 9393 | (push c r)) | |
| 9394 | ((and (assoc (car c) contexts) | |
| 9395 | (setq vrules (org-contextualize-validate-key | |
| 9396 | (car c) contexts))) | |
| 9397 | (mapc (lambda (vr) | |
| 9398 | (unless (equal (car vr) (cadr vr)) | |
| 9399 | (setq repl vr))) | |
| 9400 | vrules) | |
| 9401 | (if (not repl) (push c r) | |
| 9402 | (push (cadr repl) s) | |
| 9403 | (push | |
| 9404 | (cons (car c) | |
| 9405 | (cdr (or (assoc (cadr repl) alist) | |
| 9406 | (error "Undefined key `%s' as contextual replacement for `%s'" | |
| 9407 | (cadr repl) (car c))))) | |
| 9408 | r)))))) | |
| 9409 | ;; Return limited ALIST, possibly with keys modified, and deduplicated | |
| 9410 | (delq | |
| 9411 | nil | |
| 9412 | (delete-dups | |
| 9413 | (mapcar (lambda (x) | |
| 9414 | (let ((tpl (car x))) | |
| 9415 | (unless (delq | |
| 9416 | nil | |
| 9417 | (mapcar (lambda (y) | |
| 9418 | (equal y tpl)) | |
| 9419 | s)) | |
| 9420 | x))) | |
| 9421 | (reverse r)))))) | |
| 9422 | ||
| 9423 | (defun org-contextualize-validate-key (key contexts) | |
| 9424 | "Check CONTEXTS for agenda or capture KEY." | |
| 9425 | (let (res) | |
| 9426 | (dolist (r contexts) | |
| 9427 | (dolist (rr (car (last r))) | |
| 9428 | (when | |
| 9429 | (and (equal key (car r)) | |
| 9430 | (if (functionp rr) (funcall rr) | |
| 9431 | (or (and (eq (car rr) 'in-file) | |
| 9432 | (buffer-file-name) | |
| 9433 | (string-match (cdr rr) (buffer-file-name))) | |
| 9434 | (and (eq (car rr) 'in-mode) | |
| 9435 | (string-match (cdr rr) (symbol-name major-mode))) | |
| 9436 | (and (eq (car rr) 'in-buffer) | |
| 9437 | (string-match (cdr rr) (buffer-name))) | |
| 9438 | (when (and (eq (car rr) 'not-in-file) | |
| 9439 | (buffer-file-name)) | |
| 9440 | (not (string-match (cdr rr) (buffer-file-name)))) | |
| 9441 | (when (eq (car rr) 'not-in-mode) | |
| 9442 | (not (string-match (cdr rr) (symbol-name major-mode)))) | |
| 9443 | (when (eq (car rr) 'not-in-buffer) | |
| 9444 | (not (string-match (cdr rr) (buffer-name))))))) | |
| 9445 | (push r res)))) | |
| 9446 | (delete-dups (delq nil res)))) | |
| 9447 | ||
| 9448 | (defun org-context-p (&rest contexts) | |
| 9449 | "Check if local context is any of CONTEXTS. | |
| 9450 | Possible values in the list of contexts are `table', `headline', and `item'." | |
| 9451 | (let ((pos (point))) | |
| 9452 | (goto-char (point-at-bol)) | |
| 9453 | (prog1 (or (and (memq 'table contexts) | |
| 9454 | (looking-at "[ \t]*|")) | |
| 9455 | (and (memq 'headline contexts) | |
| 9456 | (looking-at org-outline-regexp)) | |
| 9457 | (and (memq 'item contexts) | |
| 9458 | (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)")) | |
| 9459 | (and (memq 'item-body contexts) | |
| 9460 | (org-in-item-p))) | |
| 9461 | (goto-char pos)))) | |
| 9462 | ||
| 9463 | ;;;###autoload | |
| 9464 | (defun org-run-like-in-org-mode (cmd) | |
| 9465 | "Run a command, pretending that the current buffer is in Org mode. | |
| 9466 | This will temporarily bind local variables that are typically bound in | |
| 9467 | Org mode to the values they have in Org mode, and then interactively | |
| 9468 | call CMD." | |
| 9469 | (org-load-modules-maybe) | |
| 9470 | (unless org-local-vars | |
| 9471 | (setq org-local-vars (org-get-local-variables))) | |
| 9472 | (let (binds) | |
| 9473 | (dolist (var org-local-vars) | |
| 9474 | (when (or (not (boundp (car var))) | |
| 9475 | (eq (symbol-value (car var)) | |
| 9476 | (default-value (car var)))) | |
| 9477 | (push (list (car var) `(quote ,(cadr var))) binds))) | |
| 9478 | (eval `(let ,binds | |
| 9479 | (call-interactively (quote ,cmd)))))) | |
| 9480 | ||
| 9481 | (defun org-get-category (&optional pos force-refresh) | |
| 9482 | "Get the category applying to position POS." | |
| 9483 | (save-match-data | |
| 9484 | (when force-refresh (org-refresh-category-properties)) | |
| 9485 | (let ((pos (or pos (point)))) | |
| 9486 | (or (get-text-property pos 'org-category) | |
| 9487 | (progn (org-refresh-category-properties) | |
| 9488 | (get-text-property pos 'org-category)))))) | |
| 9489 | ||
| 9490 | ;;; Refresh properties | |
| 9491 | ||
| 9492 | (defun org-refresh-properties (dprop tprop) | |
| 9493 | "Refresh buffer text properties. | |
| 9494 | DPROP is the drawer property and TPROP is either the | |
| 9495 | corresponding text property to set, or an alist with each element | |
| 9496 | being a text property (as a symbol) and a function to apply to | |
| 9497 | the value of the drawer property." | |
| 9498 | (let* ((case-fold-search t) | |
| 9499 | (inhibit-read-only t) | |
| 9500 | (inherit? (org-property-inherit-p dprop)) | |
| 9501 | (property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t)) | |
| 9502 | (global (and inherit? (org--property-global-value dprop nil)))) | |
| 9503 | (org-with-silent-modifications | |
| 9504 | (org-with-point-at 1 | |
| 9505 | ;; Set global values (e.g., values defined through | |
| 9506 | ;; "#+PROPERTY:" keywords) to the whole buffer. | |
| 9507 | (when global (put-text-property (point-min) (point-max) tprop global)) | |
| 9508 | ;; Set local values. | |
| 9509 | (while (re-search-forward property-re nil t) | |
| 9510 | (when (org-at-property-p) | |
| 9511 | (org-refresh-property tprop (org-entry-get (point) dprop) inherit?)) | |
| 9512 | (outline-next-heading)))))) | |
| 9513 | ||
| 9514 | (defun org-refresh-property (tprop p &optional inherit) | |
| 9515 | "Refresh the buffer text property TPROP from the drawer property P. | |
| 9516 | The refresh happens only for the current headline, or the whole | |
| 9517 | sub-tree if optional argument INHERIT is non-nil." | |
| 9518 | (unless (org-before-first-heading-p) | |
| 9519 | (save-excursion | |
| 9520 | (org-back-to-heading t) | |
| 9521 | (let ((start (point)) | |
| 9522 | (end (save-excursion | |
| 9523 | (if inherit (org-end-of-subtree t t) | |
| 9524 | (or (outline-next-heading) (point-max)))))) | |
| 9525 | (if (symbolp tprop) | |
| 9526 | ;; TPROP is a text property symbol. | |
| 9527 | (put-text-property start end tprop p) | |
| 9528 | ;; TPROP is an alist with (property . function) elements. | |
| 9529 | (pcase-dolist (`(,prop . ,f) tprop) | |
| 9530 | (put-text-property start end prop (funcall f p)))))))) | |
| 9531 | ||
| 9532 | (defun org-refresh-category-properties () | |
| 9533 | "Refresh category text properties in the buffer." | |
| 9534 | (let ((case-fold-search t) | |
| 9535 | (inhibit-read-only t) | |
| 9536 | (default-category | |
| 9537 | (cond ((null org-category) | |
| 9538 | (if buffer-file-name | |
| 9539 | (file-name-sans-extension | |
| 9540 | (file-name-nondirectory buffer-file-name)) | |
| 9541 | "???")) | |
| 9542 | ((symbolp org-category) (symbol-name org-category)) | |
| 9543 | (t org-category)))) | |
| 9544 | (org-with-silent-modifications | |
| 9545 | (org-with-wide-buffer | |
| 9546 | ;; Set buffer-wide category. Search last #+CATEGORY keyword. | |
| 9547 | ;; This is the default category for the buffer. If none is | |
| 9548 | ;; found, fall-back to `org-category' or buffer file name. | |
| 9549 | (put-text-property | |
| 9550 | (point-min) (point-max) | |
| 9551 | 'org-category | |
| 9552 | (catch 'buffer-category | |
| 9553 | (goto-char (point-max)) | |
| 9554 | (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t) | |
| 9555 | (let ((element (org-element-at-point))) | |
| 9556 | (when (eq (org-element-type element) 'keyword) | |
| 9557 | (throw 'buffer-category | |
| 9558 | (org-element-property :value element))))) | |
| 9559 | default-category)) | |
| 9560 | ;; Set sub-tree specific categories. | |
| 9561 | (goto-char (point-min)) | |
| 9562 | (let ((regexp (org-re-property "CATEGORY"))) | |
| 9563 | (while (re-search-forward regexp nil t) | |
| 9564 | (let ((value (match-string-no-properties 3))) | |
| 9565 | (when (org-at-property-p) | |
| 9566 | (put-text-property | |
| 9567 | (save-excursion (org-back-to-heading t) (point)) | |
| 9568 | (save-excursion (org-end-of-subtree t t) (point)) | |
| 9569 | 'org-category | |
| 9570 | value))))))))) | |
| 9571 | ||
| 9572 | (defun org-refresh-stats-properties () | |
| 9573 | "Refresh stats text properties in the buffer." | |
| 9574 | (org-with-silent-modifications | |
| 9575 | (org-with-point-at 1 | |
| 9576 | (let ((regexp (concat org-outline-regexp-bol | |
| 9577 | ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]"))) | |
| 9578 | (while (re-search-forward regexp nil t) | |
| 9579 | (let* ((numerator (string-to-number (match-string 1))) | |
| 9580 | (denominator (and (match-end 2) | |
| 9581 | (string-to-number (match-string 2)))) | |
| 9582 | (stats (cond ((not denominator) numerator) ;percent | |
| 9583 | ((= denominator 0) 0) | |
| 9584 | (t (/ (* numerator 100) denominator))))) | |
| 9585 | (put-text-property (point) (progn (org-end-of-subtree t t) (point)) | |
| 9586 | 'org-stats stats))))))) | |
| 9587 | ||
| 9588 | (defun org-refresh-effort-properties () | |
| 9589 | "Refresh effort properties" | |
| 9590 | (org-refresh-properties | |
| 9591 | org-effort-property | |
| 9592 | '((effort . identity) | |
| 9593 | (effort-minutes . org-duration-to-minutes)))) | |
| 9594 | ||
| 9595 | ;;;; Link Stuff | |
| 9596 | ||
| 9597 | ;;; Link abbreviations | |
| 9598 | ||
| 9599 | (defun org-link-expand-abbrev (link) | |
| 9600 | "Apply replacements as defined in `org-link-abbrev-alist'." | |
| 9601 | (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link) | |
| 9602 | (let* ((key (match-string 1 link)) | |
| 9603 | (as (or (assoc key org-link-abbrev-alist-local) | |
| 9604 | (assoc key org-link-abbrev-alist))) | |
| 9605 | (tag (and (match-end 2) (match-string 3 link))) | |
| 9606 | rpl) | |
| 9607 | (if (not as) | |
| 9608 | link | |
| 9609 | (setq rpl (cdr as)) | |
| 9610 | (cond | |
| 9611 | ((symbolp rpl) (funcall rpl tag)) | |
| 9612 | ((string-match "%(\\([^)]+\\))" rpl) | |
| 9613 | (replace-match | |
| 9614 | (save-match-data | |
| 9615 | (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl)) | |
| 9616 | ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) | |
| 9617 | ((string-match "%h" rpl) | |
| 9618 | (replace-match (url-hexify-string (or tag "")) t t rpl)) | |
| 9619 | (t (concat rpl tag))))) | |
| 9620 | link)) | |
| 9621 | ||
| 9622 | ;;; Storing and inserting links | |
| 9623 | ||
| 9624 | (defvar org-insert-link-history nil | |
| 9625 | "Minibuffer history for links inserted with `org-insert-link'.") | |
| 9626 | ||
| 9627 | (defvar org-stored-links nil | |
| 9628 | "Contains the links stored with `org-store-link'.") | |
| 9629 | ||
| 9630 | (defvar org-store-link-plist nil | |
| 9631 | "Plist with info about the most recently link created with `org-store-link'.") | |
| 9632 | ||
| 9633 | (defun org-store-link-functions () | |
| 9634 | "Return a list of functions that are called to create and store a link. | |
| 9635 | The functions defined in the :store property of | |
| 9636 | `org-link-parameters'. | |
| 9637 | ||
| 9638 | Each function will be called in turn until one returns a non-nil | |
| 9639 | value. Each function should check if it is responsible for | |
| 9640 | creating this link (for example by looking at the major mode). | |
| 9641 | If not, it must exit and return nil. If yes, it should return | |
| 9642 | a non-nil value after calling `org-store-link-props' with a list | |
| 9643 | of properties and values. Special properties are: | |
| 9644 | ||
| 9645 | :type The link prefix, like \"http\". This must be given. | |
| 9646 | :link The link, like \"http://www.astro.uva.nl/~dominik\". | |
| 9647 | This is obligatory as well. | |
| 9648 | :description Optional default description for the second pair | |
| 9649 | of brackets in an Org mode link. The user can still change | |
| 9650 | this when inserting this link into an Org mode buffer. | |
| 9651 | ||
| 9652 | In addition to these, any additional properties can be specified | |
| 9653 | and then used in capture templates." | |
| 9654 | (cl-loop for link in org-link-parameters | |
| 9655 | with store-func | |
| 9656 | do (setq store-func (org-link-get-parameter (car link) :store)) | |
| 9657 | if store-func | |
| 9658 | collect store-func)) | |
| 9659 | ||
| 9660 | (defvar org-agenda-buffer-name) ; Defined in org-agenda.el | |
| 9661 | (defvar org-id-link-to-org-use-id) ; Defined in org-id.el | |
| 9662 | ||
| 9663 | ;;;###autoload | |
| 9664 | (defun org-store-link (arg) | |
| 9665 | "Store an org-link to the current location. | |
| 9666 | \\<org-mode-map> | |
| 9667 | This link is added to `org-stored-links' and can later be inserted | |
| 9668 | into an Org buffer with `org-insert-link' (`\\[org-insert-link]'). | |
| 9669 | ||
| 9670 | For some link types, a `\\[universal-argument]' prefix ARG is interpreted. \ | |
| 9671 | A single | |
| 9672 | `\\[universal-argument]' negates `org-context-in-file-links' for file links or | |
| 9673 | `org-gnus-prefer-web-links' for links to Usenet articles. | |
| 9674 | ||
| 9675 | A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \ | |
| 9676 | skipping storing functions that are not | |
| 9677 | part of Org core. | |
| 9678 | ||
| 9679 | A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ | |
| 9680 | prefix ARG forces storing a link for each line in the | |
| 9681 | active region." | |
| 9682 | (interactive "P") | |
| 9683 | (org-load-modules-maybe) | |
| 9684 | (if (and (equal arg '(64)) (org-region-active-p)) | |
| 9685 | (save-excursion | |
| 9686 | (let ((end (region-end))) | |
| 9687 | (goto-char (region-beginning)) | |
| 9688 | (set-mark (point)) | |
| 9689 | (while (< (point-at-eol) end) | |
| 9690 | (move-end-of-line 1) (activate-mark) | |
| 9691 | (let (current-prefix-arg) | |
| 9692 | (call-interactively 'org-store-link)) | |
| 9693 | (move-beginning-of-line 2) | |
| 9694 | (set-mark (point))))) | |
| 9695 | (setq org-store-link-plist nil) | |
| 9696 | (let (link cpltxt desc description search txt custom-id agenda-link) | |
| 9697 | (cond | |
| 9698 | ;; Store a link using an external link type, if any function is | |
| 9699 | ;; available. If more than one can generate a link from current | |
| 9700 | ;; location, ask which one to use. | |
| 9701 | ((and (not (equal arg '(16))) | |
| 9702 | (let ((results-alist nil)) | |
| 9703 | (dolist (f (org-store-link-functions)) | |
| 9704 | (when (funcall f) | |
| 9705 | ;; XXX: return value is not link's plist, so we | |
| 9706 | ;; store the new value before it is modified. It | |
| 9707 | ;; would be cleaner to ask store link functions to | |
| 9708 | ;; return the plist instead. | |
| 9709 | (push (cons f (copy-sequence org-store-link-plist)) | |
| 9710 | results-alist))) | |
| 9711 | (pcase results-alist | |
| 9712 | (`nil nil) | |
| 9713 | (`((,_ . ,_)) t) ;single choice: nothing to do | |
| 9714 | (`((,name . ,_) . ,_) | |
| 9715 | ;; Reinstate link plist associated to the chosen | |
| 9716 | ;; function. | |
| 9717 | (apply #'org-store-link-props | |
| 9718 | (cdr (assoc-string | |
| 9719 | (completing-read | |
| 9720 | "Which function for creating the link? " | |
| 9721 | (mapcar #'car results-alist) | |
| 9722 | nil t (symbol-name name)) | |
| 9723 | results-alist))) | |
| 9724 | t)))) | |
| 9725 | (setq link (plist-get org-store-link-plist :link)) | |
| 9726 | (setq desc (or (plist-get org-store-link-plist :description) | |
| 9727 | link))) | |
| 9728 | ||
| 9729 | ;; Store a link from a source code buffer. | |
| 9730 | ((org-src-edit-buffer-p) | |
| 9731 | (let ((coderef-format (org-src-coderef-format))) | |
| 9732 | (cond ((save-excursion | |
| 9733 | (beginning-of-line) | |
| 9734 | (looking-at (org-src-coderef-regexp coderef-format))) | |
| 9735 | (setq link (format "(%s)" (match-string-no-properties 3)))) | |
| 9736 | ((called-interactively-p 'any) | |
| 9737 | (let ((label (read-string "Code line label: "))) | |
| 9738 | (end-of-line) | |
| 9739 | (setq link (format coderef-format label)) | |
| 9740 | (let ((gc (- 79 (length link)))) | |
| 9741 | (if (< (current-column) gc) | |
| 9742 | (org-move-to-column gc t) | |
| 9743 | (insert " "))) | |
| 9744 | (insert link) | |
| 9745 | (setq link (concat "(" label ")")) | |
| 9746 | (setq desc nil))) | |
| 9747 | (t (setq link nil))))) | |
| 9748 | ||
| 9749 | ;; We are in the agenda, link to referenced location | |
| 9750 | ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name)) | |
| 9751 | (let ((m (or (get-text-property (point) 'org-hd-marker) | |
| 9752 | (get-text-property (point) 'org-marker)))) | |
| 9753 | (when m | |
| 9754 | (org-with-point-at m | |
| 9755 | (setq agenda-link | |
| 9756 | (if (called-interactively-p 'any) | |
| 9757 | (call-interactively 'org-store-link) | |
| 9758 | (org-store-link nil))))))) | |
| 9759 | ||
| 9760 | ((eq major-mode 'calendar-mode) | |
| 9761 | (let ((cd (calendar-cursor-to-date))) | |
| 9762 | (setq link | |
| 9763 | (format-time-string | |
| 9764 | (car org-time-stamp-formats) | |
| 9765 | (apply 'encode-time | |
| 9766 | (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) | |
| 9767 | nil nil nil)))) | |
| 9768 | (org-store-link-props :type "calendar" :date cd))) | |
| 9769 | ||
| 9770 | ((eq major-mode 'help-mode) | |
| 9771 | (setq link (concat "help:" (save-excursion | |
| 9772 | (goto-char (point-min)) | |
| 9773 | (looking-at "^[^ ]+") | |
| 9774 | (match-string 0)))) | |
| 9775 | (org-store-link-props :type "help")) | |
| 9776 | ||
| 9777 | ((eq major-mode 'w3-mode) | |
| 9778 | (setq cpltxt (if (and (buffer-name) | |
| 9779 | (not (string-match "Untitled" (buffer-name)))) | |
| 9780 | (buffer-name) | |
| 9781 | (url-view-url t)) | |
| 9782 | link (url-view-url t)) | |
| 9783 | (org-store-link-props :type "w3" :url (url-view-url t))) | |
| 9784 | ||
| 9785 | ((eq major-mode 'image-mode) | |
| 9786 | (setq cpltxt (concat "file:" | |
| 9787 | (abbreviate-file-name buffer-file-name)) | |
| 9788 | link cpltxt) | |
| 9789 | (org-store-link-props :type "image" :file buffer-file-name)) | |
| 9790 | ||
| 9791 | ;; In dired, store a link to the file of the current line | |
| 9792 | ((derived-mode-p 'dired-mode) | |
| 9793 | (let ((file (dired-get-filename nil t))) | |
| 9794 | (setq file (if file | |
| 9795 | (abbreviate-file-name | |
| 9796 | (expand-file-name (dired-get-filename nil t))) | |
| 9797 | ;; otherwise, no file so use current directory. | |
| 9798 | default-directory)) | |
| 9799 | (setq cpltxt (concat "file:" file) | |
| 9800 | link cpltxt))) | |
| 9801 | ||
| 9802 | ((setq search (run-hook-with-args-until-success | |
| 9803 | 'org-create-file-search-functions)) | |
| 9804 | (setq link (concat "file:" (abbreviate-file-name buffer-file-name) | |
| 9805 | "::" search)) | |
| 9806 | (setq cpltxt (or description link))) | |
| 9807 | ||
| 9808 | ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) | |
| 9809 | (org-with-limited-levels | |
| 9810 | (setq custom-id (org-entry-get nil "CUSTOM_ID")) | |
| 9811 | (cond | |
| 9812 | ;; Store a link using the target at point | |
| 9813 | ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1) | |
| 9814 | (setq cpltxt | |
| 9815 | (concat "file:" | |
| 9816 | (abbreviate-file-name | |
| 9817 | (buffer-file-name (buffer-base-buffer))) | |
| 9818 | "::" (match-string 1)) | |
| 9819 | link cpltxt)) | |
| 9820 | ((and (featurep 'org-id) | |
| 9821 | (or (eq org-id-link-to-org-use-id t) | |
| 9822 | (and (called-interactively-p 'any) | |
| 9823 | (or (eq org-id-link-to-org-use-id 'create-if-interactive) | |
| 9824 | (and (eq org-id-link-to-org-use-id | |
| 9825 | 'create-if-interactive-and-no-custom-id) | |
| 9826 | (not custom-id)))) | |
| 9827 | (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) | |
| 9828 | ;; Store a link using the ID at point | |
| 9829 | (setq link (condition-case nil | |
| 9830 | (prog1 (org-id-store-link) | |
| 9831 | (setq desc (or (plist-get org-store-link-plist | |
| 9832 | :description) | |
| 9833 | ""))) | |
| 9834 | (error | |
| 9835 | ;; Probably before first headline, link only to file | |
| 9836 | (concat "file:" | |
| 9837 | (abbreviate-file-name | |
| 9838 | (buffer-file-name (buffer-base-buffer)))))))) | |
| 9839 | (t | |
| 9840 | ;; Just link to current headline | |
| 9841 | (setq cpltxt (concat "file:" | |
| 9842 | (abbreviate-file-name | |
| 9843 | (buffer-file-name (buffer-base-buffer))))) | |
| 9844 | ;; Add a context search string | |
| 9845 | (when (org-xor org-context-in-file-links | |
| 9846 | (equal arg '(4))) | |
| 9847 | (let* ((element (org-element-at-point)) | |
| 9848 | (name (org-element-property :name element))) | |
| 9849 | (setq txt (cond | |
| 9850 | ((org-at-heading-p) nil) | |
| 9851 | (name) | |
| 9852 | ((org-region-active-p) | |
| 9853 | (buffer-substring (region-beginning) (region-end))))) | |
| 9854 | (when (or (null txt) (string-match "\\S-" txt)) | |
| 9855 | (setq cpltxt | |
| 9856 | (concat cpltxt "::" | |
| 9857 | (condition-case nil | |
| 9858 | (org-make-org-heading-search-string txt) | |
| 9859 | (error ""))) | |
| 9860 | desc (or name | |
| 9861 | (nth 4 (ignore-errors (org-heading-components))) | |
| 9862 | "NONE"))))) | |
| 9863 | (when (string-match "::\\'" cpltxt) | |
| 9864 | (setq cpltxt (substring cpltxt 0 -2))) | |
| 9865 | (setq link cpltxt))))) | |
| 9866 | ||
| 9867 | ((buffer-file-name (buffer-base-buffer)) | |
| 9868 | ;; Just link to this file here. | |
| 9869 | (setq cpltxt (concat "file:" | |
| 9870 | (abbreviate-file-name | |
| 9871 | (buffer-file-name (buffer-base-buffer))))) | |
| 9872 | ;; Add a context string. | |
| 9873 | (when (org-xor org-context-in-file-links | |
| 9874 | (equal arg '(4))) | |
| 9875 | (setq txt (if (org-region-active-p) | |
| 9876 | (buffer-substring (region-beginning) (region-end)) | |
| 9877 | (buffer-substring (point-at-bol) (point-at-eol)))) | |
| 9878 | ;; Only use search option if there is some text. | |
| 9879 | (when (string-match "\\S-" txt) | |
| 9880 | (setq cpltxt | |
| 9881 | (concat cpltxt "::" (org-make-org-heading-search-string txt)) | |
| 9882 | desc "NONE"))) | |
| 9883 | (setq link cpltxt)) | |
| 9884 | ||
| 9885 | ((called-interactively-p 'interactive) | |
| 9886 | (user-error "No method for storing a link from this buffer")) | |
| 9887 | ||
| 9888 | (t (setq link nil))) | |
| 9889 | ||
| 9890 | ;; We're done setting link and desc, clean up | |
| 9891 | (when (consp link) (setq cpltxt (car link) link (cdr link))) | |
| 9892 | (setq link (or link cpltxt) | |
| 9893 | desc (or desc cpltxt)) | |
| 9894 | (cond ((not desc)) | |
| 9895 | ((equal desc "NONE") (setq desc nil)) | |
| 9896 | (t (setq desc | |
| 9897 | (replace-regexp-in-string | |
| 9898 | org-bracket-link-analytic-regexp | |
| 9899 | (lambda (m) (or (match-string 5 m) (match-string 3 m))) | |
| 9900 | desc)))) | |
| 9901 | ;; Return the link | |
| 9902 | (if (not (and (or (called-interactively-p 'any) | |
| 9903 | executing-kbd-macro) | |
| 9904 | link)) | |
| 9905 | (or agenda-link (and link (org-make-link-string link desc))) | |
| 9906 | (push (list link desc) org-stored-links) | |
| 9907 | (message "Stored: %s" (or desc link)) | |
| 9908 | (when custom-id | |
| 9909 | (setq link (concat "file:" (abbreviate-file-name | |
| 9910 | (buffer-file-name)) "::#" custom-id)) | |
| 9911 | (push (list link desc) org-stored-links)) | |
| 9912 | (car org-stored-links))))) | |
| 9913 | ||
| 9914 | (defun org-store-link-props (&rest plist) | |
| 9915 | "Store link properties. | |
| 9916 | The properties are pre-processed by extracting names, addresses | |
| 9917 | and dates." | |
| 9918 | (let ((x (plist-get plist :from))) | |
| 9919 | (when x | |
| 9920 | (let ((adr (mail-extract-address-components x))) | |
| 9921 | (setq plist (plist-put plist :fromname (car adr))) | |
| 9922 | (setq plist (plist-put plist :fromaddress (nth 1 adr)))))) | |
| 9923 | (let ((x (plist-get plist :to))) | |
| 9924 | (when x | |
| 9925 | (let ((adr (mail-extract-address-components x))) | |
| 9926 | (setq plist (plist-put plist :toname (car adr))) | |
| 9927 | (setq plist (plist-put plist :toaddress (nth 1 adr)))))) | |
| 9928 | (let ((x (ignore-errors (date-to-time (plist-get plist :date))))) | |
| 9929 | (when x | |
| 9930 | (setq plist (plist-put plist :date-timestamp | |
| 9931 | (format-time-string | |
| 9932 | (org-time-stamp-format t) x))) | |
| 9933 | (setq plist (plist-put plist :date-timestamp-inactive | |
| 9934 | (format-time-string | |
| 9935 | (org-time-stamp-format t t) x))))) | |
| 9936 | (let ((from (plist-get plist :from)) | |
| 9937 | (to (plist-get plist :to))) | |
| 9938 | (when (and from to org-from-is-user-regexp) | |
| 9939 | (setq plist | |
| 9940 | (plist-put plist :fromto | |
| 9941 | (if (string-match org-from-is-user-regexp from) | |
| 9942 | (concat "to %t") | |
| 9943 | (concat "from %f")))))) | |
| 9944 | (setq org-store-link-plist plist)) | |
| 9945 | ||
| 9946 | (defun org-add-link-props (&rest plist) | |
| 9947 | "Add these properties to the link property list." | |
| 9948 | (let (key value) | |
| 9949 | (while plist | |
| 9950 | (setq key (pop plist) value (pop plist)) | |
| 9951 | (setq org-store-link-plist | |
| 9952 | (plist-put org-store-link-plist key value))))) | |
| 9953 | ||
| 9954 | (defun org-email-link-description (&optional fmt) | |
| 9955 | "Return the description part of an email link. | |
| 9956 | This takes information from `org-store-link-plist' and formats it | |
| 9957 | according to FMT (default from `org-email-link-description-format')." | |
| 9958 | (setq fmt (or fmt org-email-link-description-format)) | |
| 9959 | (let* ((p org-store-link-plist) | |
| 9960 | (to (plist-get p :toaddress)) | |
| 9961 | (from (plist-get p :fromaddress)) | |
| 9962 | (table | |
| 9963 | (list | |
| 9964 | (cons "%c" (plist-get p :fromto)) | |
| 9965 | (cons "%F" (plist-get p :from)) | |
| 9966 | (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?")) | |
| 9967 | (cons "%T" (plist-get p :to)) | |
| 9968 | (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) | |
| 9969 | (cons "%s" (plist-get p :subject)) | |
| 9970 | (cons "%d" (plist-get p :date)) | |
| 9971 | (cons "%m" (plist-get p :message-id))))) | |
| 9972 | (when (string-match "%c" fmt) | |
| 9973 | ;; Check if the user wrote this message | |
| 9974 | (if (and org-from-is-user-regexp from to | |
| 9975 | (save-match-data (string-match org-from-is-user-regexp from))) | |
| 9976 | (setq fmt (replace-match "to %t" t t fmt)) | |
| 9977 | (setq fmt (replace-match "from %f" t t fmt)))) | |
| 9978 | (org-replace-escapes fmt table))) | |
| 9979 | ||
| 9980 | (defun org-make-org-heading-search-string (&optional string) | |
| 9981 | "Make search string for the current headline or STRING." | |
| 9982 | (let ((s (or string | |
| 9983 | (and (derived-mode-p 'org-mode) | |
| 9984 | (save-excursion | |
| 9985 | (org-back-to-heading t) | |
| 9986 | (org-element-property :raw-value (org-element-at-point)))))) | |
| 9987 | (lines org-context-in-file-links)) | |
| 9988 | (unless string (setq s (concat "*" s))) ;Add * for headlines | |
| 9989 | (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) | |
| 9990 | (when (and string (integerp lines) (> lines 0)) | |
| 9991 | (let ((slines (org-split-string s "\n"))) | |
| 9992 | (when (< lines (length slines)) | |
| 9993 | (setq s (mapconcat | |
| 9994 | 'identity | |
| 9995 | (reverse (nthcdr (- (length slines) lines) | |
| 9996 | (reverse slines))) "\n"))))) | |
| 9997 | (mapconcat #'identity (split-string s) " "))) | |
| 9998 | ||
| 9999 | (defconst org-link-escape-chars | |
| 10000 | ;;%20 %5B %5D %25 | |
| 10001 | '(?\s ?\[ ?\] ?%) | |
| 10002 | "List of characters that should be escaped in a link when stored to Org. | |
| 10003 | This is the list that is used for internal purposes.") | |
| 10004 | ||
| 10005 | (defun org-make-link-string (link &optional description) | |
| 10006 | "Make a link with brackets, consisting of LINK and DESCRIPTION." | |
| 10007 | (unless (org-string-nw-p link) (error "Empty link")) | |
| 10008 | (let ((uri (cond ((string-match org-link-types-re link) | |
| 10009 | (concat (match-string 1 link) | |
| 10010 | (org-link-escape (substring link (match-end 1))))) | |
| 10011 | ((or (file-name-absolute-p link) | |
| 10012 | (string-match-p "\\`\\.\\.?/" link)) | |
| 10013 | (org-link-escape link)) | |
| 10014 | ;; For readability, do not encode space characters | |
| 10015 | ;; in fuzzy links. | |
| 10016 | (t (org-link-escape link (remq ?\s org-link-escape-chars))))) | |
| 10017 | (description | |
| 10018 | (and (org-string-nw-p description) | |
| 10019 | ;; Remove brackets from description, as they are fatal. | |
| 10020 | (replace-regexp-in-string | |
| 10021 | "[][]" (lambda (m) (if (equal "[" m) "{" "}")) | |
| 10022 | (org-trim description))))) | |
| 10023 | (format "[[%s]%s]" | |
| 10024 | uri | |
| 10025 | (if description (format "[%s]" description) "")))) | |
| 10026 | ||
| 10027 | (defun org-link-escape (text &optional table merge) | |
| 10028 | "Return percent escaped representation of TEXT. | |
| 10029 | TEXT is a string with the text to escape. | |
| 10030 | Optional argument TABLE is a list with characters that should be | |
| 10031 | escaped. When nil, `org-link-escape-chars' is used. | |
| 10032 | If optional argument MERGE is set, merge TABLE into | |
| 10033 | `org-link-escape-chars'." | |
| 10034 | (let ((characters-to-encode | |
| 10035 | (cond ((null table) org-link-escape-chars) | |
| 10036 | (merge (append org-link-escape-chars table)) | |
| 10037 | (t table)))) | |
| 10038 | (mapconcat | |
| 10039 | (lambda (c) | |
| 10040 | (if (or (memq c characters-to-encode) | |
| 10041 | (and org-url-hexify-p (or (< c 32) (> c 126)))) | |
| 10042 | (mapconcat (lambda (e) (format "%%%.2X" e)) | |
| 10043 | (or (encode-coding-char c 'utf-8) | |
| 10044 | (error "Unable to percent escape character: %c" c)) | |
| 10045 | "") | |
| 10046 | (char-to-string c))) | |
| 10047 | text ""))) | |
| 10048 | ||
| 10049 | (defun org-link-unescape (str) | |
| 10050 | "Unhex hexified Unicode parts in string STR. | |
| 10051 | E.g. `%C3%B6' becomes the german o-Umlaut. This is the | |
| 10052 | reciprocal of `org-link-escape', which see." | |
| 10053 | (if (org-string-nw-p str) | |
| 10054 | (replace-regexp-in-string | |
| 10055 | "\\(%[0-9A-Za-z]\\{2\\}\\)+" #'org-link-unescape-compound str t t) | |
| 10056 | str)) | |
| 10057 | ||
| 10058 | (defun org-link-unescape-compound (hex) | |
| 10059 | "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut. | |
| 10060 | Note: this function also decodes single byte encodings like | |
| 10061 | `%E1' (a-acute) if not followed by another `%[A-F0-9]{2}' group." | |
| 10062 | (save-match-data | |
| 10063 | (let* ((bytes (cdr (split-string hex "%"))) | |
| 10064 | (ret "") | |
| 10065 | (eat 0) | |
| 10066 | (sum 0)) | |
| 10067 | (while bytes | |
| 10068 | (let* ((val (string-to-number (pop bytes) 16)) | |
| 10069 | (shift-xor | |
| 10070 | (if (= 0 eat) | |
| 10071 | (cond | |
| 10072 | ((>= val 252) (cons 6 252)) | |
| 10073 | ((>= val 248) (cons 5 248)) | |
| 10074 | ((>= val 240) (cons 4 240)) | |
| 10075 | ((>= val 224) (cons 3 224)) | |
| 10076 | ((>= val 192) (cons 2 192)) | |
| 10077 | (t (cons 0 0))) | |
| 10078 | (cons 6 128)))) | |
| 10079 | (when (>= val 192) (setq eat (car shift-xor))) | |
| 10080 | (setq val (logxor val (cdr shift-xor))) | |
| 10081 | (setq sum (+ (lsh sum (car shift-xor)) val)) | |
| 10082 | (when (> eat 0) (setq eat (- eat 1))) | |
| 10083 | (cond | |
| 10084 | ((= 0 eat) ;multi byte | |
| 10085 | (setq ret (concat ret (char-to-string sum))) | |
| 10086 | (setq sum 0)) | |
| 10087 | ((not bytes) ; single byte(s) | |
| 10088 | (setq ret (org-link-unescape-single-byte-sequence hex)))))) | |
| 10089 | ret))) | |
| 10090 | ||
| 10091 | (defun org-link-unescape-single-byte-sequence (hex) | |
| 10092 | "Unhexify hex-encoded single byte character sequences." | |
| 10093 | (mapconcat (lambda (byte) | |
| 10094 | (char-to-string (string-to-number byte 16))) | |
| 10095 | (cdr (split-string hex "%")) "")) | |
| 10096 | ||
| 10097 | (defun org-xor (a b) | |
| 10098 | "Exclusive or." | |
| 10099 | (if a (not b) b)) | |
| 10100 | ||
| 10101 | (defun org-fixup-message-id-for-http (s) | |
| 10102 | "Replace special characters in a message id, so it can be used in an http query." | |
| 10103 | (when (string-match "%" s) | |
| 10104 | (setq s (mapconcat (lambda (c) | |
| 10105 | (if (eq c ?%) | |
| 10106 | "%25" | |
| 10107 | (char-to-string c))) | |
| 10108 | s ""))) | |
| 10109 | (while (string-match "<" s) | |
| 10110 | (setq s (replace-match "%3C" t t s))) | |
| 10111 | (while (string-match ">" s) | |
| 10112 | (setq s (replace-match "%3E" t t s))) | |
| 10113 | (while (string-match "@" s) | |
| 10114 | (setq s (replace-match "%40" t t s))) | |
| 10115 | s) | |
| 10116 | ||
| 10117 | (defun org-link-prettify (link) | |
| 10118 | "Return a human-readable representation of LINK. | |
| 10119 | The car of LINK must be a raw link. | |
| 10120 | The cdr of LINK must be either a link description or nil." | |
| 10121 | (let ((desc (or (cadr link) "<no description>"))) | |
| 10122 | (concat (format "%-45s" (substring desc 0 (min (length desc) 40))) | |
| 10123 | "<" (car link) ">"))) | |
| 10124 | ||
| 10125 | ;;;###autoload | |
| 10126 | (defun org-insert-link-global () | |
| 10127 | "Insert a link like Org mode does. | |
| 10128 | This command can be called in any mode to insert a link in Org syntax." | |
| 10129 | (interactive) | |
| 10130 | (org-load-modules-maybe) | |
| 10131 | (org-run-like-in-org-mode 'org-insert-link)) | |
| 10132 | ||
| 10133 | (defun org-insert-all-links (arg &optional pre post) | |
| 10134 | "Insert all links in `org-stored-links'. | |
| 10135 | When a universal prefix, do not delete the links from `org-stored-links'. | |
| 10136 | When `ARG' is a number, insert the last N link(s). | |
| 10137 | `PRE' and `POST' are optional arguments to define a string to | |
| 10138 | prepend or to append." | |
| 10139 | (interactive "P") | |
| 10140 | (let ((org-keep-stored-link-after-insertion (equal arg '(4))) | |
| 10141 | (links (copy-sequence org-stored-links)) | |
| 10142 | (pr (or pre "- ")) | |
| 10143 | (po (or post "\n")) | |
| 10144 | (cnt 1) l) | |
| 10145 | (if (null org-stored-links) | |
| 10146 | (message "No link to insert") | |
| 10147 | (while (and (or (listp arg) (>= arg cnt)) | |
| 10148 | (setq l (if (listp arg) | |
| 10149 | (pop links) | |
| 10150 | (pop org-stored-links)))) | |
| 10151 | (setq cnt (1+ cnt)) | |
| 10152 | (insert pr) | |
| 10153 | (org-insert-link nil (car l) (or (cadr l) "<no description>")) | |
| 10154 | (insert po))))) | |
| 10155 | ||
| 10156 | (defun org-insert-last-stored-link (arg) | |
| 10157 | "Insert the last link stored in `org-stored-links'." | |
| 10158 | (interactive "p") | |
| 10159 | (org-insert-all-links arg "" "\n")) | |
| 10160 | ||
| 10161 | (defun org-link-fontify-links-to-this-file () | |
| 10162 | "Fontify links to the current file in `org-stored-links'." | |
| 10163 | (let ((f (buffer-file-name)) a b) | |
| 10164 | (setq a (mapcar (lambda(l) | |
| 10165 | (let ((ll (car l))) | |
| 10166 | (when (and (string-match "^file:\\(.+\\)::" ll) | |
| 10167 | (equal f (expand-file-name (match-string 1 ll)))) | |
| 10168 | ll))) | |
| 10169 | org-stored-links)) | |
| 10170 | (when (featurep 'org-id) | |
| 10171 | (setq b (mapcar (lambda(l) | |
| 10172 | (let ((ll (car l))) | |
| 10173 | (when (and (string-match "^id:\\(.+\\)$" ll) | |
| 10174 | (equal f (expand-file-name | |
| 10175 | (or (org-id-find-id-file | |
| 10176 | (match-string 1 ll)) "")))) | |
| 10177 | ll))) | |
| 10178 | org-stored-links))) | |
| 10179 | (mapcar (lambda(l) | |
| 10180 | (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) | |
| 10181 | (delq nil (append a b))))) | |
| 10182 | ||
| 10183 | (defvar org--links-history nil) | |
| 10184 | (defun org-insert-link (&optional complete-file link-location default-description) | |
| 10185 | "Insert a link. At the prompt, enter the link. | |
| 10186 | ||
| 10187 | Completion can be used to insert any of the link protocol prefixes in use. | |
| 10188 | ||
| 10189 | The history can be used to select a link previously stored with | |
| 10190 | `org-store-link'. When the empty string is entered (i.e. if you just | |
| 10191 | press `RET' at the prompt), the link defaults to the most recently | |
| 10192 | stored link. As `SPC' triggers completion in the minibuffer, you need to | |
| 10193 | use `M-SPC' or `C-q SPC' to force the insertion of a space character. | |
| 10194 | ||
| 10195 | You will also be prompted for a description, and if one is given, it will | |
| 10196 | be displayed in the buffer instead of the link. | |
| 10197 | ||
| 10198 | If there is already a link at point, this command will allow you to edit | |
| 10199 | link and description parts. | |
| 10200 | ||
| 10201 | With a `\\[universal-argument]' prefix, prompts for a file to link to. The \ | |
| 10202 | file name can be | |
| 10203 | selected using completion. The path to the file will be relative to the | |
| 10204 | current directory if the file is in the current directory or a subdirectory. | |
| 10205 | Otherwise, the link will be the absolute path as completed in the minibuffer | |
| 10206 | \(i.e. normally ~/path/to/file). You can configure this behavior using the | |
| 10207 | option `org-link-file-path-type'. | |
| 10208 | ||
| 10209 | With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \ | |
| 10210 | absolute path even if the file is in | |
| 10211 | the current directory or below. | |
| 10212 | ||
| 10213 | A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ | |
| 10214 | prefix negates `org-keep-stored-link-after-insertion'. | |
| 10215 | ||
| 10216 | If the LINK-LOCATION parameter is non-nil, this value will be used as | |
| 10217 | the link location instead of reading one interactively. | |
| 10218 | ||
| 10219 | If the DEFAULT-DESCRIPTION parameter is non-nil, this value will | |
| 10220 | be used as the default description. Otherwise, if | |
| 10221 | `org-make-link-description-function' is non-nil, this function | |
| 10222 | will be called with the link target, and the result will be the | |
| 10223 | default link description." | |
| 10224 | (interactive "P") | |
| 10225 | (let* ((wcf (current-window-configuration)) | |
| 10226 | (origbuf (current-buffer)) | |
| 10227 | (region (when (org-region-active-p) | |
| 10228 | (buffer-substring (region-beginning) (region-end)))) | |
| 10229 | (remove (and region (list (region-beginning) (region-end)))) | |
| 10230 | (desc region) | |
| 10231 | (link link-location) | |
| 10232 | (abbrevs org-link-abbrev-alist-local) | |
| 10233 | entry all-prefixes auto-desc) | |
| 10234 | (cond | |
| 10235 | (link-location) ; specified by arg, just use it. | |
| 10236 | ((org-in-regexp org-bracket-link-regexp 1) | |
| 10237 | ;; We do have a link at point, and we are going to edit it. | |
| 10238 | (setq remove (list (match-beginning 0) (match-end 0))) | |
| 10239 | (setq desc (when (match-end 3) (match-string-no-properties 3))) | |
| 10240 | (setq link (read-string "Link: " | |
| 10241 | (org-link-unescape | |
| 10242 | (match-string-no-properties 1))))) | |
| 10243 | ((or (org-in-regexp org-angle-link-re) | |
| 10244 | (org-in-regexp org-plain-link-re)) | |
| 10245 | ;; Convert to bracket link | |
| 10246 | (setq remove (list (match-beginning 0) (match-end 0)) | |
| 10247 | link (read-string "Link: " | |
| 10248 | (org-unbracket-string "<" ">" (match-string 0))))) | |
| 10249 | ((member complete-file '((4) (16))) | |
| 10250 | ;; Completing read for file names. | |
| 10251 | (setq link (org-file-complete-link complete-file))) | |
| 10252 | (t | |
| 10253 | ;; Read link, with completion for stored links. | |
| 10254 | (org-link-fontify-links-to-this-file) | |
| 10255 | (org-switch-to-buffer-other-window "*Org Links*") | |
| 10256 | (with-current-buffer "*Org Links*" | |
| 10257 | (erase-buffer) | |
| 10258 | (insert "Insert a link. | |
| 10259 | Use TAB to complete link prefixes, then RET for type-specific completion support\n") | |
| 10260 | (when org-stored-links | |
| 10261 | (insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") | |
| 10262 | (insert (mapconcat 'org-link-prettify | |
| 10263 | (reverse org-stored-links) "\n"))) | |
| 10264 | (goto-char (point-min))) | |
| 10265 | (let ((cw (selected-window))) | |
| 10266 | (select-window (get-buffer-window "*Org Links*" 'visible)) | |
| 10267 | (with-current-buffer "*Org Links*" (setq truncate-lines t)) | |
| 10268 | (unless (pos-visible-in-window-p (point-max)) | |
| 10269 | (org-fit-window-to-buffer)) | |
| 10270 | (and (window-live-p cw) (select-window cw))) | |
| 10271 | (setq all-prefixes (append (mapcar 'car abbrevs) | |
| 10272 | (mapcar 'car org-link-abbrev-alist) | |
| 10273 | (org-link-types))) | |
| 10274 | (unwind-protect | |
| 10275 | ;; Fake a link history, containing the stored links. | |
| 10276 | (let ((org--links-history | |
| 10277 | (append (mapcar #'car org-stored-links) | |
| 10278 | org-insert-link-history))) | |
| 10279 | (setq link | |
| 10280 | (org-completing-read | |
| 10281 | "Link: " | |
| 10282 | (append | |
| 10283 | (mapcar (lambda (x) (concat x ":")) all-prefixes) | |
| 10284 | (mapcar #'car org-stored-links)) | |
| 10285 | nil nil nil | |
| 10286 | 'org--links-history | |
| 10287 | (caar org-stored-links))) | |
| 10288 | (unless (org-string-nw-p link) (user-error "No link selected")) | |
| 10289 | (dolist (l org-stored-links) | |
| 10290 | (when (equal link (cadr l)) | |
| 10291 | (setq link (car l)) | |
| 10292 | (setq auto-desc t))) | |
| 10293 | (when (or (member link all-prefixes) | |
| 10294 | (and (equal ":" (substring link -1)) | |
| 10295 | (member (substring link 0 -1) all-prefixes) | |
| 10296 | (setq link (substring link 0 -1)))) | |
| 10297 | (setq link (with-current-buffer origbuf | |
| 10298 | (org-link-try-special-completion link))))) | |
| 10299 | (set-window-configuration wcf) | |
| 10300 | (kill-buffer "*Org Links*")) | |
| 10301 | (setq entry (assoc link org-stored-links)) | |
| 10302 | (or entry (push link org-insert-link-history)) | |
| 10303 | (setq desc (or desc (nth 1 entry))))) | |
| 10304 | ||
| 10305 | (when (funcall (if (equal complete-file '(64)) 'not 'identity) | |
| 10306 | (not org-keep-stored-link-after-insertion)) | |
| 10307 | (setq org-stored-links (delq (assoc link org-stored-links) | |
| 10308 | org-stored-links))) | |
| 10309 | ||
| 10310 | (when (and (string-match org-plain-link-re link) | |
| 10311 | (not (string-match org-ts-regexp link))) | |
| 10312 | ;; URL-like link, normalize the use of angular brackets. | |
| 10313 | (setq link (org-unbracket-string "<" ">" link))) | |
| 10314 | ||
| 10315 | ;; Check if we are linking to the current file with a search | |
| 10316 | ;; option If yes, simplify the link by using only the search | |
| 10317 | ;; option. | |
| 10318 | (when (and buffer-file-name | |
| 10319 | (let ((case-fold-search nil)) | |
| 10320 | (string-match "\\`file:\\(.+?\\)::" link))) | |
| 10321 | (let ((path (match-string-no-properties 1 link)) | |
| 10322 | (search (substring-no-properties link (match-end 0)))) | |
| 10323 | (save-match-data | |
| 10324 | (when (equal (file-truename buffer-file-name) (file-truename path)) | |
| 10325 | ;; We are linking to this same file, with a search option | |
| 10326 | (setq link search))))) | |
| 10327 | ||
| 10328 | ;; Check if we can/should use a relative path. If yes, simplify | |
| 10329 | ;; the link. | |
| 10330 | (let ((case-fold-search nil)) | |
| 10331 | (when (string-match "\\`\\(file\\|docview\\):" link) | |
| 10332 | (let* ((type (match-string-no-properties 0 link)) | |
| 10333 | (path-start (match-end 0)) | |
| 10334 | (search (and (string-match "::\\(.*\\)\\'" link) | |
| 10335 | (match-string 1 link))) | |
| 10336 | (path | |
| 10337 | (if search | |
| 10338 | (substring-no-properties | |
| 10339 | link path-start (match-beginning 0)) | |
| 10340 | (substring-no-properties link (match-end 0)))) | |
| 10341 | (origpath path)) | |
| 10342 | (cond | |
| 10343 | ((or (eq org-link-file-path-type 'absolute) | |
| 10344 | (equal complete-file '(16))) | |
| 10345 | (setq path (abbreviate-file-name (expand-file-name path)))) | |
| 10346 | ((eq org-link-file-path-type 'noabbrev) | |
| 10347 | (setq path (expand-file-name path))) | |
| 10348 | ((eq org-link-file-path-type 'relative) | |
| 10349 | (setq path (file-relative-name path))) | |
| 10350 | (t | |
| 10351 | (save-match-data | |
| 10352 | (if (string-match (concat "^" (regexp-quote | |
| 10353 | (expand-file-name | |
| 10354 | (file-name-as-directory | |
| 10355 | default-directory)))) | |
| 10356 | (expand-file-name path)) | |
| 10357 | ;; We are linking a file with relative path name. | |
| 10358 | (setq path (substring (expand-file-name path) | |
| 10359 | (match-end 0))) | |
| 10360 | (setq path (abbreviate-file-name (expand-file-name path))))))) | |
| 10361 | (setq link (concat type path (and search (concat "::" search)))) | |
| 10362 | (when (equal desc origpath) | |
| 10363 | (setq desc path))))) | |
| 10364 | ||
| 10365 | (unless auto-desc | |
| 10366 | (let ((initial-input | |
| 10367 | (cond | |
| 10368 | (default-description) | |
| 10369 | ((not org-make-link-description-function) desc) | |
| 10370 | (t (condition-case nil | |
| 10371 | (funcall org-make-link-description-function link desc) | |
| 10372 | (error | |
| 10373 | (message "Can't get link description from `%s'" | |
| 10374 | (symbol-name org-make-link-description-function)) | |
| 10375 | (sit-for 2) | |
| 10376 | nil)))))) | |
| 10377 | (setq desc (read-string "Description: " initial-input)))) | |
| 10378 | ||
| 10379 | (unless (string-match "\\S-" desc) (setq desc nil)) | |
| 10380 | (when remove (apply 'delete-region remove)) | |
| 10381 | (insert (org-make-link-string link desc)) | |
| 10382 | ;; Redisplay so as the new link has proper invisible characters. | |
| 10383 | (sit-for 0))) | |
| 10384 | ||
| 10385 | (defun org-link-try-special-completion (type) | |
| 10386 | "If there is completion support for link type TYPE, offer it." | |
| 10387 | (let ((fun (org-link-get-parameter type :complete))) | |
| 10388 | (if (functionp fun) | |
| 10389 | (funcall fun) | |
| 10390 | (read-string "Link (no completion support): " (concat type ":"))))) | |
| 10391 | ||
| 10392 | (defun org-file-complete-link (&optional arg) | |
| 10393 | "Create a file link using completion." | |
| 10394 | (let ((file (read-file-name "File: ")) | |
| 10395 | (pwd (file-name-as-directory (expand-file-name "."))) | |
| 10396 | (pwd1 (file-name-as-directory (abbreviate-file-name | |
| 10397 | (expand-file-name "."))))) | |
| 10398 | (cond ((equal arg '(16)) | |
| 10399 | (concat "file:" | |
| 10400 | (abbreviate-file-name (expand-file-name file)))) | |
| 10401 | ((string-match | |
| 10402 | (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) | |
| 10403 | (concat "file:" (match-string 1 file))) | |
| 10404 | ((string-match | |
| 10405 | (concat "^" (regexp-quote pwd) "\\(.+\\)") | |
| 10406 | (expand-file-name file)) | |
| 10407 | (concat "file:" | |
| 10408 | (match-string 1 (expand-file-name file)))) | |
| 10409 | (t (concat "file:" file))))) | |
| 10410 | ||
| 10411 | (defun org-completing-read (&rest args) | |
| 10412 | "Completing-read with SPACE being a normal character." | |
| 10413 | (let ((enable-recursive-minibuffers t) | |
| 10414 | (minibuffer-local-completion-map | |
| 10415 | (copy-keymap minibuffer-local-completion-map))) | |
| 10416 | (org-defkey minibuffer-local-completion-map " " 'self-insert-command) | |
| 10417 | (org-defkey minibuffer-local-completion-map "?" 'self-insert-command) | |
| 10418 | (org-defkey minibuffer-local-completion-map (kbd "C-c !") | |
| 10419 | 'org-time-stamp-inactive) | |
| 10420 | (apply #'completing-read args))) | |
| 10421 | ||
| 10422 | ;;; Opening/following a link | |
| 10423 | ||
| 10424 | (defvar org-link-search-failed nil) | |
| 10425 | ||
| 10426 | (defvar org-open-link-functions nil | |
| 10427 | "Hook for functions finding a plain text link. | |
| 10428 | These functions must take a single argument, the link content. | |
| 10429 | They will be called for links that look like [[link text][description]] | |
| 10430 | when LINK TEXT does not have a protocol like \"http:\" and does not look | |
| 10431 | like a filename (e.g. \"./blue.png\"). | |
| 10432 | ||
| 10433 | These functions will be called *before* Org attempts to resolve the | |
| 10434 | link by doing text searches in the current buffer - so if you want a | |
| 10435 | link \"[[target]]\" to still find \"<<target>>\", your function should | |
| 10436 | handle this as a special case. | |
| 10437 | ||
| 10438 | When the function does handle the link, it must return a non-nil value. | |
| 10439 | If it decides that it is not responsible for this link, it must return | |
| 10440 | nil to indicate that that Org can continue with other options like | |
| 10441 | exact and fuzzy text search.") | |
| 10442 | ||
| 10443 | (defun org-next-link (&optional search-backward) | |
| 10444 | "Move forward to the next link. | |
| 10445 | If the link is in hidden text, expose it." | |
| 10446 | (interactive "P") | |
| 10447 | (when (and org-link-search-failed (eq this-command last-command)) | |
| 10448 | (goto-char (point-min)) | |
| 10449 | (message "Link search wrapped back to beginning of buffer")) | |
| 10450 | (setq org-link-search-failed nil) | |
| 10451 | (let* ((pos (point)) | |
| 10452 | (ct (org-context)) | |
| 10453 | (a (assq :link ct)) | |
| 10454 | (srch-fun (if search-backward 're-search-backward 're-search-forward))) | |
| 10455 | (cond (a (goto-char (nth (if search-backward 1 2) a))) | |
| 10456 | ((looking-at org-any-link-re) | |
| 10457 | ;; Don't stay stuck at link without an org-link face | |
| 10458 | (forward-char (if search-backward -1 1)))) | |
| 10459 | (if (funcall srch-fun org-any-link-re nil t) | |
| 10460 | (progn | |
| 10461 | (goto-char (match-beginning 0)) | |
| 10462 | (when (org-invisible-p) (org-show-context))) | |
| 10463 | (goto-char pos) | |
| 10464 | (setq org-link-search-failed t) | |
| 10465 | (message "No further link found")))) | |
| 10466 | ||
| 10467 | (defun org-previous-link () | |
| 10468 | "Move backward to the previous link. | |
| 10469 | If the link is in hidden text, expose it." | |
| 10470 | (interactive) | |
| 10471 | (funcall 'org-next-link t)) | |
| 10472 | ||
| 10473 | (defun org-translate-link (s) | |
| 10474 | "Translate a link string if a translation function has been defined." | |
| 10475 | (with-temp-buffer | |
| 10476 | (insert (org-trim s)) | |
| 10477 | (org-trim (org-element-interpret-data (org-element-context))))) | |
| 10478 | ||
| 10479 | (defun org-translate-link-from-planner (type path) | |
| 10480 | "Translate a link from Emacs Planner syntax so that Org can follow it. | |
| 10481 | This is still an experimental function, your mileage may vary." | |
| 10482 | (cond | |
| 10483 | ((member type '("http" "https" "news" "ftp")) | |
| 10484 | ;; standard Internet links are the same. | |
| 10485 | nil) | |
| 10486 | ((and (equal type "irc") (string-match "^//" path)) | |
| 10487 | ;; Planner has two / at the beginning of an irc link, we have 1. | |
| 10488 | ;; We should have zero, actually.... | |
| 10489 | (setq path (substring path 1))) | |
| 10490 | ((and (equal type "lisp") (string-match "^/" path)) | |
| 10491 | ;; Planner has a slash, we do not. | |
| 10492 | (setq type "elisp" path (substring path 1))) | |
| 10493 | ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) | |
| 10494 | ;; A typical message link. Planner has the id after the final slash, | |
| 10495 | ;; we separate it with a hash mark | |
| 10496 | (setq path (concat (match-string 1 path) "#" | |
| 10497 | (org-unbracket-string "<" ">" (match-string 2 path)))))) | |
| 10498 | (cons type path)) | |
| 10499 | ||
| 10500 | (defun org-find-file-at-mouse (ev) | |
| 10501 | "Open file link or URL at mouse." | |
| 10502 | (interactive "e") | |
| 10503 | (mouse-set-point ev) | |
| 10504 | (org-open-at-point 'in-emacs)) | |
| 10505 | ||
| 10506 | (defun org-open-at-mouse (ev) | |
| 10507 | "Open file link or URL at mouse. | |
| 10508 | See the docstring of `org-open-file' for details." | |
| 10509 | (interactive "e") | |
| 10510 | (mouse-set-point ev) | |
| 10511 | (when (eq major-mode 'org-agenda-mode) | |
| 10512 | (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) | |
| 10513 | (org-open-at-point)) | |
| 10514 | ||
| 10515 | (defvar org-window-config-before-follow-link nil | |
| 10516 | "The window configuration before following a link. | |
| 10517 | This is saved in case the need arises to restore it.") | |
| 10518 | ||
| 10519 | ;;;###autoload | |
| 10520 | (defun org-open-at-point-global () | |
| 10521 | "Follow a link or time-stamp like Org mode does. | |
| 10522 | This command can be called in any mode to follow an external link | |
| 10523 | or a time-stamp that has Org mode syntax. Its behavior is | |
| 10524 | undefined when called on internal links (e.g., fuzzy links). | |
| 10525 | Raise an error when there is nothing to follow. " | |
| 10526 | (interactive) | |
| 10527 | (cond ((org-in-regexp org-any-link-re) | |
| 10528 | (org-open-link-from-string (match-string-no-properties 0))) | |
| 10529 | ((or (org-in-regexp org-ts-regexp-both nil t) | |
| 10530 | (org-in-regexp org-tsr-regexp-both nil t)) | |
| 10531 | (org-follow-timestamp-link)) | |
| 10532 | (t (user-error "No link found")))) | |
| 10533 | ||
| 10534 | ;;;###autoload | |
| 10535 | (defun org-open-link-from-string (s &optional arg reference-buffer) | |
| 10536 | "Open a link in the string S, as if it was in Org mode." | |
| 10537 | (interactive "sLink: \nP") | |
| 10538 | (let ((reference-buffer (or reference-buffer (current-buffer)))) | |
| 10539 | (with-temp-buffer | |
| 10540 | (let ((org-inhibit-startup (not reference-buffer))) | |
| 10541 | (org-mode) | |
| 10542 | (insert s) | |
| 10543 | (goto-char (point-min)) | |
| 10544 | (when reference-buffer | |
| 10545 | (setq org-link-abbrev-alist-local | |
| 10546 | (with-current-buffer reference-buffer | |
| 10547 | org-link-abbrev-alist-local))) | |
| 10548 | (org-open-at-point arg reference-buffer))))) | |
| 10549 | ||
| 10550 | (defvar org-open-at-point-functions nil | |
| 10551 | "Hook that is run when following a link at point. | |
| 10552 | ||
| 10553 | Functions in this hook must return t if they identify and follow | |
| 10554 | a link at point. If they don't find anything interesting at point, | |
| 10555 | they must return nil.") | |
| 10556 | ||
| 10557 | (defvar org-link-search-inhibit-query nil) | |
| 10558 | (defvar clean-buffer-list-kill-buffer-names) ;Defined in midnight.el | |
| 10559 | (defun org--open-doi-link (path) | |
| 10560 | "Open a \"doi\" type link. | |
| 10561 | PATH is a the path to search for, as a string." | |
| 10562 | (browse-url (url-encode-url (concat org-doi-server-url path)))) | |
| 10563 | ||
| 10564 | (defun org--open-elisp-link (path) | |
| 10565 | "Open a \"elisp\" type link. | |
| 10566 | PATH is the sexp to evaluate, as a string." | |
| 10567 | (let ((cmd path)) | |
| 10568 | (if (or (and (org-string-nw-p | |
| 10569 | org-confirm-elisp-link-not-regexp) | |
| 10570 | (string-match-p org-confirm-elisp-link-not-regexp cmd)) | |
| 10571 | (not org-confirm-elisp-link-function) | |
| 10572 | (funcall org-confirm-elisp-link-function | |
| 10573 | (format "Execute \"%s\" as elisp? " | |
| 10574 | (org-add-props cmd nil 'face 'org-warning)))) | |
| 10575 | (message "%s => %s" cmd | |
| 10576 | (if (eq (string-to-char cmd) ?\() | |
| 10577 | (eval (read cmd)) | |
| 10578 | (call-interactively (read cmd)))) | |
| 10579 | (user-error "Abort")))) | |
| 10580 | ||
| 10581 | (defun org--open-help-link (path) | |
| 10582 | "Open a \"help\" type link. | |
| 10583 | PATH is a symbol name, as a string." | |
| 10584 | (pcase (intern path) | |
| 10585 | ((and (pred fboundp) variable) (describe-function variable)) | |
| 10586 | ((and (pred boundp) function) (describe-variable function)) | |
| 10587 | (name (user-error "Unknown function or variable: %s" name)))) | |
| 10588 | ||
| 10589 | (defun org--open-shell-link (path) | |
| 10590 | "Open a \"shell\" type link. | |
| 10591 | PATH is the command to execute, as a string." | |
| 10592 | (let ((buf (generate-new-buffer "*Org Shell Output*")) | |
| 10593 | (cmd path)) | |
| 10594 | (if (or (and (org-string-nw-p | |
| 10595 | org-confirm-shell-link-not-regexp) | |
| 10596 | (string-match | |
| 10597 | org-confirm-shell-link-not-regexp cmd)) | |
| 10598 | (not org-confirm-shell-link-function) | |
| 10599 | (funcall org-confirm-shell-link-function | |
| 10600 | (format "Execute \"%s\" in shell? " | |
| 10601 | (org-add-props cmd nil | |
| 10602 | 'face 'org-warning)))) | |
| 10603 | (progn | |
| 10604 | (message "Executing %s" cmd) | |
| 10605 | (shell-command cmd buf) | |
| 10606 | (when (featurep 'midnight) | |
| 10607 | (setq clean-buffer-list-kill-buffer-names | |
| 10608 | (cons (buffer-name buf) | |
| 10609 | clean-buffer-list-kill-buffer-names)))) | |
| 10610 | (user-error "Abort")))) | |
| 10611 | ||
| 10612 | (defun org-open-at-point (&optional arg reference-buffer) | |
| 10613 | "Open link, timestamp, footnote or tags at point. | |
| 10614 | ||
| 10615 | When point is on a link, follow it. Normally, files will be | |
| 10616 | opened by an appropriate application. If the optional prefix | |
| 10617 | argument ARG is non-nil, Emacs will visit the file. With | |
| 10618 | a double prefix argument, try to open outside of Emacs, in the | |
| 10619 | application the system uses for this file type. | |
| 10620 | ||
| 10621 | When point is on a timestamp, open the agenda at the day | |
| 10622 | specified. | |
| 10623 | ||
| 10624 | When point is a footnote definition, move to the first reference | |
| 10625 | found. If it is on a reference, move to the associated | |
| 10626 | definition. | |
| 10627 | ||
| 10628 | When point is on a headline, display a list of every link in the | |
| 10629 | entry, so it is possible to pick one, or all, of them. If point | |
| 10630 | is on a tag, call `org-tags-view' instead. | |
| 10631 | ||
| 10632 | When optional argument REFERENCE-BUFFER is non-nil, it should | |
| 10633 | specify a buffer from where the link search should happen. This | |
| 10634 | is used internally by `org-open-link-from-string'. | |
| 10635 | ||
| 10636 | On top of syntactically correct links, this function will also | |
| 10637 | try to open links and time-stamps in comments, example | |
| 10638 | blocks... i.e., whenever point is on something looking like | |
| 10639 | a timestamp or a link." | |
| 10640 | (interactive "P") | |
| 10641 | ;; On a code block, open block's results. | |
| 10642 | (unless (call-interactively 'org-babel-open-src-block-result) | |
| 10643 | (org-load-modules-maybe) | |
| 10644 | (setq org-window-config-before-follow-link (current-window-configuration)) | |
| 10645 | (org-remove-occur-highlights nil nil t) | |
| 10646 | (unless (run-hook-with-args-until-success 'org-open-at-point-functions) | |
| 10647 | (let* ((context | |
| 10648 | ;; Only consider supported types, even if they are not | |
| 10649 | ;; the closest one. | |
| 10650 | (org-element-lineage | |
| 10651 | (org-element-context) | |
| 10652 | '(clock footnote-definition footnote-reference headline | |
| 10653 | inlinetask link timestamp) | |
| 10654 | t)) | |
| 10655 | (type (org-element-type context)) | |
| 10656 | (value (org-element-property :value context))) | |
| 10657 | (cond | |
| 10658 | ;; On a headline or an inlinetask, but not on a timestamp, | |
| 10659 | ;; a link, a footnote reference. | |
| 10660 | ((memq type '(headline inlinetask)) | |
| 10661 | (org-match-line org-complex-heading-regexp) | |
| 10662 | (if (and (match-beginning 5) | |
| 10663 | (>= (point) (match-beginning 5)) | |
| 10664 | (< (point) (match-end 5))) | |
| 10665 | ;; On tags. | |
| 10666 | (org-tags-view arg (substring (match-string 5) 0 -1)) | |
| 10667 | ;; Not on tags. | |
| 10668 | (pcase (org-offer-links-in-entry (current-buffer) (point) arg) | |
| 10669 | (`(nil . ,_) | |
| 10670 | (require 'org-attach) | |
| 10671 | (org-attach-reveal 'if-exists)) | |
| 10672 | (`(,links . ,links-end) | |
| 10673 | (dolist (link (if (stringp links) (list links) links)) | |
| 10674 | (search-forward link nil links-end) | |
| 10675 | (goto-char (match-beginning 0)) | |
| 10676 | (org-open-at-point)))))) | |
| 10677 | ;; On a footnote reference or at definition's label. | |
| 10678 | ((or (eq type 'footnote-reference) | |
| 10679 | (and (eq type 'footnote-definition) | |
| 10680 | (save-excursion | |
| 10681 | ;; Do not validate action when point is on the | |
| 10682 | ;; spaces right after the footnote label, in | |
| 10683 | ;; order to be on par with behavior on links. | |
| 10684 | (skip-chars-forward " \t") | |
| 10685 | (let ((begin | |
| 10686 | (org-element-property :contents-begin context))) | |
| 10687 | (if begin (< (point) begin) | |
| 10688 | (= (org-element-property :post-affiliated context) | |
| 10689 | (line-beginning-position))))))) | |
| 10690 | (org-footnote-action)) | |
| 10691 | ;; No valid context. Ignore catch-all types like `headline'. | |
| 10692 | ;; If point is on something looking like a link or | |
| 10693 | ;; a time-stamp, try opening it. It may be useful in | |
| 10694 | ;; comments, example blocks... | |
| 10695 | ((memq type '(footnote-definition headline inlinetask nil)) | |
| 10696 | (call-interactively #'org-open-at-point-global)) | |
| 10697 | ;; On a clock line, make sure point is on the timestamp | |
| 10698 | ;; before opening it. | |
| 10699 | ((and (eq type 'clock) | |
| 10700 | value | |
| 10701 | (>= (point) (org-element-property :begin value)) | |
| 10702 | (<= (point) (org-element-property :end value))) | |
| 10703 | (org-follow-timestamp-link)) | |
| 10704 | ;; Do nothing on white spaces after an object. | |
| 10705 | ((>= (point) | |
| 10706 | (save-excursion | |
| 10707 | (goto-char (org-element-property :end context)) | |
| 10708 | (skip-chars-backward " \t") | |
| 10709 | (point))) | |
| 10710 | (user-error "No link found")) | |
| 10711 | ((eq type 'timestamp) (org-follow-timestamp-link)) | |
| 10712 | ((eq type 'link) | |
| 10713 | (let ((type (org-element-property :type context)) | |
| 10714 | (path (org-link-unescape (org-element-property :path context)))) | |
| 10715 | ;; Switch back to REFERENCE-BUFFER needed when called in | |
| 10716 | ;; a temporary buffer through `org-open-link-from-string'. | |
| 10717 | (with-current-buffer (or reference-buffer (current-buffer)) | |
| 10718 | (cond | |
| 10719 | ((equal type "file") | |
| 10720 | (if (string-match "[*?{]" (file-name-nondirectory path)) | |
| 10721 | (dired path) | |
| 10722 | ;; Look into `org-link-parameters' in order to find | |
| 10723 | ;; a DEDICATED-FUNCTION to open file. The function | |
| 10724 | ;; will be applied on raw link instead of parsed | |
| 10725 | ;; link due to the limitation in `org-add-link-type' | |
| 10726 | ;; ("open" function called with a single argument). | |
| 10727 | ;; If no such function is found, fallback to | |
| 10728 | ;; `org-open-file'. | |
| 10729 | (let* ((option (org-element-property :search-option context)) | |
| 10730 | (app (org-element-property :application context)) | |
| 10731 | (dedicated-function | |
| 10732 | (org-link-get-parameter | |
| 10733 | (if app (concat type "+" app) type) | |
| 10734 | :follow))) | |
| 10735 | (if dedicated-function | |
| 10736 | (funcall dedicated-function | |
| 10737 | (concat path | |
| 10738 | (and option (concat "::" option)))) | |
| 10739 | (apply #'org-open-file | |
| 10740 | path | |
| 10741 | (cond (arg) | |
| 10742 | ((equal app "emacs") 'emacs) | |
| 10743 | ((equal app "sys") 'system)) | |
| 10744 | (cond ((not option) nil) | |
| 10745 | ((string-match-p "\\`[0-9]+\\'" option) | |
| 10746 | (list (string-to-number option))) | |
| 10747 | (t (list nil | |
| 10748 | (org-link-unescape option))))))))) | |
| 10749 | ((functionp (org-link-get-parameter type :follow)) | |
| 10750 | (funcall (org-link-get-parameter type :follow) path)) | |
| 10751 | ((member type '("coderef" "custom-id" "fuzzy" "radio")) | |
| 10752 | (unless (run-hook-with-args-until-success | |
| 10753 | 'org-open-link-functions path) | |
| 10754 | (if (not arg) (org-mark-ring-push) | |
| 10755 | (switch-to-buffer-other-window | |
| 10756 | (org-get-buffer-for-internal-link (current-buffer)))) | |
| 10757 | (let ((destination | |
| 10758 | (org-with-wide-buffer | |
| 10759 | (if (equal type "radio") | |
| 10760 | (org-search-radio-target | |
| 10761 | (org-element-property :path context)) | |
| 10762 | (org-link-search | |
| 10763 | (if (member type '("custom-id" "coderef")) | |
| 10764 | (org-element-property :raw-link context) | |
| 10765 | path) | |
| 10766 | ;; Prevent fuzzy links from matching | |
| 10767 | ;; themselves. | |
| 10768 | (and (equal type "fuzzy") | |
| 10769 | (+ 2 (org-element-property :begin context))))) | |
| 10770 | (point)))) | |
| 10771 | (unless (and (<= (point-min) destination) | |
| 10772 | (>= (point-max) destination)) | |
| 10773 | (widen)) | |
| 10774 | (goto-char destination)))) | |
| 10775 | (t (browse-url-at-point)))))) | |
| 10776 | (t (user-error "No link found"))))) | |
| 10777 | (run-hook-with-args 'org-follow-link-hook))) | |
| 10778 | ||
| 10779 | (defun org-offer-links-in-entry (buffer marker &optional nth zero) | |
| 10780 | "Offer links in the current entry and return the selected link. | |
| 10781 | If there is only one link, return it. | |
| 10782 | If NTH is an integer, return the NTH link found. | |
| 10783 | If ZERO is a string, check also this string for a link, and if | |
| 10784 | there is one, return it." | |
| 10785 | (with-current-buffer buffer | |
| 10786 | (org-with-wide-buffer | |
| 10787 | (goto-char marker) | |
| 10788 | (let ((cnt ?0) | |
| 10789 | have-zero end links link c) | |
| 10790 | (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) | |
| 10791 | (push (match-string 0 zero) links) | |
| 10792 | (setq cnt (1- cnt) have-zero t)) | |
| 10793 | (save-excursion | |
| 10794 | (org-back-to-heading t) | |
| 10795 | (setq end (save-excursion (outline-next-heading) (point))) | |
| 10796 | (while (re-search-forward org-any-link-re end t) | |
| 10797 | (push (match-string 0) links)) | |
| 10798 | (setq links (org-uniquify (reverse links)))) | |
| 10799 | (cond | |
| 10800 | ((null links) | |
| 10801 | (message "No links")) | |
| 10802 | ((equal (length links) 1) | |
| 10803 | (setq link (car links))) | |
| 10804 | ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) | |
| 10805 | (setq link (nth (if have-zero nth (1- nth)) links))) | |
| 10806 | (t ; we have to select a link | |
| 10807 | (save-excursion | |
| 10808 | (save-window-excursion | |
| 10809 | (delete-other-windows) | |
| 10810 | (with-output-to-temp-buffer "*Select Link*" | |
| 10811 | (dolist (l links) | |
| 10812 | (cond | |
| 10813 | ((not (string-match org-bracket-link-regexp l)) | |
| 10814 | (princ (format "[%c] %s\n" (cl-incf cnt) | |
| 10815 | (org-unbracket-string "<" ">" l)))) | |
| 10816 | ((match-end 3) | |
| 10817 | (princ (format "[%c] %s (%s)\n" (cl-incf cnt) | |
| 10818 | (match-string 3 l) (match-string 1 l)))) | |
| 10819 | (t (princ (format "[%c] %s\n" (cl-incf cnt) | |
| 10820 | (match-string 1 l))))))) | |
| 10821 | (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) | |
| 10822 | (message "Select link to open, RET to open all:") | |
| 10823 | (setq c (read-char-exclusive)) | |
| 10824 | (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) | |
| 10825 | (when (equal c ?q) (user-error "Abort")) | |
| 10826 | (if (equal c ?\C-m) | |
| 10827 | (setq link links) | |
| 10828 | (setq nth (- c ?0)) | |
| 10829 | (when have-zero (setq nth (1+ nth))) | |
| 10830 | (unless (and (integerp nth) (>= (length links) nth)) | |
| 10831 | (user-error "Invalid link selection")) | |
| 10832 | (setq link (nth (1- nth) links))))) | |
| 10833 | (cons link end))))) | |
| 10834 | ||
| 10835 | ;; TODO: These functions are deprecated since `org-open-at-point' | |
| 10836 | ;; hard-codes behavior for "file+emacs" and "file+sys" types. | |
| 10837 | (defun org-open-file-with-system (path) | |
| 10838 | "Open file at PATH using the system way of opening it." | |
| 10839 | (org-open-file path 'system)) | |
| 10840 | (defun org-open-file-with-emacs (path) | |
| 10841 | "Open file at PATH in Emacs." | |
| 10842 | (org-open-file path 'emacs)) | |
| 10843 | ||
| 10844 | ||
| 10845 | ;;; File search | |
| 10846 | ||
| 10847 | (defvar org-create-file-search-functions nil | |
| 10848 | "List of functions to construct the right search string for a file link. | |
| 10849 | These functions are called in turn with point at the location to | |
| 10850 | which the link should point. | |
| 10851 | ||
| 10852 | A function in the hook should first test if it would like to | |
| 10853 | handle this file type, for example by checking the `major-mode' | |
| 10854 | or the file extension. If it decides not to handle this file, it | |
| 10855 | should just return nil to give other functions a chance. If it | |
| 10856 | does handle the file, it must return the search string to be used | |
| 10857 | when following the link. The search string will be part of the | |
| 10858 | file link, given after a double colon, and `org-open-at-point' | |
| 10859 | will automatically search for it. If special measures must be | |
| 10860 | taken to make the search successful, another function should be | |
| 10861 | added to the companion hook `org-execute-file-search-functions', | |
| 10862 | which see. | |
| 10863 | ||
| 10864 | A function in this hook may also use `setq' to set the variable | |
| 10865 | `description' to provide a suggestion for the descriptive text to | |
| 10866 | be used for this link when it gets inserted into an Org buffer | |
| 10867 | with \\[org-insert-link].") | |
| 10868 | ||
| 10869 | (defvar org-execute-file-search-functions nil | |
| 10870 | "List of functions to execute a file search triggered by a link. | |
| 10871 | ||
| 10872 | Functions added to this hook must accept a single argument, the | |
| 10873 | search string that was part of the file link, the part after the | |
| 10874 | double colon. The function must first check if it would like to | |
| 10875 | handle this search, for example by checking the `major-mode' or | |
| 10876 | the file extension. If it decides not to handle this search, it | |
| 10877 | should just return nil to give other functions a chance. If it | |
| 10878 | does handle the search, it must return a non-nil value to keep | |
| 10879 | other functions from trying. | |
| 10880 | ||
| 10881 | Each function can access the current prefix argument through the | |
| 10882 | variable `current-prefix-arg'. Note that a single prefix is used | |
| 10883 | to force opening a link in Emacs, so it may be good to only use a | |
| 10884 | numeric or double prefix to guide the search function. | |
| 10885 | ||
| 10886 | In case this is needed, a function in this hook can also restore | |
| 10887 | the window configuration before `org-open-at-point' was called using: | |
| 10888 | ||
| 10889 | (set-window-configuration org-window-config-before-follow-link)") | |
| 10890 | ||
| 10891 | (defun org-search-radio-target (target) | |
| 10892 | "Search a radio target matching TARGET in current buffer. | |
| 10893 | White spaces are not significant." | |
| 10894 | (let ((re (format "<<<%s>>>" | |
| 10895 | (mapconcat #'regexp-quote | |
| 10896 | (split-string target) | |
| 10897 | "[ \t]+\\(?:\n[ \t]*\\)?"))) | |
| 10898 | (origin (point))) | |
| 10899 | (goto-char (point-min)) | |
| 10900 | (catch :radio-match | |
| 10901 | (while (re-search-forward re nil t) | |
| 10902 | (backward-char) | |
| 10903 | (let ((object (org-element-context))) | |
| 10904 | (when (eq (org-element-type object) 'radio-target) | |
| 10905 | (goto-char (org-element-property :begin object)) | |
| 10906 | (org-show-context 'link-search) | |
| 10907 | (throw :radio-match nil)))) | |
| 10908 | (goto-char origin) | |
| 10909 | (user-error "No match for radio target: %s" target)))) | |
| 10910 | ||
| 10911 | (defun org-link-search (s &optional avoid-pos stealth) | |
| 10912 | "Search for a search string S. | |
| 10913 | ||
| 10914 | If S starts with \"#\", it triggers a custom ID search. | |
| 10915 | ||
| 10916 | If S is enclosed within parenthesis, it initiates a coderef | |
| 10917 | search. | |
| 10918 | ||
| 10919 | If S is surrounded by forward slashes, it is interpreted as | |
| 10920 | a regular expression. In Org mode files, this will create an | |
| 10921 | `org-occur' sparse tree. In ordinary files, `occur' will be used | |
| 10922 | to list matches. If the current buffer is in `dired-mode', grep | |
| 10923 | will be used to search in all files. | |
| 10924 | ||
| 10925 | When AVOID-POS is given, ignore matches near that position. | |
| 10926 | ||
| 10927 | When optional argument STEALTH is non-nil, do not modify | |
| 10928 | visibility around point, thus ignoring `org-show-context-detail' | |
| 10929 | variable. | |
| 10930 | ||
| 10931 | Search is case-insensitive and ignores white spaces. Return type | |
| 10932 | of matched result, which is either `dedicated' or `fuzzy'." | |
| 10933 | (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s)) | |
| 10934 | (let* ((case-fold-search t) | |
| 10935 | (origin (point)) | |
| 10936 | (normalized (replace-regexp-in-string "\n[ \t]*" " " s)) | |
| 10937 | (starred (eq (string-to-char normalized) ?*)) | |
| 10938 | (words (split-string (if starred (substring s 1) s))) | |
| 10939 | (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)")) | |
| 10940 | (s-single-re (mapconcat #'regexp-quote words "[ \t]+")) | |
| 10941 | type) | |
| 10942 | (cond | |
| 10943 | ;; Check if there are any special search functions. | |
| 10944 | ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) | |
| 10945 | ((eq (string-to-char s) ?#) | |
| 10946 | ;; Look for a custom ID S if S starts with "#". | |
| 10947 | (let* ((id (substring normalized 1)) | |
| 10948 | (match (org-find-property "CUSTOM_ID" id))) | |
| 10949 | (if match (progn (goto-char match) (setf type 'dedicated)) | |
| 10950 | (error "No match for custom ID: %s" id)))) | |
| 10951 | ((string-match "\\`(\\(.*\\))\\'" normalized) | |
| 10952 | ;; Look for coderef targets if S is enclosed within parenthesis. | |
| 10953 | (let ((coderef (match-string-no-properties 1 normalized)) | |
| 10954 | (re (substring s-single-re 1 -1))) | |
| 10955 | (goto-char (point-min)) | |
| 10956 | (catch :coderef-match | |
| 10957 | (while (re-search-forward re nil t) | |
| 10958 | (let ((element (org-element-at-point))) | |
| 10959 | (when (and (memq (org-element-type element) | |
| 10960 | '(example-block src-block)) | |
| 10961 | ;; Build proper regexp according to current | |
| 10962 | ;; block's label format. | |
| 10963 | (let ((label-fmt | |
| 10964 | (regexp-quote | |
| 10965 | (or (org-element-property :label-fmt element) | |
| 10966 | org-coderef-label-format)))) | |
| 10967 | (save-excursion | |
| 10968 | (beginning-of-line) | |
| 10969 | (looking-at (format ".*?\\(%s\\)[ \t]*$" | |
| 10970 | (format label-fmt coderef)))))) | |
| 10971 | (setq type 'dedicated) | |
| 10972 | (goto-char (match-beginning 1)) | |
| 10973 | (throw :coderef-match nil)))) | |
| 10974 | (goto-char origin) | |
| 10975 | (error "No match for coderef: %s" coderef)))) | |
| 10976 | ((string-match "\\`/\\(.*\\)/\\'" normalized) | |
| 10977 | ;; Look for a regular expression. | |
| 10978 | (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur) | |
| 10979 | (match-string 1 s))) | |
| 10980 | ;; From here, we handle fuzzy links. | |
| 10981 | ;; | |
| 10982 | ;; Look for targets, only if not in a headline search. | |
| 10983 | ((and (not starred) | |
| 10984 | (let ((target (format "<<%s>>" s-multi-re))) | |
| 10985 | (catch :target-match | |
| 10986 | (goto-char (point-min)) | |
| 10987 | (while (re-search-forward target nil t) | |
| 10988 | (backward-char) | |
| 10989 | (let ((context (org-element-context))) | |
| 10990 | (when (eq (org-element-type context) 'target) | |
| 10991 | (setq type 'dedicated) | |
| 10992 | (goto-char (org-element-property :begin context)) | |
| 10993 | (throw :target-match t)))) | |
| 10994 | nil)))) | |
| 10995 | ;; Look for elements named after S, only if not in a headline | |
| 10996 | ;; search. | |
| 10997 | ((and (not starred) | |
| 10998 | (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re))) | |
| 10999 | (catch :name-match | |
| 11000 | (goto-char (point-min)) | |
| 11001 | (while (re-search-forward name nil t) | |
| 11002 | (let ((element (org-element-at-point))) | |
| 11003 | (when (equal words | |
| 11004 | (split-string | |
| 11005 | (org-element-property :name element))) | |
| 11006 | (setq type 'dedicated) | |
| 11007 | (beginning-of-line) | |
| 11008 | (throw :name-match t)))) | |
| 11009 | nil)))) | |
| 11010 | ;; Regular text search. Prefer headlines in Org mode buffers. | |
| 11011 | ;; Ignore COMMENT keyword, TODO keywords, priority cookies, | |
| 11012 | ;; statistics cookies and tags. | |
| 11013 | ((and (derived-mode-p 'org-mode) | |
| 11014 | (let ((title-re | |
| 11015 | (format "%s.*\\(?:%s[ \t]\\)?.*%s" | |
| 11016 | org-outline-regexp-bol | |
| 11017 | org-comment-string | |
| 11018 | (mapconcat #'regexp-quote words ".+"))) | |
| 11019 | (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]") | |
| 11020 | (comment-re (eval-when-compile | |
| 11021 | (format "\\`%s[ \t]+" org-comment-string)))) | |
| 11022 | (goto-char (point-min)) | |
| 11023 | (catch :found | |
| 11024 | (while (re-search-forward title-re nil t) | |
| 11025 | (when (equal words | |
| 11026 | (split-string | |
| 11027 | (replace-regexp-in-string | |
| 11028 | cookie-re "" | |
| 11029 | (replace-regexp-in-string | |
| 11030 | comment-re "" (org-get-heading t t t))))) | |
| 11031 | (throw :found t))) | |
| 11032 | nil))) | |
| 11033 | (beginning-of-line) | |
| 11034 | (setq type 'dedicated)) | |
| 11035 | ;; Offer to create non-existent headline depending on | |
| 11036 | ;; `org-link-search-must-match-exact-headline'. | |
| 11037 | ((and (derived-mode-p 'org-mode) | |
| 11038 | (not org-link-search-inhibit-query) | |
| 11039 | (eq org-link-search-must-match-exact-headline 'query-to-create) | |
| 11040 | (yes-or-no-p "No match - create this as a new heading? ")) | |
| 11041 | (goto-char (point-max)) | |
| 11042 | (unless (bolp) (newline)) | |
| 11043 | (org-insert-heading nil t t) | |
| 11044 | (insert s "\n") | |
| 11045 | (beginning-of-line 0)) | |
| 11046 | ;; Only headlines are looked after. No need to process | |
| 11047 | ;; further: throw an error. | |
| 11048 | ((and (derived-mode-p 'org-mode) | |
| 11049 | (or starred org-link-search-must-match-exact-headline)) | |
| 11050 | (goto-char origin) | |
| 11051 | (error "No match for fuzzy expression: %s" normalized)) | |
| 11052 | ;; Regular text search. | |
| 11053 | ((catch :fuzzy-match | |
| 11054 | (goto-char (point-min)) | |
| 11055 | (while (re-search-forward s-multi-re nil t) | |
| 11056 | ;; Skip match if it contains AVOID-POS or it is included in | |
| 11057 | ;; a link with a description but outside the description. | |
| 11058 | (unless (or (and avoid-pos | |
| 11059 | (<= (match-beginning 0) avoid-pos) | |
| 11060 | (> (match-end 0) avoid-pos)) | |
| 11061 | (and (save-match-data | |
| 11062 | (org-in-regexp org-bracket-link-regexp)) | |
| 11063 | (match-beginning 3) | |
| 11064 | (or (> (match-beginning 3) (point)) | |
| 11065 | (<= (match-end 3) (point))) | |
| 11066 | (org-element-lineage | |
| 11067 | (save-match-data (org-element-context)) | |
| 11068 | '(link) t))) | |
| 11069 | (goto-char (match-beginning 0)) | |
| 11070 | (setq type 'fuzzy) | |
| 11071 | (throw :fuzzy-match t))) | |
| 11072 | nil)) | |
| 11073 | ;; All failed. Throw an error. | |
| 11074 | (t (goto-char origin) | |
| 11075 | (error "No match for fuzzy expression: %s" normalized))) | |
| 11076 | ;; Disclose surroundings of match, if appropriate. | |
| 11077 | (when (and (derived-mode-p 'org-mode) (not stealth)) | |
| 11078 | (org-show-context 'link-search)) | |
| 11079 | type)) | |
| 11080 | ||
| 11081 | (defun org-get-buffer-for-internal-link (buffer) | |
| 11082 | "Return a buffer to be used for displaying the link target of internal links." | |
| 11083 | (cond | |
| 11084 | ((not org-display-internal-link-with-indirect-buffer) | |
| 11085 | buffer) | |
| 11086 | ((string-suffix-p "(Clone)" (buffer-name buffer)) | |
| 11087 | (message "Buffer is already a clone, not making another one") | |
| 11088 | ;; we also do not modify visibility in this case | |
| 11089 | buffer) | |
| 11090 | (t ; make a new indirect buffer for displaying the link | |
| 11091 | (let* ((bn (buffer-name buffer)) | |
| 11092 | (ibn (concat bn "(Clone)")) | |
| 11093 | (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone)))) | |
| 11094 | (with-current-buffer ib (org-overview)) | |
| 11095 | ib)))) | |
| 11096 | ||
| 11097 | (defun org-do-occur (regexp &optional cleanup) | |
| 11098 | "Call the Emacs command `occur'. | |
| 11099 | If CLEANUP is non-nil, remove the printout of the regular expression | |
| 11100 | in the *Occur* buffer. This is useful if the regex is long and not useful | |
| 11101 | to read." | |
| 11102 | (occur regexp) | |
| 11103 | (when cleanup | |
| 11104 | (let ((cwin (selected-window)) win beg end) | |
| 11105 | (when (setq win (get-buffer-window "*Occur*")) | |
| 11106 | (select-window win)) | |
| 11107 | (goto-char (point-min)) | |
| 11108 | (when (re-search-forward "match[a-z]+" nil t) | |
| 11109 | (setq beg (match-end 0)) | |
| 11110 | (when (re-search-forward "^[ \t]*[0-9]+" nil t) | |
| 11111 | (setq end (1- (match-beginning 0))))) | |
| 11112 | (and beg end (let ((inhibit-read-only t)) (delete-region beg end))) | |
| 11113 | (goto-char (point-min)) | |
| 11114 | (select-window cwin)))) | |
| 11115 | ||
| 11116 | ;;; The mark ring for links jumps | |
| 11117 | ||
| 11118 | (defvar org-mark-ring nil | |
| 11119 | "Mark ring for positions before jumps in Org mode.") | |
| 11120 | (defvar org-mark-ring-last-goto nil | |
| 11121 | "Last position in the mark ring used to go back.") | |
| 11122 | ;; Fill and close the ring | |
| 11123 | (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded | |
| 11124 | (dotimes (_ org-mark-ring-length) | |
| 11125 | (push (make-marker) org-mark-ring)) | |
| 11126 | (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring) | |
| 11127 | org-mark-ring) | |
| 11128 | ||
| 11129 | (defun org-mark-ring-push (&optional pos buffer) | |
| 11130 | "Put the current position or POS into the mark ring and rotate it." | |
| 11131 | (interactive) | |
| 11132 | (setq pos (or pos (point))) | |
| 11133 | (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring)) | |
| 11134 | (move-marker (car org-mark-ring) | |
| 11135 | (or pos (point)) | |
| 11136 | (or buffer (current-buffer))) | |
| 11137 | (message "%s" | |
| 11138 | (substitute-command-keys | |
| 11139 | "Position saved to mark ring, go back with \ | |
| 11140 | `\\[org-mark-ring-goto]'."))) | |
| 11141 | ||
| 11142 | (defun org-mark-ring-goto (&optional n) | |
| 11143 | "Jump to the previous position in the mark ring. | |
| 11144 | With prefix arg N, jump back that many stored positions. When | |
| 11145 | called several times in succession, walk through the entire ring. | |
| 11146 | Org mode commands jumping to a different position in the current file, | |
| 11147 | or to another Org file, automatically push the old position onto the ring." | |
| 11148 | (interactive "p") | |
| 11149 | (let (p m) | |
| 11150 | (if (eq last-command this-command) | |
| 11151 | (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring))) | |
| 11152 | (setq p org-mark-ring)) | |
| 11153 | (setq org-mark-ring-last-goto p) | |
| 11154 | (setq m (car p)) | |
| 11155 | (pop-to-buffer-same-window (marker-buffer m)) | |
| 11156 | (goto-char m) | |
| 11157 | (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) | |
| 11158 | ||
| 11159 | (defun org-add-angle-brackets (s) | |
| 11160 | (unless (equal (substring s 0 1) "<") (setq s (concat "<" s))) | |
| 11161 | (unless (equal (substring s -1) ">") (setq s (concat s ">"))) | |
| 11162 | s) | |
| 11163 | ||
| 11164 | ;;; Following specific links | |
| 11165 | ||
| 11166 | (defvar org-agenda-buffer-tmp-name) | |
| 11167 | (defvar org-agenda-start-on-weekday) | |
| 11168 | (defun org-follow-timestamp-link () | |
| 11169 | "Open an agenda view for the time-stamp date/range at point." | |
| 11170 | (cond | |
| 11171 | ((org-at-date-range-p t) | |
| 11172 | (let ((org-agenda-start-on-weekday) | |
| 11173 | (t1 (match-string 1)) | |
| 11174 | (t2 (match-string 2)) tt1 tt2) | |
| 11175 | (setq tt1 (time-to-days (org-time-string-to-time t1)) | |
| 11176 | tt2 (time-to-days (org-time-string-to-time t2))) | |
| 11177 | (let ((org-agenda-buffer-tmp-name | |
| 11178 | (format "*Org Agenda(a:%s)" | |
| 11179 | (concat (substring t1 0 10) "--" (substring t2 0 10))))) | |
| 11180 | (org-agenda-list nil tt1 (1+ (- tt2 tt1)))))) | |
| 11181 | ((org-at-timestamp-p 'lax) | |
| 11182 | (let ((org-agenda-buffer-tmp-name | |
| 11183 | (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10)))) | |
| 11184 | (org-agenda-list nil (time-to-days (org-time-string-to-time | |
| 11185 | (substring (match-string 1) 0 10))) | |
| 11186 | 1))) | |
| 11187 | (t (error "This should not happen")))) | |
| 11188 | ||
| 11189 | ||
| 11190 | ;;; Following file links | |
| 11191 | (declare-function mailcap-parse-mailcaps "mailcap" (&optional path force)) | |
| 11192 | (declare-function mailcap-extension-to-mime "mailcap" (extn)) | |
| 11193 | (declare-function mailcap-mime-info | |
| 11194 | "mailcap" (string &optional request no-decode)) | |
| 11195 | (defvar org-wait nil) | |
| 11196 | (defun org-open-file (path &optional in-emacs line search) | |
| 11197 | "Open the file at PATH. | |
| 11198 | First, this expands any special file name abbreviations. Then the | |
| 11199 | configuration variable `org-file-apps' is checked if it contains an | |
| 11200 | entry for this file type, and if yes, the corresponding command is launched. | |
| 11201 | ||
| 11202 | If no application is found, Emacs simply visits the file. | |
| 11203 | ||
| 11204 | With optional prefix argument IN-EMACS, Emacs will visit the file. | |
| 11205 | With a double \\[universal-argument] \\[universal-argument] \ | |
| 11206 | prefix arg, Org tries to avoid opening in Emacs | |
| 11207 | and to use an external application to visit the file. | |
| 11208 | ||
| 11209 | Optional LINE specifies a line to go to, optional SEARCH a string | |
| 11210 | to search for. If LINE or SEARCH is given, the file will be | |
| 11211 | opened in Emacs, unless an entry from org-file-apps that makes | |
| 11212 | use of groups in a regexp matches. | |
| 11213 | ||
| 11214 | If you want to change the way frames are used when following a | |
| 11215 | link, please customize `org-link-frame-setup'. | |
| 11216 | ||
| 11217 | If the file does not exist, an error is thrown." | |
| 11218 | (let* ((file (if (equal path "") | |
| 11219 | buffer-file-name | |
| 11220 | (substitute-in-file-name (expand-file-name path)))) | |
| 11221 | (file-apps (append org-file-apps (org-default-apps))) | |
| 11222 | (apps (cl-remove-if | |
| 11223 | 'org-file-apps-entry-match-against-dlink-p file-apps)) | |
| 11224 | (apps-dlink (cl-remove-if-not | |
| 11225 | 'org-file-apps-entry-match-against-dlink-p file-apps)) | |
| 11226 | (remp (and (assq 'remote apps) (org-file-remote-p file))) | |
| 11227 | (dirp (unless remp (file-directory-p file))) | |
| 11228 | (file (if (and dirp org-open-directory-means-index-dot-org) | |
| 11229 | (concat (file-name-as-directory file) "index.org") | |
| 11230 | file)) | |
| 11231 | (a-m-a-p (assq 'auto-mode apps)) | |
| 11232 | (dfile (downcase file)) | |
| 11233 | ;; Reconstruct the original link from the PATH, LINE and | |
| 11234 | ;; SEARCH args. | |
| 11235 | (link (cond (line (concat file "::" (number-to-string line))) | |
| 11236 | (search (concat file "::" search)) | |
| 11237 | (t file))) | |
| 11238 | (dlink (downcase link)) | |
| 11239 | (ext | |
| 11240 | (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile) | |
| 11241 | (match-string 1 dfile))) | |
| 11242 | (save-position-maybe | |
| 11243 | (let ((old-buffer (current-buffer)) | |
| 11244 | (old-pos (point)) | |
| 11245 | (old-mode major-mode)) | |
| 11246 | (lambda () | |
| 11247 | (and (derived-mode-p 'org-mode) | |
| 11248 | (eq old-mode 'org-mode) | |
| 11249 | (or (not (eq old-buffer (current-buffer))) | |
| 11250 | (not (eq old-pos (point)))) | |
| 11251 | (org-mark-ring-push old-pos old-buffer))))) | |
| 11252 | cmd link-match-data) | |
| 11253 | (cond | |
| 11254 | ((member in-emacs '((16) system)) | |
| 11255 | (setq cmd (cdr (assq 'system apps)))) | |
| 11256 | (in-emacs (setq cmd 'emacs)) | |
| 11257 | (t | |
| 11258 | (setq cmd (or (and remp (cdr (assq 'remote apps))) | |
| 11259 | (and dirp (cdr (assq 'directory apps))) | |
| 11260 | ;; First, try matching against apps-dlink if we | |
| 11261 | ;; get a match here, store the match data for | |
| 11262 | ;; later. | |
| 11263 | (let ((match (assoc-default dlink apps-dlink | |
| 11264 | 'string-match))) | |
| 11265 | (if match | |
| 11266 | (progn (setq link-match-data (match-data)) | |
| 11267 | match) | |
| 11268 | (progn (setq in-emacs (or in-emacs line search)) | |
| 11269 | nil))) ; if we have no match in apps-dlink, | |
| 11270 | ; always open the file in emacs if line or search | |
| 11271 | ; is given (for backwards compatibility) | |
| 11272 | (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) | |
| 11273 | 'string-match) | |
| 11274 | (cdr (assoc ext apps)) | |
| 11275 | (cdr (assq t apps)))))) | |
| 11276 | (when (eq cmd 'system) | |
| 11277 | (setq cmd (cdr (assq 'system apps)))) | |
| 11278 | (when (eq cmd 'default) | |
| 11279 | (setq cmd (cdr (assoc t apps)))) | |
| 11280 | (when (eq cmd 'mailcap) | |
| 11281 | (require 'mailcap) | |
| 11282 | (mailcap-parse-mailcaps) | |
| 11283 | (let* ((mime-type (mailcap-extension-to-mime (or ext ""))) | |
| 11284 | (command (mailcap-mime-info mime-type))) | |
| 11285 | (if (stringp command) | |
| 11286 | (setq cmd command) | |
| 11287 | (setq cmd 'emacs)))) | |
| 11288 | (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files | |
| 11289 | (not (file-exists-p file)) | |
| 11290 | (not org-open-non-existing-files)) | |
| 11291 | (user-error "No such file: %s" file)) | |
| 11292 | (cond | |
| 11293 | ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) | |
| 11294 | ;; Remove quotes around the file name - we'll use shell-quote-argument. | |
| 11295 | (while (string-match "['\"]%s['\"]" cmd) | |
| 11296 | (setq cmd (replace-match "%s" t t cmd))) | |
| 11297 | (setq cmd (replace-regexp-in-string | |
| 11298 | "%s" | |
| 11299 | (shell-quote-argument (convert-standard-filename file)) | |
| 11300 | cmd | |
| 11301 | nil t)) | |
| 11302 | ||
| 11303 | ;; Replace "%1", "%2" etc. in command with group matches from regex | |
| 11304 | (save-match-data | |
| 11305 | (let ((match-index 1) | |
| 11306 | (number-of-groups (- (/ (length link-match-data) 2) 1))) | |
| 11307 | (set-match-data link-match-data) | |
| 11308 | (while (<= match-index number-of-groups) | |
| 11309 | (let ((regex (concat "%" (number-to-string match-index))) | |
| 11310 | (replace-with (match-string match-index dlink))) | |
| 11311 | (while (string-match regex cmd) | |
| 11312 | (setq cmd (replace-match replace-with t t cmd)))) | |
| 11313 | (setq match-index (+ match-index 1))))) | |
| 11314 | ||
| 11315 | (save-window-excursion | |
| 11316 | (message "Running %s...done" cmd) | |
| 11317 | (start-process-shell-command cmd nil cmd) | |
| 11318 | (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))) | |
| 11319 | ((or (stringp cmd) | |
| 11320 | (eq cmd 'emacs)) | |
| 11321 | (funcall (cdr (assq 'file org-link-frame-setup)) file) | |
| 11322 | (widen) | |
| 11323 | (cond (line (org-goto-line line) | |
| 11324 | (when (derived-mode-p 'org-mode) (org-reveal))) | |
| 11325 | (search (condition-case err | |
| 11326 | (org-link-search search) | |
| 11327 | ;; Save position before error-ing out so user | |
| 11328 | ;; can easily move back to the original buffer. | |
| 11329 | (error (funcall save-position-maybe) | |
| 11330 | (error (nth 1 err))))))) | |
| 11331 | ((functionp cmd) | |
| 11332 | (save-match-data | |
| 11333 | (set-match-data link-match-data) | |
| 11334 | (condition-case nil | |
| 11335 | (funcall cmd file link) | |
| 11336 | ;; FIXME: Remove this check when most default installations | |
| 11337 | ;; of Emacs have at least Org 9.0. | |
| 11338 | ((debug wrong-number-of-arguments wrong-type-argument | |
| 11339 | invalid-function) | |
| 11340 | (user-error "Please see Org News for version 9.0 about \ | |
| 11341 | `org-file-apps'--Lisp error: %S" cmd))))) | |
| 11342 | ((consp cmd) | |
| 11343 | ;; FIXME: Remove this check when most default installations of | |
| 11344 | ;; Emacs have at least Org 9.0. Heads-up instead of silently | |
| 11345 | ;; fall back to `org-link-frame-setup' for an old usage of | |
| 11346 | ;; `org-file-apps' with sexp instead of a function for `cmd'. | |
| 11347 | (user-error "Please see Org News for version 9.0 about \ | |
| 11348 | `org-file-apps'--Error: Deprecated usage of %S" cmd)) | |
| 11349 | (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) | |
| 11350 | (funcall save-position-maybe))) | |
| 11351 | ||
| 11352 | (defun org-file-apps-entry-match-against-dlink-p (entry) | |
| 11353 | "This function returns non-nil if `entry' uses a regular | |
| 11354 | expression which should be matched against the whole link by | |
| 11355 | org-open-file. | |
| 11356 | ||
| 11357 | It assumes that is the case when the entry uses a regular | |
| 11358 | expression which has at least one grouping construct and the | |
| 11359 | action is either a lisp form or a command string containing | |
| 11360 | `%1', i.e. using at least one subexpression match as a | |
| 11361 | parameter." | |
| 11362 | (let ((selector (car entry)) | |
| 11363 | (action (cdr entry))) | |
| 11364 | (if (stringp selector) | |
| 11365 | (and (> (regexp-opt-depth selector) 0) | |
| 11366 | (or (and (stringp action) | |
| 11367 | (string-match "%[0-9]" action)) | |
| 11368 | (consp action))) | |
| 11369 | nil))) | |
| 11370 | ||
| 11371 | (defun org-default-apps () | |
| 11372 | "Return the default applications for this operating system." | |
| 11373 | (cond | |
| 11374 | ((eq system-type 'darwin) | |
| 11375 | org-file-apps-defaults-macosx) | |
| 11376 | ((eq system-type 'windows-nt) | |
| 11377 | org-file-apps-defaults-windowsnt) | |
| 11378 | (t org-file-apps-defaults-gnu))) | |
| 11379 | ||
| 11380 | (defun org-apps-regexp-alist (list &optional add-auto-mode) | |
| 11381 | "Convert extensions to regular expressions in the cars of LIST. | |
| 11382 | Also, weed out any non-string entries, because the return value is used | |
| 11383 | only for regexp matching. | |
| 11384 | When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist' | |
| 11385 | point to the symbol `emacs', indicating that the file should | |
| 11386 | be opened in Emacs." | |
| 11387 | (append | |
| 11388 | (delq nil | |
| 11389 | (mapcar (lambda (x) | |
| 11390 | (unless (not (stringp (car x))) | |
| 11391 | (if (string-match "\\W" (car x)) | |
| 11392 | x | |
| 11393 | (cons (concat "\\." (car x) "\\'") (cdr x))))) | |
| 11394 | list)) | |
| 11395 | (when add-auto-mode | |
| 11396 | (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) | |
| 11397 | ||
| 11398 | (defvar ange-ftp-name-format) | |
| 11399 | (defun org-file-remote-p (file) | |
| 11400 | "Test whether FILE specifies a location on a remote system. | |
| 11401 | Return non-nil if the location is indeed remote. | |
| 11402 | ||
| 11403 | For example, the filename \"/user@host:/foo\" specifies a location | |
| 11404 | on the system \"/user@host:\"." | |
| 11405 | (cond ((fboundp 'file-remote-p) | |
| 11406 | (file-remote-p file)) | |
| 11407 | ((fboundp 'tramp-handle-file-remote-p) | |
| 11408 | (tramp-handle-file-remote-p file)) | |
| 11409 | ((and (boundp 'ange-ftp-name-format) | |
| 11410 | (string-match (car ange-ftp-name-format) file)) | |
| 11411 | t))) | |
| 11412 | ||
| 11413 | ||
| 11414 | ;;;; Refiling | |
| 11415 | ||
| 11416 | (defun org-get-org-file () | |
| 11417 | "Read a filename, with default directory `org-directory'." | |
| 11418 | (let ((default (or org-default-notes-file remember-data-file))) | |
| 11419 | (read-file-name (format "File name [%s]: " default) | |
| 11420 | (file-name-as-directory org-directory) | |
| 11421 | default))) | |
| 11422 | ||
| 11423 | (defun org-notes-order-reversed-p () | |
| 11424 | "Check if the current file should receive notes in reversed order." | |
| 11425 | (cond | |
| 11426 | ((not org-reverse-note-order) nil) | |
| 11427 | ((eq t org-reverse-note-order) t) | |
| 11428 | ((not (listp org-reverse-note-order)) nil) | |
| 11429 | (t (catch 'exit | |
| 11430 | (dolist (entry org-reverse-note-order) | |
| 11431 | (when (string-match (car entry) buffer-file-name) | |
| 11432 | (throw 'exit (cdr entry)))))))) | |
| 11433 | ||
| 11434 | (defvar org-refile-target-table nil | |
| 11435 | "The list of refile targets, created by `org-refile'.") | |
| 11436 | ||
| 11437 | (defvar org-agenda-new-buffers nil | |
| 11438 | "Buffers created to visit agenda files.") | |
| 11439 | ||
| 11440 | (defvar org-refile-cache nil | |
| 11441 | "Cache for refile targets.") | |
| 11442 | ||
| 11443 | (defvar org-refile-markers nil | |
| 11444 | "All the markers used for caching refile locations.") | |
| 11445 | ||
| 11446 | (defun org-refile-marker (pos) | |
| 11447 | "Get a new refile marker, but only if caching is in use." | |
| 11448 | (if (not org-refile-use-cache) | |
| 11449 | pos | |
| 11450 | (let ((m (make-marker))) | |
| 11451 | (move-marker m pos) | |
| 11452 | (push m org-refile-markers) | |
| 11453 | m))) | |
| 11454 | ||
| 11455 | (defun org-refile-cache-clear () | |
| 11456 | "Clear the refile cache and disable all the markers." | |
| 11457 | (dolist (m org-refile-markers) (move-marker m nil)) | |
| 11458 | (setq org-refile-markers nil) | |
| 11459 | (setq org-refile-cache nil) | |
| 11460 | (message "Refile cache has been cleared")) | |
| 11461 | ||
| 11462 | (defun org-refile-cache-check-set (set) | |
| 11463 | "Check if all the markers in the cache still have live buffers." | |
| 11464 | (let (marker) | |
| 11465 | (catch 'exit | |
| 11466 | (while (and set (setq marker (nth 3 (pop set)))) | |
| 11467 | ;; If `org-refile-use-outline-path' is 'file, marker may be nil | |
| 11468 | (when (and marker (null (marker-buffer marker))) | |
| 11469 | (message "Please regenerate the refile cache with `C-0 C-c C-w'") | |
| 11470 | (sit-for 3) | |
| 11471 | (throw 'exit nil))) | |
| 11472 | t))) | |
| 11473 | ||
| 11474 | (defun org-refile-cache-put (set &rest identifiers) | |
| 11475 | "Push the refile targets SET into the cache, under IDENTIFIERS." | |
| 11476 | (let* ((key (sha1 (prin1-to-string identifiers))) | |
| 11477 | (entry (assoc key org-refile-cache))) | |
| 11478 | (if entry | |
| 11479 | (setcdr entry set) | |
| 11480 | (push (cons key set) org-refile-cache)))) | |
| 11481 | ||
| 11482 | (defun org-refile-cache-get (&rest identifiers) | |
| 11483 | "Retrieve the cached value for refile targets given by IDENTIFIERS." | |
| 11484 | (cond | |
| 11485 | ((not org-refile-cache) nil) | |
| 11486 | ((not org-refile-use-cache) (org-refile-cache-clear) nil) | |
| 11487 | (t | |
| 11488 | (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers)) | |
| 11489 | org-refile-cache)))) | |
| 11490 | (and set (org-refile-cache-check-set set) set))))) | |
| 11491 | ||
| 11492 | (defvar org-outline-path-cache nil | |
| 11493 | "Alist between buffer positions and outline paths. | |
| 11494 | It value is an alist (POSITION . PATH) where POSITION is the | |
| 11495 | buffer position at the beginning of an entry and PATH is a list | |
| 11496 | of strings describing the outline path for that entry, in reverse | |
| 11497 | order.") | |
| 11498 | ||
| 11499 | (defun org-refile-get-targets (&optional default-buffer) | |
| 11500 | "Produce a table with refile targets." | |
| 11501 | (let ((case-fold-search nil) | |
| 11502 | ;; otherwise org confuses "TODO" as a kw and "Todo" as a word | |
| 11503 | (entries (or org-refile-targets '((nil . (:level . 1))))) | |
| 11504 | targets tgs files desc descre) | |
| 11505 | (message "Getting targets...") | |
| 11506 | (with-current-buffer (or default-buffer (current-buffer)) | |
| 11507 | (dolist (entry entries) | |
| 11508 | (setq files (car entry) desc (cdr entry)) | |
| 11509 | (cond | |
| 11510 | ((null files) (setq files (list (current-buffer)))) | |
| 11511 | ((eq files 'org-agenda-files) | |
| 11512 | (setq files (org-agenda-files 'unrestricted))) | |
| 11513 | ((and (symbolp files) (fboundp files)) | |
| 11514 | (setq files (funcall files))) | |
| 11515 | ((and (symbolp files) (boundp files)) | |
| 11516 | (setq files (symbol-value files)))) | |
| 11517 | (when (stringp files) (setq files (list files))) | |
| 11518 | (cond | |
| 11519 | ((eq (car desc) :tag) | |
| 11520 | (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) | |
| 11521 | ((eq (car desc) :todo) | |
| 11522 | (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) | |
| 11523 | ((eq (car desc) :regexp) | |
| 11524 | (setq descre (cdr desc))) | |
| 11525 | ((eq (car desc) :level) | |
| 11526 | (setq descre (concat "^\\*\\{" (number-to-string | |
| 11527 | (if org-odd-levels-only | |
| 11528 | (1- (* 2 (cdr desc))) | |
| 11529 | (cdr desc))) | |
| 11530 | "\\}[ \t]"))) | |
| 11531 | ((eq (car desc) :maxlevel) | |
| 11532 | (setq descre (concat "^\\*\\{1," (number-to-string | |
| 11533 | (if org-odd-levels-only | |
| 11534 | (1- (* 2 (cdr desc))) | |
| 11535 | (cdr desc))) | |
| 11536 | "\\}[ \t]"))) | |
| 11537 | (t (error "Bad refiling target description %s" desc))) | |
| 11538 | (dolist (f files) | |
| 11539 | (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) | |
| 11540 | (or | |
| 11541 | (setq tgs (org-refile-cache-get (buffer-file-name) descre)) | |
| 11542 | (progn | |
| 11543 | (when (bufferp f) | |
| 11544 | (setq f (buffer-file-name (buffer-base-buffer f)))) | |
| 11545 | (setq f (and f (expand-file-name f))) | |
| 11546 | (when (eq org-refile-use-outline-path 'file) | |
| 11547 | (push (list (file-name-nondirectory f) f nil nil) tgs)) | |
| 11548 | (when (eq org-refile-use-outline-path 'buffer-name) | |
| 11549 | (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs)) | |
| 11550 | (when (eq org-refile-use-outline-path 'full-file-path) | |
| 11551 | (push (list (file-truename (buffer-file-name (buffer-base-buffer))) f nil nil) tgs)) | |
| 11552 | (org-with-wide-buffer | |
| 11553 | (goto-char (point-min)) | |
| 11554 | (setq org-outline-path-cache nil) | |
| 11555 | (while (re-search-forward descre nil t) | |
| 11556 | (beginning-of-line) | |
| 11557 | (let ((case-fold-search nil)) | |
| 11558 | (looking-at org-complex-heading-regexp)) | |
| 11559 | (let ((begin (point)) | |
| 11560 | (heading (match-string-no-properties 4))) | |
| 11561 | (unless (or (and | |
| 11562 | org-refile-target-verify-function | |
| 11563 | (not | |
| 11564 | (funcall org-refile-target-verify-function))) | |
| 11565 | (not heading)) | |
| 11566 | (let ((re (format org-complex-heading-regexp-format | |
| 11567 | (regexp-quote heading))) | |
| 11568 | (target | |
| 11569 | (if (not org-refile-use-outline-path) heading | |
| 11570 | (mapconcat | |
| 11571 | #'identity | |
| 11572 | (append | |
| 11573 | (pcase org-refile-use-outline-path | |
| 11574 | (`file (list (file-name-nondirectory | |
| 11575 | (buffer-file-name | |
| 11576 | (buffer-base-buffer))))) | |
| 11577 | (`full-file-path | |
| 11578 | (list (buffer-file-name | |
| 11579 | (buffer-base-buffer)))) | |
| 11580 | (`buffer-name | |
| 11581 | (list (buffer-name | |
| 11582 | (buffer-base-buffer)))) | |
| 11583 | (_ nil)) | |
| 11584 | (mapcar (lambda (s) (replace-regexp-in-string | |
| 11585 | "/" "\\/" s nil t)) | |
| 11586 | (org-get-outline-path t t))) | |
| 11587 | "/")))) | |
| 11588 | (push (list target f re (org-refile-marker (point))) | |
| 11589 | tgs))) | |
| 11590 | (when (= (point) begin) | |
| 11591 | ;; Verification function has not moved point. | |
| 11592 | (end-of-line))))))) | |
| 11593 | (when org-refile-use-cache | |
| 11594 | (org-refile-cache-put tgs (buffer-file-name) descre)) | |
| 11595 | (setq targets (append tgs targets)))))) | |
| 11596 | (message "Getting targets...done") | |
| 11597 | (delete-dups (nreverse targets)))) | |
| 11598 | ||
| 11599 | (defun org--get-outline-path-1 (&optional use-cache) | |
| 11600 | "Return outline path to current headline. | |
| 11601 | ||
| 11602 | Outline path is a list of strings, in reverse order. When | |
| 11603 | optional argument USE-CACHE is non-nil, make use of a cache. See | |
| 11604 | `org-get-outline-path' for details. | |
| 11605 | ||
| 11606 | Assume buffer is widened and point is on a headline." | |
| 11607 | (or (and use-cache (cdr (assq (point) org-outline-path-cache))) | |
| 11608 | (let ((p (point)) | |
| 11609 | (heading (let ((case-fold-search nil)) | |
| 11610 | (looking-at org-complex-heading-regexp) | |
| 11611 | (if (not (match-end 4)) "" | |
| 11612 | ;; Remove statistics cookies. | |
| 11613 | (org-trim | |
| 11614 | (org-link-display-format | |
| 11615 | (replace-regexp-in-string | |
| 11616 | "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" | |
| 11617 | (match-string-no-properties 4)))))))) | |
| 11618 | (if (org-up-heading-safe) | |
| 11619 | (let ((path (cons heading (org--get-outline-path-1 use-cache)))) | |
| 11620 | (when use-cache | |
| 11621 | (push (cons p path) org-outline-path-cache)) | |
| 11622 | path) | |
| 11623 | ;; This is a new root node. Since we assume we are moving | |
| 11624 | ;; forward, we can drop previous cache so as to limit number | |
| 11625 | ;; of associations there. | |
| 11626 | (let ((path (list heading))) | |
| 11627 | (when use-cache (setq org-outline-path-cache (list (cons p path)))) | |
| 11628 | path))))) | |
| 11629 | ||
| 11630 | (defun org-get-outline-path (&optional with-self use-cache) | |
| 11631 | "Return the outline path to the current entry. | |
| 11632 | ||
| 11633 | An outline path is a list of ancestors for current headline, as | |
| 11634 | a list of strings. Statistics cookies are removed and links are | |
| 11635 | replaced with their description, if any, or their path otherwise. | |
| 11636 | ||
| 11637 | When optional argument WITH-SELF is non-nil, the path also | |
| 11638 | includes the current headline. | |
| 11639 | ||
| 11640 | When optional argument USE-CACHE is non-nil, cache outline paths | |
| 11641 | between calls to this function so as to avoid backtracking. This | |
| 11642 | argument is useful when planning to find more than one outline | |
| 11643 | path in the same document. In that case, there are two | |
| 11644 | conditions to satisfy: | |
| 11645 | - `org-outline-path-cache' is set to nil before starting the | |
| 11646 | process; | |
| 11647 | - outline paths are computed by increasing buffer positions." | |
| 11648 | (org-with-wide-buffer | |
| 11649 | (and (or (and with-self (org-back-to-heading t)) | |
| 11650 | (org-up-heading-safe)) | |
| 11651 | (reverse (org--get-outline-path-1 use-cache))))) | |
| 11652 | ||
| 11653 | (defun org-format-outline-path (path &optional width prefix separator) | |
| 11654 | "Format the outline path PATH for display. | |
| 11655 | WIDTH is the maximum number of characters that is available. | |
| 11656 | PREFIX is a prefix to be included in the returned string, | |
| 11657 | such as the file name. | |
| 11658 | SEPARATOR is inserted between the different parts of the path, | |
| 11659 | the default is \"/\"." | |
| 11660 | (setq width (or width 79)) | |
| 11661 | (setq path (delq nil path)) | |
| 11662 | (unless (> width 0) | |
| 11663 | (user-error "Argument `width' must be positive")) | |
| 11664 | (setq separator (or separator "/")) | |
| 11665 | (let* ((org-odd-levels-only nil) | |
| 11666 | (fpath (concat | |
| 11667 | prefix (and prefix path separator) | |
| 11668 | (mapconcat | |
| 11669 | (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) | |
| 11670 | (cl-loop for head in path | |
| 11671 | for n from 0 | |
| 11672 | collect (org-add-props | |
| 11673 | head nil 'face | |
| 11674 | (nth (% n org-n-level-faces) org-level-faces))) | |
| 11675 | separator)))) | |
| 11676 | (when (> (length fpath) width) | |
| 11677 | (if (< width 7) | |
| 11678 | ;; It's unlikely that `width' will be this small, but don't | |
| 11679 | ;; waste characters by adding ".." if it is. | |
| 11680 | (setq fpath (substring fpath 0 width)) | |
| 11681 | (setf (substring fpath (- width 2)) ".."))) | |
| 11682 | fpath)) | |
| 11683 | ||
| 11684 | (defun org-display-outline-path (&optional file current separator just-return-string) | |
| 11685 | "Display the current outline path in the echo area. | |
| 11686 | ||
| 11687 | If FILE is non-nil, prepend the output with the file name. | |
| 11688 | If CURRENT is non-nil, append the current heading to the output. | |
| 11689 | SEPARATOR is passed through to `org-format-outline-path'. It separates | |
| 11690 | the different parts of the path and defaults to \"/\". | |
| 11691 | If JUST-RETURN-STRING is non-nil, return a string, don't display a message." | |
| 11692 | (interactive "P") | |
| 11693 | (let* (case-fold-search | |
| 11694 | (bfn (buffer-file-name (buffer-base-buffer))) | |
| 11695 | (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) | |
| 11696 | res) | |
| 11697 | (when current (setq path (append path | |
| 11698 | (save-excursion | |
| 11699 | (org-back-to-heading t) | |
| 11700 | (when (looking-at org-complex-heading-regexp) | |
| 11701 | (list (match-string 4))))))) | |
| 11702 | (setq res | |
| 11703 | (org-format-outline-path | |
| 11704 | path | |
| 11705 | (1- (frame-width)) | |
| 11706 | (and file bfn (concat (file-name-nondirectory bfn) separator)) | |
| 11707 | separator)) | |
| 11708 | (if just-return-string | |
| 11709 | (org-no-properties res) | |
| 11710 | (org-unlogged-message "%s" res)))) | |
| 11711 | ||
| 11712 | (defvar org-refile-history nil | |
| 11713 | "History for refiling operations.") | |
| 11714 | ||
| 11715 | (defvar org-after-refile-insert-hook nil | |
| 11716 | "Hook run after `org-refile' has inserted its stuff at the new location. | |
| 11717 | Note that this is still *before* the stuff will be removed from | |
| 11718 | the *old* location.") | |
| 11719 | ||
| 11720 | (defvar org-capture-last-stored-marker) | |
| 11721 | (defvar org-refile-keep nil | |
| 11722 | "Non-nil means `org-refile' will copy instead of refile.") | |
| 11723 | ||
| 11724 | (defun org-copy () | |
| 11725 | "Like `org-refile', but copy." | |
| 11726 | (interactive) | |
| 11727 | (let ((org-refile-keep t)) | |
| 11728 | (funcall 'org-refile nil nil nil "Copy"))) | |
| 11729 | ||
| 11730 | (defun org-refile (&optional arg default-buffer rfloc msg) | |
| 11731 | "Move the entry or entries at point to another heading. | |
| 11732 | ||
| 11733 | The list of target headings is compiled using the information in | |
| 11734 | `org-refile-targets', which see. | |
| 11735 | ||
| 11736 | At the target location, the entry is filed as a subitem of the | |
| 11737 | target heading. Depending on `org-reverse-note-order', the new | |
| 11738 | subitem will either be the first or the last subitem. | |
| 11739 | ||
| 11740 | If there is an active region, all entries in that region will be | |
| 11741 | refiled. However, the region must fulfill the requirement that | |
| 11742 | the first heading sets the top-level of the moved text. | |
| 11743 | ||
| 11744 | With a `\\[universal-argument]' ARG, the command will only visit the target \ | |
| 11745 | location | |
| 11746 | and not actually move anything. | |
| 11747 | ||
| 11748 | With a prefix `\\[universal-argument] \\[universal-argument]', go to the \ | |
| 11749 | location where the last | |
| 11750 | refiling operation has put the subtree. | |
| 11751 | ||
| 11752 | With a numeric prefix argument of `2', refile to the running clock. | |
| 11753 | ||
| 11754 | With a numeric prefix argument of `3', emulate `org-refile-keep' | |
| 11755 | being set to t and copy to the target location, don't move it. | |
| 11756 | Beware that keeping refiled entries may result in duplicated ID | |
| 11757 | properties. | |
| 11758 | ||
| 11759 | RFLOC can be a refile location obtained in a different way. | |
| 11760 | ||
| 11761 | MSG is a string to replace \"Refile\" in the default prompt with | |
| 11762 | another verb. E.g. `org-copy' sets this parameter to \"Copy\". | |
| 11763 | ||
| 11764 | See also `org-refile-use-outline-path'. | |
| 11765 | ||
| 11766 | If you are using target caching (see `org-refile-use-cache'), you | |
| 11767 | have to clear the target cache in order to find new targets. | |
| 11768 | This can be done with a `0' prefix (`C-0 C-c C-w') or a triple | |
| 11769 | prefix argument (`C-u C-u C-u C-c C-w')." | |
| 11770 | (interactive "P") | |
| 11771 | (if (member arg '(0 (64))) | |
| 11772 | (org-refile-cache-clear) | |
| 11773 | (let* ((actionmsg (cond (msg msg) | |
| 11774 | ((equal arg 3) "Refile (and keep)") | |
| 11775 | (t "Refile"))) | |
| 11776 | (regionp (org-region-active-p)) | |
| 11777 | (region-start (and regionp (region-beginning))) | |
| 11778 | (region-end (and regionp (region-end))) | |
| 11779 | (org-refile-keep (if (equal arg 3) t org-refile-keep)) | |
| 11780 | pos it nbuf file level reversed) | |
| 11781 | (setq last-command nil) | |
| 11782 | (when regionp | |
| 11783 | (goto-char region-start) | |
| 11784 | (or (bolp) (goto-char (point-at-bol))) | |
| 11785 | (setq region-start (point)) | |
| 11786 | (unless (or (org-kill-is-subtree-p | |
| 11787 | (buffer-substring region-start region-end)) | |
| 11788 | (prog1 org-refile-active-region-within-subtree | |
| 11789 | (let ((s (point-at-eol))) | |
| 11790 | (org-toggle-heading) | |
| 11791 | (setq region-end (+ (- (point-at-eol) s) region-end))))) | |
| 11792 | (user-error "The region is not a (sequence of) subtree(s)"))) | |
| 11793 | (if (equal arg '(16)) | |
| 11794 | (org-refile-goto-last-stored) | |
| 11795 | (when (or | |
| 11796 | (and (equal arg 2) | |
| 11797 | org-clock-hd-marker (marker-buffer org-clock-hd-marker) | |
| 11798 | (prog1 | |
| 11799 | (setq it (list (or org-clock-heading "running clock") | |
| 11800 | (buffer-file-name | |
| 11801 | (marker-buffer org-clock-hd-marker)) | |
| 11802 | "" | |
| 11803 | (marker-position org-clock-hd-marker))) | |
| 11804 | (setq arg nil))) | |
| 11805 | (setq it | |
| 11806 | (or rfloc | |
| 11807 | (let (heading-text) | |
| 11808 | (save-excursion | |
| 11809 | (unless (and arg (listp arg)) | |
| 11810 | (org-back-to-heading t) | |
| 11811 | (setq heading-text | |
| 11812 | (replace-regexp-in-string | |
| 11813 | org-bracket-link-regexp | |
| 11814 | "\\3" | |
| 11815 | (or (nth 4 (org-heading-components)) | |
| 11816 | "")))) | |
| 11817 | (org-refile-get-location | |
| 11818 | (cond ((and arg (listp arg)) "Goto") | |
| 11819 | (regionp (concat actionmsg " region to")) | |
| 11820 | (t (concat actionmsg " subtree \"" | |
| 11821 | heading-text "\" to"))) | |
| 11822 | default-buffer | |
| 11823 | (and (not (equal '(4) arg)) | |
| 11824 | org-refile-allow-creating-parent-nodes))))))) | |
| 11825 | (setq file (nth 1 it) | |
| 11826 | pos (nth 3 it)) | |
| 11827 | (when (and (not arg) | |
| 11828 | pos | |
| 11829 | (equal (buffer-file-name) file) | |
| 11830 | (if regionp | |
| 11831 | (and (>= pos region-start) | |
| 11832 | (<= pos region-end)) | |
| 11833 | (and (>= pos (point)) | |
| 11834 | (< pos (save-excursion | |
| 11835 | (org-end-of-subtree t t)))))) | |
| 11836 | (error "Cannot refile to position inside the tree or region")) | |
| 11837 | (setq nbuf (or (find-buffer-visiting file) | |
| 11838 | (find-file-noselect file))) | |
| 11839 | (if (and arg (not (equal arg 3))) | |
| 11840 | (progn | |
| 11841 | (pop-to-buffer-same-window nbuf) | |
| 11842 | (goto-char (cond (pos) | |
| 11843 | ((org-notes-order-reversed-p) (point-min)) | |
| 11844 | (t (point-max)))) | |
| 11845 | (org-show-context 'org-goto)) | |
| 11846 | (if regionp | |
| 11847 | (progn | |
| 11848 | (org-kill-new (buffer-substring region-start region-end)) | |
| 11849 | (org-save-markers-in-region region-start region-end)) | |
| 11850 | (org-copy-subtree 1 nil t)) | |
| 11851 | (with-current-buffer (setq nbuf (or (find-buffer-visiting file) | |
| 11852 | (find-file-noselect file))) | |
| 11853 | (setq reversed (org-notes-order-reversed-p)) | |
| 11854 | (org-with-wide-buffer | |
| 11855 | (if pos | |
| 11856 | (progn | |
| 11857 | (goto-char pos) | |
| 11858 | (setq level (org-get-valid-level (funcall outline-level) 1)) | |
| 11859 | (goto-char | |
| 11860 | (if reversed | |
| 11861 | (or (outline-next-heading) (point-max)) | |
| 11862 | (or (save-excursion (org-get-next-sibling)) | |
| 11863 | (org-end-of-subtree t t) | |
| 11864 | (point-max))))) | |
| 11865 | (setq level 1) | |
| 11866 | (if (not reversed) | |
| 11867 | (goto-char (point-max)) | |
| 11868 | (goto-char (point-min)) | |
| 11869 | (or (outline-next-heading) (goto-char (point-max))))) | |
| 11870 | (unless (bolp) (newline)) | |
| 11871 | (org-paste-subtree level nil nil t) | |
| 11872 | (when org-log-refile | |
| 11873 | (org-add-log-setup 'refile nil nil org-log-refile) | |
| 11874 | (unless (eq org-log-refile 'note) | |
| 11875 | (save-excursion (org-add-log-note)))) | |
| 11876 | (and org-auto-align-tags | |
| 11877 | (let ((org-loop-over-headlines-in-active-region nil)) | |
| 11878 | (org-set-tags nil t))) | |
| 11879 | (let ((bookmark-name (plist-get org-bookmark-names-plist | |
| 11880 | :last-refile))) | |
| 11881 | (when bookmark-name | |
| 11882 | (with-demoted-errors | |
| 11883 | (bookmark-set bookmark-name)))) | |
| 11884 | ;; If we are refiling for capture, make sure that the | |
| 11885 | ;; last-capture pointers point here | |
| 11886 | (when (bound-and-true-p org-capture-is-refiling) | |
| 11887 | (let ((bookmark-name (plist-get org-bookmark-names-plist | |
| 11888 | :last-capture-marker))) | |
| 11889 | (when bookmark-name | |
| 11890 | (with-demoted-errors | |
| 11891 | (bookmark-set bookmark-name)))) | |
| 11892 | (move-marker org-capture-last-stored-marker (point))) | |
| 11893 | (when (fboundp 'deactivate-mark) (deactivate-mark)) | |
| 11894 | (run-hooks 'org-after-refile-insert-hook))) | |
| 11895 | (unless org-refile-keep | |
| 11896 | (if regionp | |
| 11897 | (delete-region (point) (+ (point) (- region-end region-start))) | |
| 11898 | (delete-region | |
| 11899 | (and (org-back-to-heading t) (point)) | |
| 11900 | (min (1+ (buffer-size)) (org-end-of-subtree t t) (point))))) | |
| 11901 | (when (featurep 'org-inlinetask) | |
| 11902 | (org-inlinetask-remove-END-maybe)) | |
| 11903 | (setq org-markers-to-move nil) | |
| 11904 | (message (concat actionmsg " to \"%s\" in file %s: done") (car it) file))))))) | |
| 11905 | ||
| 11906 | (defun org-refile-goto-last-stored () | |
| 11907 | "Go to the location where the last refile was stored." | |
| 11908 | (interactive) | |
| 11909 | (bookmark-jump (plist-get org-bookmark-names-plist :last-refile)) | |
| 11910 | (message "This is the location of the last refile")) | |
| 11911 | ||
| 11912 | (defun org-refile--get-location (refloc tbl) | |
| 11913 | "When user refile to REFLOC, find the associated target in TBL. | |
| 11914 | Also check `org-refile-target-table'." | |
| 11915 | (car (delq | |
| 11916 | nil | |
| 11917 | (mapcar | |
| 11918 | (lambda (r) (or (assoc r tbl) | |
| 11919 | (assoc r org-refile-target-table))) | |
| 11920 | (list (replace-regexp-in-string "/$" "" refloc) | |
| 11921 | (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc)))))) | |
| 11922 | ||
| 11923 | (defun org-refile-get-location (&optional prompt default-buffer new-nodes) | |
| 11924 | "Prompt the user for a refile location, using PROMPT. | |
| 11925 | PROMPT should not be suffixed with a colon and a space, because | |
| 11926 | this function appends the default value from | |
| 11927 | `org-refile-history' automatically, if that is not empty." | |
| 11928 | (let ((org-refile-targets org-refile-targets) | |
| 11929 | (org-refile-use-outline-path org-refile-use-outline-path)) | |
| 11930 | (setq org-refile-target-table (org-refile-get-targets default-buffer))) | |
| 11931 | (unless org-refile-target-table | |
| 11932 | (user-error "No refile targets")) | |
| 11933 | (let* ((cbuf (current-buffer)) | |
| 11934 | (cfn (buffer-file-name (buffer-base-buffer cbuf))) | |
| 11935 | (cfunc (if (and org-refile-use-outline-path | |
| 11936 | org-outline-path-complete-in-steps) | |
| 11937 | #'org-olpath-completing-read | |
| 11938 | #'completing-read)) | |
| 11939 | (extra (if org-refile-use-outline-path "/" "")) | |
| 11940 | (cbnex (concat (buffer-name) extra)) | |
| 11941 | (filename (and cfn (expand-file-name cfn))) | |
| 11942 | (tbl (mapcar | |
| 11943 | (lambda (x) | |
| 11944 | (if (and (not (member org-refile-use-outline-path | |
| 11945 | '(file full-file-path))) | |
| 11946 | (not (equal filename (nth 1 x)))) | |
| 11947 | (cons (concat (car x) extra " (" | |
| 11948 | (file-name-nondirectory (nth 1 x)) ")") | |
| 11949 | (cdr x)) | |
| 11950 | (cons (concat (car x) extra) (cdr x)))) | |
| 11951 | org-refile-target-table)) | |
| 11952 | (completion-ignore-case t) | |
| 11953 | cdef | |
| 11954 | (prompt (concat prompt | |
| 11955 | (or (and (car org-refile-history) | |
| 11956 | (concat " (default " (car org-refile-history) ")")) | |
| 11957 | (and (assoc cbnex tbl) (setq cdef cbnex) | |
| 11958 | (concat " (default " cbnex ")"))) ": ")) | |
| 11959 | pa answ parent-target child parent old-hist) | |
| 11960 | (setq old-hist org-refile-history) | |
| 11961 | (setq answ (funcall cfunc prompt tbl nil (not new-nodes) | |
| 11962 | nil 'org-refile-history (or cdef (car org-refile-history)))) | |
| 11963 | (if (setq pa (org-refile--get-location answ tbl)) | |
| 11964 | (progn | |
| 11965 | (org-refile-check-position pa) | |
| 11966 | (when (or (not org-refile-history) | |
| 11967 | (not (eq old-hist org-refile-history)) | |
| 11968 | (not (equal (car pa) (car org-refile-history)))) | |
| 11969 | (setq org-refile-history | |
| 11970 | (cons (car pa) (if (assoc (car org-refile-history) tbl) | |
| 11971 | org-refile-history | |
| 11972 | (cdr org-refile-history)))) | |
| 11973 | (when (equal (car org-refile-history) (nth 1 org-refile-history)) | |
| 11974 | (pop org-refile-history))) | |
| 11975 | pa) | |
| 11976 | (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) | |
| 11977 | (progn | |
| 11978 | (setq parent (match-string 1 answ) | |
| 11979 | child (match-string 2 answ)) | |
| 11980 | (setq parent-target (org-refile--get-location parent tbl)) | |
| 11981 | (when (and parent-target | |
| 11982 | (or (eq new-nodes t) | |
| 11983 | (and (eq new-nodes 'confirm) | |
| 11984 | (y-or-n-p (format "Create new node \"%s\"? " | |
| 11985 | child))))) | |
| 11986 | (org-refile-new-child parent-target child))) | |
| 11987 | (user-error "Invalid target location"))))) | |
| 11988 | ||
| 11989 | (declare-function org-string-nw-p "org-macs" (s)) | |
| 11990 | (defun org-refile-check-position (refile-pointer) | |
| 11991 | "Check if the refile pointer matches the headline to which it points." | |
| 11992 | (let* ((file (nth 1 refile-pointer)) | |
| 11993 | (re (nth 2 refile-pointer)) | |
| 11994 | (pos (nth 3 refile-pointer)) | |
| 11995 | buffer) | |
| 11996 | (if (and (not (markerp pos)) (not file)) | |
| 11997 | (user-error "Please indicate a target file in the refile path") | |
| 11998 | (when (org-string-nw-p re) | |
| 11999 | (setq buffer (if (markerp pos) | |
| 12000 | (marker-buffer pos) | |
| 12001 | (or (find-buffer-visiting file) | |
| 12002 | (find-file-noselect file)))) | |
| 12003 | (with-current-buffer buffer | |
| 12004 | (org-with-wide-buffer | |
| 12005 | (goto-char pos) | |
| 12006 | (beginning-of-line 1) | |
| 12007 | (unless (looking-at-p re) | |
| 12008 | (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))) | |
| 12009 | ||
| 12010 | (defun org-refile-new-child (parent-target child) | |
| 12011 | "Use refile target PARENT-TARGET to add new CHILD below it." | |
| 12012 | (unless parent-target | |
| 12013 | (error "Cannot find parent for new node")) | |
| 12014 | (let ((file (nth 1 parent-target)) | |
| 12015 | (pos (nth 3 parent-target)) | |
| 12016 | level) | |
| 12017 | (with-current-buffer (or (find-buffer-visiting file) | |
| 12018 | (find-file-noselect file)) | |
| 12019 | (org-with-wide-buffer | |
| 12020 | (if pos | |
| 12021 | (goto-char pos) | |
| 12022 | (goto-char (point-max)) | |
| 12023 | (unless (bolp) (newline))) | |
| 12024 | (when (looking-at org-outline-regexp) | |
| 12025 | (setq level (funcall outline-level)) | |
| 12026 | (org-end-of-subtree t t)) | |
| 12027 | (org-back-over-empty-lines) | |
| 12028 | (insert "\n" (make-string | |
| 12029 | (if pos (org-get-valid-level level 1) 1) ?*) | |
| 12030 | " " child "\n") | |
| 12031 | (beginning-of-line 0) | |
| 12032 | (list (concat (car parent-target) "/" child) file "" (point)))))) | |
| 12033 | ||
| 12034 | (defun org-olpath-completing-read (prompt collection &rest args) | |
| 12035 | "Read an outline path like a file name." | |
| 12036 | (let ((thetable collection)) | |
| 12037 | (apply #'completing-read | |
| 12038 | prompt | |
| 12039 | (lambda (string predicate &optional flag) | |
| 12040 | (cond | |
| 12041 | ((eq flag nil) (try-completion string thetable)) | |
| 12042 | ((eq flag t) | |
| 12043 | (let ((l (length string))) | |
| 12044 | (mapcar (lambda (x) | |
| 12045 | (let ((r (substring x l)) | |
| 12046 | (f (if (string-match " ([^)]*)$" x) | |
| 12047 | (match-string 0 x) | |
| 12048 | ""))) | |
| 12049 | (if (string-match "/" r) | |
| 12050 | (concat string (substring r 0 (match-end 0)) f) | |
| 12051 | x))) | |
| 12052 | (all-completions string thetable predicate)))) | |
| 12053 | ;; Exact match? | |
| 12054 | ((eq flag 'lambda) (assoc string thetable)))) | |
| 12055 | args))) | |
| 12056 | ||
| 12057 | ;;;; Dynamic blocks | |
| 12058 | ||
| 12059 | (defun org-find-dblock (name) | |
| 12060 | "Find the first dynamic block with name NAME in the buffer. | |
| 12061 | If not found, stay at current position and return nil." | |
| 12062 | (let ((case-fold-search t) pos) | |
| 12063 | (save-excursion | |
| 12064 | (goto-char (point-min)) | |
| 12065 | (setq pos (and (re-search-forward | |
| 12066 | (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t) | |
| 12067 | (match-beginning 0)))) | |
| 12068 | (when pos (goto-char pos)) | |
| 12069 | pos)) | |
| 12070 | ||
| 12071 | (defun org-create-dblock (plist) | |
| 12072 | "Create a dynamic block section, with parameters taken from PLIST. | |
| 12073 | PLIST must contain a :name entry which is used as the name of the block." | |
| 12074 | (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol))) | |
| 12075 | (end-of-line 1) | |
| 12076 | (newline)) | |
| 12077 | (let ((col (current-column)) | |
| 12078 | (name (plist-get plist :name))) | |
| 12079 | (insert "#+BEGIN: " name) | |
| 12080 | (while plist | |
| 12081 | (if (eq (car plist) :name) | |
| 12082 | (setq plist (cddr plist)) | |
| 12083 | (insert " " (prin1-to-string (pop plist))))) | |
| 12084 | (insert "\n\n" (make-string col ?\ ) "#+END:\n") | |
| 12085 | (beginning-of-line -2))) | |
| 12086 | ||
| 12087 | (defun org-prepare-dblock () | |
| 12088 | "Prepare dynamic block for refresh. | |
| 12089 | This empties the block, puts the cursor at the insert position and returns | |
| 12090 | the property list including an extra property :name with the block name." | |
| 12091 | (unless (looking-at org-dblock-start-re) | |
| 12092 | (user-error "Not at a dynamic block")) | |
| 12093 | (let* ((begdel (1+ (match-end 0))) | |
| 12094 | (name (org-no-properties (match-string 1))) | |
| 12095 | (params (append (list :name name) | |
| 12096 | (read (concat "(" (match-string 3) ")"))))) | |
| 12097 | (save-excursion | |
| 12098 | (beginning-of-line 1) | |
| 12099 | (skip-chars-forward " \t") | |
| 12100 | (setq params (plist-put params :indentation-column (current-column)))) | |
| 12101 | (unless (re-search-forward org-dblock-end-re nil t) | |
| 12102 | (error "Dynamic block not terminated")) | |
| 12103 | (setq params | |
| 12104 | (append params | |
| 12105 | (list :content (buffer-substring | |
| 12106 | begdel (match-beginning 0))))) | |
| 12107 | (delete-region begdel (match-beginning 0)) | |
| 12108 | (goto-char begdel) | |
| 12109 | (open-line 1) | |
| 12110 | params)) | |
| 12111 | ||
| 12112 | (defun org-map-dblocks (&optional command) | |
| 12113 | "Apply COMMAND to all dynamic blocks in the current buffer. | |
| 12114 | If COMMAND is not given, use `org-update-dblock'." | |
| 12115 | (let ((cmd (or command 'org-update-dblock))) | |
| 12116 | (save-excursion | |
| 12117 | (goto-char (point-min)) | |
| 12118 | (while (re-search-forward org-dblock-start-re nil t) | |
| 12119 | (goto-char (match-beginning 0)) | |
| 12120 | (save-excursion | |
| 12121 | (condition-case nil | |
| 12122 | (funcall cmd) | |
| 12123 | (error (message "Error during update of dynamic block")))) | |
| 12124 | (unless (re-search-forward org-dblock-end-re nil t) | |
| 12125 | (error "Dynamic block not terminated")))))) | |
| 12126 | ||
| 12127 | (defun org-dblock-update (&optional arg) | |
| 12128 | "User command for updating dynamic blocks. | |
| 12129 | Update the dynamic block at point. With prefix ARG, update all dynamic | |
| 12130 | blocks in the buffer." | |
| 12131 | (interactive "P") | |
| 12132 | (if arg | |
| 12133 | (org-update-all-dblocks) | |
| 12134 | (or (looking-at org-dblock-start-re) | |
| 12135 | (org-beginning-of-dblock)) | |
| 12136 | (org-update-dblock))) | |
| 12137 | ||
| 12138 | (defun org-update-dblock () | |
| 12139 | "Update the dynamic block at point. | |
| 12140 | This means to empty the block, parse for parameters and then call | |
| 12141 | the correct writing function." | |
| 12142 | (interactive) | |
| 12143 | (save-excursion | |
| 12144 | (let* ((win (selected-window)) | |
| 12145 | (pos (point)) | |
| 12146 | (line (org-current-line)) | |
| 12147 | (params (org-prepare-dblock)) | |
| 12148 | (name (plist-get params :name)) | |
| 12149 | (indent (plist-get params :indentation-column)) | |
| 12150 | (cmd (intern (concat "org-dblock-write:" name)))) | |
| 12151 | (message "Updating dynamic block `%s' at line %d..." name line) | |
| 12152 | (funcall cmd params) | |
| 12153 | (message "Updating dynamic block `%s' at line %d...done" name line) | |
| 12154 | (goto-char pos) | |
| 12155 | (when (and indent (> indent 0)) | |
| 12156 | (setq indent (make-string indent ?\ )) | |
| 12157 | (save-excursion | |
| 12158 | (select-window win) | |
| 12159 | (org-beginning-of-dblock) | |
| 12160 | (forward-line 1) | |
| 12161 | (while (not (looking-at org-dblock-end-re)) | |
| 12162 | (insert indent) | |
| 12163 | (beginning-of-line 2)) | |
| 12164 | (when (looking-at org-dblock-end-re) | |
| 12165 | (and (looking-at "[ \t]+") | |
| 12166 | (replace-match "")) | |
| 12167 | (insert indent))))))) | |
| 12168 | ||
| 12169 | (defun org-beginning-of-dblock () | |
| 12170 | "Find the beginning of the dynamic block at point. | |
| 12171 | Error if there is no such block at point." | |
| 12172 | (let ((pos (point)) | |
| 12173 | beg) | |
| 12174 | (end-of-line 1) | |
| 12175 | (if (and (re-search-backward org-dblock-start-re nil t) | |
| 12176 | (setq beg (match-beginning 0)) | |
| 12177 | (re-search-forward org-dblock-end-re nil t) | |
| 12178 | (> (match-end 0) pos)) | |
| 12179 | (goto-char beg) | |
| 12180 | (goto-char pos) | |
| 12181 | (error "Not in a dynamic block")))) | |
| 12182 | ||
| 12183 | (defun org-update-all-dblocks () | |
| 12184 | "Update all dynamic blocks in the buffer. | |
| 12185 | This function can be used in a hook." | |
| 12186 | (interactive) | |
| 12187 | (when (derived-mode-p 'org-mode) | |
| 12188 | (org-map-dblocks 'org-update-dblock))) | |
| 12189 | ||
| 12190 | ||
| 12191 | ;;;; Completion | |
| 12192 | ||
| 12193 | (declare-function org-export-backend-options "ox" (cl-x) t) | |
| 12194 | (defun org-get-export-keywords () | |
| 12195 | "Return a list of all currently understood export keywords. | |
| 12196 | Export keywords include options, block names, attributes and | |
| 12197 | keywords relative to each registered export back-end." | |
| 12198 | (let (keywords) | |
| 12199 | (dolist (backend | |
| 12200 | (bound-and-true-p org-export-registered-backends) | |
| 12201 | (delq nil keywords)) | |
| 12202 | ;; Back-end name (for keywords, like #+LATEX:) | |
| 12203 | (push (upcase (symbol-name (org-export-backend-name backend))) keywords) | |
| 12204 | (dolist (option-entry (org-export-backend-options backend)) | |
| 12205 | ;; Back-end options. | |
| 12206 | (push (nth 1 option-entry) keywords))))) | |
| 12207 | ||
| 12208 | (defconst org-options-keywords | |
| 12209 | '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:" | |
| 12210 | "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:" | |
| 12211 | "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:" | |
| 12212 | "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:" | |
| 12213 | "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:")) | |
| 12214 | ||
| 12215 | (defcustom org-structure-template-alist | |
| 12216 | '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC") | |
| 12217 | ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE") | |
| 12218 | ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE") | |
| 12219 | ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE") | |
| 12220 | ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM") | |
| 12221 | ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER") | |
| 12222 | ("C" "#+BEGIN_COMMENT\n?\n#+END_COMMENT") | |
| 12223 | ("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT") | |
| 12224 | ("L" "#+LaTeX: ") | |
| 12225 | ("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT") | |
| 12226 | ("H" "#+HTML: ") | |
| 12227 | ("a" "#+BEGIN_EXPORT ascii\n?\n#+END_EXPORT") | |
| 12228 | ("A" "#+ASCII: ") | |
| 12229 | ("i" "#+INDEX: ?") | |
| 12230 | ("I" "#+INCLUDE: %file ?")) | |
| 12231 | "Structure completion elements. | |
| 12232 | This is a list of abbreviation keys and values. The value gets inserted | |
| 12233 | if you type `<' followed by the key and then press the completion key, | |
| 12234 | usually `TAB'. %file will be replaced by a file name after prompting | |
| 12235 | for the file using completion. The cursor will be placed at the position | |
| 12236 | of the `?' in the template. | |
| 12237 | There are two templates for each key, the first uses the original Org syntax, | |
| 12238 | the second uses Emacs Muse-like syntax tags. These Muse-like tags become | |
| 12239 | the default when the /org-mtags.el/ module has been loaded. See also the | |
| 12240 | variable `org-mtags-prefer-muse-templates'." | |
| 12241 | :group 'org-edit-structure | |
| 12242 | :type '(repeat | |
| 12243 | (list | |
| 12244 | (string :tag "Key") | |
| 12245 | (string :tag "Template"))) | |
| 12246 | :version "26.1" | |
| 12247 | :package-version '(Org . "8.3")) | |
| 12248 | ||
| 12249 | (defun org-try-structure-completion () | |
| 12250 | "Try to complete a structure template before point. | |
| 12251 | This looks for strings like \"<e\" on an otherwise empty line and | |
| 12252 | expands them." | |
| 12253 | (let ((l (buffer-substring (point-at-bol) (point))) | |
| 12254 | a) | |
| 12255 | (when (and (looking-at "[ \t]*$") | |
| 12256 | (string-match "^[ \t]*<\\([a-zA-Z]+\\)$" l) | |
| 12257 | (setq a (assoc (match-string 1 l) org-structure-template-alist))) | |
| 12258 | (org-complete-expand-structure-template (+ -1 (point-at-bol) | |
| 12259 | (match-beginning 1)) a) | |
| 12260 | t))) | |
| 12261 | ||
| 12262 | (defun org-complete-expand-structure-template (start cell) | |
| 12263 | "Expand a structure template." | |
| 12264 | (let ((rpl (nth 1 cell)) | |
| 12265 | (ind "")) | |
| 12266 | (delete-region start (point)) | |
| 12267 | (when (string-match "\\`[ \t]*#\\+" rpl) | |
| 12268 | (cond | |
| 12269 | ((bolp)) | |
| 12270 | ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point)))) | |
| 12271 | (setq ind (buffer-substring (point-at-bol) (point)))) | |
| 12272 | (t (newline)))) | |
| 12273 | (setq start (point)) | |
| 12274 | (when (string-match "%file" rpl) | |
| 12275 | (setq rpl (replace-match | |
| 12276 | (concat | |
| 12277 | "\"" | |
| 12278 | (save-match-data | |
| 12279 | (abbreviate-file-name (read-file-name "Include file: "))) | |
| 12280 | "\"") | |
| 12281 | t t rpl))) | |
| 12282 | (setq rpl (mapconcat 'identity (split-string rpl "\n") | |
| 12283 | (concat "\n" ind))) | |
| 12284 | (insert rpl) | |
| 12285 | (when (re-search-backward "\\?" start t) (delete-char 1)))) | |
| 12286 | ||
| 12287 | ;;;; TODO, DEADLINE, Comments | |
| 12288 | ||
| 12289 | (defun org-toggle-comment () | |
| 12290 | "Change the COMMENT state of an entry." | |
| 12291 | (interactive) | |
| 12292 | (save-excursion | |
| 12293 | (org-back-to-heading) | |
| 12294 | (let ((case-fold-search nil)) | |
| 12295 | (looking-at org-complex-heading-regexp)) | |
| 12296 | (goto-char (or (match-end 3) (match-end 2) (match-end 1))) | |
| 12297 | (skip-chars-forward " \t") | |
| 12298 | (unless (memq (char-before) '(?\s ?\t)) (insert " ")) | |
| 12299 | (if (org-in-commented-heading-p t) | |
| 12300 | (delete-region (point) | |
| 12301 | (progn (search-forward " " (line-end-position) 'move) | |
| 12302 | (skip-chars-forward " \t") | |
| 12303 | (point))) | |
| 12304 | (insert org-comment-string) | |
| 12305 | (unless (eolp) (insert " "))))) | |
| 12306 | ||
| 12307 | (defvar org-last-todo-state-is-todo nil | |
| 12308 | "This is non-nil when the last TODO state change led to a TODO state. | |
| 12309 | If the last change removed the TODO tag or switched to DONE, then | |
| 12310 | this is nil.") | |
| 12311 | ||
| 12312 | (defvar org-setting-tags nil) ; dynamically skipped | |
| 12313 | ||
| 12314 | (defvar org-todo-setup-filter-hook nil | |
| 12315 | "Hook for functions that pre-filter todo specs. | |
| 12316 | Each function takes a todo spec and returns either nil or the spec | |
| 12317 | transformed into canonical form." ) | |
| 12318 | ||
| 12319 | (defvar org-todo-get-default-hook nil | |
| 12320 | "Hook for functions that get a default item for todo. | |
| 12321 | Each function takes arguments (NEW-MARK OLD-MARK) and returns either | |
| 12322 | nil or a string to be used for the todo mark." ) | |
| 12323 | ||
| 12324 | (defvar org-agenda-headline-snapshot-before-repeat) | |
| 12325 | ||
| 12326 | (defun org-current-effective-time () | |
| 12327 | "Return current time adjusted for `org-extend-today-until' variable." | |
| 12328 | (let* ((ct (org-current-time)) | |
| 12329 | (dct (decode-time ct)) | |
| 12330 | (ct1 | |
| 12331 | (cond | |
| 12332 | (org-use-last-clock-out-time-as-effective-time | |
| 12333 | (or (org-clock-get-last-clock-out-time) ct)) | |
| 12334 | ((and org-use-effective-time (< (nth 2 dct) org-extend-today-until)) | |
| 12335 | (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))) | |
| 12336 | (t ct)))) | |
| 12337 | ct1)) | |
| 12338 | ||
| 12339 | (defun org-todo-yesterday (&optional arg) | |
| 12340 | "Like `org-todo' but the time of change will be 23:59 of yesterday." | |
| 12341 | (interactive "P") | |
| 12342 | (if (eq major-mode 'org-agenda-mode) | |
| 12343 | (apply 'org-agenda-todo-yesterday arg) | |
| 12344 | (let* ((org-use-effective-time t) | |
| 12345 | (hour (nth 2 (decode-time (org-current-time)))) | |
| 12346 | (org-extend-today-until (1+ hour))) | |
| 12347 | (org-todo arg)))) | |
| 12348 | ||
| 12349 | (defvar org-block-entry-blocking "" | |
| 12350 | "First entry preventing the TODO state change.") | |
| 12351 | ||
| 12352 | (defun org-cancel-repeater () | |
| 12353 | "Cancel a repeater by setting its numeric value to zero." | |
| 12354 | (interactive) | |
| 12355 | (save-excursion | |
| 12356 | (org-back-to-heading t) | |
| 12357 | (let ((bound1 (point)) | |
| 12358 | (bound0 (save-excursion (outline-next-heading) (point)))) | |
| 12359 | (when (and (re-search-forward | |
| 12360 | (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" | |
| 12361 | org-deadline-time-regexp "\\)\\|\\(" | |
| 12362 | org-ts-regexp "\\)") | |
| 12363 | bound0 t) | |
| 12364 | (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]" | |
| 12365 | bound1 t)) | |
| 12366 | (replace-match "0" t nil nil 1))))) | |
| 12367 | ||
| 12368 | (defvar org-state) | |
| 12369 | (defvar org-blocked-by-checkboxes) | |
| 12370 | (defun org-todo (&optional arg) | |
| 12371 | "Change the TODO state of an item. | |
| 12372 | ||
| 12373 | The state of an item is given by a keyword at the start of the heading, | |
| 12374 | like | |
| 12375 | *** TODO Write paper | |
| 12376 | *** DONE Call mom | |
| 12377 | ||
| 12378 | The different keywords are specified in the variable `org-todo-keywords'. | |
| 12379 | By default the available states are \"TODO\" and \"DONE\". So, for this | |
| 12380 | example: when the item starts with TODO, it is changed to DONE. | |
| 12381 | When it starts with DONE, the DONE is removed. And when neither TODO nor | |
| 12382 | DONE are present, add TODO at the beginning of the heading. | |
| 12383 | ||
| 12384 | With `\\[universal-argument]' prefix ARG, use completion to determine the new \ | |
| 12385 | state. | |
| 12386 | With numeric prefix ARG, switch to that state. | |
| 12387 | With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \ | |
| 12388 | next set of TODO \ | |
| 12389 | keywords (nextset). | |
| 12390 | With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ | |
| 12391 | prefix, circumvent any state blocking. | |
| 12392 | With a numeric prefix arg of 0, inhibit note taking for the change. | |
| 12393 | With a numeric prefix arg of -1, cancel repeater to allow marking as DONE. | |
| 12394 | ||
| 12395 | When called through ELisp, arg is also interpreted in the following way: | |
| 12396 | `none' -> empty state | |
| 12397 | \"\" -> switch to empty state | |
| 12398 | `done' -> switch to DONE | |
| 12399 | `nextset' -> switch to the next set of keywords | |
| 12400 | `previousset' -> switch to the previous set of keywords | |
| 12401 | \"WAITING\" -> switch to the specified keyword, but only if it | |
| 12402 | really is a member of `org-todo-keywords'." | |
| 12403 | (interactive "P") | |
| 12404 | (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) | |
| 12405 | (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) | |
| 12406 | 'region-start-level 'region)) | |
| 12407 | org-loop-over-headlines-in-active-region) | |
| 12408 | (org-map-entries | |
| 12409 | `(org-todo ,arg) | |
| 12410 | org-loop-over-headlines-in-active-region | |
| 12411 | cl (when (org-invisible-p) (org-end-of-subtree nil t)))) | |
| 12412 | (when (equal arg '(16)) (setq arg 'nextset)) | |
| 12413 | (when (equal arg -1) (org-cancel-repeater) (setq arg nil)) | |
| 12414 | (let ((org-blocker-hook org-blocker-hook) | |
| 12415 | commentp | |
| 12416 | case-fold-search) | |
| 12417 | (when (equal arg '(64)) | |
| 12418 | (setq arg nil org-blocker-hook nil)) | |
| 12419 | (when (and org-blocker-hook | |
| 12420 | (or org-inhibit-blocking | |
| 12421 | (org-entry-get nil "NOBLOCKING"))) | |
| 12422 | (setq org-blocker-hook nil)) | |
| 12423 | (save-excursion | |
| 12424 | (catch 'exit | |
| 12425 | (org-back-to-heading t) | |
| 12426 | (when (org-in-commented-heading-p t) | |
| 12427 | (org-toggle-comment) | |
| 12428 | (setq commentp t)) | |
| 12429 | (when (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) | |
| 12430 | (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)")) | |
| 12431 | (looking-at "\\(?: *\\|[ \t]*$\\)")) | |
| 12432 | (let* ((match-data (match-data)) | |
| 12433 | (startpos (copy-marker (line-beginning-position))) | |
| 12434 | (logging (save-match-data (org-entry-get nil "LOGGING" t t))) | |
| 12435 | (org-log-done org-log-done) | |
| 12436 | (org-log-repeat org-log-repeat) | |
| 12437 | (org-todo-log-states org-todo-log-states) | |
| 12438 | (org-inhibit-logging | |
| 12439 | (if (equal arg 0) | |
| 12440 | (progn (setq arg nil) 'note) org-inhibit-logging)) | |
| 12441 | (this (match-string 1)) | |
| 12442 | (hl-pos (match-beginning 0)) | |
| 12443 | (head (org-get-todo-sequence-head this)) | |
| 12444 | (ass (assoc head org-todo-kwd-alist)) | |
| 12445 | (interpret (nth 1 ass)) | |
| 12446 | (done-word (nth 3 ass)) | |
| 12447 | (final-done-word (nth 4 ass)) | |
| 12448 | (org-last-state (or this "")) | |
| 12449 | (completion-ignore-case t) | |
| 12450 | (member (member this org-todo-keywords-1)) | |
| 12451 | (tail (cdr member)) | |
| 12452 | (org-state (cond | |
| 12453 | ((and org-todo-key-trigger | |
| 12454 | (or (and (equal arg '(4)) | |
| 12455 | (eq org-use-fast-todo-selection 'prefix)) | |
| 12456 | (and (not arg) org-use-fast-todo-selection | |
| 12457 | (not (eq org-use-fast-todo-selection | |
| 12458 | 'prefix))))) | |
| 12459 | ;; Use fast selection. | |
| 12460 | (org-fast-todo-selection)) | |
| 12461 | ((and (equal arg '(4)) | |
| 12462 | (or (not org-use-fast-todo-selection) | |
| 12463 | (not org-todo-key-trigger))) | |
| 12464 | ;; Read a state with completion. | |
| 12465 | (completing-read | |
| 12466 | "State: " (mapcar #'list org-todo-keywords-1) | |
| 12467 | nil t)) | |
| 12468 | ((eq arg 'right) | |
| 12469 | (if this | |
| 12470 | (if tail (car tail) nil) | |
| 12471 | (car org-todo-keywords-1))) | |
| 12472 | ((eq arg 'left) | |
| 12473 | (unless (equal member org-todo-keywords-1) | |
| 12474 | (if this | |
| 12475 | (nth (- (length org-todo-keywords-1) | |
| 12476 | (length tail) 2) | |
| 12477 | org-todo-keywords-1) | |
| 12478 | (org-last org-todo-keywords-1)))) | |
| 12479 | ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) | |
| 12480 | (setq arg nil))) ;hack to fall back to cycling | |
| 12481 | (arg | |
| 12482 | ;; User or caller requests a specific state. | |
| 12483 | (cond | |
| 12484 | ((equal arg "") nil) | |
| 12485 | ((eq arg 'none) nil) | |
| 12486 | ((eq arg 'done) (or done-word (car org-done-keywords))) | |
| 12487 | ((eq arg 'nextset) | |
| 12488 | (or (car (cdr (member head org-todo-heads))) | |
| 12489 | (car org-todo-heads))) | |
| 12490 | ((eq arg 'previousset) | |
| 12491 | (let ((org-todo-heads (reverse org-todo-heads))) | |
| 12492 | (or (car (cdr (member head org-todo-heads))) | |
| 12493 | (car org-todo-heads)))) | |
| 12494 | ((car (member arg org-todo-keywords-1))) | |
| 12495 | ((stringp arg) | |
| 12496 | (user-error "State `%s' not valid in this file" arg)) | |
| 12497 | ((nth (1- (prefix-numeric-value arg)) | |
| 12498 | org-todo-keywords-1)))) | |
| 12499 | ((null member) (or head (car org-todo-keywords-1))) | |
| 12500 | ((equal this final-done-word) nil) ;-> make empty | |
| 12501 | ((null tail) nil) ;-> first entry | |
| 12502 | ((memq interpret '(type priority)) | |
| 12503 | (if (eq this-command last-command) | |
| 12504 | (car tail) | |
| 12505 | (if (> (length tail) 0) | |
| 12506 | (or done-word (car org-done-keywords)) | |
| 12507 | nil))) | |
| 12508 | (t | |
| 12509 | (car tail)))) | |
| 12510 | (org-state (or | |
| 12511 | (run-hook-with-args-until-success | |
| 12512 | 'org-todo-get-default-hook org-state org-last-state) | |
| 12513 | org-state)) | |
| 12514 | (next (if org-state (concat " " org-state " ") " ")) | |
| 12515 | (change-plist (list :type 'todo-state-change :from this :to org-state | |
| 12516 | :position startpos)) | |
| 12517 | dolog now-done-p) | |
| 12518 | (when org-blocker-hook | |
| 12519 | (let (org-blocked-by-checkboxes block-reason) | |
| 12520 | (setq org-last-todo-state-is-todo | |
| 12521 | (not (member this org-done-keywords))) | |
| 12522 | (unless (save-excursion | |
| 12523 | (save-match-data | |
| 12524 | (org-with-wide-buffer | |
| 12525 | (run-hook-with-args-until-failure | |
| 12526 | 'org-blocker-hook change-plist)))) | |
| 12527 | (setq block-reason (if org-blocked-by-checkboxes | |
| 12528 | "contained checkboxes" | |
| 12529 | (format "\"%s\"" org-block-entry-blocking))) | |
| 12530 | (if (called-interactively-p 'interactive) | |
| 12531 | (user-error "TODO state change from %s to %s blocked (by %s)" | |
| 12532 | this org-state block-reason) | |
| 12533 | ;; Fail silently. | |
| 12534 | (message "TODO state change from %s to %s blocked (by %s)" | |
| 12535 | this org-state block-reason) | |
| 12536 | (throw 'exit nil))))) | |
| 12537 | (store-match-data match-data) | |
| 12538 | (replace-match next t t) | |
| 12539 | (cond ((equal this org-state) | |
| 12540 | (message "TODO state was already %s" (org-trim next))) | |
| 12541 | ((not (pos-visible-in-window-p hl-pos)) | |
| 12542 | (message "TODO state changed to %s" (org-trim next)))) | |
| 12543 | (unless head | |
| 12544 | (setq head (org-get-todo-sequence-head org-state) | |
| 12545 | ass (assoc head org-todo-kwd-alist) | |
| 12546 | interpret (nth 1 ass) | |
| 12547 | done-word (nth 3 ass) | |
| 12548 | final-done-word (nth 4 ass))) | |
| 12549 | (when (memq arg '(nextset previousset)) | |
| 12550 | (message "Keyword-Set %d/%d: %s" | |
| 12551 | (- (length org-todo-sets) -1 | |
| 12552 | (length (memq (assoc org-state org-todo-sets) org-todo-sets))) | |
| 12553 | (length org-todo-sets) | |
| 12554 | (mapconcat 'identity (assoc org-state org-todo-sets) " "))) | |
| 12555 | (setq org-last-todo-state-is-todo | |
| 12556 | (not (member org-state org-done-keywords))) | |
| 12557 | (setq now-done-p (and (member org-state org-done-keywords) | |
| 12558 | (not (member this org-done-keywords)))) | |
| 12559 | (and logging (org-local-logging logging)) | |
| 12560 | (when (and (or org-todo-log-states org-log-done) | |
| 12561 | (not (eq org-inhibit-logging t)) | |
| 12562 | (not (memq arg '(nextset previousset)))) | |
| 12563 | ;; We need to look at recording a time and note. | |
| 12564 | (setq dolog (or (nth 1 (assoc org-state org-todo-log-states)) | |
| 12565 | (nth 2 (assoc this org-todo-log-states)))) | |
| 12566 | (when (and (eq dolog 'note) (eq org-inhibit-logging 'note)) | |
| 12567 | (setq dolog 'time)) | |
| 12568 | (when (or (and (not org-state) (not org-closed-keep-when-no-todo)) | |
| 12569 | (and org-state | |
| 12570 | (member org-state org-not-done-keywords) | |
| 12571 | (not (member this org-not-done-keywords)))) | |
| 12572 | ;; This is now a todo state and was not one before | |
| 12573 | ;; If there was a CLOSED time stamp, get rid of it. | |
| 12574 | (org-add-planning-info nil nil 'closed)) | |
| 12575 | (when (and now-done-p org-log-done) | |
| 12576 | ;; It is now done, and it was not done before. | |
| 12577 | (org-add-planning-info 'closed (org-current-effective-time)) | |
| 12578 | (when (and (not dolog) (eq 'note org-log-done)) | |
| 12579 | (org-add-log-setup 'done org-state this 'note))) | |
| 12580 | (when (and org-state dolog) | |
| 12581 | ;; This is a non-nil state, and we need to log it. | |
| 12582 | (org-add-log-setup 'state org-state this dolog))) | |
| 12583 | ;; Fixup tag positioning. | |
| 12584 | (org-todo-trigger-tag-changes org-state) | |
| 12585 | (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) | |
| 12586 | (when org-provide-todo-statistics | |
| 12587 | (org-update-parent-todo-statistics)) | |
| 12588 | (run-hooks 'org-after-todo-state-change-hook) | |
| 12589 | (when (and arg (not (member org-state org-done-keywords))) | |
| 12590 | (setq head (org-get-todo-sequence-head org-state))) | |
| 12591 | (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) | |
| 12592 | ;; Do we need to trigger a repeat? | |
| 12593 | (when now-done-p | |
| 12594 | (when (boundp 'org-agenda-headline-snapshot-before-repeat) | |
| 12595 | ;; This is for the agenda, take a snapshot of the headline. | |
| 12596 | (save-match-data | |
| 12597 | (setq org-agenda-headline-snapshot-before-repeat | |
| 12598 | (org-get-heading)))) | |
| 12599 | (org-auto-repeat-maybe org-state)) | |
| 12600 | ;; Fixup cursor location if close to the keyword. | |
| 12601 | (when (and (outline-on-heading-p) | |
| 12602 | (not (bolp)) | |
| 12603 | (save-excursion (beginning-of-line 1) | |
| 12604 | (looking-at org-todo-line-regexp)) | |
| 12605 | (< (point) (+ 2 (or (match-end 2) (match-end 1))))) | |
| 12606 | (goto-char (or (match-end 2) (match-end 1))) | |
| 12607 | (and (looking-at " ") (just-one-space))) | |
| 12608 | (when org-trigger-hook | |
| 12609 | (save-excursion | |
| 12610 | (run-hook-with-args 'org-trigger-hook change-plist))) | |
| 12611 | (when commentp (org-toggle-comment)))))))) | |
| 12612 | ||
| 12613 | (defun org-block-todo-from-children-or-siblings-or-parent (change-plist) | |
| 12614 | "Block turning an entry into a TODO, using the hierarchy. | |
| 12615 | This checks whether the current task should be blocked from state | |
| 12616 | changes. Such blocking occurs when: | |
| 12617 | ||
| 12618 | 1. The task has children which are not all in a completed state. | |
| 12619 | ||
| 12620 | 2. A task has a parent with the property :ORDERED:, and there | |
| 12621 | are siblings prior to the current task with incomplete | |
| 12622 | status. | |
| 12623 | ||
| 12624 | 3. The parent of the task is blocked because it has siblings that should | |
| 12625 | be done first, or is child of a block grandparent TODO entry." | |
| 12626 | ||
| 12627 | (if (not org-enforce-todo-dependencies) | |
| 12628 | t ; if locally turned off don't block | |
| 12629 | (catch 'dont-block | |
| 12630 | ;; If this is not a todo state change, or if this entry is already DONE, | |
| 12631 | ;; do not block | |
| 12632 | (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) | |
| 12633 | (member (plist-get change-plist :from) | |
| 12634 | (cons 'done org-done-keywords)) | |
| 12635 | (member (plist-get change-plist :to) | |
| 12636 | (cons 'todo org-not-done-keywords)) | |
| 12637 | (not (plist-get change-plist :to))) | |
| 12638 | (throw 'dont-block t)) | |
| 12639 | ;; If this task has children, and any are undone, it's blocked | |
| 12640 | (save-excursion | |
| 12641 | (org-back-to-heading t) | |
| 12642 | (let ((this-level (funcall outline-level))) | |
| 12643 | (outline-next-heading) | |
| 12644 | (let ((child-level (funcall outline-level))) | |
| 12645 | (while (and (not (eobp)) | |
| 12646 | (> child-level this-level)) | |
| 12647 | ;; this todo has children, check whether they are all | |
| 12648 | ;; completed | |
| 12649 | (when (and (not (org-entry-is-done-p)) | |
| 12650 | (org-entry-is-todo-p)) | |
| 12651 | (setq org-block-entry-blocking (org-get-heading)) | |
| 12652 | (throw 'dont-block nil)) | |
| 12653 | (outline-next-heading) | |
| 12654 | (setq child-level (funcall outline-level)))))) | |
| 12655 | ;; Otherwise, if the task's parent has the :ORDERED: property, and | |
| 12656 | ;; any previous siblings are undone, it's blocked | |
| 12657 | (save-excursion | |
| 12658 | (org-back-to-heading t) | |
| 12659 | (let* ((pos (point)) | |
| 12660 | (parent-pos (and (org-up-heading-safe) (point))) | |
| 12661 | (case-fold-search nil)) | |
| 12662 | (unless parent-pos (throw 'dont-block t)) ; no parent | |
| 12663 | (when (and (org-not-nil (org-entry-get (point) "ORDERED")) | |
| 12664 | (forward-line 1) | |
| 12665 | (re-search-forward org-not-done-heading-regexp pos t)) | |
| 12666 | (setq org-block-entry-blocking (match-string 0)) | |
| 12667 | (throw 'dont-block nil)) ; block, there is an older sibling not done. | |
| 12668 | ;; Search further up the hierarchy, to see if an ancestor is blocked | |
| 12669 | (while t | |
| 12670 | (goto-char parent-pos) | |
| 12671 | (unless (looking-at org-not-done-heading-regexp) | |
| 12672 | (throw 'dont-block t)) ; do not block, parent is not a TODO | |
| 12673 | (setq pos (point)) | |
| 12674 | (setq parent-pos (and (org-up-heading-safe) (point))) | |
| 12675 | (unless parent-pos (throw 'dont-block t)) ; no parent | |
| 12676 | (when (and (org-not-nil (org-entry-get (point) "ORDERED")) | |
| 12677 | (forward-line 1) | |
| 12678 | (re-search-forward org-not-done-heading-regexp pos t) | |
| 12679 | (setq org-block-entry-blocking (org-get-heading))) | |
| 12680 | (throw 'dont-block nil)))))))) ; block, older sibling not done. | |
| 12681 | ||
| 12682 | (defcustom org-track-ordered-property-with-tag nil | |
| 12683 | "Should the ORDERED property also be shown as a tag? | |
| 12684 | The ORDERED property decides if an entry should require subtasks to be | |
| 12685 | completed in sequence. Since a property is not very visible, setting | |
| 12686 | this option means that toggling the ORDERED property with the command | |
| 12687 | `org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is | |
| 12688 | not relevant for the behavior, but it makes things more visible. | |
| 12689 | ||
| 12690 | Note that toggling the tag with tags commands will not change the property | |
| 12691 | and therefore not influence behavior! | |
| 12692 | ||
| 12693 | This can be t, meaning the tag ORDERED should be used, It can also be a | |
| 12694 | string to select a different tag for this task." | |
| 12695 | :group 'org-todo | |
| 12696 | :type '(choice | |
| 12697 | (const :tag "No tracking" nil) | |
| 12698 | (const :tag "Track with ORDERED tag" t) | |
| 12699 | (string :tag "Use other tag"))) | |
| 12700 | ||
| 12701 | (defun org-toggle-ordered-property () | |
| 12702 | "Toggle the ORDERED property of the current entry. | |
| 12703 | For better visibility, you can track the value of this property with a tag. | |
| 12704 | See variable `org-track-ordered-property-with-tag'." | |
| 12705 | (interactive) | |
| 12706 | (let* ((t1 org-track-ordered-property-with-tag) | |
| 12707 | (tag (and t1 (if (stringp t1) t1 "ORDERED")))) | |
| 12708 | (save-excursion | |
| 12709 | (org-back-to-heading) | |
| 12710 | (if (org-entry-get nil "ORDERED") | |
| 12711 | (progn | |
| 12712 | (org-delete-property "ORDERED") | |
| 12713 | (and tag (org-toggle-tag tag 'off)) | |
| 12714 | (message "Subtasks can be completed in arbitrary order")) | |
| 12715 | (org-entry-put nil "ORDERED" "t") | |
| 12716 | (and tag (org-toggle-tag tag 'on)) | |
| 12717 | (message "Subtasks must be completed in sequence"))))) | |
| 12718 | ||
| 12719 | (defun org-block-todo-from-checkboxes (change-plist) | |
| 12720 | "Block turning an entry into a TODO, using checkboxes. | |
| 12721 | This checks whether the current task should be blocked from state | |
| 12722 | changes because there are unchecked boxes in this entry." | |
| 12723 | (if (not org-enforce-todo-checkbox-dependencies) | |
| 12724 | t ; if locally turned off don't block | |
| 12725 | (catch 'dont-block | |
| 12726 | ;; If this is not a todo state change, or if this entry is already DONE, | |
| 12727 | ;; do not block | |
| 12728 | (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) | |
| 12729 | (member (plist-get change-plist :from) | |
| 12730 | (cons 'done org-done-keywords)) | |
| 12731 | (member (plist-get change-plist :to) | |
| 12732 | (cons 'todo org-not-done-keywords)) | |
| 12733 | (not (plist-get change-plist :to))) | |
| 12734 | (throw 'dont-block t)) | |
| 12735 | ;; If this task has checkboxes that are not checked, it's blocked | |
| 12736 | (save-excursion | |
| 12737 | (org-back-to-heading t) | |
| 12738 | (let ((beg (point)) end) | |
| 12739 | (outline-next-heading) | |
| 12740 | (setq end (point)) | |
| 12741 | (goto-char beg) | |
| 12742 | (when (org-list-search-forward | |
| 12743 | (concat (org-item-beginning-re) | |
| 12744 | "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" | |
| 12745 | "\\[[- ]\\]") | |
| 12746 | end t) | |
| 12747 | (when (boundp 'org-blocked-by-checkboxes) | |
| 12748 | (setq org-blocked-by-checkboxes t)) | |
| 12749 | (throw 'dont-block nil)))) | |
| 12750 | t))) ; do not block | |
| 12751 | ||
| 12752 | (defun org-entry-blocked-p () | |
| 12753 | "Non-nil if entry at point is blocked." | |
| 12754 | (and (not (org-entry-get nil "NOBLOCKING")) | |
| 12755 | (member (org-entry-get nil "TODO") org-not-done-keywords) | |
| 12756 | (not (run-hook-with-args-until-failure | |
| 12757 | 'org-blocker-hook | |
| 12758 | (list :type 'todo-state-change | |
| 12759 | :position (point) | |
| 12760 | :from 'todo | |
| 12761 | :to 'done))))) | |
| 12762 | ||
| 12763 | (defun org-update-statistics-cookies (all) | |
| 12764 | "Update the statistics cookie, either from TODO or from checkboxes. | |
| 12765 | This should be called with the cursor in a line with a statistics | |
| 12766 | cookie. When called with a \\[universal-argument] prefix, update | |
| 12767 | all statistics cookies in the buffer." | |
| 12768 | (interactive "P") | |
| 12769 | (if all | |
| 12770 | (progn | |
| 12771 | (org-update-checkbox-count 'all) | |
| 12772 | (org-map-entries 'org-update-parent-todo-statistics)) | |
| 12773 | (if (not (org-at-heading-p)) | |
| 12774 | (org-update-checkbox-count) | |
| 12775 | (let ((pos (point-marker)) | |
| 12776 | end l1 l2) | |
| 12777 | (ignore-errors (org-back-to-heading t)) | |
| 12778 | (if (not (org-at-heading-p)) | |
| 12779 | (org-update-checkbox-count) | |
| 12780 | (setq l1 (org-outline-level)) | |
| 12781 | (setq end (save-excursion | |
| 12782 | (outline-next-heading) | |
| 12783 | (when (org-at-heading-p) (setq l2 (org-outline-level))) | |
| 12784 | (point))) | |
| 12785 | (if (and (save-excursion | |
| 12786 | (re-search-forward | |
| 12787 | "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t)) | |
| 12788 | (not (save-excursion (re-search-forward | |
| 12789 | ":COOKIE_DATA:.*\\<todo\\>" end t)))) | |
| 12790 | (org-update-checkbox-count) | |
| 12791 | (if (and l2 (> l2 l1)) | |
| 12792 | (progn | |
| 12793 | (goto-char end) | |
| 12794 | (org-update-parent-todo-statistics)) | |
| 12795 | (goto-char pos) | |
| 12796 | (beginning-of-line 1) | |
| 12797 | (while (re-search-forward | |
| 12798 | "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)" | |
| 12799 | (point-at-eol) t) | |
| 12800 | (replace-match (if (match-end 2) "[100%]" "[0/0]") t t))))) | |
| 12801 | (goto-char pos) | |
| 12802 | (move-marker pos nil))))) | |
| 12803 | ||
| 12804 | (defvar org-entry-property-inherited-from) ;; defined below | |
| 12805 | (defun org-update-parent-todo-statistics () | |
| 12806 | "Update any statistics cookie in the parent of the current headline. | |
| 12807 | When `org-hierarchical-todo-statistics' is nil, statistics will cover | |
| 12808 | the entire subtree and this will travel up the hierarchy and update | |
| 12809 | statistics everywhere." | |
| 12810 | (let* ((prop (save-excursion (org-up-heading-safe) | |
| 12811 | (org-entry-get nil "COOKIE_DATA" 'inherit))) | |
| 12812 | (recursive (or (not org-hierarchical-todo-statistics) | |
| 12813 | (and prop (string-match "\\<recursive\\>" prop)))) | |
| 12814 | (lim (or (and prop (marker-position org-entry-property-inherited-from)) | |
| 12815 | 0)) | |
| 12816 | (first t) | |
| 12817 | (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") | |
| 12818 | level ltoggle l1 new ndel | |
| 12819 | (cnt-all 0) (cnt-done 0) is-percent kwd | |
| 12820 | checkbox-beg cookie-present) | |
| 12821 | (catch 'exit | |
| 12822 | (save-excursion | |
| 12823 | (beginning-of-line 1) | |
| 12824 | (setq ltoggle (funcall outline-level)) | |
| 12825 | ;; Three situations are to consider: | |
| 12826 | ||
| 12827 | ;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up | |
| 12828 | ;; to the top-level ancestor on the headline; | |
| 12829 | ||
| 12830 | ;; 2. If parent has "recursive" property, repeat up to the | |
| 12831 | ;; headline setting that property, taking inheritance into | |
| 12832 | ;; account; | |
| 12833 | ||
| 12834 | ;; 3. Else, move up to direct parent and proceed only once. | |
| 12835 | (while (and (setq level (org-up-heading-safe)) | |
| 12836 | (or recursive first) | |
| 12837 | (>= (point) lim)) | |
| 12838 | (setq first nil cookie-present nil) | |
| 12839 | (unless (and level | |
| 12840 | (not (string-match | |
| 12841 | "\\<checkbox\\>" | |
| 12842 | (downcase (or (org-entry-get nil "COOKIE_DATA") | |
| 12843 | ""))))) | |
| 12844 | (throw 'exit nil)) | |
| 12845 | (while (re-search-forward box-re (point-at-eol) t) | |
| 12846 | (setq cnt-all 0 cnt-done 0 cookie-present t) | |
| 12847 | (setq is-percent (match-end 2) checkbox-beg (match-beginning 0)) | |
| 12848 | (save-match-data | |
| 12849 | (unless (outline-next-heading) (throw 'exit nil)) | |
| 12850 | (while (and (looking-at org-complex-heading-regexp) | |
| 12851 | (> (setq l1 (length (match-string 1))) level)) | |
| 12852 | (setq kwd (and (or recursive (= l1 ltoggle)) | |
| 12853 | (match-string 2))) | |
| 12854 | (if (or (eq org-provide-todo-statistics 'all-headlines) | |
| 12855 | (and (eq org-provide-todo-statistics t) | |
| 12856 | (or (member kwd org-done-keywords))) | |
| 12857 | (and (listp org-provide-todo-statistics) | |
| 12858 | (stringp (car org-provide-todo-statistics)) | |
| 12859 | (or (member kwd org-provide-todo-statistics) | |
| 12860 | (member kwd org-done-keywords))) | |
| 12861 | (and (listp org-provide-todo-statistics) | |
| 12862 | (listp (car org-provide-todo-statistics)) | |
| 12863 | (or (member kwd (car org-provide-todo-statistics)) | |
| 12864 | (and (member kwd org-done-keywords) | |
| 12865 | (member kwd (cadr org-provide-todo-statistics)))))) | |
| 12866 | (setq cnt-all (1+ cnt-all)) | |
| 12867 | (and (eq org-provide-todo-statistics t) | |
| 12868 | kwd | |
| 12869 | (setq cnt-all (1+ cnt-all)))) | |
| 12870 | (when (or (and (member org-provide-todo-statistics '(t all-headlines)) | |
| 12871 | (member kwd org-done-keywords)) | |
| 12872 | (and (listp org-provide-todo-statistics) | |
| 12873 | (listp (car org-provide-todo-statistics)) | |
| 12874 | (member kwd org-done-keywords) | |
| 12875 | (member kwd (cadr org-provide-todo-statistics))) | |
| 12876 | (and (listp org-provide-todo-statistics) | |
| 12877 | (stringp (car org-provide-todo-statistics)) | |
| 12878 | (member kwd org-done-keywords))) | |
| 12879 | (setq cnt-done (1+ cnt-done))) | |
| 12880 | (outline-next-heading))) | |
| 12881 | (setq new | |
| 12882 | (if is-percent | |
| 12883 | (format "[%d%%]" (floor (* 100.0 cnt-done) | |
| 12884 | (max 1 cnt-all))) | |
| 12885 | (format "[%d/%d]" cnt-done cnt-all)) | |
| 12886 | ndel (- (match-end 0) checkbox-beg)) | |
| 12887 | (goto-char checkbox-beg) | |
| 12888 | (insert new) | |
| 12889 | (delete-region (point) (+ (point) ndel)) | |
| 12890 | (when org-auto-align-tags (org-fix-tags-on-the-fly))) | |
| 12891 | (when cookie-present | |
| 12892 | (run-hook-with-args 'org-after-todo-statistics-hook | |
| 12893 | cnt-done (- cnt-all cnt-done)))))) | |
| 12894 | (run-hooks 'org-todo-statistics-hook))) | |
| 12895 | ||
| 12896 | (defvar org-after-todo-statistics-hook nil | |
| 12897 | "Hook that is called after a TODO statistics cookie has been updated. | |
| 12898 | Each function is called with two arguments: the number of not-done entries | |
| 12899 | and the number of done entries. | |
| 12900 | ||
| 12901 | For example, the following function, when added to this hook, will switch | |
| 12902 | an entry to DONE when all children are done, and back to TODO when new | |
| 12903 | entries are set to a TODO status. Note that this hook is only called | |
| 12904 | when there is a statistics cookie in the headline! | |
| 12905 | ||
| 12906 | (defun org-summary-todo (n-done n-not-done) | |
| 12907 | \"Switch entry to DONE when all subentries are done, to TODO otherwise.\" | |
| 12908 | (let (org-log-done org-log-states) ; turn off logging | |
| 12909 | (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\")))) | |
| 12910 | ") | |
| 12911 | ||
| 12912 | (defvar org-todo-statistics-hook nil | |
| 12913 | "Hook that is run whenever Org thinks TODO statistics should be updated. | |
| 12914 | This hook runs even if there is no statistics cookie present, in which case | |
| 12915 | `org-after-todo-statistics-hook' would not run.") | |
| 12916 | ||
| 12917 | (defun org-todo-trigger-tag-changes (state) | |
| 12918 | "Apply the changes defined in `org-todo-state-tags-triggers'." | |
| 12919 | (let ((l org-todo-state-tags-triggers) | |
| 12920 | changes) | |
| 12921 | (when (or (not state) (equal state "")) | |
| 12922 | (setq changes (append changes (cdr (assoc "" l))))) | |
| 12923 | (when (and (stringp state) (> (length state) 0)) | |
| 12924 | (setq changes (append changes (cdr (assoc state l))))) | |
| 12925 | (when (member state org-not-done-keywords) | |
| 12926 | (setq changes (append changes (cdr (assq 'todo l))))) | |
| 12927 | (when (member state org-done-keywords) | |
| 12928 | (setq changes (append changes (cdr (assq 'done l))))) | |
| 12929 | (dolist (c changes) | |
| 12930 | (org-toggle-tag (car c) (if (cdr c) 'on 'off))))) | |
| 12931 | ||
| 12932 | (defun org-local-logging (value) | |
| 12933 | "Get logging settings from a property VALUE." | |
| 12934 | ;; Directly set the variables, they are already local. | |
| 12935 | (setq org-log-done nil | |
| 12936 | org-log-repeat nil | |
| 12937 | org-todo-log-states nil) | |
| 12938 | (dolist (w (split-string value)) | |
| 12939 | (let (a) | |
| 12940 | (cond | |
| 12941 | ((setq a (assoc w org-startup-options)) | |
| 12942 | (and (member (nth 1 a) '(org-log-done org-log-repeat)) | |
| 12943 | (set (nth 1 a) (nth 2 a)))) | |
| 12944 | ((setq a (org-extract-log-state-settings w)) | |
| 12945 | (and (member (car a) org-todo-keywords-1) | |
| 12946 | (push a org-todo-log-states))))))) | |
| 12947 | ||
| 12948 | (defun org-get-todo-sequence-head (kwd) | |
| 12949 | "Return the head of the TODO sequence to which KWD belongs. | |
| 12950 | If KWD is not set, check if there is a text property remembering the | |
| 12951 | right sequence." | |
| 12952 | (let (p) | |
| 12953 | (cond | |
| 12954 | ((not kwd) | |
| 12955 | (or (get-text-property (point-at-bol) 'org-todo-head) | |
| 12956 | (progn | |
| 12957 | (setq p (next-single-property-change (point-at-bol) 'org-todo-head | |
| 12958 | nil (point-at-eol))) | |
| 12959 | (get-text-property p 'org-todo-head)))) | |
| 12960 | ((not (member kwd org-todo-keywords-1)) | |
| 12961 | (car org-todo-keywords-1)) | |
| 12962 | (t (nth 2 (assoc kwd org-todo-kwd-alist)))))) | |
| 12963 | ||
| 12964 | (defun org-fast-todo-selection () | |
| 12965 | "Fast TODO keyword selection with single keys. | |
| 12966 | Returns the new TODO keyword, or nil if no state change should occur." | |
| 12967 | (let* ((fulltable org-todo-key-alist) | |
| 12968 | (done-keywords org-done-keywords) ;; needed for the faces. | |
| 12969 | (maxlen (apply 'max (mapcar | |
| 12970 | (lambda (x) | |
| 12971 | (if (stringp (car x)) (string-width (car x)) 0)) | |
| 12972 | fulltable))) | |
| 12973 | (expert nil) | |
| 12974 | (fwidth (+ maxlen 3 1 3)) | |
| 12975 | (ncol (/ (- (window-width) 4) fwidth)) | |
| 12976 | tg cnt e c tbl | |
| 12977 | groups ingroup) | |
| 12978 | (save-excursion | |
| 12979 | (save-window-excursion | |
| 12980 | (if expert | |
| 12981 | (set-buffer (get-buffer-create " *Org todo*")) | |
| 12982 | (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) | |
| 12983 | (erase-buffer) | |
| 12984 | (setq-local org-done-keywords done-keywords) | |
| 12985 | (setq tbl fulltable cnt 0) | |
| 12986 | (while (setq e (pop tbl)) | |
| 12987 | (cond | |
| 12988 | ((equal e '(:startgroup)) | |
| 12989 | (push '() groups) (setq ingroup t) | |
| 12990 | (unless (= cnt 0) | |
| 12991 | (setq cnt 0) | |
| 12992 | (insert "\n")) | |
| 12993 | (insert "{ ")) | |
| 12994 | ((equal e '(:endgroup)) | |
| 12995 | (setq ingroup nil cnt 0) | |
| 12996 | (insert "}\n")) | |
| 12997 | ((equal e '(:newline)) | |
| 12998 | (unless (= cnt 0) | |
| 12999 | (setq cnt 0) | |
| 13000 | (insert "\n") | |
| 13001 | (setq e (car tbl)) | |
| 13002 | (while (equal (car tbl) '(:newline)) | |
| 13003 | (insert "\n") | |
| 13004 | (setq tbl (cdr tbl))))) | |
| 13005 | (t | |
| 13006 | (setq tg (car e) c (cdr e)) | |
| 13007 | (when ingroup (push tg (car groups))) | |
| 13008 | (setq tg (org-add-props tg nil 'face | |
| 13009 | (org-get-todo-face tg))) | |
| 13010 | (when (and (= cnt 0) (not ingroup)) (insert " ")) | |
| 13011 | (insert "[" c "] " tg (make-string | |
| 13012 | (- fwidth 4 (length tg)) ?\ )) | |
| 13013 | (when (= (setq cnt (1+ cnt)) ncol) | |
| 13014 | (insert "\n") | |
| 13015 | (when ingroup (insert " ")) | |
| 13016 | (setq cnt 0))))) | |
| 13017 | (insert "\n") | |
| 13018 | (goto-char (point-min)) | |
| 13019 | (unless expert (org-fit-window-to-buffer)) | |
| 13020 | (message "[a-z..]:Set [SPC]:clear") | |
| 13021 | (setq c (let ((inhibit-quit t)) (read-char-exclusive))) | |
| 13022 | (cond | |
| 13023 | ((or (= c ?\C-g) | |
| 13024 | (and (= c ?q) (not (rassoc c fulltable)))) | |
| 13025 | (setq quit-flag t)) | |
| 13026 | ((= c ?\ ) nil) | |
| 13027 | ((setq e (rassoc c fulltable) tg (car e)) | |
| 13028 | tg) | |
| 13029 | (t (setq quit-flag t))))))) | |
| 13030 | ||
| 13031 | (defun org-entry-is-todo-p () | |
| 13032 | (member (org-get-todo-state) org-not-done-keywords)) | |
| 13033 | ||
| 13034 | (defun org-entry-is-done-p () | |
| 13035 | (member (org-get-todo-state) org-done-keywords)) | |
| 13036 | ||
| 13037 | (defun org-get-todo-state () | |
| 13038 | "Return the TODO keyword of the current subtree." | |
| 13039 | (save-excursion | |
| 13040 | (org-back-to-heading t) | |
| 13041 | (and (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) | |
| 13042 | (match-end 2) | |
| 13043 | (match-string 2)))) | |
| 13044 | ||
| 13045 | (defun org-at-date-range-p (&optional inactive-ok) | |
| 13046 | "Non-nil if point is inside a date range. | |
| 13047 | ||
| 13048 | When optional argument INACTIVE-OK is non-nil, also consider | |
| 13049 | inactive time ranges. | |
| 13050 | ||
| 13051 | When this function returns a non-nil value, match data is set | |
| 13052 | according to `org-tr-regexp-both' or `org-tr-regexp', depending | |
| 13053 | on INACTIVE-OK." | |
| 13054 | (interactive) | |
| 13055 | (save-excursion | |
| 13056 | (catch 'exit | |
| 13057 | (let ((pos (point))) | |
| 13058 | (skip-chars-backward "^[<\r\n") | |
| 13059 | (skip-chars-backward "<[") | |
| 13060 | (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) | |
| 13061 | (>= (match-end 0) pos) | |
| 13062 | (throw 'exit t)) | |
| 13063 | (skip-chars-backward "^<[\r\n") | |
| 13064 | (skip-chars-backward "<[") | |
| 13065 | (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) | |
| 13066 | (>= (match-end 0) pos) | |
| 13067 | (throw 'exit t))) | |
| 13068 | nil))) | |
| 13069 | ||
| 13070 | (defun org-get-repeat (&optional timestamp) | |
| 13071 | "Check if there is a time-stamp with repeater in this entry. | |
| 13072 | ||
| 13073 | Return the repeater, as a string, or nil. Also return nil when | |
| 13074 | this function is called before first heading. | |
| 13075 | ||
| 13076 | When optional argument TIMESTAMP is a string, extract the | |
| 13077 | repeater from there instead." | |
| 13078 | (save-match-data | |
| 13079 | (cond (timestamp | |
| 13080 | (and (string-match org-repeat-re timestamp) | |
| 13081 | (match-string-no-properties 1 timestamp))) | |
| 13082 | ((org-before-first-heading-p) nil) | |
| 13083 | (t | |
| 13084 | (save-excursion | |
| 13085 | (org-back-to-heading t) | |
| 13086 | (let ((end (org-entry-end-position))) | |
| 13087 | (catch :repeat | |
| 13088 | (while (re-search-forward org-repeat-re end t) | |
| 13089 | (when (save-match-data (org-at-timestamp-p 'agenda)) | |
| 13090 | (throw :repeat (match-string-no-properties 1))))))))))) | |
| 13091 | ||
| 13092 | (defvar org-last-changed-timestamp) | |
| 13093 | (defvar org-last-inserted-timestamp) | |
| 13094 | (defvar org-log-post-message) | |
| 13095 | (defvar org-log-note-purpose) | |
| 13096 | (defvar org-log-note-how nil) | |
| 13097 | (defvar org-log-note-extra) | |
| 13098 | (defun org-auto-repeat-maybe (done-word) | |
| 13099 | "Check if the current headline contains a repeated time-stamp. | |
| 13100 | ||
| 13101 | If yes, set TODO state back to what it was and change the base date | |
| 13102 | of repeating deadline/scheduled time stamps to new date. | |
| 13103 | ||
| 13104 | This function is run automatically after each state change to a DONE state." | |
| 13105 | (let* ((repeat (org-get-repeat)) | |
| 13106 | (aa (assoc org-last-state org-todo-kwd-alist)) | |
| 13107 | (interpret (nth 1 aa)) | |
| 13108 | (head (nth 2 aa)) | |
| 13109 | (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) | |
| 13110 | (msg "Entry repeats: ") | |
| 13111 | (org-log-done nil) | |
| 13112 | (org-todo-log-states nil) | |
| 13113 | (end (copy-marker (org-entry-end-position)))) | |
| 13114 | (unwind-protect | |
| 13115 | (when (and repeat (not (zerop (string-to-number (substring repeat 1))))) | |
| 13116 | (when (eq org-log-repeat t) (setq org-log-repeat 'state)) | |
| 13117 | (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective) | |
| 13118 | org-todo-repeat-to-state))) | |
| 13119 | (org-todo (cond | |
| 13120 | ((and to-state (member to-state org-todo-keywords-1)) | |
| 13121 | to-state) | |
| 13122 | ((eq interpret 'type) org-last-state) | |
| 13123 | (head) | |
| 13124 | (t 'none)))) | |
| 13125 | (org-back-to-heading t) | |
| 13126 | (org-add-planning-info nil nil 'closed) | |
| 13127 | ;; When `org-log-repeat' is non-nil or entry contains | |
| 13128 | ;; a clock, set LAST_REPEAT property. | |
| 13129 | (when (or org-log-repeat | |
| 13130 | (catch :clock | |
| 13131 | (save-excursion | |
| 13132 | (while (re-search-forward org-clock-line-re end t) | |
| 13133 | (when (org-at-clock-log-p) (throw :clock t)))))) | |
| 13134 | (org-entry-put nil "LAST_REPEAT" (format-time-string | |
| 13135 | (org-time-stamp-format t t) | |
| 13136 | (current-time)))) | |
| 13137 | (when org-log-repeat | |
| 13138 | (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) | |
| 13139 | (memq 'org-add-log-note post-command-hook)) | |
| 13140 | ;; We are already setup for some record. | |
| 13141 | (when (eq org-log-repeat 'note) | |
| 13142 | ;; Make sure we take a note, not only a time stamp. | |
| 13143 | (setq org-log-note-how 'note)) | |
| 13144 | ;; Set up for taking a record. | |
| 13145 | (org-add-log-setup 'state | |
| 13146 | (or done-word (car org-done-keywords)) | |
| 13147 | org-last-state | |
| 13148 | org-log-repeat))) | |
| 13149 | (let ((planning-re (regexp-opt | |
| 13150 | (list org-scheduled-string org-deadline-string)))) | |
| 13151 | (while (re-search-forward org-ts-regexp end t) | |
| 13152 | (let* ((ts (match-string 0)) | |
| 13153 | (planning? (org-at-planning-p)) | |
| 13154 | (type (if (not planning?) "Plain:" | |
| 13155 | (save-excursion | |
| 13156 | (re-search-backward | |
| 13157 | planning-re (line-beginning-position) t) | |
| 13158 | (match-string 0))))) | |
| 13159 | (cond | |
| 13160 | ;; Ignore fake time-stamps (e.g., within comments). | |
| 13161 | ((not (org-at-timestamp-p 'agenda))) | |
| 13162 | ;; Time-stamps without a repeater are usually | |
| 13163 | ;; skipped. However, a SCHEDULED time-stamp without | |
| 13164 | ;; one is removed, as they are no longer relevant. | |
| 13165 | ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" | |
| 13166 | ts)) | |
| 13167 | (when (equal type org-scheduled-string) | |
| 13168 | (org-remove-timestamp-with-keyword type))) | |
| 13169 | (t | |
| 13170 | (let ((n (string-to-number (match-string 2 ts))) | |
| 13171 | (what (match-string 3 ts))) | |
| 13172 | (when (equal what "w") (setq n (* n 7) what "d")) | |
| 13173 | (when (and (equal what "h") | |
| 13174 | (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" | |
| 13175 | ts))) | |
| 13176 | (user-error | |
| 13177 | "Cannot repeat in Repeat in %d hour(s) because no hour \ | |
| 13178 | has been set" | |
| 13179 | n)) | |
| 13180 | ;; Preparation, see if we need to modify the start | |
| 13181 | ;; date for the change. | |
| 13182 | (when (match-end 1) | |
| 13183 | (let ((time (save-match-data | |
| 13184 | (org-time-string-to-time ts)))) | |
| 13185 | (cond | |
| 13186 | ((equal (match-string 1 ts) ".") | |
| 13187 | ;; Shift starting date to today | |
| 13188 | (org-timestamp-change | |
| 13189 | (- (org-today) (time-to-days time)) | |
| 13190 | 'day)) | |
| 13191 | ((equal (match-string 1 ts) "+") | |
| 13192 | (let ((nshiftmax 10) | |
| 13193 | (nshift 0)) | |
| 13194 | (while (or (= nshift 0) | |
| 13195 | (not (time-less-p (current-time) time))) | |
| 13196 | (when (= (cl-incf nshift) nshiftmax) | |
| 13197 | (or (y-or-n-p | |
| 13198 | (format "%d repeater intervals were not \ | |
| 13199 | enough to shift date past today. Continue? " | |
| 13200 | nshift)) | |
| 13201 | (user-error "Abort"))) | |
| 13202 | (org-timestamp-change n (cdr (assoc what whata))) | |
| 13203 | (org-in-regexp org-ts-regexp3) | |
| 13204 | (setq ts (match-string 1)) | |
| 13205 | (setq time | |
| 13206 | (save-match-data | |
| 13207 | (org-time-string-to-time ts))))) | |
| 13208 | (org-timestamp-change (- n) (cdr (assoc what whata))) | |
| 13209 | ;; Rematch, so that we have everything in place | |
| 13210 | ;; for the real shift. | |
| 13211 | (org-in-regexp org-ts-regexp3) | |
| 13212 | (setq ts (match-string 1)) | |
| 13213 | (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" | |
| 13214 | ts))))) | |
| 13215 | (save-excursion | |
| 13216 | (org-timestamp-change n (cdr (assoc what whata)) nil t)) | |
| 13217 | (setq msg | |
| 13218 | (concat | |
| 13219 | msg type " " org-last-changed-timestamp " ")))))))) | |
| 13220 | (setq org-log-post-message msg) | |
| 13221 | (message "%s" msg)) | |
| 13222 | (set-marker end nil)))) | |
| 13223 | ||
| 13224 | (defun org-show-todo-tree (arg) | |
| 13225 | "Make a compact tree which shows all headlines marked with TODO. | |
| 13226 | The tree will show the lines where the regexp matches, and all higher | |
| 13227 | headlines above the match. | |
| 13228 | With a `\\[universal-argument]' prefix, prompt for a regexp to match. | |
| 13229 | With a numeric prefix N, construct a sparse tree for the Nth element | |
| 13230 | of `org-todo-keywords-1'." | |
| 13231 | (interactive "P") | |
| 13232 | (let ((case-fold-search nil) | |
| 13233 | (kwd-re | |
| 13234 | (cond ((null arg) org-not-done-regexp) | |
| 13235 | ((equal arg '(4)) | |
| 13236 | (let ((kwd | |
| 13237 | (completing-read "Keyword (or KWD1|KWD2|...): " | |
| 13238 | (mapcar #'list org-todo-keywords-1)))) | |
| 13239 | (concat "\\(" | |
| 13240 | (mapconcat 'identity (org-split-string kwd "|") "\\|") | |
| 13241 | "\\)\\>"))) | |
| 13242 | ((<= (prefix-numeric-value arg) (length org-todo-keywords-1)) | |
| 13243 | (regexp-quote (nth (1- (prefix-numeric-value arg)) | |
| 13244 | org-todo-keywords-1))) | |
| 13245 | (t (user-error "Invalid prefix argument: %s" arg))))) | |
| 13246 | (message "%d TODO entries found" | |
| 13247 | (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) | |
| 13248 | ||
| 13249 | (defun org--deadline-or-schedule (arg type time) | |
| 13250 | "Insert DEADLINE or SCHEDULE information in current entry. | |
| 13251 | TYPE is either `deadline' or `scheduled'. See `org-deadline' or | |
| 13252 | `org-schedule' for information about ARG and TIME arguments." | |
| 13253 | (let* ((deadline? (eq type 'deadline)) | |
| 13254 | (keyword (if deadline? org-deadline-string org-scheduled-string)) | |
| 13255 | (log (if deadline? org-log-redeadline org-log-reschedule)) | |
| 13256 | (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) | |
| 13257 | (old-date-time (and old-date (org-time-string-to-time old-date))) | |
| 13258 | ;; Save repeater cookie from either TIME or current scheduled | |
| 13259 | ;; time stamp. We are going to insert it back at the end of | |
| 13260 | ;; the process. | |
| 13261 | (repeater (or (and (org-string-nw-p time) | |
| 13262 | ;; We use `org-repeat-re' because we need | |
| 13263 | ;; to tell the difference between a real | |
| 13264 | ;; repeater and a time delta, e.g. "+2d". | |
| 13265 | (string-match org-repeat-re time) | |
| 13266 | (match-string 1 time)) | |
| 13267 | (and (org-string-nw-p old-date) | |
| 13268 | (string-match "\\([.+-]+[0-9]+[hdwmy]\ | |
| 13269 | \\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)" | |
| 13270 | old-date) | |
| 13271 | (match-string 1 old-date))))) | |
| 13272 | (pcase arg | |
| 13273 | (`(4) | |
| 13274 | (when (and old-date log) | |
| 13275 | (org-add-log-setup (if deadline? 'deldeadline 'delschedule) | |
| 13276 | nil old-date log)) | |
| 13277 | (org-remove-timestamp-with-keyword keyword) | |
| 13278 | (message (if deadline? "Item no longer has a deadline." | |
| 13279 | "Item is no longer scheduled."))) | |
| 13280 | (`(16) | |
| 13281 | (save-excursion | |
| 13282 | (org-back-to-heading t) | |
| 13283 | (let ((regexp (if deadline? org-deadline-time-regexp | |
| 13284 | org-scheduled-time-regexp))) | |
| 13285 | (if (not (re-search-forward regexp (line-end-position 2) t)) | |
| 13286 | (user-error (if deadline? "No deadline information to update" | |
| 13287 | "No scheduled information to update")) | |
| 13288 | (let* ((rpl0 (match-string 1)) | |
| 13289 | (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) | |
| 13290 | (msg (if deadline? "Warn starting from" "Delay until"))) | |
| 13291 | (replace-match | |
| 13292 | (concat keyword | |
| 13293 | " <" rpl | |
| 13294 | (format " -%dd" | |
| 13295 | (abs (- (time-to-days | |
| 13296 | (save-match-data | |
| 13297 | (org-read-date | |
| 13298 | nil t nil msg old-date-time))) | |
| 13299 | (time-to-days old-date-time)))) | |
| 13300 | ">") t t)))))) | |
| 13301 | (_ | |
| 13302 | (org-add-planning-info type time 'closed) | |
| 13303 | (when (and old-date | |
| 13304 | log | |
| 13305 | (not (equal old-date org-last-inserted-timestamp))) | |
| 13306 | (org-add-log-setup (if deadline? 'redeadline 'reschedule) | |
| 13307 | org-last-inserted-timestamp | |
| 13308 | old-date | |
| 13309 | log)) | |
| 13310 | (when repeater | |
| 13311 | (save-excursion | |
| 13312 | (org-back-to-heading t) | |
| 13313 | (when (re-search-forward | |
| 13314 | (concat keyword " " org-last-inserted-timestamp) | |
| 13315 | (line-end-position 2) | |
| 13316 | t) | |
| 13317 | (goto-char (1- (match-end 0))) | |
| 13318 | (insert " " repeater) | |
| 13319 | (setq org-last-inserted-timestamp | |
| 13320 | (concat (substring org-last-inserted-timestamp 0 -1) | |
| 13321 | " " repeater | |
| 13322 | (substring org-last-inserted-timestamp -1)))))) | |
| 13323 | (message (if deadline? "Deadline on %s" "Scheduled to %s") | |
| 13324 | org-last-inserted-timestamp))))) | |
| 13325 | ||
| 13326 | (defun org-deadline (arg &optional time) | |
| 13327 | "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. | |
| 13328 | With one universal prefix argument, remove any deadline from the item. | |
| 13329 | With two universal prefix arguments, prompt for a warning delay. | |
| 13330 | With argument TIME, set the deadline at the corresponding date. TIME | |
| 13331 | can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." | |
| 13332 | (interactive "P") | |
| 13333 | (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) | |
| 13334 | (org-map-entries | |
| 13335 | (lambda () (org--deadline-or-schedule arg 'deadline time)) | |
| 13336 | nil | |
| 13337 | (if (eq org-loop-over-headlines-in-active-region 'start-level) | |
| 13338 | 'region-start-level | |
| 13339 | 'region) | |
| 13340 | (lambda () (when (org-invisible-p) (org-end-of-subtree nil t)))) | |
| 13341 | (org--deadline-or-schedule arg 'deadline time))) | |
| 13342 | ||
| 13343 | (defun org-schedule (arg &optional time) | |
| 13344 | "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. | |
| 13345 | With one universal prefix argument, remove any scheduling date from the item. | |
| 13346 | With two universal prefix arguments, prompt for a delay cookie. | |
| 13347 | With argument TIME, scheduled at the corresponding date. TIME can | |
| 13348 | either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." | |
| 13349 | (interactive "P") | |
| 13350 | (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) | |
| 13351 | (org-map-entries | |
| 13352 | (lambda () (org--deadline-or-schedule arg 'scheduled time)) | |
| 13353 | nil | |
| 13354 | (if (eq org-loop-over-headlines-in-active-region 'start-level) | |
| 13355 | 'region-start-level | |
| 13356 | 'region) | |
| 13357 | (lambda () (when (org-invisible-p) (org-end-of-subtree nil t)))) | |
| 13358 | (org--deadline-or-schedule arg 'scheduled time))) | |
| 13359 | ||
| 13360 | (defun org-get-scheduled-time (pom &optional inherit) | |
| 13361 | "Get the scheduled time as a time tuple, of a format suitable | |
| 13362 | for calling org-schedule with, or if there is no scheduling, | |
| 13363 | returns nil." | |
| 13364 | (let ((time (org-entry-get pom "SCHEDULED" inherit))) | |
| 13365 | (when time | |
| 13366 | (apply 'encode-time (org-parse-time-string time))))) | |
| 13367 | ||
| 13368 | (defun org-get-deadline-time (pom &optional inherit) | |
| 13369 | "Get the deadline as a time tuple, of a format suitable for | |
| 13370 | calling org-deadline with, or if there is no scheduling, returns | |
| 13371 | nil." | |
| 13372 | (let ((time (org-entry-get pom "DEADLINE" inherit))) | |
| 13373 | (when time | |
| 13374 | (apply 'encode-time (org-parse-time-string time))))) | |
| 13375 | ||
| 13376 | (defun org-remove-timestamp-with-keyword (keyword) | |
| 13377 | "Remove all time stamps with KEYWORD in the current entry." | |
| 13378 | (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*")) | |
| 13379 | beg) | |
| 13380 | (save-excursion | |
| 13381 | (org-back-to-heading t) | |
| 13382 | (setq beg (point)) | |
| 13383 | (outline-next-heading) | |
| 13384 | (while (re-search-backward re beg t) | |
| 13385 | (replace-match "") | |
| 13386 | (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) | |
| 13387 | (equal (char-before) ?\ )) | |
| 13388 | (backward-delete-char 1) | |
| 13389 | (when (string-match "^[ \t]*$" (buffer-substring | |
| 13390 | (point-at-bol) (point-at-eol))) | |
| 13391 | (delete-region (point-at-bol) | |
| 13392 | (min (point-max) (1+ (point-at-eol)))))))))) | |
| 13393 | ||
| 13394 | (defvar org-time-was-given) ; dynamically scoped parameter | |
| 13395 | (defvar org-end-time-was-given) ; dynamically scoped parameter | |
| 13396 | ||
| 13397 | (defun org-at-planning-p () | |
| 13398 | "Non-nil when point is on a planning info line." | |
| 13399 | ;; This is as accurate and faster than `org-element-at-point' since | |
| 13400 | ;; planning info location is fixed in the section. | |
| 13401 | (org-with-wide-buffer | |
| 13402 | (beginning-of-line) | |
| 13403 | (and (looking-at-p org-planning-line-re) | |
| 13404 | (eq (point) | |
| 13405 | (ignore-errors | |
| 13406 | (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p)) | |
| 13407 | (org-back-to-heading t) | |
| 13408 | (org-with-limited-levels (org-back-to-heading t))) | |
| 13409 | (line-beginning-position 2)))))) | |
| 13410 | ||
| 13411 | (defun org-add-planning-info (what &optional time &rest remove) | |
| 13412 | "Insert new timestamp with keyword in the planning line. | |
| 13413 | WHAT indicates what kind of time stamp to add. It is a symbol | |
| 13414 | among `closed', `deadline', `scheduled' and nil. TIME indicates | |
| 13415 | the time to use. If none is given, the user is prompted for | |
| 13416 | a date. REMOVE indicates what kind of entries to remove. An old | |
| 13417 | WHAT entry will also be removed." | |
| 13418 | (let (org-time-was-given org-end-time-was-given default-time default-input) | |
| 13419 | (catch 'exit | |
| 13420 | (when (and (memq what '(scheduled deadline)) | |
| 13421 | (or (not time) | |
| 13422 | (and (stringp time) | |
| 13423 | (string-match "^[-+]+[0-9]" time)))) | |
| 13424 | ;; Try to get a default date/time from existing timestamp | |
| 13425 | (save-excursion | |
| 13426 | (org-back-to-heading t) | |
| 13427 | (let ((end (save-excursion (outline-next-heading) (point))) ts) | |
| 13428 | (when (re-search-forward (if (eq what 'scheduled) | |
| 13429 | org-scheduled-time-regexp | |
| 13430 | org-deadline-time-regexp) | |
| 13431 | end t) | |
| 13432 | (setq ts (match-string 1) | |
| 13433 | default-time (apply 'encode-time (org-parse-time-string ts)) | |
| 13434 | default-input (and ts (org-get-compact-tod ts))))))) | |
| 13435 | (when what | |
| 13436 | (setq time | |
| 13437 | (if (stringp time) | |
| 13438 | ;; This is a string (relative or absolute), set | |
| 13439 | ;; proper date. | |
| 13440 | (apply #'encode-time | |
| 13441 | (org-read-date-analyze | |
| 13442 | time default-time (decode-time default-time))) | |
| 13443 | ;; If necessary, get the time from the user | |
| 13444 | (or time (org-read-date nil 'to-time nil nil | |
| 13445 | default-time default-input))))) | |
| 13446 | ||
| 13447 | (org-with-wide-buffer | |
| 13448 | (org-back-to-heading t) | |
| 13449 | (forward-line) | |
| 13450 | (unless (bolp) (insert "\n")) | |
| 13451 | (cond ((looking-at-p org-planning-line-re) | |
| 13452 | ;; Move to current indentation. | |
| 13453 | (skip-chars-forward " \t") | |
| 13454 | ;; Check if we have to remove something. | |
| 13455 | (dolist (type (if what (cons what remove) remove)) | |
| 13456 | (save-excursion | |
| 13457 | (when (re-search-forward | |
| 13458 | (cl-case type | |
| 13459 | (closed org-closed-time-regexp) | |
| 13460 | (deadline org-deadline-time-regexp) | |
| 13461 | (scheduled org-scheduled-time-regexp) | |
| 13462 | (otherwise | |
| 13463 | (error "Invalid planning type: %s" type))) | |
| 13464 | (line-end-position) t) | |
| 13465 | ;; Delete until next keyword or end of line. | |
| 13466 | (delete-region | |
| 13467 | (match-beginning 0) | |
| 13468 | (if (re-search-forward org-keyword-time-not-clock-regexp | |
| 13469 | (line-end-position) | |
| 13470 | t) | |
| 13471 | (match-beginning 0) | |
| 13472 | (line-end-position)))))) | |
| 13473 | ;; If there is nothing more to add and no more keyword | |
| 13474 | ;; is left, remove the line completely. | |
| 13475 | (if (and (looking-at-p "[ \t]*$") (not what)) | |
| 13476 | (delete-region (line-beginning-position) | |
| 13477 | (line-beginning-position 2)) | |
| 13478 | ;; If we removed last keyword, do not leave trailing | |
| 13479 | ;; white space at the end of line. | |
| 13480 | (let ((p (point))) | |
| 13481 | (save-excursion | |
| 13482 | (end-of-line) | |
| 13483 | (unless (= (skip-chars-backward " \t" p) 0) | |
| 13484 | (delete-region (point) (line-end-position))))))) | |
| 13485 | ((not what) (throw 'exit nil)) ; Nothing to do. | |
| 13486 | (t (insert-before-markers "\n") | |
| 13487 | (backward-char 1) | |
| 13488 | (when org-adapt-indentation | |
| 13489 | (indent-to-column (1+ (org-outline-level)))))) | |
| 13490 | (when what | |
| 13491 | ;; Insert planning keyword. | |
| 13492 | (insert (cl-case what | |
| 13493 | (closed org-closed-string) | |
| 13494 | (deadline org-deadline-string) | |
| 13495 | (scheduled org-scheduled-string) | |
| 13496 | (otherwise (error "Invalid planning type: %s" what))) | |
| 13497 | " ") | |
| 13498 | ;; Insert associated timestamp. | |
| 13499 | (let ((ts (org-insert-time-stamp | |
| 13500 | time | |
| 13501 | (or org-time-was-given | |
| 13502 | (and (eq what 'closed) org-log-done-with-time)) | |
| 13503 | (eq what 'closed) | |
| 13504 | nil nil (list org-end-time-was-given)))) | |
| 13505 | (unless (eolp) (insert " ")) | |
| 13506 | ts)))))) | |
| 13507 | ||
| 13508 | (defvar org-log-note-marker (make-marker) | |
| 13509 | "Marker pointing at the entry where the note is to be inserted.") | |
| 13510 | (defvar org-log-note-purpose nil) | |
| 13511 | (defvar org-log-note-state nil) | |
| 13512 | (defvar org-log-note-previous-state nil) | |
| 13513 | (defvar org-log-note-extra nil) | |
| 13514 | (defvar org-log-note-window-configuration nil) | |
| 13515 | (defvar org-log-note-return-to (make-marker)) | |
| 13516 | (defvar org-log-note-effective-time nil | |
| 13517 | "Remembered current time so that dynamically scoped | |
| 13518 | `org-extend-today-until' affects timestamps in state change log") | |
| 13519 | ||
| 13520 | (defvar org-log-post-message nil | |
| 13521 | "Message to be displayed after a log note has been stored. | |
| 13522 | The auto-repeater uses this.") | |
| 13523 | ||
| 13524 | (defun org-add-note () | |
| 13525 | "Add a note to the current entry. | |
| 13526 | This is done in the same way as adding a state change note." | |
| 13527 | (interactive) | |
| 13528 | (org-add-log-setup 'note)) | |
| 13529 | ||
| 13530 | (defun org-log-beginning (&optional create) | |
| 13531 | "Return expected start of log notes in current entry. | |
| 13532 | When optional argument CREATE is non-nil, the function creates | |
| 13533 | a drawer to store notes, if necessary. Returned position ignores | |
| 13534 | narrowing." | |
| 13535 | (org-with-wide-buffer | |
| 13536 | (let ((drawer (org-log-into-drawer))) | |
| 13537 | (cond | |
| 13538 | (drawer | |
| 13539 | (org-end-of-meta-data) | |
| 13540 | (let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")) | |
| 13541 | (end (if (org-at-heading-p) (point) | |
| 13542 | (save-excursion (outline-next-heading) (point)))) | |
| 13543 | (case-fold-search t)) | |
| 13544 | (catch 'exit | |
| 13545 | ;; Try to find existing drawer. | |
| 13546 | (while (re-search-forward regexp end t) | |
| 13547 | (let ((element (org-element-at-point))) | |
| 13548 | (when (eq (org-element-type element) 'drawer) | |
| 13549 | (let ((cend (org-element-property :contents-end element))) | |
| 13550 | (when (and (not org-log-states-order-reversed) cend) | |
| 13551 | (goto-char cend))) | |
| 13552 | (throw 'exit nil)))) | |
| 13553 | ;; No drawer found. Create one, if permitted. | |
| 13554 | (when create | |
| 13555 | (unless (bolp) (insert "\n")) | |
| 13556 | (let ((beg (point))) | |
| 13557 | (insert ":" drawer ":\n:END:\n") | |
| 13558 | (org-indent-region beg (point))) | |
| 13559 | (end-of-line -1))))) | |
| 13560 | (t | |
| 13561 | (org-end-of-meta-data org-log-state-notes-insert-after-drawers) | |
| 13562 | (skip-chars-forward " \t\n") | |
| 13563 | (beginning-of-line) | |
| 13564 | (unless org-log-states-order-reversed | |
| 13565 | (org-skip-over-state-notes) | |
| 13566 | (skip-chars-backward " \t\n") | |
| 13567 | (forward-line))))) | |
| 13568 | (if (bolp) (point) (line-beginning-position 2)))) | |
| 13569 | ||
| 13570 | (defun org-add-log-setup (&optional purpose state prev-state how extra) | |
| 13571 | "Set up the post command hook to take a note. | |
| 13572 | If this is about to TODO state change, the new state is expected in STATE. | |
| 13573 | HOW is an indicator what kind of note should be created. | |
| 13574 | EXTRA is additional text that will be inserted into the notes buffer." | |
| 13575 | (move-marker org-log-note-marker (point)) | |
| 13576 | (setq org-log-note-purpose purpose | |
| 13577 | org-log-note-state state | |
| 13578 | org-log-note-previous-state prev-state | |
| 13579 | org-log-note-how how | |
| 13580 | org-log-note-extra extra | |
| 13581 | org-log-note-effective-time (org-current-effective-time)) | |
| 13582 | (add-hook 'post-command-hook 'org-add-log-note 'append)) | |
| 13583 | ||
| 13584 | (defun org-skip-over-state-notes () | |
| 13585 | "Skip past the list of State notes in an entry." | |
| 13586 | (when (ignore-errors (goto-char (org-in-item-p))) | |
| 13587 | (let* ((struct (org-list-struct)) | |
| 13588 | (prevs (org-list-prevs-alist struct)) | |
| 13589 | (regexp | |
| 13590 | (concat "[ \t]*- +" | |
| 13591 | (replace-regexp-in-string | |
| 13592 | " +" " +" | |
| 13593 | (org-replace-escapes | |
| 13594 | (regexp-quote (cdr (assq 'state org-log-note-headings))) | |
| 13595 | `(("%d" . ,org-ts-regexp-inactive) | |
| 13596 | ("%D" . ,org-ts-regexp) | |
| 13597 | ("%s" . "\\(?:\"\\S-+\"\\)?") | |
| 13598 | ("%S" . "\\(?:\"\\S-+\"\\)?") | |
| 13599 | ("%t" . ,org-ts-regexp-inactive) | |
| 13600 | ("%T" . ,org-ts-regexp) | |
| 13601 | ("%u" . ".*?") | |
| 13602 | ("%U" . ".*?"))))))) | |
| 13603 | (while (looking-at-p regexp) | |
| 13604 | (goto-char (or (org-list-get-next-item (point) struct prevs) | |
| 13605 | (org-list-get-item-end (point) struct))))))) | |
| 13606 | ||
| 13607 | (defun org-add-log-note (&optional _purpose) | |
| 13608 | "Pop up a window for taking a note, and add this note later." | |
| 13609 | (remove-hook 'post-command-hook 'org-add-log-note) | |
| 13610 | (setq org-log-note-window-configuration (current-window-configuration)) | |
| 13611 | (delete-other-windows) | |
| 13612 | (move-marker org-log-note-return-to (point)) | |
| 13613 | (pop-to-buffer-same-window (marker-buffer org-log-note-marker)) | |
| 13614 | (goto-char org-log-note-marker) | |
| 13615 | (org-switch-to-buffer-other-window "*Org Note*") | |
| 13616 | (erase-buffer) | |
| 13617 | (if (memq org-log-note-how '(time state)) | |
| 13618 | (org-store-log-note) | |
| 13619 | (let ((org-inhibit-startup t)) (org-mode)) | |
| 13620 | (insert (format "# Insert note for %s. | |
| 13621 | # Finish with C-c C-c, or cancel with C-c C-k.\n\n" | |
| 13622 | (cond | |
| 13623 | ((eq org-log-note-purpose 'clock-out) "stopped clock") | |
| 13624 | ((eq org-log-note-purpose 'done) "closed todo item") | |
| 13625 | ((eq org-log-note-purpose 'state) | |
| 13626 | (format "state change from \"%s\" to \"%s\"" | |
| 13627 | (or org-log-note-previous-state "") | |
| 13628 | (or org-log-note-state ""))) | |
| 13629 | ((eq org-log-note-purpose 'reschedule) | |
| 13630 | "rescheduling") | |
| 13631 | ((eq org-log-note-purpose 'delschedule) | |
| 13632 | "no longer scheduled") | |
| 13633 | ((eq org-log-note-purpose 'redeadline) | |
| 13634 | "changing deadline") | |
| 13635 | ((eq org-log-note-purpose 'deldeadline) | |
| 13636 | "removing deadline") | |
| 13637 | ((eq org-log-note-purpose 'refile) | |
| 13638 | "refiling") | |
| 13639 | ((eq org-log-note-purpose 'note) | |
| 13640 | "this entry") | |
| 13641 | (t (error "This should not happen"))))) | |
| 13642 | (when org-log-note-extra (insert org-log-note-extra)) | |
| 13643 | (setq-local org-finish-function 'org-store-log-note) | |
| 13644 | (run-hooks 'org-log-buffer-setup-hook))) | |
| 13645 | ||
| 13646 | (defvar org-note-abort nil) ; dynamically scoped | |
| 13647 | (defun org-store-log-note () | |
| 13648 | "Finish taking a log note, and insert it to where it belongs." | |
| 13649 | (let ((txt (prog1 (buffer-string) | |
| 13650 | (kill-buffer))) | |
| 13651 | (note (cdr (assq org-log-note-purpose org-log-note-headings))) | |
| 13652 | lines) | |
| 13653 | (while (string-match "\\`# .*\n[ \t\n]*" txt) | |
| 13654 | (setq txt (replace-match "" t t txt))) | |
| 13655 | (when (string-match "\\s-+\\'" txt) | |
| 13656 | (setq txt (replace-match "" t t txt))) | |
| 13657 | (setq lines (and (not (equal "" txt)) (org-split-string txt "\n"))) | |
| 13658 | (when (org-string-nw-p note) | |
| 13659 | (setq note | |
| 13660 | (org-replace-escapes | |
| 13661 | note | |
| 13662 | (list (cons "%u" (user-login-name)) | |
| 13663 | (cons "%U" user-full-name) | |
| 13664 | (cons "%t" (format-time-string | |
| 13665 | (org-time-stamp-format 'long 'inactive) | |
| 13666 | org-log-note-effective-time)) | |
| 13667 | (cons "%T" (format-time-string | |
| 13668 | (org-time-stamp-format 'long nil) | |
| 13669 | org-log-note-effective-time)) | |
| 13670 | (cons "%d" (format-time-string | |
| 13671 | (org-time-stamp-format nil 'inactive) | |
| 13672 | org-log-note-effective-time)) | |
| 13673 | (cons "%D" (format-time-string | |
| 13674 | (org-time-stamp-format nil nil) | |
| 13675 | org-log-note-effective-time)) | |
| 13676 | (cons "%s" (cond | |
| 13677 | ((not org-log-note-state) "") | |
| 13678 | ((string-match-p org-ts-regexp | |
| 13679 | org-log-note-state) | |
| 13680 | (format "\"[%s]\"" | |
| 13681 | (substring org-log-note-state 1 -1))) | |
| 13682 | (t (format "\"%s\"" org-log-note-state)))) | |
| 13683 | (cons "%S" | |
| 13684 | (cond | |
| 13685 | ((not org-log-note-previous-state) "") | |
| 13686 | ((string-match-p org-ts-regexp | |
| 13687 | org-log-note-previous-state) | |
| 13688 | (format "\"[%s]\"" | |
| 13689 | (substring | |
| 13690 | org-log-note-previous-state 1 -1))) | |
| 13691 | (t (format "\"%s\"" | |
| 13692 | org-log-note-previous-state))))))) | |
| 13693 | (when lines (setq note (concat note " \\\\"))) | |
| 13694 | (push note lines)) | |
| 13695 | (when (and lines (not org-note-abort)) | |
| 13696 | (with-current-buffer (marker-buffer org-log-note-marker) | |
| 13697 | (org-with-wide-buffer | |
| 13698 | ;; Find location for the new note. | |
| 13699 | (goto-char org-log-note-marker) | |
| 13700 | (set-marker org-log-note-marker nil) | |
| 13701 | ;; Note associated to a clock is to be located right after | |
| 13702 | ;; the clock. Do not move point. | |
| 13703 | (unless (eq org-log-note-purpose 'clock-out) | |
| 13704 | (goto-char (org-log-beginning t))) | |
| 13705 | ;; Make sure point is at the beginning of an empty line. | |
| 13706 | (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) | |
| 13707 | ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) | |
| 13708 | ;; In an existing list, add a new item at the top level. | |
| 13709 | ;; Otherwise, indent line like a regular one. | |
| 13710 | (let ((itemp (org-in-item-p))) | |
| 13711 | (if itemp | |
| 13712 | (indent-line-to | |
| 13713 | (let ((struct (save-excursion | |
| 13714 | (goto-char itemp) (org-list-struct)))) | |
| 13715 | (org-list-get-ind (org-list-get-top-point struct) struct))) | |
| 13716 | (org-indent-line))) | |
| 13717 | (insert (org-list-bullet-string "-") (pop lines)) | |
| 13718 | (let ((ind (org-list-item-body-column (line-beginning-position)))) | |
| 13719 | (dolist (line lines) | |
| 13720 | (insert "\n") | |
| 13721 | (indent-line-to ind) | |
| 13722 | (insert line))) | |
| 13723 | (message "Note stored") | |
| 13724 | (org-back-to-heading t) | |
| 13725 | (org-cycle-hide-drawers 'children)) | |
| 13726 | ;; Fix `buffer-undo-list' when `org-store-log-note' is called | |
| 13727 | ;; from within `org-add-log-note' because `buffer-undo-list' | |
| 13728 | ;; is then modified outside of `org-with-remote-undo'. | |
| 13729 | (when (eq this-command 'org-agenda-todo) | |
| 13730 | (setcdr buffer-undo-list (cddr buffer-undo-list)))))) | |
| 13731 | ;; Don't add undo information when called from `org-agenda-todo'. | |
| 13732 | (let ((buffer-undo-list (eq this-command 'org-agenda-todo))) | |
| 13733 | (set-window-configuration org-log-note-window-configuration) | |
| 13734 | (with-current-buffer (marker-buffer org-log-note-return-to) | |
| 13735 | (goto-char org-log-note-return-to)) | |
| 13736 | (move-marker org-log-note-return-to nil) | |
| 13737 | (when org-log-post-message (message "%s" org-log-post-message)))) | |
| 13738 | ||
| 13739 | (defun org-remove-empty-drawer-at (pos) | |
| 13740 | "Remove an empty drawer at position POS. | |
| 13741 | POS may also be a marker." | |
| 13742 | (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) | |
| 13743 | (org-with-wide-buffer | |
| 13744 | (goto-char pos) | |
| 13745 | (let ((drawer (org-element-at-point))) | |
| 13746 | (when (and (memq (org-element-type drawer) '(drawer property-drawer)) | |
| 13747 | (not (org-element-property :contents-begin drawer))) | |
| 13748 | (delete-region (org-element-property :begin drawer) | |
| 13749 | (progn (goto-char (org-element-property :end drawer)) | |
| 13750 | (skip-chars-backward " \r\t\n") | |
| 13751 | (forward-line) | |
| 13752 | (point)))))))) | |
| 13753 | ||
| 13754 | (defvar org-ts-type nil) | |
| 13755 | (defun org-sparse-tree (&optional arg type) | |
| 13756 | "Create a sparse tree, prompt for the details. | |
| 13757 | This command can create sparse trees. You first need to select the type | |
| 13758 | of match used to create the tree: | |
| 13759 | ||
| 13760 | t Show all TODO entries. | |
| 13761 | T Show entries with a specific TODO keyword. | |
| 13762 | m Show entries selected by a tags/property match. | |
| 13763 | p Enter a property name and its value (both with completion on existing | |
| 13764 | names/values) and show entries with that property. | |
| 13765 | r Show entries matching a regular expression (`/' can be used as well). | |
| 13766 | b Show deadlines and scheduled items before a date. | |
| 13767 | a Show deadlines and scheduled items after a date. | |
| 13768 | d Show deadlines due within `org-deadline-warning-days'. | |
| 13769 | D Show deadlines and scheduled items between a date range." | |
| 13770 | (interactive "P") | |
| 13771 | (setq type (or type org-sparse-tree-default-date-type)) | |
| 13772 | (setq org-ts-type type) | |
| 13773 | (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty | |
| 13774 | \[d]eadlines [b]efore-date [a]fter-date [D]ates range | |
| 13775 | \[c]ycle through date types: %s" | |
| 13776 | (cl-case type | |
| 13777 | (all "all timestamps") | |
| 13778 | (scheduled "only scheduled") | |
| 13779 | (deadline "only deadline") | |
| 13780 | (active "only active timestamps") | |
| 13781 | (inactive "only inactive timestamps") | |
| 13782 | (closed "with a closed time-stamp") | |
| 13783 | (otherwise "scheduled/deadline"))) | |
| 13784 | (let ((answer (read-char-exclusive))) | |
| 13785 | (cl-case answer | |
| 13786 | (?c | |
| 13787 | (org-sparse-tree | |
| 13788 | arg | |
| 13789 | (cadr | |
| 13790 | (memq type '(nil all scheduled deadline active inactive closed))))) | |
| 13791 | (?d (call-interactively 'org-check-deadlines)) | |
| 13792 | (?b (call-interactively 'org-check-before-date)) | |
| 13793 | (?a (call-interactively 'org-check-after-date)) | |
| 13794 | (?D (call-interactively 'org-check-dates-range)) | |
| 13795 | (?t (call-interactively 'org-show-todo-tree)) | |
| 13796 | (?T (org-show-todo-tree '(4))) | |
| 13797 | (?m (call-interactively 'org-match-sparse-tree)) | |
| 13798 | ((?p ?P) | |
| 13799 | (let* ((kwd (completing-read | |
| 13800 | "Property: " (mapcar #'list (org-buffer-property-keys)))) | |
| 13801 | (value (completing-read | |
| 13802 | "Value: " (mapcar #'list (org-property-values kwd))))) | |
| 13803 | (unless (string-match "\\`{.*}\\'" value) | |
| 13804 | (setq value (concat "\"" value "\""))) | |
| 13805 | (org-match-sparse-tree arg (concat kwd "=" value)))) | |
| 13806 | ((?r ?R ?/) (call-interactively 'org-occur)) | |
| 13807 | (otherwise (user-error "No such sparse tree command \"%c\"" answer))))) | |
| 13808 | ||
| 13809 | (defvar-local org-occur-highlights nil | |
| 13810 | "List of overlays used for occur matches.") | |
| 13811 | (defvar-local org-occur-parameters nil | |
| 13812 | "Parameters of the active org-occur calls. | |
| 13813 | This is a list, each call to org-occur pushes as cons cell, | |
| 13814 | containing the regular expression and the callback, onto the list. | |
| 13815 | The list can contain several entries if `org-occur' has been called | |
| 13816 | several time with the KEEP-PREVIOUS argument. Otherwise, this list | |
| 13817 | will only contain one set of parameters. When the highlights are | |
| 13818 | removed (for example with `C-c C-c', or with the next edit (depending | |
| 13819 | on `org-remove-highlights-with-change'), this variable is emptied | |
| 13820 | as well.") | |
| 13821 | ||
| 13822 | (defun org-occur (regexp &optional keep-previous callback) | |
| 13823 | "Make a compact tree which shows all matches of REGEXP. | |
| 13824 | ||
| 13825 | The tree will show the lines where the regexp matches, and any other context | |
| 13826 | defined in `org-show-context-detail', which see. | |
| 13827 | ||
| 13828 | When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing | |
| 13829 | done by a previous call to `org-occur' will be kept, to allow stacking of | |
| 13830 | calls to this command. | |
| 13831 | ||
| 13832 | Optional argument CALLBACK can be a function of no argument. In this case, | |
| 13833 | it is called with point at the end of the match, match data being set | |
| 13834 | accordingly. Current match is shown only if the return value is non-nil. | |
| 13835 | The function must neither move point nor alter narrowing." | |
| 13836 | (interactive "sRegexp: \nP") | |
| 13837 | (when (equal regexp "") | |
| 13838 | (user-error "Regexp cannot be empty")) | |
| 13839 | (unless keep-previous | |
| 13840 | (org-remove-occur-highlights nil nil t)) | |
| 13841 | (push (cons regexp callback) org-occur-parameters) | |
| 13842 | (let ((cnt 0)) | |
| 13843 | (save-excursion | |
| 13844 | (goto-char (point-min)) | |
| 13845 | (when (or (not keep-previous) ; do not want to keep | |
| 13846 | (not org-occur-highlights)) ; no previous matches | |
| 13847 | ;; hide everything | |
| 13848 | (org-overview)) | |
| 13849 | (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart) | |
| 13850 | (isearch-no-upper-case-p regexp t) | |
| 13851 | org-occur-case-fold-search))) | |
| 13852 | (while (re-search-forward regexp nil t) | |
| 13853 | (when (or (not callback) | |
| 13854 | (save-match-data (funcall callback))) | |
| 13855 | (setq cnt (1+ cnt)) | |
| 13856 | (when org-highlight-sparse-tree-matches | |
| 13857 | (org-highlight-new-match (match-beginning 0) (match-end 0))) | |
| 13858 | (org-show-context 'occur-tree))))) | |
| 13859 | (when org-remove-highlights-with-change | |
| 13860 | (add-hook 'before-change-functions 'org-remove-occur-highlights | |
| 13861 | nil 'local)) | |
| 13862 | (unless org-sparse-tree-open-archived-trees | |
| 13863 | (org-hide-archived-subtrees (point-min) (point-max))) | |
| 13864 | (run-hooks 'org-occur-hook) | |
| 13865 | (when (called-interactively-p 'interactive) | |
| 13866 | (message "%d match(es) for regexp %s" cnt regexp)) | |
| 13867 | cnt)) | |
| 13868 | ||
| 13869 | (defun org-occur-next-match (&optional n _reset) | |
| 13870 | "Function for `next-error-function' to find sparse tree matches. | |
| 13871 | N is the number of matches to move, when negative move backwards. | |
| 13872 | This function always goes back to the starting point when no | |
| 13873 | match is found." | |
| 13874 | (let* ((limit (if (< n 0) (point-min) (point-max))) | |
| 13875 | (search-func (if (< n 0) | |
| 13876 | 'previous-single-char-property-change | |
| 13877 | 'next-single-char-property-change)) | |
| 13878 | (n (abs n)) | |
| 13879 | (pos (point)) | |
| 13880 | p1) | |
| 13881 | (catch 'exit | |
| 13882 | (while (setq p1 (funcall search-func (point) 'org-type)) | |
| 13883 | (when (equal p1 limit) | |
| 13884 | (goto-char pos) | |
| 13885 | (user-error "No more matches")) | |
| 13886 | (when (equal (get-char-property p1 'org-type) 'org-occur) | |
| 13887 | (setq n (1- n)) | |
| 13888 | (when (= n 0) | |
| 13889 | (goto-char p1) | |
| 13890 | (throw 'exit (point)))) | |
| 13891 | (goto-char p1)) | |
| 13892 | (goto-char p1) | |
| 13893 | (user-error "No more matches")))) | |
| 13894 | ||
| 13895 | (defun org-show-context (&optional key) | |
| 13896 | "Make sure point and context are visible. | |
| 13897 | Optional argument KEY, when non-nil, is a symbol. See | |
| 13898 | `org-show-context-detail' for allowed values and how much is to | |
| 13899 | be shown." | |
| 13900 | (org-show-set-visibility | |
| 13901 | (cond ((symbolp org-show-context-detail) org-show-context-detail) | |
| 13902 | ((cdr (assq key org-show-context-detail))) | |
| 13903 | (t (cdr (assq 'default org-show-context-detail)))))) | |
| 13904 | ||
| 13905 | (defun org-show-set-visibility (detail) | |
| 13906 | "Set visibility around point according to DETAIL. | |
| 13907 | DETAIL is either nil, `minimal', `local', `ancestors', `lineage', | |
| 13908 | `tree', `canonical' or t. See `org-show-context-detail' for more | |
| 13909 | information." | |
| 13910 | ;; Show current heading and possibly its entry, following headline | |
| 13911 | ;; or all children. | |
| 13912 | (if (and (org-at-heading-p) (not (eq detail 'local))) | |
| 13913 | (org-flag-heading nil) | |
| 13914 | (org-show-entry) | |
| 13915 | ;; If point is hidden within a drawer or a block, make sure to | |
| 13916 | ;; expose it. | |
| 13917 | (dolist (o (overlays-at (point))) | |
| 13918 | (when (memq (overlay-get o 'invisible) '(org-hide-block outline)) | |
| 13919 | (delete-overlay o))) | |
| 13920 | (unless (org-before-first-heading-p) | |
| 13921 | (org-with-limited-levels | |
| 13922 | (cl-case detail | |
| 13923 | ((tree canonical t) (org-show-children)) | |
| 13924 | ((nil minimal ancestors)) | |
| 13925 | (t (save-excursion | |
| 13926 | (outline-next-heading) | |
| 13927 | (org-flag-heading nil))))))) | |
| 13928 | ;; Show all siblings. | |
| 13929 | (when (eq detail 'lineage) (org-show-siblings)) | |
| 13930 | ;; Show ancestors, possibly with their children. | |
| 13931 | (when (memq detail '(ancestors lineage tree canonical t)) | |
| 13932 | (save-excursion | |
| 13933 | (while (org-up-heading-safe) | |
| 13934 | (org-flag-heading nil) | |
| 13935 | (when (memq detail '(canonical t)) (org-show-entry)) | |
| 13936 | (when (memq detail '(tree canonical t)) (org-show-children)))))) | |
| 13937 | ||
| 13938 | (defvar org-reveal-start-hook nil | |
| 13939 | "Hook run before revealing a location.") | |
| 13940 | ||
| 13941 | (defun org-reveal (&optional siblings) | |
| 13942 | "Show current entry, hierarchy above it, and the following headline. | |
| 13943 | ||
| 13944 | This can be used to show a consistent set of context around | |
| 13945 | locations exposed with `org-show-context'. | |
| 13946 | ||
| 13947 | With optional argument SIBLINGS, on each level of the hierarchy all | |
| 13948 | siblings are shown. This repairs the tree structure to what it would | |
| 13949 | look like when opened with hierarchical calls to `org-cycle'. | |
| 13950 | ||
| 13951 | With a \\[universal-argument] \\[universal-argument] prefix, \ | |
| 13952 | go to the parent and show the entire tree." | |
| 13953 | (interactive "P") | |
| 13954 | (run-hooks 'org-reveal-start-hook) | |
| 13955 | (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical)) | |
| 13956 | ((equal siblings '(16)) | |
| 13957 | (save-excursion | |
| 13958 | (when (org-up-heading-safe) | |
| 13959 | (org-show-subtree) | |
| 13960 | (run-hook-with-args 'org-cycle-hook 'subtree)))) | |
| 13961 | (t (org-show-set-visibility 'lineage)))) | |
| 13962 | ||
| 13963 | (defun org-highlight-new-match (beg end) | |
| 13964 | "Highlight from BEG to END and mark the highlight is an occur headline." | |
| 13965 | (let ((ov (make-overlay beg end))) | |
| 13966 | (overlay-put ov 'face 'secondary-selection) | |
| 13967 | (overlay-put ov 'org-type 'org-occur) | |
| 13968 | (push ov org-occur-highlights))) | |
| 13969 | ||
| 13970 | (defun org-remove-occur-highlights (&optional _beg _end noremove) | |
| 13971 | "Remove the occur highlights from the buffer. | |
| 13972 | BEG and END are ignored. If NOREMOVE is nil, remove this function | |
| 13973 | from the `before-change-functions' in the current buffer." | |
| 13974 | (interactive) | |
| 13975 | (unless org-inhibit-highlight-removal | |
| 13976 | (mapc #'delete-overlay org-occur-highlights) | |
| 13977 | (setq org-occur-highlights nil) | |
| 13978 | (setq org-occur-parameters nil) | |
| 13979 | (unless noremove | |
| 13980 | (remove-hook 'before-change-functions | |
| 13981 | 'org-remove-occur-highlights 'local)))) | |
| 13982 | ||
| 13983 | ;;;; Priorities | |
| 13984 | ||
| 13985 | (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)" | |
| 13986 | "Regular expression matching the priority indicator.") | |
| 13987 | ||
| 13988 | (defvar org-remove-priority-next-time nil) | |
| 13989 | ||
| 13990 | (defun org-priority-up () | |
| 13991 | "Increase the priority of the current item." | |
| 13992 | (interactive) | |
| 13993 | (org-priority 'up)) | |
| 13994 | ||
| 13995 | (defun org-priority-down () | |
| 13996 | "Decrease the priority of the current item." | |
| 13997 | (interactive) | |
| 13998 | (org-priority 'down)) | |
| 13999 | ||
| 14000 | (defun org-priority (&optional action _show) | |
| 14001 | "Change the priority of an item. | |
| 14002 | ACTION can be `set', `up', `down', or a character." | |
| 14003 | (interactive "P") | |
| 14004 | (if (equal action '(4)) | |
| 14005 | (org-show-priority) | |
| 14006 | (unless org-enable-priority-commands | |
| 14007 | (user-error "Priority commands are disabled")) | |
| 14008 | (setq action (or action 'set)) | |
| 14009 | (let (current new news have remove) | |
| 14010 | (save-excursion | |
| 14011 | (org-back-to-heading t) | |
| 14012 | (when (looking-at org-priority-regexp) | |
| 14013 | (setq current (string-to-char (match-string 2)) | |
| 14014 | have t)) | |
| 14015 | (cond | |
| 14016 | ((eq action 'remove) | |
| 14017 | (setq remove t new ?\ )) | |
| 14018 | ((or (eq action 'set) | |
| 14019 | (integerp action)) | |
| 14020 | (if (not (eq action 'set)) | |
| 14021 | (setq new action) | |
| 14022 | (message "Priority %c-%c, SPC to remove: " | |
| 14023 | org-highest-priority org-lowest-priority) | |
| 14024 | (save-match-data | |
| 14025 | (setq new (read-char-exclusive)))) | |
| 14026 | (when (and (= (upcase org-highest-priority) org-highest-priority) | |
| 14027 | (= (upcase org-lowest-priority) org-lowest-priority)) | |
| 14028 | (setq new (upcase new))) | |
| 14029 | (cond ((equal new ?\ ) (setq remove t)) | |
| 14030 | ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) | |
| 14031 | (user-error "Priority must be between `%c' and `%c'" | |
| 14032 | org-highest-priority org-lowest-priority)))) | |
| 14033 | ((eq action 'up) | |
| 14034 | (setq new (if have | |
| 14035 | (1- current) ; normal cycling | |
| 14036 | ;; last priority was empty | |
| 14037 | (if (eq last-command this-command) | |
| 14038 | org-lowest-priority ; wrap around empty to lowest | |
| 14039 | ;; default | |
| 14040 | (if org-priority-start-cycle-with-default | |
| 14041 | org-default-priority | |
| 14042 | (1- org-default-priority)))))) | |
| 14043 | ((eq action 'down) | |
| 14044 | (setq new (if have | |
| 14045 | (1+ current) ; normal cycling | |
| 14046 | ;; last priority was empty | |
| 14047 | (if (eq last-command this-command) | |
| 14048 | org-highest-priority ; wrap around empty to highest | |
| 14049 | ;; default | |
| 14050 | (if org-priority-start-cycle-with-default | |
| 14051 | org-default-priority | |
| 14052 | (1+ org-default-priority)))))) | |
| 14053 | (t (user-error "Invalid action"))) | |
| 14054 | (when (or (< (upcase new) org-highest-priority) | |
| 14055 | (> (upcase new) org-lowest-priority)) | |
| 14056 | (if (and (memq action '(up down)) | |
| 14057 | (not have) (not (eq last-command this-command))) | |
| 14058 | ;; `new' is from default priority | |
| 14059 | (error | |
| 14060 | "The default can not be set, see `org-default-priority' why") | |
| 14061 | ;; normal cycling: `new' is beyond highest/lowest priority | |
| 14062 | ;; and is wrapped around to the empty priority | |
| 14063 | (setq remove t))) | |
| 14064 | (setq news (format "%c" new)) | |
| 14065 | (if have | |
| 14066 | (if remove | |
| 14067 | (replace-match "" t t nil 1) | |
| 14068 | (replace-match news t t nil 2)) | |
| 14069 | (if remove | |
| 14070 | (user-error "No priority cookie found in line") | |
| 14071 | (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) | |
| 14072 | (if (match-end 2) | |
| 14073 | (progn | |
| 14074 | (goto-char (match-end 2)) | |
| 14075 | (insert " [#" news "]")) | |
| 14076 | (goto-char (match-beginning 3)) | |
| 14077 | (insert "[#" news "] ")))) | |
| 14078 | (org-set-tags nil 'align)) | |
| 14079 | (if remove | |
| 14080 | (message "Priority removed") | |
| 14081 | (message "Priority of current item set to %s" news))))) | |
| 14082 | ||
| 14083 | (defun org-show-priority () | |
| 14084 | "Show the priority of the current item. | |
| 14085 | This priority is composed of the main priority given with the [#A] cookies, | |
| 14086 | and by additional input from the age of a schedules or deadline entry." | |
| 14087 | (interactive) | |
| 14088 | (let ((pri (if (eq major-mode 'org-agenda-mode) | |
| 14089 | (org-get-at-bol 'priority) | |
| 14090 | (save-excursion | |
| 14091 | (save-match-data | |
| 14092 | (beginning-of-line) | |
| 14093 | (and (looking-at org-heading-regexp) | |
| 14094 | (org-get-priority (match-string 0)))))))) | |
| 14095 | (message "Priority is %d" (if pri pri -1000)))) | |
| 14096 | ||
| 14097 | (defun org-get-priority (s) | |
| 14098 | "Find priority cookie and return priority." | |
| 14099 | (save-match-data | |
| 14100 | (if (functionp org-get-priority-function) | |
| 14101 | (funcall org-get-priority-function) | |
| 14102 | (if (not (string-match org-priority-regexp s)) | |
| 14103 | (* 1000 (- org-lowest-priority org-default-priority)) | |
| 14104 | (* 1000 (- org-lowest-priority | |
| 14105 | (string-to-char (match-string 2 s)))))))) | |
| 14106 | ||
| 14107 | ;;;; Tags | |
| 14108 | ||
| 14109 | (defvar org-agenda-archives-mode) | |
| 14110 | (defvar org-map-continue-from nil | |
| 14111 | "Position from where mapping should continue. | |
| 14112 | Can be set by the action argument to `org-scan-tags' and `org-map-entries'.") | |
| 14113 | ||
| 14114 | (defvar org-scanner-tags nil | |
| 14115 | "The current tag list while the tags scanner is running.") | |
| 14116 | ||
| 14117 | (defvar org-trust-scanner-tags nil | |
| 14118 | "Should `org-get-tags-at' use the tags for the scanner. | |
| 14119 | This is for internal dynamical scoping only. | |
| 14120 | When this is non-nil, the function `org-get-tags-at' will return the value | |
| 14121 | of `org-scanner-tags' instead of building the list by itself. This | |
| 14122 | can lead to large speed-ups when the tags scanner is used in a file with | |
| 14123 | many entries, and when the list of tags is retrieved, for example to | |
| 14124 | obtain a list of properties. Building the tags list for each entry in such | |
| 14125 | a file becomes an N^2 operation - but with this variable set, it scales | |
| 14126 | as N.") | |
| 14127 | ||
| 14128 | (defvar org--matcher-tags-todo-only nil) | |
| 14129 | ||
| 14130 | (defun org-scan-tags (action matcher todo-only &optional start-level) | |
| 14131 | "Scan headline tags with inheritance and produce output ACTION. | |
| 14132 | ||
| 14133 | ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, | |
| 14134 | or `agenda' to produce an entry list for an agenda view. It can also be | |
| 14135 | a Lisp form or a function that should be called at each matched headline, in | |
| 14136 | this case the return value is a list of all return values from these calls. | |
| 14137 | ||
| 14138 | MATCHER is a function accepting three arguments, returning | |
| 14139 | a non-nil value whenever a given set of tags qualifies a headline | |
| 14140 | for inclusion. See `org-make-tags-matcher' for more information. | |
| 14141 | As a special case, it can also be set to t (respectively nil) in | |
| 14142 | order to match all (respectively none) headline. | |
| 14143 | ||
| 14144 | When TODO-ONLY is non-nil, only lines with a TODO keyword are | |
| 14145 | included in the output. | |
| 14146 | ||
| 14147 | START-LEVEL can be a string with asterisks, reducing the scope to | |
| 14148 | headlines matching this string." | |
| 14149 | (require 'org-agenda) | |
| 14150 | (let* ((re (concat "^" | |
| 14151 | (if start-level | |
| 14152 | ;; Get the correct level to match | |
| 14153 | (concat "\\*\\{" (number-to-string start-level) "\\} ") | |
| 14154 | org-outline-regexp) | |
| 14155 | " *\\(\\<\\(" | |
| 14156 | (mapconcat #'regexp-quote org-todo-keywords-1 "\\|") | |
| 14157 | "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) | |
| 14158 | (props (list 'face 'default | |
| 14159 | 'done-face 'org-agenda-done | |
| 14160 | 'undone-face 'default | |
| 14161 | 'mouse-face 'highlight | |
| 14162 | 'org-not-done-regexp org-not-done-regexp | |
| 14163 | 'org-todo-regexp org-todo-regexp | |
| 14164 | 'org-complex-heading-regexp org-complex-heading-regexp | |
| 14165 | 'help-echo | |
| 14166 | (format "mouse-2 or RET jump to Org file %S" | |
| 14167 | (abbreviate-file-name | |
| 14168 | (or (buffer-file-name (buffer-base-buffer)) | |
| 14169 | (buffer-name (buffer-base-buffer))))))) | |
| 14170 | (org-map-continue-from nil) | |
| 14171 | lspos tags tags-list | |
| 14172 | (tags-alist (list (cons 0 org-file-tags))) | |
| 14173 | (llast 0) rtn rtn1 level category i txt | |
| 14174 | todo marker entry priority | |
| 14175 | ts-date ts-date-type ts-date-pair) | |
| 14176 | (unless (or (member action '(agenda sparse-tree)) (functionp action)) | |
| 14177 | (setq action (list 'lambda nil action))) | |
| 14178 | (save-excursion | |
| 14179 | (goto-char (point-min)) | |
| 14180 | (when (eq action 'sparse-tree) | |
| 14181 | (org-overview) | |
| 14182 | (org-remove-occur-highlights)) | |
| 14183 | (while (let (case-fold-search) | |
| 14184 | (re-search-forward re nil t)) | |
| 14185 | (setq org-map-continue-from nil) | |
| 14186 | (catch :skip | |
| 14187 | ;; Ignore closing parts of inline tasks. | |
| 14188 | (when (and (fboundp 'org-inlinetask-end-p) (org-inlinetask-end-p)) | |
| 14189 | (throw :skip t)) | |
| 14190 | (setq todo | |
| 14191 | ;; TODO: is the 1-2 difference a bug? | |
| 14192 | (when (match-end 1) (match-string-no-properties 2)) | |
| 14193 | tags (when (match-end 4) (match-string-no-properties 4))) | |
| 14194 | (goto-char (setq lspos (match-beginning 0))) | |
| 14195 | (setq level (org-reduced-level (org-outline-level)) | |
| 14196 | category (org-get-category)) | |
| 14197 | (when (eq action 'agenda) | |
| 14198 | (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) | |
| 14199 | ts-date (car ts-date-pair) | |
| 14200 | ts-date-type (cdr ts-date-pair))) | |
| 14201 | (setq i llast llast level) | |
| 14202 | ;; remove tag lists from same and sublevels | |
| 14203 | (while (>= i level) | |
| 14204 | (when (setq entry (assoc i tags-alist)) | |
| 14205 | (setq tags-alist (delete entry tags-alist))) | |
| 14206 | (setq i (1- i))) | |
| 14207 | ;; add the next tags | |
| 14208 | (when tags | |
| 14209 | (setq tags (org-split-string tags ":") | |
| 14210 | tags-alist | |
| 14211 | (cons (cons level tags) tags-alist))) | |
| 14212 | ;; compile tags for current headline | |
| 14213 | (setq tags-list | |
| 14214 | (if org-use-tag-inheritance | |
| 14215 | (apply 'append (mapcar 'cdr (reverse tags-alist))) | |
| 14216 | tags) | |
| 14217 | org-scanner-tags tags-list) | |
| 14218 | (when org-use-tag-inheritance | |
| 14219 | (setcdr (car tags-alist) | |
| 14220 | (mapcar (lambda (x) | |
| 14221 | (setq x (copy-sequence x)) | |
| 14222 | (org-add-prop-inherited x)) | |
| 14223 | (cdar tags-alist)))) | |
| 14224 | (when (and tags org-use-tag-inheritance | |
| 14225 | (or (not (eq t org-use-tag-inheritance)) | |
| 14226 | org-tags-exclude-from-inheritance)) | |
| 14227 | ;; Selective inheritance, remove uninherited ones. | |
| 14228 | (setcdr (car tags-alist) | |
| 14229 | (org-remove-uninherited-tags (cdar tags-alist)))) | |
| 14230 | (when (and | |
| 14231 | ||
| 14232 | ;; eval matcher only when the todo condition is OK | |
| 14233 | (and (or (not todo-only) (member todo org-todo-keywords-1)) | |
| 14234 | (if (functionp matcher) | |
| 14235 | (let ((case-fold-search t) (org-trust-scanner-tags t)) | |
| 14236 | (funcall matcher todo tags-list level)) | |
| 14237 | matcher)) | |
| 14238 | ||
| 14239 | ;; Call the skipper, but return t if it does not | |
| 14240 | ;; skip, so that the `and' form continues evaluating. | |
| 14241 | (progn | |
| 14242 | (unless (eq action 'sparse-tree) (org-agenda-skip)) | |
| 14243 | t) | |
| 14244 | ||
| 14245 | ;; Check if timestamps are deselecting this entry | |
| 14246 | (or (not todo-only) | |
| 14247 | (and (member todo org-todo-keywords-1) | |
| 14248 | (or (not org-agenda-tags-todo-honor-ignore-options) | |
| 14249 | (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))) | |
| 14250 | ||
| 14251 | ;; select this headline | |
| 14252 | (cond | |
| 14253 | ((eq action 'sparse-tree) | |
| 14254 | (and org-highlight-sparse-tree-matches | |
| 14255 | (org-get-heading) (match-end 0) | |
| 14256 | (org-highlight-new-match | |
| 14257 | (match-beginning 1) (match-end 1))) | |
| 14258 | (org-show-context 'tags-tree)) | |
| 14259 | ((eq action 'agenda) | |
| 14260 | (setq txt (org-agenda-format-item | |
| 14261 | "" | |
| 14262 | (concat | |
| 14263 | (if (eq org-tags-match-list-sublevels 'indented) | |
| 14264 | (make-string (1- level) ?.) "") | |
| 14265 | (org-get-heading)) | |
| 14266 | (make-string level ?\s) | |
| 14267 | category | |
| 14268 | tags-list) | |
| 14269 | priority (org-get-priority txt)) | |
| 14270 | (goto-char lspos) | |
| 14271 | (setq marker (org-agenda-new-marker)) | |
| 14272 | (org-add-props txt props | |
| 14273 | 'org-marker marker 'org-hd-marker marker 'org-category category | |
| 14274 | 'todo-state todo | |
| 14275 | 'ts-date ts-date | |
| 14276 | 'priority priority | |
| 14277 | 'type (concat "tagsmatch" ts-date-type)) | |
| 14278 | (push txt rtn)) | |
| 14279 | ((functionp action) | |
| 14280 | (setq org-map-continue-from nil) | |
| 14281 | (save-excursion | |
| 14282 | (setq rtn1 (funcall action)) | |
| 14283 | (push rtn1 rtn))) | |
| 14284 | (t (user-error "Invalid action"))) | |
| 14285 | ||
| 14286 | ;; if we are to skip sublevels, jump to end of subtree | |
| 14287 | (unless org-tags-match-list-sublevels | |
| 14288 | (org-end-of-subtree t) | |
| 14289 | (backward-char 1)))) | |
| 14290 | ;; Get the correct position from where to continue | |
| 14291 | (if org-map-continue-from | |
| 14292 | (goto-char org-map-continue-from) | |
| 14293 | (and (= (point) lspos) (end-of-line 1))))) | |
| 14294 | (when (and (eq action 'sparse-tree) | |
| 14295 | (not org-sparse-tree-open-archived-trees)) | |
| 14296 | (org-hide-archived-subtrees (point-min) (point-max))) | |
| 14297 | (nreverse rtn))) | |
| 14298 | ||
| 14299 | (defun org-remove-uninherited-tags (tags) | |
| 14300 | "Remove all tags that are not inherited from the list TAGS." | |
| 14301 | (cond | |
| 14302 | ((eq org-use-tag-inheritance t) | |
| 14303 | (if org-tags-exclude-from-inheritance | |
| 14304 | (org-delete-all org-tags-exclude-from-inheritance tags) | |
| 14305 | tags)) | |
| 14306 | ((not org-use-tag-inheritance) nil) | |
| 14307 | ((stringp org-use-tag-inheritance) | |
| 14308 | (delq nil (mapcar | |
| 14309 | (lambda (x) | |
| 14310 | (if (and (string-match org-use-tag-inheritance x) | |
| 14311 | (not (member x org-tags-exclude-from-inheritance))) | |
| 14312 | x nil)) | |
| 14313 | tags))) | |
| 14314 | ((listp org-use-tag-inheritance) | |
| 14315 | (delq nil (mapcar | |
| 14316 | (lambda (x) | |
| 14317 | (if (member x org-use-tag-inheritance) x nil)) | |
| 14318 | tags))))) | |
| 14319 | ||
| 14320 | (defun org-match-sparse-tree (&optional todo-only match) | |
| 14321 | "Create a sparse tree according to tags string MATCH. | |
| 14322 | ||
| 14323 | MATCH is a string with match syntax. It can contain a selection | |
| 14324 | of tags (\"+work+urgent-boss\"), properties (\"LEVEL>3\"), and | |
| 14325 | TODO keywords (\"TODO=\\\"WAITING\\\"\") or a combination of | |
| 14326 | those. See the manual for details. | |
| 14327 | ||
| 14328 | If optional argument TODO-ONLY is non-nil, only select lines that | |
| 14329 | are also TODO tasks." | |
| 14330 | (interactive "P") | |
| 14331 | (org-agenda-prepare-buffers (list (current-buffer))) | |
| 14332 | (let ((org--matcher-tags-todo-only todo-only)) | |
| 14333 | (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) | |
| 14334 | org--matcher-tags-todo-only))) | |
| 14335 | ||
| 14336 | (defalias 'org-tags-sparse-tree 'org-match-sparse-tree) | |
| 14337 | ||
| 14338 | (defvar org-cached-props nil) | |
| 14339 | (defun org-cached-entry-get (pom property) | |
| 14340 | (if (or (eq t org-use-property-inheritance) | |
| 14341 | (and (stringp org-use-property-inheritance) | |
| 14342 | (let ((case-fold-search t)) | |
| 14343 | (string-match-p org-use-property-inheritance property))) | |
| 14344 | (and (listp org-use-property-inheritance) | |
| 14345 | (member-ignore-case property org-use-property-inheritance))) | |
| 14346 | ;; Caching is not possible, check it directly. | |
| 14347 | (org-entry-get pom property 'inherit) | |
| 14348 | ;; Get all properties, so we can do complicated checks easily. | |
| 14349 | (cdr (assoc-string property | |
| 14350 | (or org-cached-props | |
| 14351 | (setq org-cached-props (org-entry-properties pom))) | |
| 14352 | t)))) | |
| 14353 | ||
| 14354 | (defun org-global-tags-completion-table (&optional files) | |
| 14355 | "Return the list of all tags in all agenda buffer/files. | |
| 14356 | Optional FILES argument is a list of files which can be used | |
| 14357 | instead of the agenda files." | |
| 14358 | (save-excursion | |
| 14359 | (org-uniquify | |
| 14360 | (delq nil | |
| 14361 | (apply #'append | |
| 14362 | (mapcar | |
| 14363 | (lambda (file) | |
| 14364 | (set-buffer (find-file-noselect file)) | |
| 14365 | (org--tag-add-to-alist | |
| 14366 | (org-get-buffer-tags) | |
| 14367 | (mapcar (lambda (x) | |
| 14368 | (and (stringp (car-safe x)) | |
| 14369 | (list (car-safe x)))) | |
| 14370 | org-current-tag-alist))) | |
| 14371 | (if (car-safe files) files | |
| 14372 | (org-agenda-files)))))))) | |
| 14373 | ||
| 14374 | (defun org-make-tags-matcher (match) | |
| 14375 | "Create the TAGS/TODO matcher form for the selection string MATCH. | |
| 14376 | ||
| 14377 | Returns a cons of the selection string MATCH and a function | |
| 14378 | implementing the matcher. | |
| 14379 | ||
| 14380 | The matcher is to be called at an Org entry, with point on the | |
| 14381 | headline, and returns non-nil if the entry matches the selection | |
| 14382 | string MATCH. It must be called with three arguments: the TODO | |
| 14383 | keyword at the entry (or nil if none), the list of all tags at | |
| 14384 | the entry including inherited ones and the reduced level of the | |
| 14385 | headline. Additionally, the category of the entry, if any, must | |
| 14386 | be specified as the text property `org-category' on the headline. | |
| 14387 | ||
| 14388 | This function sets the variable `org--matcher-tags-todo-only' to | |
| 14389 | a non-nil value if the matcher restricts matching to TODO | |
| 14390 | entries, otherwise it is not touched. | |
| 14391 | ||
| 14392 | See also `org-scan-tags'." | |
| 14393 | (unless match | |
| 14394 | ;; Get a new match request, with completion against the global | |
| 14395 | ;; tags table and the local tags in current buffer. | |
| 14396 | (let ((org-last-tags-completion-table | |
| 14397 | (org--tag-add-to-alist | |
| 14398 | (org-get-buffer-tags) | |
| 14399 | (org-global-tags-completion-table)))) | |
| 14400 | (setq match | |
| 14401 | (completing-read | |
| 14402 | "Match: " | |
| 14403 | 'org-tags-completion-function nil nil nil 'org-tags-history)))) | |
| 14404 | ||
| 14405 | (let ((match0 match) | |
| 14406 | (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)") | |
| 14407 | (start 0) | |
| 14408 | tagsmatch todomatch tagsmatcher todomatcher) | |
| 14409 | ||
| 14410 | ;; Expand group tags. | |
| 14411 | (setq match (org-tags-expand match)) | |
| 14412 | ||
| 14413 | ;; Check if there is a TODO part of this match, which would be the | |
| 14414 | ;; part after a "/". To make sure that this slash is not part of | |
| 14415 | ;; a property value to be matched against, we also check that | |
| 14416 | ;; there is no / after that slash. First, find the last slash. | |
| 14417 | (let ((s 0)) | |
| 14418 | (while (string-match "/+" match s) | |
| 14419 | (setq start (match-beginning 0)) | |
| 14420 | (setq s (match-end 0)))) | |
| 14421 | (if (and (string-match "/+" match start) | |
| 14422 | (not (string-match-p "\"" match start))) | |
| 14423 | ;; Match contains also a TODO-matching request. | |
| 14424 | (progn | |
| 14425 | (setq tagsmatch (substring match 0 (match-beginning 0))) | |
| 14426 | (setq todomatch (substring match (match-end 0))) | |
| 14427 | (when (string-prefix-p "!" todomatch) | |
| 14428 | (setq org--matcher-tags-todo-only t) | |
| 14429 | (setq todomatch (substring todomatch 1))) | |
| 14430 | (when (string-match "\\`\\s-*\\'" todomatch) | |
| 14431 | (setq todomatch nil))) | |
| 14432 | ;; Only matching tags. | |
| 14433 | (setq tagsmatch match) | |
| 14434 | (setq todomatch nil)) | |
| 14435 | ||
| 14436 | ;; Make the tags matcher. | |
| 14437 | (when (org-string-nw-p tagsmatch) | |
| 14438 | (let ((orlist nil) | |
| 14439 | (orterms (org-split-string tagsmatch "|")) | |
| 14440 | term) | |
| 14441 | (while (setq term (pop orterms)) | |
| 14442 | (while (and (equal (substring term -1) "\\") orterms) | |
| 14443 | (setq term (concat term "|" (pop orterms)))) ;repair bad split. | |
| 14444 | (while (string-match re term) | |
| 14445 | (let* ((rest (substring term (match-end 0))) | |
| 14446 | (minus (and (match-end 1) | |
| 14447 | (equal (match-string 1 term) "-"))) | |
| 14448 | (tag (save-match-data | |
| 14449 | (replace-regexp-in-string | |
| 14450 | "\\\\-" "-" (match-string 2 term)))) | |
| 14451 | (regexp (eq (string-to-char tag) ?{)) | |
| 14452 | (levelp (match-end 4)) | |
| 14453 | (propp (match-end 5)) | |
| 14454 | (mm | |
| 14455 | (cond | |
| 14456 | (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list)) | |
| 14457 | (levelp | |
| 14458 | `(,(org-op-to-function (match-string 3 term)) | |
| 14459 | level | |
| 14460 | ,(string-to-number (match-string 4 term)))) | |
| 14461 | (propp | |
| 14462 | (let* ((gv (pcase (upcase (match-string 5 term)) | |
| 14463 | ("CATEGORY" | |
| 14464 | '(get-text-property (point) 'org-category)) | |
| 14465 | ("TODO" 'todo) | |
| 14466 | (p `(org-cached-entry-get nil ,p)))) | |
| 14467 | (pv (match-string 7 term)) | |
| 14468 | (regexp (eq (string-to-char pv) ?{)) | |
| 14469 | (strp (eq (string-to-char pv) ?\")) | |
| 14470 | (timep (string-match-p "^\"[[<].*[]>]\"$" pv)) | |
| 14471 | (po (org-op-to-function (match-string 6 term) | |
| 14472 | (if timep 'time strp)))) | |
| 14473 | (setq pv (if (or regexp strp) (substring pv 1 -1) pv)) | |
| 14474 | (when timep (setq pv (org-matcher-time pv))) | |
| 14475 | (cond ((and regexp (eq po 'org<>)) | |
| 14476 | `(not (string-match ,pv (or ,gv "")))) | |
| 14477 | (regexp `(string-match ,pv (or ,gv ""))) | |
| 14478 | (strp `(,po (or ,gv "") ,pv)) | |
| 14479 | (t | |
| 14480 | `(,po | |
| 14481 | (string-to-number (or ,gv "")) | |
| 14482 | ,(string-to-number pv)))))) | |
| 14483 | (t `(member ,tag tags-list))))) | |
| 14484 | (push (if minus `(not ,mm) mm) tagsmatcher) | |
| 14485 | (setq term rest))) | |
| 14486 | (push `(and ,@tagsmatcher) orlist) | |
| 14487 | (setq tagsmatcher nil)) | |
| 14488 | (setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist))))) | |
| 14489 | ||
| 14490 | ;; Make the TODO matcher. | |
| 14491 | (when (org-string-nw-p todomatch) | |
| 14492 | (let ((orlist nil)) | |
| 14493 | (dolist (term (org-split-string todomatch "|")) | |
| 14494 | (while (string-match re term) | |
| 14495 | (let* ((minus (and (match-end 1) | |
| 14496 | (equal (match-string 1 term) "-"))) | |
| 14497 | (kwd (match-string 2 term)) | |
| 14498 | (regexp (eq (string-to-char kwd) ?{)) | |
| 14499 | (mm (if regexp `(string-match ,(substring kwd 1 -1) todo) | |
| 14500 | `(equal todo ,kwd)))) | |
| 14501 | (push (if minus `(not ,mm) mm) todomatcher)) | |
| 14502 | (setq term (substring term (match-end 0)))) | |
| 14503 | (push (if (> (length todomatcher) 1) | |
| 14504 | (cons 'and todomatcher) | |
| 14505 | (car todomatcher)) | |
| 14506 | orlist) | |
| 14507 | (setq todomatcher nil)) | |
| 14508 | (setq todomatcher (cons 'or orlist)))) | |
| 14509 | ||
| 14510 | ;; Return the string and function of the matcher. If no | |
| 14511 | ;; tags-specific or todo-specific matcher exists, match | |
| 14512 | ;; everything. | |
| 14513 | (let ((matcher (if (and tagsmatcher todomatcher) | |
| 14514 | `(and ,tagsmatcher ,todomatcher) | |
| 14515 | (or tagsmatcher todomatcher t)))) | |
| 14516 | (when org--matcher-tags-todo-only | |
| 14517 | (setq matcher `(and (member todo org-not-done-keywords) ,matcher))) | |
| 14518 | (cons match0 `(lambda (todo tags-list level) ,matcher))))) | |
| 14519 | ||
| 14520 | (defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded) | |
| 14521 | "Expand group tags in MATCH. | |
| 14522 | ||
| 14523 | This replaces every group tag in MATCH with a regexp tag search. | |
| 14524 | For example, a group tag \"Work\" defined as { Work : Lab Conf } | |
| 14525 | will be replaced like this: | |
| 14526 | ||
| 14527 | Work => {\\<\\(?:Work\\|Lab\\|Conf\\)\\>} | |
| 14528 | +Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>} | |
| 14529 | -Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>} | |
| 14530 | ||
| 14531 | Replacing by a regexp preserves the structure of the match. | |
| 14532 | E.g., this expansion | |
| 14533 | ||
| 14534 | Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home | |
| 14535 | ||
| 14536 | will match anything tagged with \"Lab\" and \"Home\", or tagged | |
| 14537 | with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\". | |
| 14538 | ||
| 14539 | A group tag in MATCH can contain regular expressions of its own. | |
| 14540 | For example, a group tag \"Proj\" defined as { Proj : {P@.+} } | |
| 14541 | will be replaced like this: | |
| 14542 | ||
| 14543 | Proj => {\\<\\(?:Proj\\)\\>\\|P@.+} | |
| 14544 | ||
| 14545 | When the optional argument SINGLE-AS-LIST is non-nil, MATCH is | |
| 14546 | assumed to be a single group tag, and the function will return | |
| 14547 | the list of tags in this group. | |
| 14548 | ||
| 14549 | When DOWNCASE is non-nil, expand downcased TAGS." | |
| 14550 | (if org-group-tags | |
| 14551 | (let* ((case-fold-search t) | |
| 14552 | (stable org-mode-syntax-table) | |
| 14553 | (taggroups (or org-tag-groups-alist-for-agenda org-tag-groups-alist)) | |
| 14554 | (taggroups (if downcased | |
| 14555 | (mapcar (lambda (tg) (mapcar #'downcase tg)) | |
| 14556 | taggroups) | |
| 14557 | taggroups)) | |
| 14558 | (taggroups-keys (mapcar #'car taggroups)) | |
| 14559 | (return-match (if downcased (downcase match) match)) | |
| 14560 | (count 0) | |
| 14561 | (work-already-expanded tags-already-expanded) | |
| 14562 | regexps-in-match tags-in-group regexp-in-group regexp-in-group-escaped) | |
| 14563 | ;; @ and _ are allowed as word-components in tags. | |
| 14564 | (modify-syntax-entry ?@ "w" stable) | |
| 14565 | (modify-syntax-entry ?_ "w" stable) | |
| 14566 | ;; Temporarily replace regexp-expressions in the match-expression. | |
| 14567 | (while (string-match "{.+?}" return-match) | |
| 14568 | (cl-incf count) | |
| 14569 | (push (match-string 0 return-match) regexps-in-match) | |
| 14570 | (setq return-match (replace-match (format "<%d>" count) t nil return-match))) | |
| 14571 | (while (and taggroups-keys | |
| 14572 | (with-syntax-table stable | |
| 14573 | (string-match | |
| 14574 | (concat "\\(?1:[+-]?\\)\\(?2:\\<" | |
| 14575 | (regexp-opt taggroups-keys) "\\>\\)") | |
| 14576 | return-match))) | |
| 14577 | (let* ((dir (match-string 1 return-match)) | |
| 14578 | (tag (match-string 2 return-match)) | |
| 14579 | (tag (if downcased (downcase tag) tag))) | |
| 14580 | (unless (or (get-text-property 0 'grouptag (match-string 2 return-match)) | |
| 14581 | (member tag tags-already-expanded)) | |
| 14582 | (setq tags-in-group (assoc tag taggroups)) | |
| 14583 | (push tag work-already-expanded) | |
| 14584 | ;; Recursively expand each tag in the group, if the tag hasn't | |
| 14585 | ;; already been expanded. Restore the match-data after all recursive calls. | |
| 14586 | (save-match-data | |
| 14587 | (let (tags-expanded) | |
| 14588 | (dolist (x (cdr tags-in-group)) | |
| 14589 | (if (and (member x taggroups-keys) | |
| 14590 | (not (member x work-already-expanded))) | |
| 14591 | (setq tags-expanded | |
| 14592 | (delete-dups | |
| 14593 | (append | |
| 14594 | (org-tags-expand x t downcased | |
| 14595 | work-already-expanded) | |
| 14596 | tags-expanded))) | |
| 14597 | (setq tags-expanded | |
| 14598 | (append (list x) tags-expanded))) | |
| 14599 | (setq work-already-expanded | |
| 14600 | (delete-dups | |
| 14601 | (append tags-expanded | |
| 14602 | work-already-expanded)))) | |
| 14603 | (setq tags-in-group | |
| 14604 | (delete-dups (cons (car tags-in-group) | |
| 14605 | tags-expanded))))) | |
| 14606 | ;; Filter tag-regexps from tags. | |
| 14607 | (setq regexp-in-group-escaped | |
| 14608 | (delq nil (mapcar (lambda (x) | |
| 14609 | (if (stringp x) | |
| 14610 | (and (equal "{" (substring x 0 1)) | |
| 14611 | (equal "}" (substring x -1)) | |
| 14612 | x) | |
| 14613 | x)) | |
| 14614 | tags-in-group)) | |
| 14615 | regexp-in-group | |
| 14616 | (mapcar (lambda (x) | |
| 14617 | (substring x 1 -1)) | |
| 14618 | regexp-in-group-escaped) | |
| 14619 | tags-in-group | |
| 14620 | (delq nil (mapcar (lambda (x) | |
| 14621 | (if (stringp x) | |
| 14622 | (and (not (equal "{" (substring x 0 1))) | |
| 14623 | (not (equal "}" (substring x -1))) | |
| 14624 | x) | |
| 14625 | x)) | |
| 14626 | tags-in-group))) | |
| 14627 | ;; If single-as-list, do no more in the while-loop. | |
| 14628 | (if (not single-as-list) | |
| 14629 | (progn | |
| 14630 | (when regexp-in-group | |
| 14631 | (setq regexp-in-group | |
| 14632 | (concat "\\|" | |
| 14633 | (mapconcat 'identity regexp-in-group | |
| 14634 | "\\|")))) | |
| 14635 | (setq tags-in-group | |
| 14636 | (concat dir | |
| 14637 | "{\\<" | |
| 14638 | (regexp-opt tags-in-group) | |
| 14639 | "\\>" | |
| 14640 | regexp-in-group | |
| 14641 | "}")) | |
| 14642 | (when (stringp tags-in-group) | |
| 14643 | (org-add-props tags-in-group '(grouptag t))) | |
| 14644 | (setq return-match | |
| 14645 | (replace-match tags-in-group t t return-match))) | |
| 14646 | (setq tags-in-group | |
| 14647 | (append regexp-in-group-escaped tags-in-group)))) | |
| 14648 | (setq taggroups-keys (delete tag taggroups-keys)))) | |
| 14649 | ;; Add the regular expressions back into the match-expression again. | |
| 14650 | (while regexps-in-match | |
| 14651 | (setq return-match (replace-regexp-in-string (format "<%d>" count) | |
| 14652 | (pop regexps-in-match) | |
| 14653 | return-match t t)) | |
| 14654 | (cl-decf count)) | |
| 14655 | (if single-as-list | |
| 14656 | (if tags-in-group tags-in-group (list return-match)) | |
| 14657 | return-match)) | |
| 14658 | (if single-as-list | |
| 14659 | (list (if downcased (downcase match) match)) | |
| 14660 | match))) | |
| 14661 | ||
| 14662 | (defun org-op-to-function (op &optional stringp) | |
| 14663 | "Turn an operator into the appropriate function." | |
| 14664 | (setq op | |
| 14665 | (cond | |
| 14666 | ((equal op "<" ) '(< string< org-time<)) | |
| 14667 | ((equal op ">" ) '(> org-string> org-time>)) | |
| 14668 | ((member op '("<=" "=<")) '(<= org-string<= org-time<=)) | |
| 14669 | ((member op '(">=" "=>")) '(>= org-string>= org-time>=)) | |
| 14670 | ((member op '("=" "==")) '(= string= org-time=)) | |
| 14671 | ((member op '("<>" "!=")) '(org<> org-string<> org-time<>)))) | |
| 14672 | (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op)) | |
| 14673 | ||
| 14674 | (defun org<> (a b) (not (= a b))) | |
| 14675 | (defun org-string<= (a b) (or (string= a b) (string< a b))) | |
| 14676 | (defun org-string>= (a b) (not (string< a b))) | |
| 14677 | (defun org-string> (a b) (and (not (string= a b)) (not (string< a b)))) | |
| 14678 | (defun org-string<> (a b) (not (string= a b))) | |
| 14679 | (defun org-time= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (= a b))) | |
| 14680 | (defun org-time< (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (< a b))) | |
| 14681 | (defun org-time<= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (<= a b))) | |
| 14682 | (defun org-time> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (> a b))) | |
| 14683 | (defun org-time>= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (>= a b))) | |
| 14684 | (defun org-time<> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (org<> a b))) | |
| 14685 | (defun org-2ft (s) | |
| 14686 | "Convert S to a floating point time. | |
| 14687 | If S is already a number, just return it. If it is a string, parse | |
| 14688 | it as a time string and apply `float-time' to it. If S is nil, just return 0." | |
| 14689 | (cond | |
| 14690 | ((numberp s) s) | |
| 14691 | ((stringp s) | |
| 14692 | (condition-case nil | |
| 14693 | (float-time (apply #'encode-time (org-parse-time-string s))) | |
| 14694 | (error 0.))) | |
| 14695 | (t 0.))) | |
| 14696 | ||
| 14697 | (defun org-time-today () | |
| 14698 | "Time in seconds today at 0:00. | |
| 14699 | Returns the float number of seconds since the beginning of the | |
| 14700 | epoch to the beginning of today (00:00)." | |
| 14701 | (float-time (apply 'encode-time | |
| 14702 | (append '(0 0 0) (nthcdr 3 (decode-time)))))) | |
| 14703 | ||
| 14704 | (defun org-matcher-time (s) | |
| 14705 | "Interpret a time comparison value." | |
| 14706 | (save-match-data | |
| 14707 | (cond | |
| 14708 | ((string= s "<now>") (float-time)) | |
| 14709 | ((string= s "<today>") (org-time-today)) | |
| 14710 | ((string= s "<tomorrow>") (+ 86400.0 (org-time-today))) | |
| 14711 | ((string= s "<yesterday>") (- (org-time-today) 86400.0)) | |
| 14712 | ((string-match "^<\\([-+][0-9]+\\)\\([hdwmy]\\)>$" s) | |
| 14713 | (+ (org-time-today) | |
| 14714 | (* (string-to-number (match-string 1 s)) | |
| 14715 | (cdr (assoc (match-string 2 s) | |
| 14716 | '(("d" . 86400.0) ("w" . 604800.0) | |
| 14717 | ("m" . 2678400.0) ("y" . 31557600.0))))))) | |
| 14718 | (t (org-2ft s))))) | |
| 14719 | ||
| 14720 | (defun org-match-any-p (re list) | |
| 14721 | "Does re match any element of list?" | |
| 14722 | (setq list (mapcar (lambda (x) (string-match re x)) list)) | |
| 14723 | (delq nil list)) | |
| 14724 | ||
| 14725 | (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param | |
| 14726 | (defvar org-tags-overlay (make-overlay 1 1)) | |
| 14727 | (delete-overlay org-tags-overlay) | |
| 14728 | ||
| 14729 | (defun org-get-local-tags-at (&optional pos) | |
| 14730 | "Get a list of tags defined in the current headline." | |
| 14731 | (org-get-tags-at pos 'local)) | |
| 14732 | ||
| 14733 | (defun org-get-local-tags () | |
| 14734 | "Get a list of tags defined in the current headline." | |
| 14735 | (org-get-tags-at nil 'local)) | |
| 14736 | ||
| 14737 | (defun org-get-tags-at (&optional pos local) | |
| 14738 | "Get a list of all headline tags applicable at POS. | |
| 14739 | POS defaults to point. If tags are inherited, the list contains | |
| 14740 | the targets in the same sequence as the headlines appear, i.e. | |
| 14741 | the tags of the current headline come last. | |
| 14742 | When LOCAL is non-nil, only return tags from the current headline, | |
| 14743 | ignore inherited ones." | |
| 14744 | (interactive) | |
| 14745 | (if (and org-trust-scanner-tags | |
| 14746 | (or (not pos) (equal pos (point))) | |
| 14747 | (not local)) | |
| 14748 | org-scanner-tags | |
| 14749 | (let (tags ltags lastpos parent) | |
| 14750 | (save-excursion | |
| 14751 | (save-restriction | |
| 14752 | (widen) | |
| 14753 | (goto-char (or pos (point))) | |
| 14754 | (save-match-data | |
| 14755 | (catch 'done | |
| 14756 | (condition-case nil | |
| 14757 | (progn | |
| 14758 | (org-back-to-heading t) | |
| 14759 | (while (not (equal lastpos (point))) | |
| 14760 | (setq lastpos (point)) | |
| 14761 | (when (looking-at ".+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$") | |
| 14762 | (setq ltags (org-split-string | |
| 14763 | (match-string-no-properties 1) ":")) | |
| 14764 | (when parent | |
| 14765 | (setq ltags (mapcar 'org-add-prop-inherited ltags))) | |
| 14766 | (setq tags (append | |
| 14767 | (if parent | |
| 14768 | (org-remove-uninherited-tags ltags) | |
| 14769 | ltags) | |
| 14770 | tags))) | |
| 14771 | (or org-use-tag-inheritance (throw 'done t)) | |
| 14772 | (when local (throw 'done t)) | |
| 14773 | (or (org-up-heading-safe) (error nil)) | |
| 14774 | (setq parent t))) | |
| 14775 | (error nil))))) | |
| 14776 | (if local | |
| 14777 | tags | |
| 14778 | (reverse (delete-dups | |
| 14779 | (reverse (append | |
| 14780 | (org-remove-uninherited-tags | |
| 14781 | org-file-tags) | |
| 14782 | tags))))))))) | |
| 14783 | ||
| 14784 | (defun org-add-prop-inherited (s) | |
| 14785 | (add-text-properties 0 (length s) '(inherited t) s) | |
| 14786 | s) | |
| 14787 | ||
| 14788 | (defun org-toggle-tag (tag &optional onoff) | |
| 14789 | "Toggle the tag TAG for the current line. | |
| 14790 | If ONOFF is `on' or `off', don't toggle but set to this state." | |
| 14791 | (save-excursion | |
| 14792 | (org-back-to-heading t) | |
| 14793 | (let ((current | |
| 14794 | (when (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$" | |
| 14795 | (line-end-position) t) | |
| 14796 | (let ((tags (match-string 1))) | |
| 14797 | ;; Clear current tags. | |
| 14798 | (replace-match "") | |
| 14799 | ;; Reverse the tags list so any new tag is appended to | |
| 14800 | ;; the current list of tags. | |
| 14801 | (nreverse (org-split-string tags ":"))))) | |
| 14802 | res) | |
| 14803 | (pcase onoff | |
| 14804 | (`off (setq current (delete tag current))) | |
| 14805 | ((or `on (guard (not (member tag current)))) | |
| 14806 | (setq res t) | |
| 14807 | (cl-pushnew tag current :test #'equal)) | |
| 14808 | (_ (setq current (delete tag current)))) | |
| 14809 | (end-of-line) | |
| 14810 | (if current | |
| 14811 | (progn | |
| 14812 | (insert " :" (mapconcat #'identity (nreverse current) ":") ":") | |
| 14813 | (org-set-tags nil t)) | |
| 14814 | (delete-horizontal-space)) | |
| 14815 | (run-hooks 'org-after-tags-change-hook) | |
| 14816 | res))) | |
| 14817 | ||
| 14818 | (defun org--align-tags-here (to-col) | |
| 14819 | "Align tags on the current headline to TO-COL. | |
| 14820 | Assume point is on a headline." | |
| 14821 | (let ((pos (point))) | |
| 14822 | (beginning-of-line) | |
| 14823 | (if (or (not (looking-at ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) | |
| 14824 | (>= pos (match-beginning 2))) | |
| 14825 | ;; No tags or point within tags: do not align. | |
| 14826 | (goto-char pos) | |
| 14827 | (goto-char (match-beginning 1)) | |
| 14828 | (let ((shift (max (- (if (>= to-col 0) to-col | |
| 14829 | (- (abs to-col) (string-width (match-string 2)))) | |
| 14830 | (current-column)) | |
| 14831 | 1))) | |
| 14832 | (replace-match (make-string shift ?\s) nil nil nil 1) | |
| 14833 | ;; Preserve initial position, if possible. In any case, stop | |
| 14834 | ;; before tags. | |
| 14835 | (when (< pos (point)) (goto-char pos)))))) | |
| 14836 | ||
| 14837 | (defun org-set-tags-command (&optional arg just-align) | |
| 14838 | "Call the set-tags command for the current entry." | |
| 14839 | (interactive "P") | |
| 14840 | (if (or (org-at-heading-p) (and arg (org-before-first-heading-p))) | |
| 14841 | (org-set-tags arg just-align) | |
| 14842 | (save-excursion | |
| 14843 | (unless (and (org-region-active-p) | |
| 14844 | org-loop-over-headlines-in-active-region) | |
| 14845 | (org-back-to-heading t)) | |
| 14846 | (org-set-tags arg just-align)))) | |
| 14847 | ||
| 14848 | (defun org-set-tags-to (data) | |
| 14849 | "Set the tags of the current entry to DATA, replacing current tags. | |
| 14850 | DATA may be a tags string like \":aa:bb:cc:\", or a list of tags. | |
| 14851 | If DATA is nil or the empty string, all tags are removed." | |
| 14852 | (interactive "sTags: ") | |
| 14853 | (let ((data | |
| 14854 | (pcase (if (stringp data) (org-trim data) data) | |
| 14855 | ((or `nil "") nil) | |
| 14856 | ((pred listp) (format ":%s:" (mapconcat #'identity data ":"))) | |
| 14857 | ((pred stringp) | |
| 14858 | (format ":%s:" | |
| 14859 | (mapconcat #'identity (org-split-string data ":+") ":"))) | |
| 14860 | (_ (error "Invalid tag specification: %S" data))))) | |
| 14861 | (org-with-wide-buffer | |
| 14862 | (org-back-to-heading t) | |
| 14863 | (let ((case-fold-search nil)) (looking-at org-complex-heading-regexp)) | |
| 14864 | (when (or (match-end 5) data) | |
| 14865 | (goto-char (or (match-beginning 5) (line-end-position))) | |
| 14866 | (skip-chars-backward " \t") | |
| 14867 | (delete-region (point) (line-end-position)) | |
| 14868 | (when data | |
| 14869 | (insert " " data) | |
| 14870 | (org-set-tags nil 'align)))))) | |
| 14871 | ||
| 14872 | (defun org-align-all-tags () | |
| 14873 | "Align the tags in all headings." | |
| 14874 | (interactive) | |
| 14875 | (save-excursion | |
| 14876 | (or (ignore-errors (org-back-to-heading t)) | |
| 14877 | (outline-next-heading)) | |
| 14878 | (if (org-at-heading-p) | |
| 14879 | (org-set-tags t) | |
| 14880 | (message "No headings")))) | |
| 14881 | ||
| 14882 | (defvar org-indent-indentation-per-level) | |
| 14883 | (defun org-set-tags (&optional arg just-align) | |
| 14884 | "Set the tags for the current headline. | |
| 14885 | With prefix ARG, realign all tags in headings in the current buffer. | |
| 14886 | When JUST-ALIGN is non-nil, only align tags." | |
| 14887 | (interactive "P") | |
| 14888 | (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) | |
| 14889 | (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) | |
| 14890 | 'region-start-level | |
| 14891 | 'region)) | |
| 14892 | org-loop-over-headlines-in-active-region) | |
| 14893 | (org-map-entries | |
| 14894 | ;; We don't use ARG and JUST-ALIGN here because these args | |
| 14895 | ;; are not useful when looping over headlines. | |
| 14896 | #'org-set-tags | |
| 14897 | org-loop-over-headlines-in-active-region | |
| 14898 | cl | |
| 14899 | '(when (org-invisible-p) (org-end-of-subtree nil t)))) | |
| 14900 | (let ((org-setting-tags t)) | |
| 14901 | (if arg | |
| 14902 | (save-excursion | |
| 14903 | (goto-char (point-min)) | |
| 14904 | (while (re-search-forward org-outline-regexp-bol nil t) | |
| 14905 | (org-set-tags nil t) | |
| 14906 | (end-of-line)) | |
| 14907 | (message "All tags realigned to column %d" org-tags-column)) | |
| 14908 | (let* ((current (org-get-tags-string)) | |
| 14909 | (tags | |
| 14910 | (if just-align current | |
| 14911 | ;; Get a new set of tags from the user. | |
| 14912 | (save-excursion | |
| 14913 | (let* ((table | |
| 14914 | (setq | |
| 14915 | org-last-tags-completion-table | |
| 14916 | (org--tag-add-to-alist | |
| 14917 | (and | |
| 14918 | org-complete-tags-always-offer-all-agenda-tags | |
| 14919 | (org-global-tags-completion-table | |
| 14920 | (org-agenda-files))) | |
| 14921 | (or org-current-tag-alist | |
| 14922 | (org-get-buffer-tags))))) | |
| 14923 | (current-tags (org-split-string current ":")) | |
| 14924 | (inherited-tags | |
| 14925 | (nreverse (nthcdr (length current-tags) | |
| 14926 | (nreverse (org-get-tags-at)))))) | |
| 14927 | (replace-regexp-in-string | |
| 14928 | "\\([-+&]+\\|,\\)" | |
| 14929 | ":" | |
| 14930 | (if (or (eq t org-use-fast-tag-selection) | |
| 14931 | (and org-use-fast-tag-selection | |
| 14932 | (delq nil (mapcar #'cdr table)))) | |
| 14933 | (org-fast-tag-selection | |
| 14934 | current-tags inherited-tags table | |
| 14935 | (and org-fast-tag-selection-include-todo | |
| 14936 | org-todo-key-alist)) | |
| 14937 | (let ((org-add-colon-after-tag-completion | |
| 14938 | (< 1 (length table)))) | |
| 14939 | (org-trim | |
| 14940 | (completing-read | |
| 14941 | "Tags: " | |
| 14942 | #'org-tags-completion-function | |
| 14943 | nil nil current 'org-tags-history)))))))))) | |
| 14944 | ||
| 14945 | (when org-tags-sort-function | |
| 14946 | (setq tags | |
| 14947 | (mapconcat | |
| 14948 | #'identity | |
| 14949 | (sort (org-split-string tags "[^[:alnum:]_@#%]+") | |
| 14950 | org-tags-sort-function) | |
| 14951 | ":"))) | |
| 14952 | ||
| 14953 | (if (or (string= ":" tags) | |
| 14954 | (string= "::" tags)) | |
| 14955 | (setq tags "")) | |
| 14956 | (if (not (org-string-nw-p tags)) (setq tags "") | |
| 14957 | (unless (string-suffix-p ":" tags) (setq tags (concat tags ":"))) | |
| 14958 | (unless (string-prefix-p ":" tags) (setq tags (concat ":" tags)))) | |
| 14959 | ||
| 14960 | ;; Insert new tags at the correct column. | |
| 14961 | (unless (equal current tags) | |
| 14962 | (save-excursion | |
| 14963 | (beginning-of-line) | |
| 14964 | (let ((case-fold-search nil)) | |
| 14965 | (looking-at org-complex-heading-regexp)) | |
| 14966 | ;; Remove current tags, if any. | |
| 14967 | (when (match-end 5) (replace-match "" nil nil nil 5)) | |
| 14968 | ;; Insert new tags, if any. Otherwise, remove trailing | |
| 14969 | ;; white spaces. | |
| 14970 | (end-of-line) | |
| 14971 | (if (not (equal tags "")) | |
| 14972 | ;; When text is being inserted on an invisible | |
| 14973 | ;; region boundary, it can be inadvertently sucked | |
| 14974 | ;; into invisibility. | |
| 14975 | (outline-flag-region (point) (progn (insert " " tags) (point)) nil) | |
| 14976 | (skip-chars-backward " \t") | |
| 14977 | (delete-region (point) (line-end-position))))) | |
| 14978 | ;; Align tags, if any. Fix tags column if `org-indent-mode' | |
| 14979 | ;; is on. | |
| 14980 | (unless (equal tags "") | |
| 14981 | (let* ((level (save-excursion | |
| 14982 | (beginning-of-line) | |
| 14983 | (skip-chars-forward "\\*"))) | |
| 14984 | (offset (if (bound-and-true-p org-indent-mode) | |
| 14985 | (* (1- org-indent-indentation-per-level) | |
| 14986 | (1- level)) | |
| 14987 | 0)) | |
| 14988 | (tags-column | |
| 14989 | (+ org-tags-column | |
| 14990 | (if (> org-tags-column 0) (- offset) offset)))) | |
| 14991 | (org--align-tags-here tags-column)))) | |
| 14992 | (unless just-align (run-hooks 'org-after-tags-change-hook)))))) | |
| 14993 | ||
| 14994 | (defun org-change-tag-in-region (beg end tag off) | |
| 14995 | "Add or remove TAG for each entry in the region. | |
| 14996 | This works in the agenda, and also in an Org buffer." | |
| 14997 | (interactive | |
| 14998 | (list (region-beginning) (region-end) | |
| 14999 | (let ((org-last-tags-completion-table | |
| 15000 | (if (derived-mode-p 'org-mode) | |
| 15001 | (org--tag-add-to-alist | |
| 15002 | (org-get-buffer-tags) | |
| 15003 | (org-global-tags-completion-table)) | |
| 15004 | (org-global-tags-completion-table)))) | |
| 15005 | (completing-read | |
| 15006 | "Tag: " 'org-tags-completion-function nil nil nil | |
| 15007 | 'org-tags-history)) | |
| 15008 | (progn | |
| 15009 | (message "[s]et or [r]emove? ") | |
| 15010 | (equal (read-char-exclusive) ?r)))) | |
| 15011 | (when (fboundp 'deactivate-mark) (deactivate-mark)) | |
| 15012 | (let ((agendap (equal major-mode 'org-agenda-mode)) | |
| 15013 | l1 l2 m buf pos newhead (cnt 0)) | |
| 15014 | (goto-char end) | |
| 15015 | (setq l2 (1- (org-current-line))) | |
| 15016 | (goto-char beg) | |
| 15017 | (setq l1 (org-current-line)) | |
| 15018 | (cl-loop for l from l1 to l2 do | |
| 15019 | (org-goto-line l) | |
| 15020 | (setq m (get-text-property (point) 'org-hd-marker)) | |
| 15021 | (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) | |
| 15022 | (and agendap m)) | |
| 15023 | (setq buf (if agendap (marker-buffer m) (current-buffer)) | |
| 15024 | pos (if agendap m (point))) | |
| 15025 | (with-current-buffer buf | |
| 15026 | (save-excursion | |
| 15027 | (save-restriction | |
| 15028 | (goto-char pos) | |
| 15029 | (setq cnt (1+ cnt)) | |
| 15030 | (org-toggle-tag tag (if off 'off 'on)) | |
| 15031 | (setq newhead (org-get-heading))))) | |
| 15032 | (and agendap (org-agenda-change-all-lines newhead m)))) | |
| 15033 | (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) | |
| 15034 | ||
| 15035 | (defun org-tags-completion-function (string _predicate &optional flag) | |
| 15036 | (let (s1 s2 rtn (ctable org-last-tags-completion-table) | |
| 15037 | (confirm (lambda (x) (stringp (car x))))) | |
| 15038 | (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) | |
| 15039 | (setq s1 (match-string 1 string) | |
| 15040 | s2 (match-string 2 string)) | |
| 15041 | (setq s1 "" s2 string)) | |
| 15042 | (cond | |
| 15043 | ((eq flag nil) | |
| 15044 | ;; try completion | |
| 15045 | (setq rtn (try-completion s2 ctable confirm)) | |
| 15046 | (when (stringp rtn) | |
| 15047 | (setq rtn | |
| 15048 | (concat s1 s2 (substring rtn (length s2)) | |
| 15049 | (if (and org-add-colon-after-tag-completion | |
| 15050 | (assoc rtn ctable)) | |
| 15051 | ":" "")))) | |
| 15052 | rtn) | |
| 15053 | ((eq flag t) | |
| 15054 | ;; all-completions | |
| 15055 | (all-completions s2 ctable confirm)) | |
| 15056 | ((eq flag 'lambda) | |
| 15057 | ;; exact match? | |
| 15058 | (assoc s2 ctable))))) | |
| 15059 | ||
| 15060 | (defun org-fast-tag-insert (kwd tags face &optional end) | |
| 15061 | "Insert KDW, and the TAGS, the latter with face FACE. | |
| 15062 | Also insert END." | |
| 15063 | (insert (format "%-12s" (concat kwd ":")) | |
| 15064 | (org-add-props (mapconcat 'identity tags " ") nil 'face face) | |
| 15065 | (or end ""))) | |
| 15066 | ||
| 15067 | (defun org-fast-tag-show-exit (flag) | |
| 15068 | (save-excursion | |
| 15069 | (org-goto-line 3) | |
| 15070 | (when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) | |
| 15071 | (replace-match "")) | |
| 15072 | (when flag | |
| 15073 | (end-of-line 1) | |
| 15074 | (org-move-to-column (- (window-width) 19) t) | |
| 15075 | (insert (org-add-props " Next change exits" nil 'face 'org-warning))))) | |
| 15076 | ||
| 15077 | (defun org-set-current-tags-overlay (current prefix) | |
| 15078 | "Add an overlay to CURRENT tag with PREFIX." | |
| 15079 | (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) | |
| 15080 | (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) | |
| 15081 | (org-overlay-display org-tags-overlay (concat prefix s)))) | |
| 15082 | ||
| 15083 | (defvar org-last-tag-selection-key nil) | |
| 15084 | (defun org-fast-tag-selection (current inherited table &optional todo-table) | |
| 15085 | "Fast tag selection with single keys. | |
| 15086 | CURRENT is the current list of tags in the headline, INHERITED is the | |
| 15087 | list of inherited tags, and TABLE is an alist of tags and corresponding keys, | |
| 15088 | possibly with grouping information. TODO-TABLE is a similar table with | |
| 15089 | TODO keywords, should these have keys assigned to them. | |
| 15090 | If the keys are nil, a-z are automatically assigned. | |
| 15091 | Returns the new tags string, or nil to not change the current settings." | |
| 15092 | (let* ((fulltable (append table todo-table)) | |
| 15093 | (maxlen (if (null fulltable) 0 | |
| 15094 | (apply #'max | |
| 15095 | (mapcar (lambda (x) | |
| 15096 | (if (stringp (car x)) (string-width (car x)) | |
| 15097 | 0)) | |
| 15098 | fulltable)))) | |
| 15099 | (buf (current-buffer)) | |
| 15100 | (expert (eq org-fast-tag-selection-single-key 'expert)) | |
| 15101 | (buffer-tags nil) | |
| 15102 | (fwidth (+ maxlen 3 1 3)) | |
| 15103 | (ncol (/ (- (window-width) 4) fwidth)) | |
| 15104 | (i-face 'org-done) | |
| 15105 | (c-face 'org-todo) | |
| 15106 | tg cnt e c char c1 c2 ntable tbl rtn | |
| 15107 | ov-start ov-end ov-prefix | |
| 15108 | (exit-after-next org-fast-tag-selection-single-key) | |
| 15109 | (done-keywords org-done-keywords) | |
| 15110 | groups ingroup intaggroup) | |
| 15111 | (save-excursion | |
| 15112 | (beginning-of-line 1) | |
| 15113 | (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") | |
| 15114 | (setq ov-start (match-beginning 1) | |
| 15115 | ov-end (match-end 1) | |
| 15116 | ov-prefix "") | |
| 15117 | (setq ov-start (1- (point-at-eol)) | |
| 15118 | ov-end (1+ ov-start)) | |
| 15119 | (skip-chars-forward "^\n\r") | |
| 15120 | (setq ov-prefix | |
| 15121 | (concat | |
| 15122 | (buffer-substring (1- (point)) (point)) | |
| 15123 | (if (> (current-column) org-tags-column) | |
| 15124 | " " | |
| 15125 | (make-string (- org-tags-column (current-column)) ?\ )))))) | |
| 15126 | (move-overlay org-tags-overlay ov-start ov-end) | |
| 15127 | (save-window-excursion | |
| 15128 | (if expert | |
| 15129 | (set-buffer (get-buffer-create " *Org tags*")) | |
| 15130 | (delete-other-windows) | |
| 15131 | (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*")) | |
| 15132 | (org-switch-to-buffer-other-window " *Org tags*")) | |
| 15133 | (erase-buffer) | |
| 15134 | (setq-local org-done-keywords done-keywords) | |
| 15135 | (org-fast-tag-insert "Inherited" inherited i-face "\n") | |
| 15136 | (org-fast-tag-insert "Current" current c-face "\n\n") | |
| 15137 | (org-fast-tag-show-exit exit-after-next) | |
| 15138 | (org-set-current-tags-overlay current ov-prefix) | |
| 15139 | (setq tbl fulltable char ?a cnt 0) | |
| 15140 | (while (setq e (pop tbl)) | |
| 15141 | (cond | |
| 15142 | ((eq (car e) :startgroup) | |
| 15143 | (push '() groups) (setq ingroup t) | |
| 15144 | (unless (zerop cnt) | |
| 15145 | (setq cnt 0) | |
| 15146 | (insert "\n")) | |
| 15147 | (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ ")) | |
| 15148 | ((eq (car e) :endgroup) | |
| 15149 | (setq ingroup nil cnt 0) | |
| 15150 | (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n")) | |
| 15151 | ((eq (car e) :startgrouptag) | |
| 15152 | (setq intaggroup t) | |
| 15153 | (unless (zerop cnt) | |
| 15154 | (setq cnt 0) | |
| 15155 | (insert "\n")) | |
| 15156 | (insert "[ ")) | |
| 15157 | ((eq (car e) :endgrouptag) | |
| 15158 | (setq intaggroup nil cnt 0) | |
| 15159 | (insert "]\n")) | |
| 15160 | ((equal e '(:newline)) | |
| 15161 | (unless (zerop cnt) | |
| 15162 | (setq cnt 0) | |
| 15163 | (insert "\n") | |
| 15164 | (setq e (car tbl)) | |
| 15165 | (while (equal (car tbl) '(:newline)) | |
| 15166 | (insert "\n") | |
| 15167 | (setq tbl (cdr tbl))))) | |
| 15168 | ((equal e '(:grouptags)) (insert " : ")) | |
| 15169 | (t | |
| 15170 | (setq tg (copy-sequence (car e)) c2 nil) | |
| 15171 | (if (cdr e) | |
| 15172 | (setq c (cdr e)) | |
| 15173 | ;; automatically assign a character. | |
| 15174 | (setq c1 (string-to-char | |
| 15175 | (downcase (substring | |
| 15176 | tg (if (= (string-to-char tg) ?@) 1 0))))) | |
| 15177 | (if (or (rassoc c1 ntable) (rassoc c1 table)) | |
| 15178 | (while (or (rassoc char ntable) (rassoc char table)) | |
| 15179 | (setq char (1+ char))) | |
| 15180 | (setq c2 c1)) | |
| 15181 | (setq c (or c2 char))) | |
| 15182 | (when ingroup (push tg (car groups))) | |
| 15183 | (setq tg (org-add-props tg nil 'face | |
| 15184 | (cond | |
| 15185 | ((not (assoc tg table)) | |
| 15186 | (org-get-todo-face tg)) | |
| 15187 | ((member tg current) c-face) | |
| 15188 | ((member tg inherited) i-face)))) | |
| 15189 | (when (equal (caar tbl) :grouptags) | |
| 15190 | (org-add-props tg nil 'face 'org-tag-group)) | |
| 15191 | (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " ")) | |
| 15192 | (insert "[" c "] " tg (make-string | |
| 15193 | (- fwidth 4 (length tg)) ?\ )) | |
| 15194 | (push (cons tg c) ntable) | |
| 15195 | (when (= (cl-incf cnt) ncol) | |
| 15196 | (insert "\n") | |
| 15197 | (when (or ingroup intaggroup) (insert " ")) | |
| 15198 | (setq cnt 0))))) | |
| 15199 | (setq ntable (nreverse ntable)) | |
| 15200 | (insert "\n") | |
| 15201 | (goto-char (point-min)) | |
| 15202 | (unless expert (org-fit-window-to-buffer)) | |
| 15203 | (setq rtn | |
| 15204 | (catch 'exit | |
| 15205 | (while t | |
| 15206 | (message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s" | |
| 15207 | (if (not groups) "no " "") | |
| 15208 | (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) | |
| 15209 | (setq c (let ((inhibit-quit t)) (read-char-exclusive))) | |
| 15210 | (setq org-last-tag-selection-key c) | |
| 15211 | (cond | |
| 15212 | ((= c ?\r) (throw 'exit t)) | |
| 15213 | ((= c ?!) | |
| 15214 | (setq groups (not groups)) | |
| 15215 | (goto-char (point-min)) | |
| 15216 | (while (re-search-forward "[{}]" nil t) (replace-match " "))) | |
| 15217 | ((= c ?\C-c) | |
| 15218 | (if (not expert) | |
| 15219 | (org-fast-tag-show-exit | |
| 15220 | (setq exit-after-next (not exit-after-next))) | |
| 15221 | (setq expert nil) | |
| 15222 | (delete-other-windows) | |
| 15223 | (set-window-buffer (split-window-vertically) " *Org tags*") | |
| 15224 | (org-switch-to-buffer-other-window " *Org tags*") | |
| 15225 | (org-fit-window-to-buffer))) | |
| 15226 | ((or (= c ?\C-g) | |
| 15227 | (and (= c ?q) (not (rassoc c ntable)))) | |
| 15228 | (delete-overlay org-tags-overlay) | |
| 15229 | (setq quit-flag t)) | |
| 15230 | ((= c ?\ ) | |
| 15231 | (setq current nil) | |
| 15232 | (when exit-after-next (setq exit-after-next 'now))) | |
| 15233 | ((= c ?\t) | |
| 15234 | (condition-case nil | |
| 15235 | (setq tg (completing-read | |
| 15236 | "Tag: " | |
| 15237 | (or buffer-tags | |
| 15238 | (with-current-buffer buf | |
| 15239 | (setq buffer-tags | |
| 15240 | (org-get-buffer-tags)))))) | |
| 15241 | (quit (setq tg ""))) | |
| 15242 | (when (string-match "\\S-" tg) | |
| 15243 | (cl-pushnew (list tg) buffer-tags :test #'equal) | |
| 15244 | (if (member tg current) | |
| 15245 | (setq current (delete tg current)) | |
| 15246 | (push tg current))) | |
| 15247 | (when exit-after-next (setq exit-after-next 'now))) | |
| 15248 | ((setq e (rassoc c todo-table) tg (car e)) | |
| 15249 | (with-current-buffer buf | |
| 15250 | (save-excursion (org-todo tg))) | |
| 15251 | (when exit-after-next (setq exit-after-next 'now))) | |
| 15252 | ((setq e (rassoc c ntable) tg (car e)) | |
| 15253 | (if (member tg current) | |
| 15254 | (setq current (delete tg current)) | |
| 15255 | (cl-loop for g in groups do | |
| 15256 | (when (member tg g) | |
| 15257 | (dolist (x g) (setq current (delete x current))))) | |
| 15258 | (push tg current)) | |
| 15259 | (when exit-after-next (setq exit-after-next 'now)))) | |
| 15260 | ||
| 15261 | ;; Create a sorted list | |
| 15262 | (setq current | |
| 15263 | (sort current | |
| 15264 | (lambda (a b) | |
| 15265 | (assoc b (cdr (memq (assoc a ntable) ntable)))))) | |
| 15266 | (when (eq exit-after-next 'now) (throw 'exit t)) | |
| 15267 | (goto-char (point-min)) | |
| 15268 | (beginning-of-line 2) | |
| 15269 | (delete-region (point) (point-at-eol)) | |
| 15270 | (org-fast-tag-insert "Current" current c-face) | |
| 15271 | (org-set-current-tags-overlay current ov-prefix) | |
| 15272 | (while (re-search-forward "\\[.\\] \\([[:alnum:]_@#%]+\\)" nil t) | |
| 15273 | (setq tg (match-string 1)) | |
| 15274 | (add-text-properties | |
| 15275 | (match-beginning 1) (match-end 1) | |
| 15276 | (list 'face | |
| 15277 | (cond | |
| 15278 | ((member tg current) c-face) | |
| 15279 | ((member tg inherited) i-face) | |
| 15280 | (t (get-text-property (match-beginning 1) 'face)))))) | |
| 15281 | (goto-char (point-min))))) | |
| 15282 | (delete-overlay org-tags-overlay) | |
| 15283 | (if rtn | |
| 15284 | (mapconcat 'identity current ":") | |
| 15285 | nil)))) | |
| 15286 | ||
| 15287 | (defun org-get-tags-string () | |
| 15288 | "Get the TAGS string in the current headline." | |
| 15289 | (unless (org-at-heading-p t) | |
| 15290 | (user-error "Not on a heading")) | |
| 15291 | (save-excursion | |
| 15292 | (beginning-of-line 1) | |
| 15293 | (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") | |
| 15294 | (match-string-no-properties 1) | |
| 15295 | ""))) | |
| 15296 | ||
| 15297 | (defun org-get-tags () | |
| 15298 | "Get the list of tags specified in the current headline." | |
| 15299 | (org-split-string (org-get-tags-string) ":")) | |
| 15300 | ||
| 15301 | (defun org-get-buffer-tags () | |
| 15302 | "Get a table of all tags used in the buffer, for completion." | |
| 15303 | (org-with-wide-buffer | |
| 15304 | (goto-char (point-min)) | |
| 15305 | (let ((tag-re (concat org-outline-regexp-bol | |
| 15306 | "\\(?:.*?[ \t]\\)?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) | |
| 15307 | tags) | |
| 15308 | (while (re-search-forward tag-re nil t) | |
| 15309 | (dolist (tag (org-split-string (match-string-no-properties 1) ":")) | |
| 15310 | (push tag tags))) | |
| 15311 | (mapcar #'list (append org-file-tags (org-uniquify tags)))))) | |
| 15312 | ||
| 15313 | ;;;; The mapping API | |
| 15314 | ||
| 15315 | (defvar org-agenda-skip-comment-trees) | |
| 15316 | (defvar org-agenda-skip-function) | |
| 15317 | (defun org-map-entries (func &optional match scope &rest skip) | |
| 15318 | "Call FUNC at each headline selected by MATCH in SCOPE. | |
| 15319 | ||
| 15320 | FUNC is a function or a lisp form. The function will be called without | |
| 15321 | arguments, with the cursor positioned at the beginning of the headline. | |
| 15322 | The return values of all calls to the function will be collected and | |
| 15323 | returned as a list. | |
| 15324 | ||
| 15325 | The call to FUNC will be wrapped into a save-excursion form, so FUNC | |
| 15326 | does not need to preserve point. After evaluation, the cursor will be | |
| 15327 | moved to the end of the line (presumably of the headline of the | |
| 15328 | processed entry) and search continues from there. Under some | |
| 15329 | circumstances, this may not produce the wanted results. For example, | |
| 15330 | if you have removed (e.g. archived) the current (sub)tree it could | |
| 15331 | mean that the next entry will be skipped entirely. In such cases, you | |
| 15332 | can specify the position from where search should continue by making | |
| 15333 | FUNC set the variable `org-map-continue-from' to the desired buffer | |
| 15334 | position. | |
| 15335 | ||
| 15336 | MATCH is a tags/property/todo match as it is used in the agenda tags view. | |
| 15337 | Only headlines that are matched by this query will be considered during | |
| 15338 | the iteration. When MATCH is nil or t, all headlines will be | |
| 15339 | visited by the iteration. | |
| 15340 | ||
| 15341 | SCOPE determines the scope of this command. It can be any of: | |
| 15342 | ||
| 15343 | nil The current buffer, respecting the restriction if any | |
| 15344 | tree The subtree started with the entry at point | |
| 15345 | region The entries within the active region, if any | |
| 15346 | region-start-level | |
| 15347 | The entries within the active region, but only those at | |
| 15348 | the same level than the first one. | |
| 15349 | file The current buffer, without restriction | |
| 15350 | file-with-archives | |
| 15351 | The current buffer, and any archives associated with it | |
| 15352 | agenda All agenda files | |
| 15353 | agenda-with-archives | |
| 15354 | All agenda files with any archive files associated with them | |
| 15355 | \(file1 file2 ...) | |
| 15356 | If this is a list, all files in the list will be scanned | |
| 15357 | ||
| 15358 | The remaining args are treated as settings for the skipping facilities of | |
| 15359 | the scanner. The following items can be given here: | |
| 15360 | ||
| 15361 | archive skip trees with the archive tag | |
| 15362 | comment skip trees with the COMMENT keyword | |
| 15363 | function or Emacs Lisp form: | |
| 15364 | will be used as value for `org-agenda-skip-function', so | |
| 15365 | whenever the function returns a position, FUNC will not be | |
| 15366 | called for that entry and search will continue from the | |
| 15367 | position returned | |
| 15368 | ||
| 15369 | If your function needs to retrieve the tags including inherited tags | |
| 15370 | at the *current* entry, you can use the value of the variable | |
| 15371 | `org-scanner-tags' which will be much faster than getting the value | |
| 15372 | with `org-get-tags-at'. If your function gets properties with | |
| 15373 | `org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags' | |
| 15374 | to t around the call to `org-entry-properties' to get the same speedup. | |
| 15375 | Note that if your function moves around to retrieve tags and properties at | |
| 15376 | a *different* entry, you cannot use these techniques." | |
| 15377 | (unless (and (or (eq scope 'region) (eq scope 'region-start-level)) | |
| 15378 | (not (org-region-active-p))) | |
| 15379 | (let* ((org-agenda-archives-mode nil) ; just to make sure | |
| 15380 | (org-agenda-skip-archived-trees (memq 'archive skip)) | |
| 15381 | (org-agenda-skip-comment-trees (memq 'comment skip)) | |
| 15382 | (org-agenda-skip-function | |
| 15383 | (car (org-delete-all '(comment archive) skip))) | |
| 15384 | (org-tags-match-list-sublevels t) | |
| 15385 | (start-level (eq scope 'region-start-level)) | |
| 15386 | matcher res | |
| 15387 | org-todo-keywords-for-agenda | |
| 15388 | org-done-keywords-for-agenda | |
| 15389 | org-todo-keyword-alist-for-agenda | |
| 15390 | org-tag-alist-for-agenda | |
| 15391 | org--matcher-tags-todo-only) | |
| 15392 | ||
| 15393 | (cond | |
| 15394 | ((eq match t) (setq matcher t)) | |
| 15395 | ((eq match nil) (setq matcher t)) | |
| 15396 | (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t)))) | |
| 15397 | ||
| 15398 | (save-excursion | |
| 15399 | (save-restriction | |
| 15400 | (cond ((eq scope 'tree) | |
| 15401 | (org-back-to-heading t) | |
| 15402 | (org-narrow-to-subtree) | |
| 15403 | (setq scope nil)) | |
| 15404 | ((and (or (eq scope 'region) (eq scope 'region-start-level)) | |
| 15405 | (org-region-active-p)) | |
| 15406 | ;; If needed, set start-level to a string like "2" | |
| 15407 | (when start-level | |
| 15408 | (save-excursion | |
| 15409 | (goto-char (region-beginning)) | |
| 15410 | (unless (org-at-heading-p) (outline-next-heading)) | |
| 15411 | (setq start-level (org-current-level)))) | |
| 15412 | (narrow-to-region (region-beginning) | |
| 15413 | (save-excursion | |
| 15414 | (goto-char (region-end)) | |
| 15415 | (unless (and (bolp) (org-at-heading-p)) | |
| 15416 | (outline-next-heading)) | |
| 15417 | (point))) | |
| 15418 | (setq scope nil))) | |
| 15419 | ||
| 15420 | (if (not scope) | |
| 15421 | (progn | |
| 15422 | (org-agenda-prepare-buffers | |
| 15423 | (and buffer-file-name (list buffer-file-name))) | |
| 15424 | (setq res | |
| 15425 | (org-scan-tags | |
| 15426 | func matcher org--matcher-tags-todo-only start-level))) | |
| 15427 | ;; Get the right scope | |
| 15428 | (cond | |
| 15429 | ((and scope (listp scope) (symbolp (car scope))) | |
| 15430 | (setq scope (eval scope))) | |
| 15431 | ((eq scope 'agenda) | |
| 15432 | (setq scope (org-agenda-files t))) | |
| 15433 | ((eq scope 'agenda-with-archives) | |
| 15434 | (setq scope (org-agenda-files t)) | |
| 15435 | (setq scope (org-add-archive-files scope))) | |
| 15436 | ((eq scope 'file) | |
| 15437 | (setq scope (and buffer-file-name (list buffer-file-name)))) | |
| 15438 | ((eq scope 'file-with-archives) | |
| 15439 | (setq scope (org-add-archive-files (list (buffer-file-name)))))) | |
| 15440 | (org-agenda-prepare-buffers scope) | |
| 15441 | (dolist (file scope) | |
| 15442 | (with-current-buffer (org-find-base-buffer-visiting file) | |
| 15443 | (org-with-wide-buffer | |
| 15444 | (goto-char (point-min)) | |
| 15445 | (setq res | |
| 15446 | (append | |
| 15447 | res | |
| 15448 | (org-scan-tags | |
| 15449 | func matcher org--matcher-tags-todo-only))))))))) | |
| 15450 | res))) | |
| 15451 | ||
| 15452 | ;;; Properties API | |
| 15453 | ||
| 15454 | (defconst org-special-properties | |
| 15455 | '("ALLTAGS" "BLOCKED" "CLOCKSUM" "CLOCKSUM_T" "CLOSED" "DEADLINE" "FILE" | |
| 15456 | "ITEM" "PRIORITY" "SCHEDULED" "TAGS" "TIMESTAMP" "TIMESTAMP_IA" "TODO") | |
| 15457 | "The special properties valid in Org mode. | |
| 15458 | These are properties that are not defined in the property drawer, | |
| 15459 | but in some other way.") | |
| 15460 | ||
| 15461 | (defconst org-default-properties | |
| 15462 | '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID" | |
| 15463 | "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" | |
| 15464 | "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" | |
| 15465 | "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME" | |
| 15466 | "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "UNNUMBERED" | |
| 15467 | "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE" | |
| 15468 | "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS") | |
| 15469 | "Some properties that are used by Org mode for various purposes. | |
| 15470 | Being in this list makes sure that they are offered for completion.") | |
| 15471 | ||
| 15472 | (defun org--valid-property-p (property) | |
| 15473 | "Non nil when string PROPERTY is a valid property name." | |
| 15474 | (not | |
| 15475 | (or (equal property "") | |
| 15476 | (string-match-p "\\s-" property)))) | |
| 15477 | ||
| 15478 | (defun org--update-property-plist (key val props) | |
| 15479 | "Associate KEY to VAL in alist PROPS. | |
| 15480 | Modifications are made by side-effect. Return new alist." | |
| 15481 | (let* ((appending (string= (substring key -1) "+")) | |
| 15482 | (key (if appending (substring key 0 -1) key)) | |
| 15483 | (old (assoc-string key props t))) | |
| 15484 | (if (not old) (cons (cons key val) props) | |
| 15485 | (setcdr old (if appending (concat (cdr old) " " val) val)) | |
| 15486 | props))) | |
| 15487 | ||
| 15488 | (defun org-get-property-block (&optional beg force) | |
| 15489 | "Return the (beg . end) range of the body of the property drawer. | |
| 15490 | BEG is the beginning of the current subtree, or of the part | |
| 15491 | before the first headline. If it is not given, it will be found. | |
| 15492 | If the drawer does not exist, create it if FORCE is non-nil, or | |
| 15493 | return nil." | |
| 15494 | (org-with-wide-buffer | |
| 15495 | (when beg (goto-char beg)) | |
| 15496 | (unless (org-before-first-heading-p) | |
| 15497 | (let ((beg (cond (beg) | |
| 15498 | ((or (not (featurep 'org-inlinetask)) | |
| 15499 | (org-inlinetask-in-task-p)) | |
| 15500 | (org-back-to-heading t)) | |
| 15501 | (t (org-with-limited-levels (org-back-to-heading t)))))) | |
| 15502 | (forward-line) | |
| 15503 | (when (looking-at-p org-planning-line-re) (forward-line)) | |
| 15504 | (cond ((looking-at org-property-drawer-re) | |
| 15505 | (forward-line) | |
| 15506 | (cons (point) (progn (goto-char (match-end 0)) | |
| 15507 | (line-beginning-position)))) | |
| 15508 | (force | |
| 15509 | (goto-char beg) | |
| 15510 | (org-insert-property-drawer) | |
| 15511 | (let ((pos (save-excursion (search-forward ":END:") | |
| 15512 | (line-beginning-position)))) | |
| 15513 | (cons pos pos)))))))) | |
| 15514 | ||
| 15515 | (defun org-at-property-p () | |
| 15516 | "Non-nil when point is inside a property drawer. | |
| 15517 | See `org-property-re' for match data, if applicable." | |
| 15518 | (save-excursion | |
| 15519 | (beginning-of-line) | |
| 15520 | (and (looking-at org-property-re) | |
| 15521 | (let ((property-drawer (save-match-data (org-get-property-block)))) | |
| 15522 | (and property-drawer | |
| 15523 | (>= (point) (car property-drawer)) | |
| 15524 | (< (point) (cdr property-drawer))))))) | |
| 15525 | ||
| 15526 | (defun org-property-action () | |
| 15527 | "Do an action on properties." | |
| 15528 | (interactive) | |
| 15529 | (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") | |
| 15530 | (let ((c (read-char-exclusive))) | |
| 15531 | (cl-case c | |
| 15532 | (?s (call-interactively #'org-set-property)) | |
| 15533 | (?d (call-interactively #'org-delete-property)) | |
| 15534 | (?D (call-interactively #'org-delete-property-globally)) | |
| 15535 | (?c (call-interactively #'org-compute-property-at-point)) | |
| 15536 | (otherwise (user-error "No such property action %c" c))))) | |
| 15537 | ||
| 15538 | (defun org-inc-effort () | |
| 15539 | "Increment the value of the effort property in the current entry." | |
| 15540 | (interactive) | |
| 15541 | (org-set-effort nil t)) | |
| 15542 | ||
| 15543 | (defvar org-clock-effort) ; Defined in org-clock.el. | |
| 15544 | (defvar org-clock-current-task) ; Defined in org-clock.el. | |
| 15545 | (defun org-set-effort (&optional value increment) | |
| 15546 | "Set the effort property of the current entry. | |
| 15547 | With numerical prefix arg, use the nth allowed value, 0 stands for the | |
| 15548 | 10th allowed value. | |
| 15549 | ||
| 15550 | When INCREMENT is non-nil, set the property to the next allowed value." | |
| 15551 | (interactive "P") | |
| 15552 | (when (equal value 0) (setq value 10)) | |
| 15553 | (let* ((completion-ignore-case t) | |
| 15554 | (prop org-effort-property) | |
| 15555 | (cur (org-entry-get nil prop)) | |
| 15556 | (allowed (org-property-get-allowed-values nil prop 'table)) | |
| 15557 | (existing (mapcar 'list (org-property-values prop))) | |
| 15558 | (heading (nth 4 (org-heading-components))) | |
| 15559 | rpl | |
| 15560 | (val (cond | |
| 15561 | ((stringp value) value) | |
| 15562 | ((and allowed (integerp value)) | |
| 15563 | (or (car (nth (1- value) allowed)) | |
| 15564 | (car (org-last allowed)))) | |
| 15565 | ((and allowed increment) | |
| 15566 | (or (cl-caadr (member (list cur) allowed)) | |
| 15567 | (user-error "Allowed effort values are not set"))) | |
| 15568 | (allowed | |
| 15569 | (message "Select 1-9,0, [RET%s]: %s" | |
| 15570 | (if cur (concat "=" cur) "") | |
| 15571 | (mapconcat 'car allowed " ")) | |
| 15572 | (setq rpl (read-char-exclusive)) | |
| 15573 | (if (equal rpl ?\r) | |
| 15574 | cur | |
| 15575 | (setq rpl (- rpl ?0)) | |
| 15576 | (when (equal rpl 0) (setq rpl 10)) | |
| 15577 | (if (and (> rpl 0) (<= rpl (length allowed))) | |
| 15578 | (car (nth (1- rpl) allowed)) | |
| 15579 | (org-completing-read "Effort: " allowed nil)))) | |
| 15580 | (t | |
| 15581 | (org-completing-read | |
| 15582 | (concat "Effort" (and cur (string-match "\\S-" cur) | |
| 15583 | (concat " [" cur "]")) | |
| 15584 | ": ") | |
| 15585 | existing nil nil "" nil cur))))) | |
| 15586 | (unless (equal (org-entry-get nil prop) val) | |
| 15587 | (org-entry-put nil prop val)) | |
| 15588 | (org-refresh-property | |
| 15589 | '((effort . identity) | |
| 15590 | (effort-minutes . org-duration-to-minutes)) | |
| 15591 | val) | |
| 15592 | (when (equal heading (bound-and-true-p org-clock-current-task)) | |
| 15593 | (setq org-clock-effort (get-text-property (point-at-bol) 'effort)) | |
| 15594 | (org-clock-update-mode-line)) | |
| 15595 | (message "%s is now %s" prop val))) | |
| 15596 | ||
| 15597 | (defun org-entry-properties (&optional pom which) | |
| 15598 | "Get all properties of the current entry. | |
| 15599 | ||
| 15600 | When POM is a buffer position, get all properties from the entry | |
| 15601 | there instead. | |
| 15602 | ||
| 15603 | This includes the TODO keyword, the tags, time strings for | |
| 15604 | deadline, scheduled, and clocking, and any additional properties | |
| 15605 | defined in the entry. | |
| 15606 | ||
| 15607 | If WHICH is nil or `all', get all properties. If WHICH is | |
| 15608 | `special' or `standard', only get that subclass. If WHICH is | |
| 15609 | a string, only get that property. | |
| 15610 | ||
| 15611 | Return value is an alist. Keys are properties, as upcased | |
| 15612 | strings." | |
| 15613 | (org-with-point-at pom | |
| 15614 | (when (and (derived-mode-p 'org-mode) | |
| 15615 | (ignore-errors (org-back-to-heading t))) | |
| 15616 | (catch 'exit | |
| 15617 | (let* ((beg (point)) | |
| 15618 | (specific (and (stringp which) (upcase which))) | |
| 15619 | (which (cond ((not specific) which) | |
| 15620 | ((member specific org-special-properties) 'special) | |
| 15621 | (t 'standard))) | |
| 15622 | props) | |
| 15623 | ;; Get the special properties, like TODO and TAGS. | |
| 15624 | (when (memq which '(nil all special)) | |
| 15625 | (when (or (not specific) (string= specific "CLOCKSUM")) | |
| 15626 | (let ((clocksum (get-text-property (point) :org-clock-minutes))) | |
| 15627 | (when clocksum | |
| 15628 | (push (cons "CLOCKSUM" (org-duration-from-minutes clocksum)) | |
| 15629 | props))) | |
| 15630 | (when specific (throw 'exit props))) | |
| 15631 | (when (or (not specific) (string= specific "CLOCKSUM_T")) | |
| 15632 | (let ((clocksumt (get-text-property (point) | |
| 15633 | :org-clock-minutes-today))) | |
| 15634 | (when clocksumt | |
| 15635 | (push (cons "CLOCKSUM_T" | |
| 15636 | (org-duration-from-minutes clocksumt)) | |
| 15637 | props))) | |
| 15638 | (when specific (throw 'exit props))) | |
| 15639 | (when (or (not specific) (string= specific "ITEM")) | |
| 15640 | (let ((case-fold-search nil)) | |
| 15641 | (when (looking-at org-complex-heading-regexp) | |
| 15642 | (push (cons "ITEM" | |
| 15643 | (let ((title (match-string-no-properties 4))) | |
| 15644 | (if (org-string-nw-p title) | |
| 15645 | (org-remove-tabs title) | |
| 15646 | ""))) | |
| 15647 | props))) | |
| 15648 | (when specific (throw 'exit props))) | |
| 15649 | (when (or (not specific) (string= specific "TODO")) | |
| 15650 | (let ((case-fold-search nil)) | |
| 15651 | (when (and (looking-at org-todo-line-regexp) (match-end 2)) | |
| 15652 | (push (cons "TODO" (match-string-no-properties 2)) props))) | |
| 15653 | (when specific (throw 'exit props))) | |
| 15654 | (when (or (not specific) (string= specific "PRIORITY")) | |
| 15655 | (push (cons "PRIORITY" | |
| 15656 | (if (looking-at org-priority-regexp) | |
| 15657 | (match-string-no-properties 2) | |
| 15658 | (char-to-string org-default-priority))) | |
| 15659 | props) | |
| 15660 | (when specific (throw 'exit props))) | |
| 15661 | (when (or (not specific) (string= specific "FILE")) | |
| 15662 | (push (cons "FILE" (buffer-file-name (buffer-base-buffer))) | |
| 15663 | props) | |
| 15664 | (when specific (throw 'exit props))) | |
| 15665 | (when (or (not specific) (string= specific "TAGS")) | |
| 15666 | (let ((value (org-string-nw-p (org-get-tags-string)))) | |
| 15667 | (when value (push (cons "TAGS" value) props))) | |
| 15668 | (when specific (throw 'exit props))) | |
| 15669 | (when (or (not specific) (string= specific "ALLTAGS")) | |
| 15670 | (let ((value (org-get-tags-at))) | |
| 15671 | (when value | |
| 15672 | (push (cons "ALLTAGS" | |
| 15673 | (format ":%s:" (mapconcat #'identity value ":"))) | |
| 15674 | props))) | |
| 15675 | (when specific (throw 'exit props))) | |
| 15676 | (when (or (not specific) (string= specific "BLOCKED")) | |
| 15677 | (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props) | |
| 15678 | (when specific (throw 'exit props))) | |
| 15679 | (when (or (not specific) | |
| 15680 | (member specific '("CLOSED" "DEADLINE" "SCHEDULED"))) | |
| 15681 | (forward-line) | |
| 15682 | (when (looking-at-p org-planning-line-re) | |
| 15683 | (end-of-line) | |
| 15684 | (let ((bol (line-beginning-position)) | |
| 15685 | ;; Backward compatibility: time keywords used to | |
| 15686 | ;; be configurable (before 8.3). Make sure we | |
| 15687 | ;; get the correct keyword. | |
| 15688 | (key-assoc `(("CLOSED" . ,org-closed-string) | |
| 15689 | ("DEADLINE" . ,org-deadline-string) | |
| 15690 | ("SCHEDULED" . ,org-scheduled-string)))) | |
| 15691 | (dolist (pair (if specific (list (assoc specific key-assoc)) | |
| 15692 | key-assoc)) | |
| 15693 | (save-excursion | |
| 15694 | (when (search-backward (cdr pair) bol t) | |
| 15695 | (goto-char (match-end 0)) | |
| 15696 | (skip-chars-forward " \t") | |
| 15697 | (and (looking-at org-ts-regexp-both) | |
| 15698 | (push (cons (car pair) | |
| 15699 | (match-string-no-properties 0)) | |
| 15700 | props))))))) | |
| 15701 | (when specific (throw 'exit props))) | |
| 15702 | (when (or (not specific) | |
| 15703 | (member specific '("TIMESTAMP" "TIMESTAMP_IA"))) | |
| 15704 | (let ((find-ts | |
| 15705 | (lambda (end ts) | |
| 15706 | ;; Fix next time-stamp before END. TS is the | |
| 15707 | ;; list of time-stamps found so far. | |
| 15708 | (let ((ts ts) | |
| 15709 | (regexp (cond | |
| 15710 | ((string= specific "TIMESTAMP") | |
| 15711 | org-ts-regexp) | |
| 15712 | ((string= specific "TIMESTAMP_IA") | |
| 15713 | org-ts-regexp-inactive) | |
| 15714 | ((assoc "TIMESTAMP_IA" ts) | |
| 15715 | org-ts-regexp) | |
| 15716 | ((assoc "TIMESTAMP" ts) | |
| 15717 | org-ts-regexp-inactive) | |
| 15718 | (t org-ts-regexp-both)))) | |
| 15719 | (catch 'next | |
| 15720 | (while (re-search-forward regexp end t) | |
| 15721 | (backward-char) | |
| 15722 | (let ((object (org-element-context))) | |
| 15723 | ;; Accept to match timestamps in node | |
| 15724 | ;; properties, too. | |
| 15725 | (when (memq (org-element-type object) | |
| 15726 | '(node-property timestamp)) | |
| 15727 | (let ((type | |
| 15728 | (org-element-property :type object))) | |
| 15729 | (cond | |
| 15730 | ((and (memq type '(active active-range)) | |
| 15731 | (not (equal specific "TIMESTAMP_IA"))) | |
| 15732 | (unless (assoc "TIMESTAMP" ts) | |
| 15733 | (push (cons "TIMESTAMP" | |
| 15734 | (org-element-property | |
| 15735 | :raw-value object)) | |
| 15736 | ts) | |
| 15737 | (when specific (throw 'exit ts)))) | |
| 15738 | ((and (memq type '(inactive inactive-range)) | |
| 15739 | (not (string= specific "TIMESTAMP"))) | |
| 15740 | (unless (assoc "TIMESTAMP_IA" ts) | |
| 15741 | (push (cons "TIMESTAMP_IA" | |
| 15742 | (org-element-property | |
| 15743 | :raw-value object)) | |
| 15744 | ts) | |
| 15745 | (when specific (throw 'exit ts)))))) | |
| 15746 | ;; Both timestamp types are found, | |
| 15747 | ;; move to next part. | |
| 15748 | (when (= (length ts) 2) (throw 'next ts))))) | |
| 15749 | ts))))) | |
| 15750 | (goto-char beg) | |
| 15751 | ;; First look for timestamps within headline. | |
| 15752 | (let ((ts (funcall find-ts (line-end-position) nil))) | |
| 15753 | (if (= (length ts) 2) (setq props (nconc ts props)) | |
| 15754 | ;; Then find timestamps in the section, skipping | |
| 15755 | ;; planning line. | |
| 15756 | (let ((end (save-excursion (outline-next-heading)))) | |
| 15757 | (forward-line) | |
| 15758 | (when (looking-at-p org-planning-line-re) (forward-line)) | |
| 15759 | (setq props (nconc (funcall find-ts end ts) props)))))))) | |
| 15760 | ;; Get the standard properties, like :PROP:. | |
| 15761 | (when (memq which '(nil all standard)) | |
| 15762 | ;; If we are looking after a specific property, delegate | |
| 15763 | ;; to `org-entry-get', which is faster. However, make an | |
| 15764 | ;; exception for "CATEGORY", since it can be also set | |
| 15765 | ;; through keywords (i.e. #+CATEGORY). | |
| 15766 | (if (and specific (not (equal specific "CATEGORY"))) | |
| 15767 | (let ((value (org-entry-get beg specific nil t))) | |
| 15768 | (throw 'exit (and value (list (cons specific value))))) | |
| 15769 | (let ((range (org-get-property-block beg))) | |
| 15770 | (when range | |
| 15771 | (let ((end (cdr range)) seen-base) | |
| 15772 | (goto-char (car range)) | |
| 15773 | ;; Unlike to `org--update-property-plist', we | |
| 15774 | ;; handle the case where base values is found | |
| 15775 | ;; after its extension. We also forbid standard | |
| 15776 | ;; properties to be named as special properties. | |
| 15777 | (while (re-search-forward org-property-re end t) | |
| 15778 | (let* ((key (upcase (match-string-no-properties 2))) | |
| 15779 | (extendp (string-match-p "\\+\\'" key)) | |
| 15780 | (key-base (if extendp (substring key 0 -1) key)) | |
| 15781 | (value (match-string-no-properties 3))) | |
| 15782 | (cond | |
| 15783 | ((member-ignore-case key-base org-special-properties)) | |
| 15784 | (extendp | |
| 15785 | (setq props | |
| 15786 | (org--update-property-plist key value props))) | |
| 15787 | ((member key seen-base)) | |
| 15788 | (t (push key seen-base) | |
| 15789 | (let ((p (assoc-string key props t))) | |
| 15790 | (if p (setcdr p (concat value " " (cdr p))) | |
| 15791 | (push (cons key value) props)))))))))))) | |
| 15792 | (unless (assoc "CATEGORY" props) | |
| 15793 | (push (cons "CATEGORY" (org-get-category beg)) props) | |
| 15794 | (when (string= specific "CATEGORY") (throw 'exit props))) | |
| 15795 | ;; Return value. | |
| 15796 | props))))) | |
| 15797 | ||
| 15798 | (defun org--property-local-values (property literal-nil) | |
| 15799 | "Return value for PROPERTY in current entry. | |
| 15800 | Value is a list whose car is the base value for PROPERTY and cdr | |
| 15801 | a list of accumulated values. Return nil if neither is found in | |
| 15802 | the entry. Also return nil when PROPERTY is set to \"nil\", | |
| 15803 | unless LITERAL-NIL is non-nil." | |
| 15804 | (let ((range (org-get-property-block))) | |
| 15805 | (when range | |
| 15806 | (goto-char (car range)) | |
| 15807 | (let* ((case-fold-search t) | |
| 15808 | (end (cdr range)) | |
| 15809 | (value | |
| 15810 | ;; Base value. | |
| 15811 | (save-excursion | |
| 15812 | (let ((v (and (re-search-forward | |
| 15813 | (org-re-property property nil t) end t) | |
| 15814 | (match-string-no-properties 3)))) | |
| 15815 | (list (if literal-nil v (org-not-nil v))))))) | |
| 15816 | ;; Find additional values. | |
| 15817 | (let* ((property+ (org-re-property (concat property "+") nil t))) | |
| 15818 | (while (re-search-forward property+ end t) | |
| 15819 | (push (match-string-no-properties 3) value))) | |
| 15820 | ;; Return final values. | |
| 15821 | (and (not (equal value '(nil))) (nreverse value)))))) | |
| 15822 | ||
| 15823 | (defun org--property-global-value (property literal-nil) | |
| 15824 | "Return value for PROPERTY in current buffer. | |
| 15825 | Return value is a string. Return nil if property is not set | |
| 15826 | globally. Also return nil when PROPERTY is set to \"nil\", | |
| 15827 | unless LITERAL-NIL is non-nil." | |
| 15828 | (let ((global | |
| 15829 | (cdr (or (assoc-string property org-file-properties t) | |
| 15830 | (assoc-string property org-global-properties t) | |
| 15831 | (assoc-string property org-global-properties-fixed t))))) | |
| 15832 | (if literal-nil global (org-not-nil global)))) | |
| 15833 | ||
| 15834 | (defun org-entry-get (pom property &optional inherit literal-nil) | |
| 15835 | "Get value of PROPERTY for entry or content at point-or-marker POM. | |
| 15836 | ||
| 15837 | If INHERIT is non-nil and the entry does not have the property, | |
| 15838 | then also check higher levels of the hierarchy. If INHERIT is | |
| 15839 | the symbol `selective', use inheritance only if the setting in | |
| 15840 | `org-use-property-inheritance' selects PROPERTY for inheritance. | |
| 15841 | ||
| 15842 | If the property is present but empty, the return value is the | |
| 15843 | empty string. If the property is not present at all, nil is | |
| 15844 | returned. In any other case, return the value as a string. | |
| 15845 | Search is case-insensitive. | |
| 15846 | ||
| 15847 | If LITERAL-NIL is set, return the string value \"nil\" as | |
| 15848 | a string, do not interpret it as the list atom nil. This is used | |
| 15849 | for inheritance when a \"nil\" value can supersede a non-nil | |
| 15850 | value higher up the hierarchy." | |
| 15851 | (org-with-point-at pom | |
| 15852 | (cond | |
| 15853 | ((member-ignore-case property (cons "CATEGORY" org-special-properties)) | |
| 15854 | ;; We need a special property. Use `org-entry-properties' to | |
| 15855 | ;; retrieve it, but specify the wanted property. | |
| 15856 | (cdr (assoc-string property (org-entry-properties nil property)))) | |
| 15857 | ((and inherit | |
| 15858 | (or (not (eq inherit 'selective)) (org-property-inherit-p property))) | |
| 15859 | (org-entry-get-with-inheritance property literal-nil)) | |
| 15860 | (t | |
| 15861 | (let* ((local (org--property-local-values property literal-nil)) | |
| 15862 | (value (and local (mapconcat #'identity (delq nil local) " ")))) | |
| 15863 | (if literal-nil value (org-not-nil value))))))) | |
| 15864 | ||
| 15865 | (defun org-property-or-variable-value (var &optional inherit) | |
| 15866 | "Check if there is a property fixing the value of VAR. | |
| 15867 | If yes, return this value. If not, return the current value of the variable." | |
| 15868 | (let ((prop (org-entry-get nil (symbol-name var) inherit))) | |
| 15869 | (if (and prop (stringp prop) (string-match "\\S-" prop)) | |
| 15870 | (read prop) | |
| 15871 | (symbol-value var)))) | |
| 15872 | ||
| 15873 | (defun org-entry-delete (pom property) | |
| 15874 | "Delete PROPERTY from entry at point-or-marker POM. | |
| 15875 | Accumulated properties, i.e. PROPERTY+, are also removed. Return | |
| 15876 | non-nil when a property was removed." | |
| 15877 | (org-with-point-at pom | |
| 15878 | (pcase (org-get-property-block) | |
| 15879 | (`(,begin . ,origin) | |
| 15880 | (let* ((end (copy-marker origin)) | |
| 15881 | (re (org-re-property | |
| 15882 | (concat (regexp-quote property) "\\+?") t t))) | |
| 15883 | (goto-char begin) | |
| 15884 | (while (re-search-forward re end t) | |
| 15885 | (delete-region (match-beginning 0) (line-beginning-position 2))) | |
| 15886 | ;; If drawer is empty, remove it altogether. | |
| 15887 | (when (= begin end) | |
| 15888 | (delete-region (line-beginning-position 0) | |
| 15889 | (line-beginning-position 2))) | |
| 15890 | ;; Return non-nil if some property was removed. | |
| 15891 | (prog1 (/= end origin) (set-marker end nil)))) | |
| 15892 | (_ nil)))) | |
| 15893 | ||
| 15894 | ;; Multi-values properties are properties that contain multiple values | |
| 15895 | ;; These values are assumed to be single words, separated by whitespace. | |
| 15896 | (defun org-entry-add-to-multivalued-property (pom property value) | |
| 15897 | "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM." | |
| 15898 | (let* ((old (org-entry-get pom property)) | |
| 15899 | (values (and old (split-string old)))) | |
| 15900 | (setq value (org-entry-protect-space value)) | |
| 15901 | (unless (member value values) | |
| 15902 | (setq values (append values (list value))) | |
| 15903 | (org-entry-put pom property (mapconcat #'identity values " "))))) | |
| 15904 | ||
| 15905 | (defun org-entry-remove-from-multivalued-property (pom property value) | |
| 15906 | "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM." | |
| 15907 | (let* ((old (org-entry-get pom property)) | |
| 15908 | (values (and old (split-string old)))) | |
| 15909 | (setq value (org-entry-protect-space value)) | |
| 15910 | (when (member value values) | |
| 15911 | (setq values (delete value values)) | |
| 15912 | (org-entry-put pom property (mapconcat #'identity values " "))))) | |
| 15913 | ||
| 15914 | (defun org-entry-member-in-multivalued-property (pom property value) | |
| 15915 | "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?" | |
| 15916 | (let* ((old (org-entry-get pom property)) | |
| 15917 | (values (and old (split-string old)))) | |
| 15918 | (setq value (org-entry-protect-space value)) | |
| 15919 | (member value values))) | |
| 15920 | ||
| 15921 | (defun org-entry-get-multivalued-property (pom property) | |
| 15922 | "Return a list of values in a multivalued property." | |
| 15923 | (let* ((value (org-entry-get pom property)) | |
| 15924 | (values (and value (split-string value)))) | |
| 15925 | (mapcar #'org-entry-restore-space values))) | |
| 15926 | ||
| 15927 | (defun org-entry-put-multivalued-property (pom property &rest values) | |
| 15928 | "Set multivalued PROPERTY at point-or-marker POM to VALUES. | |
| 15929 | VALUES should be a list of strings. Spaces will be protected." | |
| 15930 | (org-entry-put pom property (mapconcat #'org-entry-protect-space values " ")) | |
| 15931 | (let* ((value (org-entry-get pom property)) | |
| 15932 | (values (and value (split-string value)))) | |
| 15933 | (mapcar #'org-entry-restore-space values))) | |
| 15934 | ||
| 15935 | (defun org-entry-protect-space (s) | |
| 15936 | "Protect spaces and newline in string S." | |
| 15937 | (while (string-match " " s) | |
| 15938 | (setq s (replace-match "%20" t t s))) | |
| 15939 | (while (string-match "\n" s) | |
| 15940 | (setq s (replace-match "%0A" t t s))) | |
| 15941 | s) | |
| 15942 | ||
| 15943 | (defun org-entry-restore-space (s) | |
| 15944 | "Restore spaces and newline in string S." | |
| 15945 | (while (string-match "%20" s) | |
| 15946 | (setq s (replace-match " " t t s))) | |
| 15947 | (while (string-match "%0A" s) | |
| 15948 | (setq s (replace-match "\n" t t s))) | |
| 15949 | s) | |
| 15950 | ||
| 15951 | (defvar org-entry-property-inherited-from (make-marker) | |
| 15952 | "Marker pointing to the entry from where a property was inherited. | |
| 15953 | Each call to `org-entry-get-with-inheritance' will set this marker to the | |
| 15954 | location of the entry where the inheritance search matched. If there was | |
| 15955 | no match, the marker will point nowhere. | |
| 15956 | Note that also `org-entry-get' calls this function, if the INHERIT flag | |
| 15957 | is set.") | |
| 15958 | ||
| 15959 | (defun org-entry-get-with-inheritance (property &optional literal-nil) | |
| 15960 | "Get PROPERTY of entry or content at point, search higher levels if needed. | |
| 15961 | The search will stop at the first ancestor which has the property defined. | |
| 15962 | If the value found is \"nil\", return nil to show that the property | |
| 15963 | should be considered as undefined (this is the meaning of nil here). | |
| 15964 | However, if LITERAL-NIL is set, return the string value \"nil\" instead." | |
| 15965 | (move-marker org-entry-property-inherited-from nil) | |
| 15966 | (org-with-wide-buffer | |
| 15967 | (let (value) | |
| 15968 | (catch 'exit | |
| 15969 | (while t | |
| 15970 | (let ((v (org--property-local-values property literal-nil))) | |
| 15971 | (when v | |
| 15972 | (setq value | |
| 15973 | (concat (mapconcat #'identity (delq nil v) " ") | |
| 15974 | (and value " ") | |
| 15975 | value))) | |
| 15976 | (cond | |
| 15977 | ((car v) | |
| 15978 | (org-back-to-heading t) | |
| 15979 | (move-marker org-entry-property-inherited-from (point)) | |
| 15980 | (throw 'exit nil)) | |
| 15981 | ((org-up-heading-safe)) | |
| 15982 | (t | |
| 15983 | (let ((global (org--property-global-value property literal-nil))) | |
| 15984 | (cond ((not global)) | |
| 15985 | (value (setq value (concat global " " value))) | |
| 15986 | (t (setq value global)))) | |
| 15987 | (throw 'exit nil)))))) | |
| 15988 | (if literal-nil value (org-not-nil value))))) | |
| 15989 | ||
| 15990 | (defvar org-property-changed-functions nil | |
| 15991 | "Hook called when the value of a property has changed. | |
| 15992 | Each hook function should accept two arguments, the name of the property | |
| 15993 | and the new value.") | |
| 15994 | ||
| 15995 | (defun org-entry-put (pom property value) | |
| 15996 | "Set PROPERTY to VALUE for entry at point-or-marker POM. | |
| 15997 | ||
| 15998 | If the value is nil, it is converted to the empty string. If it | |
| 15999 | is not a string, an error is raised. Also raise an error on | |
| 16000 | invalid property names. | |
| 16001 | ||
| 16002 | PROPERTY can be any regular property (see | |
| 16003 | `org-special-properties'). It can also be \"TODO\", | |
| 16004 | \"PRIORITY\", \"SCHEDULED\" and \"DEADLINE\". | |
| 16005 | ||
| 16006 | For the last two properties, VALUE may have any of the special | |
| 16007 | values \"earlier\" and \"later\". The function then increases or | |
| 16008 | decreases scheduled or deadline date by one day." | |
| 16009 | (cond ((null value) (setq value "")) | |
| 16010 | ((not (stringp value)) (error "Properties values should be strings")) | |
| 16011 | ((not (org--valid-property-p property)) | |
| 16012 | (user-error "Invalid property name: \"%s\"" property))) | |
| 16013 | (org-with-point-at pom | |
| 16014 | (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p)) | |
| 16015 | (org-back-to-heading t) | |
| 16016 | (org-with-limited-levels (org-back-to-heading t))) | |
| 16017 | (let ((beg (point))) | |
| 16018 | (cond | |
| 16019 | ((equal property "TODO") | |
| 16020 | (cond ((not (org-string-nw-p value)) (setq value 'none)) | |
| 16021 | ((not (member value org-todo-keywords-1)) | |
| 16022 | (user-error "\"%s\" is not a valid TODO state" value))) | |
| 16023 | (org-todo value) | |
| 16024 | (org-set-tags nil 'align)) | |
| 16025 | ((equal property "PRIORITY") | |
| 16026 | (org-priority (if (org-string-nw-p value) (string-to-char value) ?\s)) | |
| 16027 | (org-set-tags nil 'align)) | |
| 16028 | ((equal property "SCHEDULED") | |
| 16029 | (forward-line) | |
| 16030 | (if (and (looking-at-p org-planning-line-re) | |
| 16031 | (re-search-forward | |
| 16032 | org-scheduled-time-regexp (line-end-position) t)) | |
| 16033 | (cond ((string= value "earlier") (org-timestamp-change -1 'day)) | |
| 16034 | ((string= value "later") (org-timestamp-change 1 'day)) | |
| 16035 | ((string= value "") (org-schedule '(4))) | |
| 16036 | (t (org-schedule nil value))) | |
| 16037 | (if (member value '("earlier" "later" "")) | |
| 16038 | (call-interactively #'org-schedule) | |
| 16039 | (org-schedule nil value)))) | |
| 16040 | ((equal property "DEADLINE") | |
| 16041 | (forward-line) | |
| 16042 | (if (and (looking-at-p org-planning-line-re) | |
| 16043 | (re-search-forward | |
| 16044 | org-deadline-time-regexp (line-end-position) t)) | |
| 16045 | (cond ((string= value "earlier") (org-timestamp-change -1 'day)) | |
| 16046 | ((string= value "later") (org-timestamp-change 1 'day)) | |
| 16047 | ((string= value "") (org-deadline '(4))) | |
| 16048 | (t (org-deadline nil value))) | |
| 16049 | (if (member value '("earlier" "later" "")) | |
| 16050 | (call-interactively #'org-deadline) | |
| 16051 | (org-deadline nil value)))) | |
| 16052 | ((member property org-special-properties) | |
| 16053 | (error "The %s property cannot be set with `org-entry-put'" property)) | |
| 16054 | (t | |
| 16055 | (let* ((range (org-get-property-block beg 'force)) | |
| 16056 | (end (cdr range)) | |
| 16057 | (case-fold-search t)) | |
| 16058 | (goto-char (car range)) | |
| 16059 | (if (re-search-forward (org-re-property property nil t) end t) | |
| 16060 | (progn (delete-region (match-beginning 0) (match-end 0)) | |
| 16061 | (goto-char (match-beginning 0))) | |
| 16062 | (goto-char end) | |
| 16063 | (insert "\n") | |
| 16064 | (backward-char)) | |
| 16065 | (insert ":" property ":") | |
| 16066 | (when value (insert " " value)) | |
| 16067 | (org-indent-line))))) | |
| 16068 | (run-hook-with-args 'org-property-changed-functions property value))) | |
| 16069 | ||
| 16070 | (defun org-buffer-property-keys | |
| 16071 | (&optional specials defaults columns ignore-malformed) | |
| 16072 | "Get all property keys in the current buffer. | |
| 16073 | ||
| 16074 | When SPECIALS is non-nil, also list the special properties that | |
| 16075 | reflect things like tags and TODO state. | |
| 16076 | ||
| 16077 | When DEFAULTS is non-nil, also include properties that has | |
| 16078 | special meaning internally: ARCHIVE, CATEGORY, SUMMARY, | |
| 16079 | DESCRIPTION, LOCATION, and LOGGING and others. | |
| 16080 | ||
| 16081 | When COLUMNS in non-nil, also include property names given in | |
| 16082 | COLUMN formats in the current buffer. | |
| 16083 | ||
| 16084 | When IGNORE-MALFORMED is non-nil, malformed drawer repair will not be | |
| 16085 | automatically performed, such drawers will be silently ignored." | |
| 16086 | (let ((case-fold-search t) | |
| 16087 | (props (append | |
| 16088 | (and specials org-special-properties) | |
| 16089 | (and defaults (cons org-effort-property org-default-properties)) | |
| 16090 | nil))) | |
| 16091 | (org-with-wide-buffer | |
| 16092 | (goto-char (point-min)) | |
| 16093 | (while (re-search-forward org-property-start-re nil t) | |
| 16094 | (let ((range (org-get-property-block))) | |
| 16095 | (catch 'skip | |
| 16096 | (unless range | |
| 16097 | (when (and (not ignore-malformed) | |
| 16098 | (not (org-before-first-heading-p)) | |
| 16099 | (y-or-n-p (format "Malformed drawer at %d, repair?" | |
| 16100 | (line-beginning-position)))) | |
| 16101 | (org-get-property-block nil t)) | |
| 16102 | (throw 'skip nil)) | |
| 16103 | (goto-char (car range)) | |
| 16104 | (let ((begin (car range)) | |
| 16105 | (end (cdr range))) | |
| 16106 | ;; Make sure that found property block is not located | |
| 16107 | ;; before current point, as it would generate an infloop. | |
| 16108 | ;; It can happen, for example, in the following | |
| 16109 | ;; situation: | |
| 16110 | ;; | |
| 16111 | ;; * Headline | |
| 16112 | ;; :PROPERTIES: | |
| 16113 | ;; ... | |
| 16114 | ;; :END: | |
| 16115 | ;; *************** Inlinetask | |
| 16116 | ;; #+BEGIN_EXAMPLE | |
| 16117 | ;; :PROPERTIES: | |
| 16118 | ;; #+END_EXAMPLE | |
| 16119 | ;; | |
| 16120 | (if (< begin (point)) (throw 'skip nil) (goto-char begin)) | |
| 16121 | (while (< (point) end) | |
| 16122 | (let ((p (progn (looking-at org-property-re) | |
| 16123 | (match-string-no-properties 2)))) | |
| 16124 | ;; Only add true property name, not extension symbol. | |
| 16125 | (push (if (not (string-match-p "\\+\\'" p)) p | |
| 16126 | (substring p 0 -1)) | |
| 16127 | props)) | |
| 16128 | (forward-line)))) | |
| 16129 | (outline-next-heading))) | |
| 16130 | (when columns | |
| 16131 | (goto-char (point-min)) | |
| 16132 | (while (re-search-forward "^[ \t]*\\(?:#\\+\\|:\\)COLUMNS:" nil t) | |
| 16133 | (let ((element (org-element-at-point))) | |
| 16134 | (when (memq (org-element-type element) '(keyword node-property)) | |
| 16135 | (let ((value (org-element-property :value element)) | |
| 16136 | (start 0)) | |
| 16137 | (while (string-match "%[0-9]*\\([[:alnum:]_-]+\\)\\(([^)]+)\\)?\ | |
| 16138 | \\(?:{[^}]+}\\)?" | |
| 16139 | value start) | |
| 16140 | (setq start (match-end 0)) | |
| 16141 | (let ((p (match-string-no-properties 1 value))) | |
| 16142 | (unless (member-ignore-case p org-special-properties) | |
| 16143 | (push p props)))))))))) | |
| 16144 | (sort (delete-dups props) (lambda (a b) (string< (upcase a) (upcase b)))))) | |
| 16145 | ||
| 16146 | (defun org-property-values (key) | |
| 16147 | "List all non-nil values of property KEY in current buffer." | |
| 16148 | (org-with-wide-buffer | |
| 16149 | (goto-char (point-min)) | |
| 16150 | (let ((case-fold-search t) | |
| 16151 | (re (org-re-property key)) | |
| 16152 | values) | |
| 16153 | (while (re-search-forward re nil t) | |
| 16154 | (push (org-entry-get (point) key) values)) | |
| 16155 | (delete-dups values)))) | |
| 16156 | ||
| 16157 | (defun org-insert-property-drawer () | |
| 16158 | "Insert a property drawer into the current entry." | |
| 16159 | (org-with-wide-buffer | |
| 16160 | (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p)) | |
| 16161 | (org-back-to-heading t) | |
| 16162 | (org-with-limited-levels (org-back-to-heading t))) | |
| 16163 | (forward-line) | |
| 16164 | (when (looking-at-p org-planning-line-re) (forward-line)) | |
| 16165 | (unless (looking-at-p org-property-drawer-re) | |
| 16166 | ;; Make sure we start editing a line from current entry, not from | |
| 16167 | ;; next one. It prevents extending text properties or overlays | |
| 16168 | ;; belonging to the latter. | |
| 16169 | (when (bolp) (backward-char)) | |
| 16170 | (let ((begin (1+ (point))) | |
| 16171 | (inhibit-read-only t)) | |
| 16172 | (insert "\n:PROPERTIES:\n:END:") | |
| 16173 | (when (eobp) (insert "\n")) | |
| 16174 | (org-indent-region begin (point)))))) | |
| 16175 | ||
| 16176 | (defun org-insert-drawer (&optional arg drawer) | |
| 16177 | "Insert a drawer at point. | |
| 16178 | ||
| 16179 | When optional argument ARG is non-nil, insert a property drawer. | |
| 16180 | ||
| 16181 | Optional argument DRAWER, when non-nil, is a string representing | |
| 16182 | drawer's name. Otherwise, the user is prompted for a name. | |
| 16183 | ||
| 16184 | If a region is active, insert the drawer around that region | |
| 16185 | instead. | |
| 16186 | ||
| 16187 | Point is left between drawer's boundaries." | |
| 16188 | (interactive "P") | |
| 16189 | (let* ((drawer (if arg "PROPERTIES" | |
| 16190 | (or drawer (read-from-minibuffer "Drawer: "))))) | |
| 16191 | (cond | |
| 16192 | ;; With C-u, fall back on `org-insert-property-drawer' | |
| 16193 | (arg (org-insert-property-drawer)) | |
| 16194 | ;; Check validity of suggested drawer's name. | |
| 16195 | ((not (string-match-p org-drawer-regexp (format ":%s:" drawer))) | |
| 16196 | (user-error "Invalid drawer name")) | |
| 16197 | ;; With an active region, insert a drawer at point. | |
| 16198 | ((not (org-region-active-p)) | |
| 16199 | (progn | |
| 16200 | (unless (bolp) (insert "\n")) | |
| 16201 | (insert (format ":%s:\n\n:END:\n" drawer)) | |
| 16202 | (forward-line -2))) | |
| 16203 | ;; Otherwise, insert the drawer at point | |
| 16204 | (t | |
| 16205 | (let ((rbeg (region-beginning)) | |
| 16206 | (rend (copy-marker (region-end)))) | |
| 16207 | (unwind-protect | |
| 16208 | (progn | |
| 16209 | (goto-char rbeg) | |
| 16210 | (beginning-of-line) | |
| 16211 | (when (save-excursion | |
| 16212 | (re-search-forward org-outline-regexp-bol rend t)) | |
| 16213 | (user-error "Drawers cannot contain headlines")) | |
| 16214 | ;; Position point at the beginning of the first | |
| 16215 | ;; non-blank line in region. Insert drawer's opening | |
| 16216 | ;; there, then indent it. | |
| 16217 | (org-skip-whitespace) | |
| 16218 | (beginning-of-line) | |
| 16219 | (insert ":" drawer ":\n") | |
| 16220 | (forward-line -1) | |
| 16221 | (indent-for-tab-command) | |
| 16222 | ;; Move point to the beginning of the first blank line | |
| 16223 | ;; after the last non-blank line in region. Insert | |
| 16224 | ;; drawer's closing, then indent it. | |
| 16225 | (goto-char rend) | |
| 16226 | (skip-chars-backward " \r\t\n") | |
| 16227 | (insert "\n:END:") | |
| 16228 | (deactivate-mark t) | |
| 16229 | (indent-for-tab-command) | |
| 16230 | (unless (eolp) (insert "\n"))) | |
| 16231 | ;; Clear marker, whatever the outcome of insertion is. | |
| 16232 | (set-marker rend nil))))))) | |
| 16233 | ||
| 16234 | (defvar org-property-set-functions-alist nil | |
| 16235 | "Property set function alist. | |
| 16236 | Each entry should have the following format: | |
| 16237 | ||
| 16238 | (PROPERTY . READ-FUNCTION) | |
| 16239 | ||
| 16240 | The read function will be called with the same argument as | |
| 16241 | `org-completing-read'.") | |
| 16242 | ||
| 16243 | (defun org-set-property-function (property) | |
| 16244 | "Get the function that should be used to set PROPERTY. | |
| 16245 | This is computed according to `org-property-set-functions-alist'." | |
| 16246 | (or (cdr (assoc property org-property-set-functions-alist)) | |
| 16247 | 'org-completing-read)) | |
| 16248 | ||
| 16249 | (defun org-read-property-value (property) | |
| 16250 | "Read PROPERTY value from user." | |
| 16251 | (let* ((completion-ignore-case t) | |
| 16252 | (allowed (org-property-get-allowed-values nil property 'table)) | |
| 16253 | (cur (org-entry-get nil property)) | |
| 16254 | (prompt (concat property " value" | |
| 16255 | (if (and cur (string-match "\\S-" cur)) | |
| 16256 | (concat " [" cur "]") "") ": ")) | |
| 16257 | (set-function (org-set-property-function property)) | |
| 16258 | (val (if allowed | |
| 16259 | (funcall set-function prompt allowed nil | |
| 16260 | (not (get-text-property 0 'org-unrestricted | |
| 16261 | (caar allowed)))) | |
| 16262 | (funcall set-function prompt | |
| 16263 | (mapcar 'list (org-property-values property)) | |
| 16264 | nil nil "" nil cur)))) | |
| 16265 | (org-trim val))) | |
| 16266 | ||
| 16267 | (defvar org-last-set-property nil) | |
| 16268 | (defvar org-last-set-property-value nil) | |
| 16269 | (defun org-read-property-name () | |
| 16270 | "Read a property name." | |
| 16271 | (let ((completion-ignore-case t) | |
| 16272 | (default-prop (or (and (org-at-property-p) | |
| 16273 | (match-string-no-properties 2)) | |
| 16274 | org-last-set-property))) | |
| 16275 | (org-completing-read | |
| 16276 | (concat "Property" | |
| 16277 | (if default-prop (concat " [" default-prop "]") "") | |
| 16278 | ": ") | |
| 16279 | (mapcar #'list (org-buffer-property-keys nil t t)) | |
| 16280 | nil nil nil nil default-prop))) | |
| 16281 | ||
| 16282 | (defun org-set-property-and-value (use-last) | |
| 16283 | "Allow to set [PROPERTY]: [value] direction from prompt. | |
| 16284 | When use-default, don't even ask, just use the last | |
| 16285 | \"[PROPERTY]: [value]\" string from the history." | |
| 16286 | (interactive "P") | |
| 16287 | (let* ((completion-ignore-case t) | |
| 16288 | (pv (or (and use-last org-last-set-property-value) | |
| 16289 | (org-completing-read | |
| 16290 | "Enter a \"[Property]: [value]\" pair: " | |
| 16291 | nil nil nil nil nil | |
| 16292 | org-last-set-property-value))) | |
| 16293 | prop val) | |
| 16294 | (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv) | |
| 16295 | (setq prop (match-string 1 pv) | |
| 16296 | val (match-string 2 pv)) | |
| 16297 | (org-set-property prop val)))) | |
| 16298 | ||
| 16299 | (defun org-set-property (property value) | |
| 16300 | "In the current entry, set PROPERTY to VALUE. | |
| 16301 | ||
| 16302 | When called interactively, this will prompt for a property name, offering | |
| 16303 | completion on existing and default properties. And then it will prompt | |
| 16304 | for a value, offering completion either on allowed values (via an inherited | |
| 16305 | xxx_ALL property) or on existing values in other instances of this property | |
| 16306 | in the current file. | |
| 16307 | ||
| 16308 | Throw an error when trying to set a property with an invalid name." | |
| 16309 | (interactive (list nil nil)) | |
| 16310 | (let ((property (or property (org-read-property-name)))) | |
| 16311 | ;; `org-entry-put' also makes the following check, but this one | |
| 16312 | ;; avoids polluting `org-last-set-property' and | |
| 16313 | ;; `org-last-set-property-value' needlessly. | |
| 16314 | (unless (org--valid-property-p property) | |
| 16315 | (user-error "Invalid property name: \"%s\"" property)) | |
| 16316 | (let ((value (or value (org-read-property-value property))) | |
| 16317 | (fn (cdr (assoc-string property org-properties-postprocess-alist t)))) | |
| 16318 | (setq org-last-set-property property) | |
| 16319 | (setq org-last-set-property-value (concat property ": " value)) | |
| 16320 | ;; Possibly postprocess the inserted value: | |
| 16321 | (when fn (setq value (funcall fn value))) | |
| 16322 | (unless (equal (org-entry-get nil property) value) | |
| 16323 | (org-entry-put nil property value))))) | |
| 16324 | ||
| 16325 | (defun org-find-property (property &optional value) | |
| 16326 | "Find first entry in buffer that sets PROPERTY. | |
| 16327 | ||
| 16328 | When optional argument VALUE is non-nil, only consider an entry | |
| 16329 | if it contains PROPERTY set to this value. If PROPERTY should be | |
| 16330 | explicitly set to nil, use string \"nil\" for VALUE. | |
| 16331 | ||
| 16332 | Return position where the entry begins, or nil if there is no | |
| 16333 | such entry. If narrowing is in effect, only search the visible | |
| 16334 | part of the buffer." | |
| 16335 | (save-excursion | |
| 16336 | (goto-char (point-min)) | |
| 16337 | (let ((case-fold-search t) | |
| 16338 | (re (org-re-property property nil (not value) value))) | |
| 16339 | (catch 'exit | |
| 16340 | (while (re-search-forward re nil t) | |
| 16341 | (when (if value (org-at-property-p) | |
| 16342 | (org-entry-get (point) property nil t)) | |
| 16343 | (throw 'exit (progn (org-back-to-heading t) (point))))))))) | |
| 16344 | ||
| 16345 | (defun org-delete-property (property) | |
| 16346 | "In the current entry, delete PROPERTY." | |
| 16347 | (interactive | |
| 16348 | (let* ((completion-ignore-case t) | |
| 16349 | (cat (org-entry-get (point) "CATEGORY")) | |
| 16350 | (props0 (org-entry-properties nil 'standard)) | |
| 16351 | (props (if cat props0 | |
| 16352 | (delete `("CATEGORY" . ,(org-get-category)) props0))) | |
| 16353 | (prop (if (< 1 (length props)) | |
| 16354 | (completing-read "Property: " props nil t) | |
| 16355 | (caar props)))) | |
| 16356 | (list prop))) | |
| 16357 | (if (not property) | |
| 16358 | (message "No property to delete in this entry") | |
| 16359 | (org-entry-delete nil property) | |
| 16360 | (message "Property \"%s\" deleted" property))) | |
| 16361 | ||
| 16362 | (defun org-delete-property-globally (property) | |
| 16363 | "Remove PROPERTY globally, from all entries. | |
| 16364 | This function ignores narrowing, if any." | |
| 16365 | (interactive | |
| 16366 | (let* ((completion-ignore-case t) | |
| 16367 | (prop (completing-read | |
| 16368 | "Globally remove property: " | |
| 16369 | (mapcar #'list (org-buffer-property-keys))))) | |
| 16370 | (list prop))) | |
| 16371 | (org-with-wide-buffer | |
| 16372 | (goto-char (point-min)) | |
| 16373 | (let ((count 0) | |
| 16374 | (re (org-re-property (concat (regexp-quote property) "\\+?") t t))) | |
| 16375 | (while (re-search-forward re nil t) | |
| 16376 | (when (org-entry-delete (point) property) (cl-incf count))) | |
| 16377 | (message "Property \"%s\" removed from %d entries" property count)))) | |
| 16378 | ||
| 16379 | (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el | |
| 16380 | ||
| 16381 | (defun org-compute-property-at-point () | |
| 16382 | "Compute the property at point. | |
| 16383 | This looks for an enclosing column format, extracts the operator and | |
| 16384 | then applies it to the property in the column format's scope." | |
| 16385 | (interactive) | |
| 16386 | (unless (org-at-property-p) | |
| 16387 | (user-error "Not at a property")) | |
| 16388 | (let ((prop (match-string-no-properties 2))) | |
| 16389 | (org-columns-get-format-and-top-level) | |
| 16390 | (unless (nth 3 (assoc-string prop org-columns-current-fmt-compiled t)) | |
| 16391 | (user-error "No operator defined for property %s" prop)) | |
| 16392 | (org-columns-compute prop))) | |
| 16393 | ||
| 16394 | (defvar org-property-allowed-value-functions nil | |
| 16395 | "Hook for functions supplying allowed values for a specific property. | |
| 16396 | The functions must take a single argument, the name of the property, and | |
| 16397 | return a flat list of allowed values. If \":ETC\" is one of | |
| 16398 | the values, this means that these values are intended as defaults for | |
| 16399 | completion, but that other values should be allowed too. | |
| 16400 | The functions must return nil if they are not responsible for this | |
| 16401 | property.") | |
| 16402 | ||
| 16403 | (defun org-property-get-allowed-values (pom property &optional table) | |
| 16404 | "Get allowed values for the property PROPERTY. | |
| 16405 | When TABLE is non-nil, return an alist that can directly be used for | |
| 16406 | completion." | |
| 16407 | (let (vals) | |
| 16408 | (cond | |
| 16409 | ((equal property "TODO") | |
| 16410 | (setq vals (org-with-point-at pom | |
| 16411 | (append org-todo-keywords-1 '(""))))) | |
| 16412 | ((equal property "PRIORITY") | |
| 16413 | (let ((n org-lowest-priority)) | |
| 16414 | (while (>= n org-highest-priority) | |
| 16415 | (push (char-to-string n) vals) | |
| 16416 | (setq n (1- n))))) | |
| 16417 | ((equal property "CATEGORY")) | |
| 16418 | ((member property org-special-properties)) | |
| 16419 | ((setq vals (run-hook-with-args-until-success | |
| 16420 | 'org-property-allowed-value-functions property))) | |
| 16421 | (t | |
| 16422 | (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) | |
| 16423 | (when (and vals (string-match "\\S-" vals)) | |
| 16424 | (setq vals (car (read-from-string (concat "(" vals ")")))) | |
| 16425 | (setq vals (mapcar (lambda (x) | |
| 16426 | (cond ((stringp x) x) | |
| 16427 | ((numberp x) (number-to-string x)) | |
| 16428 | ((symbolp x) (symbol-name x)) | |
| 16429 | (t "???"))) | |
| 16430 | vals))))) | |
| 16431 | (when (member ":ETC" vals) | |
| 16432 | (setq vals (remove ":ETC" vals)) | |
| 16433 | (org-add-props (car vals) '(org-unrestricted t))) | |
| 16434 | (if table (mapcar 'list vals) vals))) | |
| 16435 | ||
| 16436 | (defun org-property-previous-allowed-value (&optional _previous) | |
| 16437 | "Switch to the next allowed value for this property." | |
| 16438 | (interactive) | |
| 16439 | (org-property-next-allowed-value t)) | |
| 16440 | ||
| 16441 | (defun org-property-next-allowed-value (&optional previous) | |
| 16442 | "Switch to the next allowed value for this property." | |
| 16443 | (interactive) | |
| 16444 | (unless (org-at-property-p) | |
| 16445 | (user-error "Not at a property")) | |
| 16446 | (let* ((prop (car (save-match-data (org-split-string (match-string 1) ":")))) | |
| 16447 | (key (match-string 2)) | |
| 16448 | (value (match-string 3)) | |
| 16449 | (allowed (or (org-property-get-allowed-values (point) key) | |
| 16450 | (and (member value '("[ ]" "[-]" "[X]")) | |
| 16451 | '("[ ]" "[X]")))) | |
| 16452 | (heading (save-match-data (nth 4 (org-heading-components)))) | |
| 16453 | nval) | |
| 16454 | (unless allowed | |
| 16455 | (user-error "Allowed values for this property have not been defined")) | |
| 16456 | (when previous (setq allowed (reverse allowed))) | |
| 16457 | (when (member value allowed) | |
| 16458 | (setq nval (car (cdr (member value allowed))))) | |
| 16459 | (setq nval (or nval (car allowed))) | |
| 16460 | (when (equal nval value) | |
| 16461 | (user-error "Only one allowed value for this property")) | |
| 16462 | (org-at-property-p) | |
| 16463 | (replace-match (concat " :" key ": " nval) t t) | |
| 16464 | (org-indent-line) | |
| 16465 | (beginning-of-line 1) | |
| 16466 | (skip-chars-forward " \t") | |
| 16467 | (when (equal prop org-effort-property) | |
| 16468 | (org-refresh-property | |
| 16469 | '((effort . identity) | |
| 16470 | (effort-minutes . org-duration-to-minutes)) | |
| 16471 | nval) | |
| 16472 | (when (string= org-clock-current-task heading) | |
| 16473 | (setq org-clock-effort nval) | |
| 16474 | (org-clock-update-mode-line))) | |
| 16475 | (run-hook-with-args 'org-property-changed-functions key nval))) | |
| 16476 | ||
| 16477 | (defun org-find-olp (path &optional this-buffer) | |
| 16478 | "Return a marker pointing to the entry at outline path OLP. | |
| 16479 | If anything goes wrong, throw an error. | |
| 16480 | You can wrap this call to catch the error like this: | |
| 16481 | ||
| 16482 | (condition-case msg | |
| 16483 | (org-mobile-locate-entry (match-string 4)) | |
| 16484 | (error (nth 1 msg))) | |
| 16485 | ||
| 16486 | The return value will then be either a string with the error message, | |
| 16487 | or a marker if everything is OK. | |
| 16488 | ||
| 16489 | If THIS-BUFFER is set, the outline path does not contain a file, | |
| 16490 | only headings." | |
| 16491 | (let* ((file (if this-buffer buffer-file-name (pop path))) | |
| 16492 | (buffer (if this-buffer (current-buffer) (find-file-noselect file))) | |
| 16493 | (level 1) | |
| 16494 | (lmin 1) | |
| 16495 | (lmax 1) | |
| 16496 | end found flevel) | |
| 16497 | (unless buffer (error "File not found :%s" file)) | |
| 16498 | (with-current-buffer buffer | |
| 16499 | (unless (derived-mode-p 'org-mode) | |
| 16500 | (error "Buffer %s needs to be in Org mode" buffer)) | |
| 16501 | (org-with-wide-buffer | |
| 16502 | (goto-char (point-min)) | |
| 16503 | (dolist (heading path) | |
| 16504 | (let ((re (format org-complex-heading-regexp-format | |
| 16505 | (regexp-quote heading))) | |
| 16506 | (cnt 0)) | |
| 16507 | (while (re-search-forward re end t) | |
| 16508 | (setq level (- (match-end 1) (match-beginning 1))) | |
| 16509 | (when (and (>= level lmin) (<= level lmax)) | |
| 16510 | (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) | |
| 16511 | (when (= cnt 0) | |
| 16512 | (error "Heading not found on level %d: %s" lmax heading)) | |
| 16513 | (when (> cnt 1) | |
| 16514 | (error "Heading not unique on level %d: %s" lmax heading)) | |
| 16515 | (goto-char found) | |
| 16516 | (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) | |
| 16517 | (setq end (save-excursion (org-end-of-subtree t t))))) | |
| 16518 | (when (org-at-heading-p) | |
| 16519 | (point-marker)))))) | |
| 16520 | ||
| 16521 | (defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) | |
| 16522 | "Find node HEADING in BUFFER. | |
| 16523 | Return a marker to the heading if it was found, or nil if not. | |
| 16524 | If POS-ONLY is set, return just the position instead of a marker. | |
| 16525 | ||
| 16526 | The heading text must match exact, but it may have a TODO keyword, | |
| 16527 | a priority cookie and tags in the standard locations." | |
| 16528 | (with-current-buffer (or buffer (current-buffer)) | |
| 16529 | (org-with-wide-buffer | |
| 16530 | (goto-char (point-min)) | |
| 16531 | (let (case-fold-search) | |
| 16532 | (when (re-search-forward | |
| 16533 | (format org-complex-heading-regexp-format | |
| 16534 | (regexp-quote heading)) nil t) | |
| 16535 | (if pos-only | |
| 16536 | (match-beginning 0) | |
| 16537 | (move-marker (make-marker) (match-beginning 0)))))))) | |
| 16538 | ||
| 16539 | (defun org-find-exact-heading-in-directory (heading &optional dir) | |
| 16540 | "Find Org node headline HEADING in all \".org\" files in directory DIR. | |
| 16541 | When the target headline is found, return a marker to this location." | |
| 16542 | (let ((files (directory-files (or dir default-directory) | |
| 16543 | t "\\`[^.#].*\\.org\\'")) | |
| 16544 | visiting m buffer) | |
| 16545 | (catch 'found | |
| 16546 | (dolist (file files) | |
| 16547 | (message "trying %s" file) | |
| 16548 | (setq visiting (org-find-base-buffer-visiting file)) | |
| 16549 | (setq buffer (or visiting (find-file-noselect file))) | |
| 16550 | (setq m (org-find-exact-headline-in-buffer | |
| 16551 | heading buffer)) | |
| 16552 | (when (and (not m) (not visiting)) (kill-buffer buffer)) | |
| 16553 | (and m (throw 'found m)))))) | |
| 16554 | ||
| 16555 | (defun org-find-entry-with-id (ident) | |
| 16556 | "Locate the entry that contains the ID property with exact value IDENT. | |
| 16557 | IDENT can be a string, a symbol or a number, this function will search for | |
| 16558 | the string representation of it. | |
| 16559 | Return the position where this entry starts, or nil if there is no such entry." | |
| 16560 | (interactive "sID: ") | |
| 16561 | (let ((id (cond | |
| 16562 | ((stringp ident) ident) | |
| 16563 | ((symbolp ident) (symbol-name ident)) | |
| 16564 | ((numberp ident) (number-to-string ident)) | |
| 16565 | (t (error "IDENT %s must be a string, symbol or number" ident))))) | |
| 16566 | (org-with-wide-buffer (org-find-property "ID" id)))) | |
| 16567 | ||
| 16568 | ;;;; Timestamps | |
| 16569 | ||
| 16570 | (defvar org-last-changed-timestamp nil) | |
| 16571 | (defvar org-last-inserted-timestamp nil | |
| 16572 | "The last time stamp inserted with `org-insert-time-stamp'.") | |
| 16573 | ||
| 16574 | (defun org-time-stamp (arg &optional inactive) | |
| 16575 | "Prompt for a date/time and insert a time stamp. | |
| 16576 | ||
| 16577 | If the user specifies a time like HH:MM or if this command is | |
| 16578 | called with at least one prefix argument, the time stamp contains | |
| 16579 | the date and the time. Otherwise, only the date is included. | |
| 16580 | ||
| 16581 | All parts of a date not specified by the user are filled in from | |
| 16582 | the timestamp at point, if any, or the current date/time | |
| 16583 | otherwise. | |
| 16584 | ||
| 16585 | If there is already a timestamp at the cursor, it is replaced. | |
| 16586 | ||
| 16587 | With two universal prefix arguments, insert an active timestamp | |
| 16588 | with the current time without prompting the user. | |
| 16589 | ||
| 16590 | When called from lisp, the timestamp is inactive if INACTIVE is | |
| 16591 | non-nil." | |
| 16592 | (interactive "P") | |
| 16593 | (let* ((ts (cond | |
| 16594 | ((org-at-date-range-p t) | |
| 16595 | (match-string (if (< (point) (- (match-beginning 2) 2)) 1 2))) | |
| 16596 | ((org-at-timestamp-p 'lax) (match-string 0)))) | |
| 16597 | ;; Default time is either the timestamp at point or today. | |
| 16598 | ;; When entering a range, only the range start is considered. | |
| 16599 | (default-time (if (not ts) (current-time) | |
| 16600 | (apply #'encode-time (org-parse-time-string ts)))) | |
| 16601 | (default-input (and ts (org-get-compact-tod ts))) | |
| 16602 | (repeater (and ts | |
| 16603 | (string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts) | |
| 16604 | (match-string 0 ts))) | |
| 16605 | org-time-was-given | |
| 16606 | org-end-time-was-given | |
| 16607 | (time | |
| 16608 | (and (if (equal arg '(16)) (current-time) | |
| 16609 | ;; Preserve `this-command' and `last-command'. | |
| 16610 | (let ((this-command this-command) | |
| 16611 | (last-command last-command)) | |
| 16612 | (org-read-date | |
| 16613 | arg 'totime nil nil default-time default-input | |
| 16614 | inactive)))))) | |
| 16615 | (cond | |
| 16616 | ((and ts | |
| 16617 | (memq last-command '(org-time-stamp org-time-stamp-inactive)) | |
| 16618 | (memq this-command '(org-time-stamp org-time-stamp-inactive))) | |
| 16619 | (insert "--") | |
| 16620 | (org-insert-time-stamp time (or org-time-was-given arg) inactive)) | |
| 16621 | (ts | |
| 16622 | ;; Make sure we're on a timestamp. When in the middle of a date | |
| 16623 | ;; range, move arbitrarily to range end. | |
| 16624 | (unless (org-at-timestamp-p 'lax) | |
| 16625 | (skip-chars-forward "-") | |
| 16626 | (org-at-timestamp-p 'lax)) | |
| 16627 | (replace-match "") | |
| 16628 | (setq org-last-changed-timestamp | |
| 16629 | (org-insert-time-stamp | |
| 16630 | time (or org-time-was-given arg) | |
| 16631 | inactive nil nil (list org-end-time-was-given))) | |
| 16632 | (when repeater | |
| 16633 | (backward-char) | |
| 16634 | (insert " " repeater) | |
| 16635 | (setq org-last-changed-timestamp | |
| 16636 | (concat (substring org-last-inserted-timestamp 0 -1) | |
| 16637 | " " repeater ">"))) | |
| 16638 | (message "Timestamp updated")) | |
| 16639 | ((equal arg '(16)) (org-insert-time-stamp time t inactive)) | |
| 16640 | (t (org-insert-time-stamp | |
| 16641 | time (or org-time-was-given arg) inactive nil nil | |
| 16642 | (list org-end-time-was-given)))))) | |
| 16643 | ||
| 16644 | ;; FIXME: can we use this for something else, like computing time differences? | |
| 16645 | (defun org-get-compact-tod (s) | |
| 16646 | (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s) | |
| 16647 | (let* ((t1 (match-string 1 s)) | |
| 16648 | (h1 (string-to-number (match-string 2 s))) | |
| 16649 | (m1 (string-to-number (match-string 3 s))) | |
| 16650 | (t2 (and (match-end 4) (match-string 5 s))) | |
| 16651 | (h2 (and t2 (string-to-number (match-string 6 s)))) | |
| 16652 | (m2 (and t2 (string-to-number (match-string 7 s)))) | |
| 16653 | dh dm) | |
| 16654 | (if (not t2) | |
| 16655 | t1 | |
| 16656 | (setq dh (- h2 h1) dm (- m2 m1)) | |
| 16657 | (when (< dm 0) (setq dm (+ dm 60) dh (1- dh))) | |
| 16658 | (concat t1 "+" (number-to-string dh) | |
| 16659 | (and (/= 0 dm) (format ":%02d" dm))))))) | |
| 16660 | ||
| 16661 | (defun org-time-stamp-inactive (&optional arg) | |
| 16662 | "Insert an inactive time stamp. | |
| 16663 | ||
| 16664 | An inactive time stamp is enclosed in square brackets instead of angle | |
| 16665 | brackets. It is inactive in the sense that it does not trigger agenda entries, | |
| 16666 | does not link to the calendar and cannot be changed with the S-cursor keys. | |
| 16667 | So these are more for recording a certain time/date. | |
| 16668 | ||
| 16669 | If the user specifies a time like HH:MM or if this command is called with | |
| 16670 | at least one prefix argument, the time stamp contains the date and the time. | |
| 16671 | Otherwise, only the date is included. | |
| 16672 | ||
| 16673 | When called with two universal prefix arguments, insert an active time stamp | |
| 16674 | with the current time without prompting the user." | |
| 16675 | (interactive "P") | |
| 16676 | (org-time-stamp arg 'inactive)) | |
| 16677 | ||
| 16678 | (defvar org-date-ovl (make-overlay 1 1)) | |
| 16679 | (overlay-put org-date-ovl 'face 'org-date-selected) | |
| 16680 | (delete-overlay org-date-ovl) | |
| 16681 | ||
| 16682 | (defvar org-ans1) ; dynamically scoped parameter | |
| 16683 | (defvar org-ans2) ; dynamically scoped parameter | |
| 16684 | ||
| 16685 | (defvar org-plain-time-of-day-regexp) ; defined below | |
| 16686 | ||
| 16687 | (defvar org-overriding-default-time nil) ; dynamically scoped | |
| 16688 | (defvar org-read-date-overlay nil) | |
| 16689 | (defvar org-dcst nil) ; dynamically scoped | |
| 16690 | (defvar org-read-date-history nil) | |
| 16691 | (defvar org-read-date-final-answer nil) | |
| 16692 | (defvar org-read-date-analyze-futurep nil) | |
| 16693 | (defvar org-read-date-analyze-forced-year nil) | |
| 16694 | (defvar org-read-date-inactive) | |
| 16695 | ||
| 16696 | (defvar org-read-date-minibuffer-local-map | |
| 16697 | (let* ((map (make-sparse-keymap))) | |
| 16698 | (set-keymap-parent map minibuffer-local-map) | |
| 16699 | (org-defkey map (kbd ".") | |
| 16700 | (lambda () (interactive) | |
| 16701 | ;; Are we at the beginning of the prompt? | |
| 16702 | (if (looking-back "^[^:]+: " | |
| 16703 | (let ((inhibit-field-text-motion t)) | |
| 16704 | (line-beginning-position))) | |
| 16705 | (org-eval-in-calendar '(calendar-goto-today)) | |
| 16706 | (insert ".")))) | |
| 16707 | (org-defkey map (kbd "C-.") | |
| 16708 | (lambda () (interactive) | |
| 16709 | (org-eval-in-calendar '(calendar-goto-today)))) | |
| 16710 | (org-defkey map [(meta shift left)] | |
| 16711 | (lambda () (interactive) | |
| 16712 | (org-eval-in-calendar '(calendar-backward-month 1)))) | |
| 16713 | (org-defkey map [(meta shift right)] | |
| 16714 | (lambda () (interactive) | |
| 16715 | (org-eval-in-calendar '(calendar-forward-month 1)))) | |
| 16716 | (org-defkey map [(meta shift up)] | |
| 16717 | (lambda () (interactive) | |
| 16718 | (org-eval-in-calendar '(calendar-backward-year 1)))) | |
| 16719 | (org-defkey map [(meta shift down)] | |
| 16720 | (lambda () (interactive) | |
| 16721 | (org-eval-in-calendar '(calendar-forward-year 1)))) | |
| 16722 | (org-defkey map [?\e (shift left)] | |
| 16723 | (lambda () (interactive) | |
| 16724 | (org-eval-in-calendar '(calendar-backward-month 1)))) | |
| 16725 | (org-defkey map [?\e (shift right)] | |
| 16726 | (lambda () (interactive) | |
| 16727 | (org-eval-in-calendar '(calendar-forward-month 1)))) | |
| 16728 | (org-defkey map [?\e (shift up)] | |
| 16729 | (lambda () (interactive) | |
| 16730 | (org-eval-in-calendar '(calendar-backward-year 1)))) | |
| 16731 | (org-defkey map [?\e (shift down)] | |
| 16732 | (lambda () (interactive) | |
| 16733 | (org-eval-in-calendar '(calendar-forward-year 1)))) | |
| 16734 | (org-defkey map [(shift up)] | |
| 16735 | (lambda () (interactive) | |
| 16736 | (org-eval-in-calendar '(calendar-backward-week 1)))) | |
| 16737 | (org-defkey map [(shift down)] | |
| 16738 | (lambda () (interactive) | |
| 16739 | (org-eval-in-calendar '(calendar-forward-week 1)))) | |
| 16740 | (org-defkey map [(shift left)] | |
| 16741 | (lambda () (interactive) | |
| 16742 | (org-eval-in-calendar '(calendar-backward-day 1)))) | |
| 16743 | (org-defkey map [(shift right)] | |
| 16744 | (lambda () (interactive) | |
| 16745 | (org-eval-in-calendar '(calendar-forward-day 1)))) | |
| 16746 | (org-defkey map "!" | |
| 16747 | (lambda () (interactive) | |
| 16748 | (org-eval-in-calendar '(diary-view-entries)) | |
| 16749 | (message ""))) | |
| 16750 | (org-defkey map ">" | |
| 16751 | (lambda () (interactive) | |
| 16752 | (org-eval-in-calendar '(calendar-scroll-left 1)))) | |
| 16753 | (org-defkey map "<" | |
| 16754 | (lambda () (interactive) | |
| 16755 | (org-eval-in-calendar '(calendar-scroll-right 1)))) | |
| 16756 | (org-defkey map "\C-v" | |
| 16757 | (lambda () (interactive) | |
| 16758 | (org-eval-in-calendar | |
| 16759 | '(calendar-scroll-left-three-months 1)))) | |
| 16760 | (org-defkey map "\M-v" | |
| 16761 | (lambda () (interactive) | |
| 16762 | (org-eval-in-calendar | |
| 16763 | '(calendar-scroll-right-three-months 1)))) | |
| 16764 | map) | |
| 16765 | "Keymap for minibuffer commands when using `org-read-date'.") | |
| 16766 | ||
| 16767 | (defvar org-def) | |
| 16768 | (defvar org-defdecode) | |
| 16769 | (defvar org-with-time) | |
| 16770 | ||
| 16771 | (defvar calendar-setup) ; Dynamically scoped. | |
| 16772 | (defun org-read-date (&optional with-time to-time from-string prompt | |
| 16773 | default-time default-input inactive) | |
| 16774 | "Read a date, possibly a time, and make things smooth for the user. | |
| 16775 | The prompt will suggest to enter an ISO date, but you can also enter anything | |
| 16776 | which will at least partially be understood by `parse-time-string'. | |
| 16777 | Unrecognized parts of the date will default to the current day, month, year, | |
| 16778 | hour and minute. If this command is called to replace a timestamp at point, | |
| 16779 | or to enter the second timestamp of a range, the default time is taken | |
| 16780 | from the existing stamp. Furthermore, the command prefers the future, | |
| 16781 | so if you are giving a date where the year is not given, and the day-month | |
| 16782 | combination is already past in the current year, it will assume you | |
| 16783 | mean next year. For details, see the manual. A few examples: | |
| 16784 | ||
| 16785 | 3-2-5 --> 2003-02-05 | |
| 16786 | feb 15 --> currentyear-02-15 | |
| 16787 | 2/15 --> currentyear-02-15 | |
| 16788 | sep 12 9 --> 2009-09-12 | |
| 16789 | 12:45 --> today 12:45 | |
| 16790 | 22 sept 0:34 --> currentyear-09-22 0:34 | |
| 16791 | 12 --> currentyear-currentmonth-12 | |
| 16792 | Fri --> nearest Friday after today | |
| 16793 | -Tue --> last Tuesday | |
| 16794 | etc. | |
| 16795 | ||
| 16796 | Furthermore you can specify a relative date by giving, as the *first* thing | |
| 16797 | in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate | |
| 16798 | change in days weeks, months, years. | |
| 16799 | With a single plus or minus, the date is relative to today. With a double | |
| 16800 | plus or minus, it is relative to the date in DEFAULT-TIME. E.g. | |
| 16801 | +4d --> four days from today | |
| 16802 | +4 --> same as above | |
| 16803 | +2w --> two weeks from today | |
| 16804 | ++5 --> five days from default date | |
| 16805 | ||
| 16806 | The function understands only English month and weekday abbreviations. | |
| 16807 | ||
| 16808 | While prompting, a calendar is popped up - you can also select the | |
| 16809 | date with the mouse (button 1). The calendar shows a period of three | |
| 16810 | months. To scroll it to other months, use the keys `>' and `<'. | |
| 16811 | If you don't like the calendar, turn it off with | |
| 16812 | (setq org-read-date-popup-calendar nil) | |
| 16813 | ||
| 16814 | With optional argument TO-TIME, the date will immediately be converted | |
| 16815 | to an internal time. | |
| 16816 | With an optional argument WITH-TIME, the prompt will suggest to | |
| 16817 | also insert a time. Note that when WITH-TIME is not set, you can | |
| 16818 | still enter a time, and this function will inform the calling routine | |
| 16819 | about this change. The calling routine may then choose to change the | |
| 16820 | format used to insert the time stamp into the buffer to include the time. | |
| 16821 | With optional argument FROM-STRING, read from this string instead from | |
| 16822 | the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is | |
| 16823 | the time/date that is used for everything that is not specified by the | |
| 16824 | user." | |
| 16825 | (require 'parse-time) | |
| 16826 | (let* ((org-with-time with-time) | |
| 16827 | (org-time-stamp-rounding-minutes | |
| 16828 | (if (equal org-with-time '(16)) | |
| 16829 | '(0 0) | |
| 16830 | org-time-stamp-rounding-minutes)) | |
| 16831 | (org-dcst org-display-custom-times) | |
| 16832 | (ct (org-current-time)) | |
| 16833 | (org-def (or org-overriding-default-time default-time ct)) | |
| 16834 | (org-defdecode (decode-time org-def)) | |
| 16835 | (cur-frame (selected-frame)) | |
| 16836 | (mouse-autoselect-window nil) ; Don't let the mouse jump | |
| 16837 | (calendar-setup | |
| 16838 | (and (eq calendar-setup 'calendar-only) 'calendar-only)) | |
| 16839 | (calendar-move-hook nil) | |
| 16840 | (calendar-view-diary-initially-flag nil) | |
| 16841 | (calendar-view-holidays-initially-flag nil) | |
| 16842 | ans (org-ans0 "") org-ans1 org-ans2 final cal-frame) | |
| 16843 | ;; Rationalize `org-def' and `org-defdecode', if required. | |
| 16844 | (when (< (nth 2 org-defdecode) org-extend-today-until) | |
| 16845 | (setf (nth 2 org-defdecode) -1) | |
| 16846 | (setf (nth 1 org-defdecode) 59) | |
| 16847 | (setq org-def (apply #'encode-time org-defdecode)) | |
| 16848 | (setq org-defdecode (decode-time org-def))) | |
| 16849 | (let* ((timestr (format-time-string | |
| 16850 | (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") | |
| 16851 | org-def)) | |
| 16852 | (prompt (concat (if prompt (concat prompt " ") "") | |
| 16853 | (format "Date+time [%s]: " timestr)))) | |
| 16854 | (cond | |
| 16855 | (from-string (setq ans from-string)) | |
| 16856 | (org-read-date-popup-calendar | |
| 16857 | (save-excursion | |
| 16858 | (save-window-excursion | |
| 16859 | (calendar) | |
| 16860 | (when (eq calendar-setup 'calendar-only) | |
| 16861 | (setq cal-frame | |
| 16862 | (window-frame (get-buffer-window "*Calendar*" 'visible))) | |
| 16863 | (select-frame cal-frame)) | |
| 16864 | (org-eval-in-calendar '(setq cursor-type nil) t) | |
| 16865 | (unwind-protect | |
| 16866 | (progn | |
| 16867 | (calendar-forward-day (- (time-to-days org-def) | |
| 16868 | (calendar-absolute-from-gregorian | |
| 16869 | (calendar-current-date)))) | |
| 16870 | (org-eval-in-calendar nil t) | |
| 16871 | (let* ((old-map (current-local-map)) | |
| 16872 | (map (copy-keymap calendar-mode-map)) | |
| 16873 | (minibuffer-local-map | |
| 16874 | (copy-keymap org-read-date-minibuffer-local-map))) | |
| 16875 | (org-defkey map (kbd "RET") 'org-calendar-select) | |
| 16876 | (org-defkey map [mouse-1] 'org-calendar-select-mouse) | |
| 16877 | (org-defkey map [mouse-2] 'org-calendar-select-mouse) | |
| 16878 | (unwind-protect | |
| 16879 | (progn | |
| 16880 | (use-local-map map) | |
| 16881 | (setq org-read-date-inactive inactive) | |
| 16882 | (add-hook 'post-command-hook 'org-read-date-display) | |
| 16883 | (setq org-ans0 | |
| 16884 | (read-string prompt | |
| 16885 | default-input | |
| 16886 | 'org-read-date-history | |
| 16887 | nil)) | |
| 16888 | ;; org-ans0: from prompt | |
| 16889 | ;; org-ans1: from mouse click | |
| 16890 | ;; org-ans2: from calendar motion | |
| 16891 | (setq ans | |
| 16892 | (concat org-ans0 " " (or org-ans1 org-ans2)))) | |
| 16893 | (remove-hook 'post-command-hook 'org-read-date-display) | |
| 16894 | (use-local-map old-map) | |
| 16895 | (when org-read-date-overlay | |
| 16896 | (delete-overlay org-read-date-overlay) | |
| 16897 | (setq org-read-date-overlay nil))))) | |
| 16898 | (bury-buffer "*Calendar*") | |
| 16899 | (when cal-frame | |
| 16900 | (delete-frame cal-frame) | |
| 16901 | (select-frame-set-input-focus cur-frame)))))) | |
| 16902 | ||
| 16903 | (t ; Naked prompt only | |
| 16904 | (unwind-protect | |
| 16905 | (setq ans (read-string prompt default-input | |
| 16906 | 'org-read-date-history timestr)) | |
| 16907 | (when org-read-date-overlay | |
| 16908 | (delete-overlay org-read-date-overlay) | |
| 16909 | (setq org-read-date-overlay nil)))))) | |
| 16910 | ||
| 16911 | (setq final (org-read-date-analyze ans org-def org-defdecode)) | |
| 16912 | ||
| 16913 | (when org-read-date-analyze-forced-year | |
| 16914 | (message "Year was forced into %s" | |
| 16915 | (if org-read-date-force-compatible-dates | |
| 16916 | "compatible range (1970-2037)" | |
| 16917 | "range representable on this machine")) | |
| 16918 | (ding)) | |
| 16919 | ||
| 16920 | ;; One round trip to get rid of 34th of August and stuff like that.... | |
| 16921 | (setq final (decode-time (apply 'encode-time final))) | |
| 16922 | ||
| 16923 | (setq org-read-date-final-answer ans) | |
| 16924 | ||
| 16925 | (if to-time | |
| 16926 | (apply 'encode-time final) | |
| 16927 | (if (and (boundp 'org-time-was-given) org-time-was-given) | |
| 16928 | (format "%04d-%02d-%02d %02d:%02d" | |
| 16929 | (nth 5 final) (nth 4 final) (nth 3 final) | |
| 16930 | (nth 2 final) (nth 1 final)) | |
| 16931 | (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) | |
| 16932 | ||
| 16933 | (defun org-read-date-display () | |
| 16934 | "Display the current date prompt interpretation in the minibuffer." | |
| 16935 | (when org-read-date-display-live | |
| 16936 | (when org-read-date-overlay | |
| 16937 | (delete-overlay org-read-date-overlay)) | |
| 16938 | (when (minibufferp (current-buffer)) | |
| 16939 | (save-excursion | |
| 16940 | (end-of-line 1) | |
| 16941 | (while (not (equal (buffer-substring | |
| 16942 | (max (point-min) (- (point) 4)) (point)) | |
| 16943 | " ")) | |
| 16944 | (insert " "))) | |
| 16945 | (let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) | |
| 16946 | " " (or org-ans1 org-ans2))) | |
| 16947 | (org-end-time-was-given nil) | |
| 16948 | (f (org-read-date-analyze ans org-def org-defdecode)) | |
| 16949 | (fmts (if org-dcst | |
| 16950 | org-time-stamp-custom-formats | |
| 16951 | org-time-stamp-formats)) | |
| 16952 | (fmt (if (or org-with-time | |
| 16953 | (and (boundp 'org-time-was-given) org-time-was-given)) | |
| 16954 | (cdr fmts) | |
| 16955 | (car fmts))) | |
| 16956 | (txt (format-time-string fmt (apply 'encode-time f))) | |
| 16957 | (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt)) | |
| 16958 | (txt (concat "=> " txt))) | |
| 16959 | (when (and org-end-time-was-given | |
| 16960 | (string-match org-plain-time-of-day-regexp txt)) | |
| 16961 | (setq txt (concat (substring txt 0 (match-end 0)) "-" | |
| 16962 | org-end-time-was-given | |
| 16963 | (substring txt (match-end 0))))) | |
| 16964 | (when org-read-date-analyze-futurep | |
| 16965 | (setq txt (concat txt " (=>F)"))) | |
| 16966 | (setq org-read-date-overlay | |
| 16967 | (make-overlay (1- (point-at-eol)) (point-at-eol))) | |
| 16968 | (org-overlay-display org-read-date-overlay txt 'secondary-selection))))) | |
| 16969 | ||
| 16970 | (defun org-read-date-analyze (ans def defdecode) | |
| 16971 | "Analyze the combined answer of the date prompt." | |
| 16972 | ;; FIXME: cleanup and comment | |
| 16973 | ;; Pass `current-time' result to `decode-time' (instead of calling | |
| 16974 | ;; without arguments) so that only `current-time' has to be | |
| 16975 | ;; overridden in tests. | |
| 16976 | (let ((org-def def) | |
| 16977 | (org-defdecode defdecode) | |
| 16978 | (nowdecode (decode-time (current-time))) | |
| 16979 | delta deltan deltaw deltadef year month day | |
| 16980 | hour minute second wday pm h2 m2 tl wday1 | |
| 16981 | iso-year iso-weekday iso-week iso-date futurep kill-year) | |
| 16982 | (setq org-read-date-analyze-futurep nil | |
| 16983 | org-read-date-analyze-forced-year nil) | |
| 16984 | (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) | |
| 16985 | (setq ans "+0")) | |
| 16986 | ||
| 16987 | (when (setq delta (org-read-date-get-relative ans (current-time) org-def)) | |
| 16988 | (setq ans (replace-match "" t t ans) | |
| 16989 | deltan (car delta) | |
| 16990 | deltaw (nth 1 delta) | |
| 16991 | deltadef (nth 2 delta))) | |
| 16992 | ||
| 16993 | ;; Check if there is an iso week date in there. If yes, store the | |
| 16994 | ;; info and postpone interpreting it until the rest of the parsing | |
| 16995 | ;; is done. | |
| 16996 | (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) | |
| 16997 | (setq iso-year (when (match-end 1) | |
| 16998 | (org-small-year-to-year | |
| 16999 | (string-to-number (match-string 1 ans)))) | |
| 17000 | iso-weekday (when (match-end 3) | |
| 17001 | (string-to-number (match-string 3 ans))) | |
| 17002 | iso-week (string-to-number (match-string 2 ans))) | |
| 17003 | (setq ans (replace-match "" t t ans))) | |
| 17004 | ||
| 17005 | ;; Help matching ISO dates with single digit month or day, like 2006-8-11. | |
| 17006 | (when (string-match | |
| 17007 | "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) | |
| 17008 | (setq year (if (match-end 2) | |
| 17009 | (string-to-number (match-string 2 ans)) | |
| 17010 | (progn (setq kill-year t) | |
| 17011 | (string-to-number (format-time-string "%Y")))) | |
| 17012 | month (string-to-number (match-string 3 ans)) | |
| 17013 | day (string-to-number (match-string 4 ans))) | |
| 17014 | (setq year (org-small-year-to-year year)) | |
| 17015 | (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) | |
| 17016 | t nil ans))) | |
| 17017 | ||
| 17018 | ;; Help matching dotted european dates | |
| 17019 | (when (string-match | |
| 17020 | "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\.\\( ?[1-9][0-9]\\{3\\}\\)?" ans) | |
| 17021 | (setq year (if (match-end 3) (string-to-number (match-string 3 ans)) | |
| 17022 | (setq kill-year t) | |
| 17023 | (string-to-number (format-time-string "%Y"))) | |
| 17024 | day (string-to-number (match-string 1 ans)) | |
| 17025 | month (string-to-number (match-string 2 ans)) | |
| 17026 | ans (replace-match (format "%04d-%02d-%02d" year month day) | |
| 17027 | t nil ans))) | |
| 17028 | ||
| 17029 | ;; Help matching american dates, like 5/30 or 5/30/7 | |
| 17030 | (when (string-match | |
| 17031 | "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) | |
| 17032 | (setq year (if (match-end 4) | |
| 17033 | (string-to-number (match-string 4 ans)) | |
| 17034 | (progn (setq kill-year t) | |
| 17035 | (string-to-number (format-time-string "%Y")))) | |
| 17036 | month (string-to-number (match-string 1 ans)) | |
| 17037 | day (string-to-number (match-string 2 ans))) | |
| 17038 | (setq year (org-small-year-to-year year)) | |
| 17039 | (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) | |
| 17040 | t nil ans))) | |
| 17041 | ;; Help matching am/pm times, because `parse-time-string' does not do that. | |
| 17042 | ;; If there is a time with am/pm, and *no* time without it, we convert | |
| 17043 | ;; so that matching will be successful. | |
| 17044 | (cl-loop for i from 1 to 2 do ; twice, for end time as well | |
| 17045 | (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) | |
| 17046 | (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) | |
| 17047 | (setq hour (string-to-number (match-string 1 ans)) | |
| 17048 | minute (if (match-end 3) | |
| 17049 | (string-to-number (match-string 3 ans)) | |
| 17050 | 0) | |
| 17051 | pm (equal ?p | |
| 17052 | (string-to-char (downcase (match-string 4 ans))))) | |
| 17053 | (if (and (= hour 12) (not pm)) | |
| 17054 | (setq hour 0) | |
| 17055 | (when (and pm (< hour 12)) (setq hour (+ 12 hour)))) | |
| 17056 | (setq ans (replace-match (format "%02d:%02d" hour minute) | |
| 17057 | t t ans)))) | |
| 17058 | ||
| 17059 | ;; Check if a time range is given as a duration | |
| 17060 | (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans) | |
| 17061 | (setq hour (string-to-number (match-string 1 ans)) | |
| 17062 | h2 (+ hour (string-to-number (match-string 3 ans))) | |
| 17063 | minute (string-to-number (match-string 2 ans)) | |
| 17064 | m2 (+ minute (if (match-end 5) (string-to-number | |
| 17065 | (match-string 5 ans))0))) | |
| 17066 | (when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) | |
| 17067 | (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) | |
| 17068 | t t ans))) | |
| 17069 | ||
| 17070 | ;; Check if there is a time range | |
| 17071 | (when (boundp 'org-end-time-was-given) | |
| 17072 | (setq org-time-was-given nil) | |
| 17073 | (when (and (string-match org-plain-time-of-day-regexp ans) | |
| 17074 | (match-end 8)) | |
| 17075 | (setq org-end-time-was-given (match-string 8 ans)) | |
| 17076 | (setq ans (concat (substring ans 0 (match-beginning 7)) | |
| 17077 | (substring ans (match-end 7)))))) | |
| 17078 | ||
| 17079 | (setq tl (parse-time-string ans) | |
| 17080 | day (or (nth 3 tl) (nth 3 org-defdecode)) | |
| 17081 | month | |
| 17082 | (cond ((nth 4 tl)) | |
| 17083 | ((not org-read-date-prefer-future) (nth 4 org-defdecode)) | |
| 17084 | ;; Day was specified. Make sure DAY+MONTH | |
| 17085 | ;; combination happens in the future. | |
| 17086 | ((nth 3 tl) | |
| 17087 | (setq futurep t) | |
| 17088 | (if (< day (nth 3 nowdecode)) (1+ (nth 4 nowdecode)) | |
| 17089 | (nth 4 nowdecode))) | |
| 17090 | (t (nth 4 org-defdecode))) | |
| 17091 | year | |
| 17092 | (cond ((and (not kill-year) (nth 5 tl))) | |
| 17093 | ((not org-read-date-prefer-future) (nth 5 org-defdecode)) | |
| 17094 | ;; Month was guessed in the future and is at least | |
| 17095 | ;; equal to NOWDECODE's. Fix year accordingly. | |
| 17096 | (futurep | |
| 17097 | (if (or (> month (nth 4 nowdecode)) | |
| 17098 | (>= day (nth 3 nowdecode))) | |
| 17099 | (nth 5 nowdecode) | |
| 17100 | (1+ (nth 5 nowdecode)))) | |
| 17101 | ;; Month was specified. Make sure MONTH+YEAR | |
| 17102 | ;; combination happens in the future. | |
| 17103 | ((nth 4 tl) | |
| 17104 | (setq futurep t) | |
| 17105 | (cond ((> month (nth 4 nowdecode)) (nth 5 nowdecode)) | |
| 17106 | ((< month (nth 4 nowdecode)) (1+ (nth 5 nowdecode))) | |
| 17107 | ((< day (nth 3 nowdecode)) (1+ (nth 5 nowdecode))) | |
| 17108 | (t (nth 5 nowdecode)))) | |
| 17109 | (t (nth 5 org-defdecode))) | |
| 17110 | hour (or (nth 2 tl) (nth 2 org-defdecode)) | |
| 17111 | minute (or (nth 1 tl) (nth 1 org-defdecode)) | |
| 17112 | second (or (nth 0 tl) 0) | |
| 17113 | wday (nth 6 tl)) | |
| 17114 | ||
| 17115 | (when (and (eq org-read-date-prefer-future 'time) | |
| 17116 | (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl)) | |
| 17117 | (equal day (nth 3 nowdecode)) | |
| 17118 | (equal month (nth 4 nowdecode)) | |
| 17119 | (equal year (nth 5 nowdecode)) | |
| 17120 | (nth 2 tl) | |
| 17121 | (or (< (nth 2 tl) (nth 2 nowdecode)) | |
| 17122 | (and (= (nth 2 tl) (nth 2 nowdecode)) | |
| 17123 | (nth 1 tl) | |
| 17124 | (< (nth 1 tl) (nth 1 nowdecode))))) | |
| 17125 | (setq day (1+ day) | |
| 17126 | futurep t)) | |
| 17127 | ||
| 17128 | ;; Special date definitions below | |
| 17129 | (cond | |
| 17130 | (iso-week | |
| 17131 | ;; There was an iso week | |
| 17132 | (require 'cal-iso) | |
| 17133 | (setq futurep nil) | |
| 17134 | (setq year (or iso-year year) | |
| 17135 | day (or iso-weekday wday 1) | |
| 17136 | wday nil ; to make sure that the trigger below does not match | |
| 17137 | iso-date (calendar-gregorian-from-absolute | |
| 17138 | (calendar-iso-to-absolute | |
| 17139 | (list iso-week day year)))) | |
| 17140 | ; FIXME: Should we also push ISO weeks into the future? | |
| 17141 | ; (when (and org-read-date-prefer-future | |
| 17142 | ; (not iso-year) | |
| 17143 | ; (< (calendar-absolute-from-gregorian iso-date) | |
| 17144 | ; (time-to-days (current-time)))) | |
| 17145 | ; (setq year (1+ year) | |
| 17146 | ; iso-date (calendar-gregorian-from-absolute | |
| 17147 | ; (calendar-iso-to-absolute | |
| 17148 | ; (list iso-week day year))))) | |
| 17149 | (setq month (car iso-date) | |
| 17150 | year (nth 2 iso-date) | |
| 17151 | day (nth 1 iso-date))) | |
| 17152 | (deltan | |
| 17153 | (setq futurep nil) | |
| 17154 | (unless deltadef | |
| 17155 | ;; Pass `current-time' result to `decode-time' (instead of | |
| 17156 | ;; calling without arguments) so that only `current-time' has | |
| 17157 | ;; to be overridden in tests. | |
| 17158 | (let ((now (decode-time (current-time)))) | |
| 17159 | (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) | |
| 17160 | (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) | |
| 17161 | ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) | |
| 17162 | ((equal deltaw "m") (setq month (+ month deltan))) | |
| 17163 | ((equal deltaw "y") (setq year (+ year deltan))))) | |
| 17164 | ((and wday (not (nth 3 tl))) | |
| 17165 | ;; Weekday was given, but no day, so pick that day in the week | |
| 17166 | ;; on or after the derived date. | |
| 17167 | (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) | |
| 17168 | (unless (equal wday wday1) | |
| 17169 | (setq day (+ day (% (- wday wday1 -7) 7)))))) | |
| 17170 | (when (and (boundp 'org-time-was-given) | |
| 17171 | (nth 2 tl)) | |
| 17172 | (setq org-time-was-given t)) | |
| 17173 | (when (< year 100) (setq year (+ 2000 year))) | |
| 17174 | ;; Check of the date is representable | |
| 17175 | (if org-read-date-force-compatible-dates | |
| 17176 | (progn | |
| 17177 | (when (< year 1970) | |
| 17178 | (setq year 1970 org-read-date-analyze-forced-year t)) | |
| 17179 | (when (> year 2037) | |
| 17180 | (setq year 2037 org-read-date-analyze-forced-year t))) | |
| 17181 | (condition-case nil | |
| 17182 | (ignore (encode-time second minute hour day month year)) | |
| 17183 | (error | |
| 17184 | (setq year (nth 5 org-defdecode)) | |
| 17185 | (setq org-read-date-analyze-forced-year t)))) | |
| 17186 | (setq org-read-date-analyze-futurep futurep) | |
| 17187 | (list second minute hour day month year))) | |
| 17188 | ||
| 17189 | (defvar parse-time-weekdays) | |
| 17190 | (defun org-read-date-get-relative (s today default) | |
| 17191 | "Check string S for special relative date string. | |
| 17192 | TODAY and DEFAULT are internal times, for today and for a default. | |
| 17193 | Return shift list (N what def-flag) | |
| 17194 | WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year. | |
| 17195 | N is the number of WHATs to shift. | |
| 17196 | DEF-FLAG is t when a double ++ or -- indicates shift relative to | |
| 17197 | the DEFAULT date rather than TODAY." | |
| 17198 | (require 'parse-time) | |
| 17199 | (when (and | |
| 17200 | (string-match | |
| 17201 | (concat | |
| 17202 | "\\`[ \t]*\\([-+]\\{0,2\\}\\)" | |
| 17203 | "\\([0-9]+\\)?" | |
| 17204 | "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" | |
| 17205 | "\\([ \t]\\|$\\)") s) | |
| 17206 | (or (> (match-end 1) (match-beginning 1)) (match-end 4))) | |
| 17207 | (let* ((dir (if (> (match-end 1) (match-beginning 1)) | |
| 17208 | (string-to-char (substring (match-string 1 s) -1)) | |
| 17209 | ?+)) | |
| 17210 | (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1))))) | |
| 17211 | (n (if (match-end 2) (string-to-number (match-string 2 s)) 1)) | |
| 17212 | (what (if (match-end 3) (match-string 3 s) "d")) | |
| 17213 | (wday1 (cdr (assoc (downcase what) parse-time-weekdays))) | |
| 17214 | (date (if rel default today)) | |
| 17215 | (wday (nth 6 (decode-time date))) | |
| 17216 | delta) | |
| 17217 | (if wday1 | |
| 17218 | (progn | |
| 17219 | (setq delta (mod (+ 7 (- wday1 wday)) 7)) | |
| 17220 | (when (= delta 0) (setq delta 7)) | |
| 17221 | (when (= dir ?-) | |
| 17222 | (setq delta (- delta 7)) | |
| 17223 | (when (= delta 0) (setq delta -7))) | |
| 17224 | (when (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) | |
| 17225 | (list delta "d" rel)) | |
| 17226 | (list (* n (if (= dir ?-) -1 1)) what rel))))) | |
| 17227 | ||
| 17228 | (defun org-order-calendar-date-args (arg1 arg2 arg3) | |
| 17229 | "Turn a user-specified date into the internal representation. | |
| 17230 | The internal representation needed by the calendar is (month day year). | |
| 17231 | This is a wrapper to handle the brain-dead convention in calendar that | |
| 17232 | user function argument order change dependent on argument order." | |
| 17233 | (pcase calendar-date-style | |
| 17234 | (`american (list arg1 arg2 arg3)) | |
| 17235 | (`european (list arg2 arg1 arg3)) | |
| 17236 | (`iso (list arg2 arg3 arg1)))) | |
| 17237 | ||
| 17238 | (defun org-eval-in-calendar (form &optional keepdate) | |
| 17239 | "Eval FORM in the calendar window and return to current window. | |
| 17240 | Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date." | |
| 17241 | (let ((sf (selected-frame)) | |
| 17242 | (sw (selected-window))) | |
| 17243 | (select-window (get-buffer-window "*Calendar*" t)) | |
| 17244 | (eval form) | |
| 17245 | (when (and (not keepdate) (calendar-cursor-to-date)) | |
| 17246 | (let* ((date (calendar-cursor-to-date)) | |
| 17247 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
| 17248 | (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) | |
| 17249 | (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) | |
| 17250 | (select-window sw) | |
| 17251 | (select-frame-set-input-focus sf))) | |
| 17252 | ||
| 17253 | (defun org-calendar-select () | |
| 17254 | "Return to `org-read-date' with the date currently selected. | |
| 17255 | This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
| 17256 | (interactive) | |
| 17257 | (when (calendar-cursor-to-date) | |
| 17258 | (let* ((date (calendar-cursor-to-date)) | |
| 17259 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
| 17260 | (setq org-ans1 (format-time-string "%Y-%m-%d" time))) | |
| 17261 | (when (active-minibuffer-window) (exit-minibuffer)))) | |
| 17262 | ||
| 17263 | (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) | |
| 17264 | "Insert a date stamp for the date given by the internal TIME. | |
| 17265 | See `format-time-string' for the format of TIME. | |
| 17266 | WITH-HM means use the stamp format that includes the time of the day. | |
| 17267 | INACTIVE means use square brackets instead of angular ones, so that the | |
| 17268 | stamp will not contribute to the agenda. | |
| 17269 | PRE and POST are optional strings to be inserted before and after the | |
| 17270 | stamp. | |
| 17271 | The command returns the inserted time stamp." | |
| 17272 | (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) | |
| 17273 | stamp) | |
| 17274 | (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) | |
| 17275 | (insert-before-markers (or pre "")) | |
| 17276 | (when (listp extra) | |
| 17277 | (setq extra (car extra)) | |
| 17278 | (if (and (stringp extra) | |
| 17279 | (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) | |
| 17280 | (setq extra (format "-%02d:%02d" | |
| 17281 | (string-to-number (match-string 1 extra)) | |
| 17282 | (string-to-number (match-string 2 extra)))) | |
| 17283 | (setq extra nil))) | |
| 17284 | (when extra | |
| 17285 | (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) | |
| 17286 | (insert-before-markers (setq stamp (format-time-string fmt time))) | |
| 17287 | (insert-before-markers (or post "")) | |
| 17288 | (setq org-last-inserted-timestamp stamp))) | |
| 17289 | ||
| 17290 | (defun org-toggle-time-stamp-overlays () | |
| 17291 | "Toggle the use of custom time stamp formats." | |
| 17292 | (interactive) | |
| 17293 | (setq org-display-custom-times (not org-display-custom-times)) | |
| 17294 | (unless org-display-custom-times | |
| 17295 | (let ((p (point-min)) (bmp (buffer-modified-p))) | |
| 17296 | (while (setq p (next-single-property-change p 'display)) | |
| 17297 | (when (and (get-text-property p 'display) | |
| 17298 | (eq (get-text-property p 'face) 'org-date)) | |
| 17299 | (remove-text-properties | |
| 17300 | p (setq p (next-single-property-change p 'display)) | |
| 17301 | '(display t)))) | |
| 17302 | (set-buffer-modified-p bmp))) | |
| 17303 | (org-restart-font-lock) | |
| 17304 | (setq org-table-may-need-update t) | |
| 17305 | (if org-display-custom-times | |
| 17306 | (message "Time stamps are overlaid with custom format") | |
| 17307 | (message "Time stamp overlays removed"))) | |
| 17308 | ||
| 17309 | (defun org-display-custom-time (beg end) | |
| 17310 | "Overlay modified time stamp format over timestamp between BEG and END." | |
| 17311 | (let* ((ts (buffer-substring beg end)) | |
| 17312 | t1 with-hm tf time str (off 0)) | |
| 17313 | (save-match-data | |
| 17314 | (setq t1 (org-parse-time-string ts t)) | |
| 17315 | (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) | |
| 17316 | (setq off (- (match-end 0) (match-beginning 0))))) | |
| 17317 | (setq end (- end off)) | |
| 17318 | (setq with-hm (and (nth 1 t1) (nth 2 t1)) | |
| 17319 | tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats) | |
| 17320 | time (org-fix-decoded-time t1) | |
| 17321 | str (org-add-props | |
| 17322 | (format-time-string | |
| 17323 | (substring tf 1 -1) (apply 'encode-time time)) | |
| 17324 | nil 'mouse-face 'highlight)) | |
| 17325 | (put-text-property beg end 'display str))) | |
| 17326 | ||
| 17327 | (defun org-fix-decoded-time (time) | |
| 17328 | "Set 0 instead of nil for the first 6 elements of time. | |
| 17329 | Don't touch the rest." | |
| 17330 | (let ((n 0)) | |
| 17331 | (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) | |
| 17332 | ||
| 17333 | (defun org-time-stamp-to-now (timestamp-string &optional seconds) | |
| 17334 | "Difference between TIMESTAMP-STRING and now in days. | |
| 17335 | If SECONDS is non-nil, return the difference in seconds." | |
| 17336 | (let ((fdiff (if seconds #'float-time #'time-to-days))) | |
| 17337 | (- (funcall fdiff (org-time-string-to-time timestamp-string)) | |
| 17338 | (funcall fdiff (current-time))))) | |
| 17339 | ||
| 17340 | (defun org-deadline-close-p (timestamp-string &optional ndays) | |
| 17341 | "Is the time in TIMESTAMP-STRING close to the current date?" | |
| 17342 | (setq ndays (or ndays (org-get-wdays timestamp-string))) | |
| 17343 | (and (<= (org-time-stamp-to-now timestamp-string) ndays) | |
| 17344 | (not (org-entry-is-done-p)))) | |
| 17345 | ||
| 17346 | (defun org-get-wdays (ts &optional delay zero-delay) | |
| 17347 | "Get the deadline lead time appropriate for timestring TS. | |
| 17348 | When DELAY is non-nil, get the delay time for scheduled items | |
| 17349 | instead of the deadline lead time. When ZERO-DELAY is non-nil | |
| 17350 | and `org-scheduled-delay-days' is 0, enforce 0 as the delay, | |
| 17351 | don't try to find the delay cookie in the scheduled timestamp." | |
| 17352 | (let ((tv (if delay org-scheduled-delay-days | |
| 17353 | org-deadline-warning-days))) | |
| 17354 | (cond | |
| 17355 | ((or (and delay (< tv 0)) | |
| 17356 | (and delay zero-delay (<= tv 0)) | |
| 17357 | (and (not delay) (<= tv 0))) | |
| 17358 | ;; Enforce this value no matter what | |
| 17359 | (- tv)) | |
| 17360 | ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) | |
| 17361 | ;; lead time is specified. | |
| 17362 | (floor (* (string-to-number (match-string 1 ts)) | |
| 17363 | (cdr (assoc (match-string 2 ts) | |
| 17364 | '(("d" . 1) ("w" . 7) | |
| 17365 | ("m" . 30.4) ("y" . 365.25) | |
| 17366 | ("h" . 0.041667))))))) | |
| 17367 | ;; go for the default. | |
| 17368 | (t tv)))) | |
| 17369 | ||
| 17370 | (defun org-calendar-select-mouse (ev) | |
| 17371 | "Return to `org-read-date' with the date currently selected. | |
| 17372 | This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
| 17373 | (interactive "e") | |
| 17374 | (mouse-set-point ev) | |
| 17375 | (when (calendar-cursor-to-date) | |
| 17376 | (let* ((date (calendar-cursor-to-date)) | |
| 17377 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
| 17378 | (setq org-ans1 (format-time-string "%Y-%m-%d" time))) | |
| 17379 | (when (active-minibuffer-window) (exit-minibuffer)))) | |
| 17380 | ||
| 17381 | (defun org-check-deadlines (ndays) | |
| 17382 | "Check if there are any deadlines due or past due. | |
| 17383 | A deadline is considered due if it happens within `org-deadline-warning-days' | |
| 17384 | days from today's date. If the deadline appears in an entry marked DONE, | |
| 17385 | it is not shown. A numeric prefix argument NDAYS can be used to test that | |
| 17386 | many days. If the prefix is a raw `\\[universal-argument]', all deadlines \ | |
| 17387 | are shown." | |
| 17388 | (interactive "P") | |
| 17389 | (let* ((org-warn-days | |
| 17390 | (cond | |
| 17391 | ((equal ndays '(4)) 100000) | |
| 17392 | (ndays (prefix-numeric-value ndays)) | |
| 17393 | (t (abs org-deadline-warning-days)))) | |
| 17394 | (case-fold-search nil) | |
| 17395 | (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) | |
| 17396 | (callback | |
| 17397 | (lambda () (org-deadline-close-p (match-string 1) org-warn-days)))) | |
| 17398 | (message "%d deadlines past-due or due within %d days" | |
| 17399 | (org-occur regexp nil callback) | |
| 17400 | org-warn-days))) | |
| 17401 | ||
| 17402 | (defsubst org-re-timestamp (type) | |
| 17403 | "Return a regexp for timestamp TYPE. | |
| 17404 | Allowed values for TYPE are: | |
| 17405 | ||
| 17406 | all: all timestamps | |
| 17407 | active: only active timestamps (<...>) | |
| 17408 | inactive: only inactive timestamps ([...]) | |
| 17409 | scheduled: only scheduled timestamps | |
| 17410 | deadline: only deadline timestamps | |
| 17411 | closed: only closed time-stamps | |
| 17412 | ||
| 17413 | When TYPE is nil, fall back on returning a regexp that matches | |
| 17414 | both scheduled and deadline timestamps." | |
| 17415 | (cl-case type | |
| 17416 | (all org-ts-regexp-both) | |
| 17417 | (active org-ts-regexp) | |
| 17418 | (inactive org-ts-regexp-inactive) | |
| 17419 | (scheduled org-scheduled-time-regexp) | |
| 17420 | (deadline org-deadline-time-regexp) | |
| 17421 | (closed org-closed-time-regexp) | |
| 17422 | (otherwise | |
| 17423 | (concat "\\<" | |
| 17424 | (regexp-opt (list org-deadline-string org-scheduled-string)) | |
| 17425 | " *<\\([^>]+\\)>")))) | |
| 17426 | ||
| 17427 | (defun org-check-before-date (d) | |
| 17428 | "Check if there are deadlines or scheduled entries before date D." | |
| 17429 | (interactive (list (org-read-date))) | |
| 17430 | (let* ((case-fold-search nil) | |
| 17431 | (regexp (org-re-timestamp org-ts-type)) | |
| 17432 | (ts-type org-ts-type) | |
| 17433 | (callback | |
| 17434 | (lambda () | |
| 17435 | (let ((match (match-string 1))) | |
| 17436 | (and (if (memq ts-type '(active inactive all)) | |
| 17437 | (eq (org-element-type (save-excursion | |
| 17438 | (backward-char) | |
| 17439 | (org-element-context))) | |
| 17440 | 'timestamp) | |
| 17441 | (org-at-planning-p)) | |
| 17442 | (time-less-p | |
| 17443 | (org-time-string-to-time match) | |
| 17444 | (org-time-string-to-time d))))))) | |
| 17445 | (message "%d entries before %s" | |
| 17446 | (org-occur regexp nil callback) | |
| 17447 | d))) | |
| 17448 | ||
| 17449 | (defun org-check-after-date (d) | |
| 17450 | "Check if there are deadlines or scheduled entries after date D." | |
| 17451 | (interactive (list (org-read-date))) | |
| 17452 | (let* ((case-fold-search nil) | |
| 17453 | (regexp (org-re-timestamp org-ts-type)) | |
| 17454 | (ts-type org-ts-type) | |
| 17455 | (callback | |
| 17456 | (lambda () | |
| 17457 | (let ((match (match-string 1))) | |
| 17458 | (and (if (memq ts-type '(active inactive all)) | |
| 17459 | (eq (org-element-type (save-excursion | |
| 17460 | (backward-char) | |
| 17461 | (org-element-context))) | |
| 17462 | 'timestamp) | |
| 17463 | (org-at-planning-p)) | |
| 17464 | (not (time-less-p | |
| 17465 | (org-time-string-to-time match) | |
| 17466 | (org-time-string-to-time d)))))))) | |
| 17467 | (message "%d entries after %s" | |
| 17468 | (org-occur regexp nil callback) | |
| 17469 | d))) | |
| 17470 | ||
| 17471 | (defun org-check-dates-range (start-date end-date) | |
| 17472 | "Check for deadlines/scheduled entries between START-DATE and END-DATE." | |
| 17473 | (interactive (list (org-read-date nil nil nil "Range starts") | |
| 17474 | (org-read-date nil nil nil "Range end"))) | |
| 17475 | (let ((case-fold-search nil) | |
| 17476 | (regexp (org-re-timestamp org-ts-type)) | |
| 17477 | (callback | |
| 17478 | (let ((type org-ts-type)) | |
| 17479 | (lambda () | |
| 17480 | (let ((match (match-string 1))) | |
| 17481 | (and | |
| 17482 | (if (memq type '(active inactive all)) | |
| 17483 | (eq (org-element-type (save-excursion | |
| 17484 | (backward-char) | |
| 17485 | (org-element-context))) | |
| 17486 | 'timestamp) | |
| 17487 | (org-at-planning-p)) | |
| 17488 | (not (time-less-p | |
| 17489 | (org-time-string-to-time match) | |
| 17490 | (org-time-string-to-time start-date))) | |
| 17491 | (time-less-p | |
| 17492 | (org-time-string-to-time match) | |
| 17493 | (org-time-string-to-time end-date)))))))) | |
| 17494 | (message "%d entries between %s and %s" | |
| 17495 | (org-occur regexp nil callback) start-date end-date))) | |
| 17496 | ||
| 17497 | (defun org-evaluate-time-range (&optional to-buffer) | |
| 17498 | "Evaluate a time range by computing the difference between start and end. | |
| 17499 | Normally the result is just printed in the echo area, but with prefix arg | |
| 17500 | TO-BUFFER, the result is inserted just after the date stamp into the buffer. | |
| 17501 | If the time range is actually in a table, the result is inserted into the | |
| 17502 | next column. | |
| 17503 | For time difference computation, a year is assumed to be exactly 365 | |
| 17504 | days in order to avoid rounding problems." | |
| 17505 | (interactive "P") | |
| 17506 | (or | |
| 17507 | (org-clock-update-time-maybe) | |
| 17508 | (save-excursion | |
| 17509 | (unless (org-at-date-range-p t) | |
| 17510 | (goto-char (point-at-bol)) | |
| 17511 | (re-search-forward org-tr-regexp-both (point-at-eol) t)) | |
| 17512 | (unless (org-at-date-range-p t) | |
| 17513 | (user-error "Not at a time-stamp range, and none found in current line"))) | |
| 17514 | (let* ((ts1 (match-string 1)) | |
| 17515 | (ts2 (match-string 2)) | |
| 17516 | (havetime (or (> (length ts1) 15) (> (length ts2) 15))) | |
| 17517 | (match-end (match-end 0)) | |
| 17518 | (time1 (org-time-string-to-time ts1)) | |
| 17519 | (time2 (org-time-string-to-time ts2)) | |
| 17520 | (t1 (float-time time1)) | |
| 17521 | (t2 (float-time time2)) | |
| 17522 | (diff (abs (- t2 t1))) | |
| 17523 | (negative (< (- t2 t1) 0)) | |
| 17524 | ;; (ys (floor (* 365 24 60 60))) | |
| 17525 | (ds (* 24 60 60)) | |
| 17526 | (hs (* 60 60)) | |
| 17527 | (fy "%dy %dd %02d:%02d") | |
| 17528 | (fy1 "%dy %dd") | |
| 17529 | (fd "%dd %02d:%02d") | |
| 17530 | (fd1 "%dd") | |
| 17531 | (fh "%02d:%02d") | |
| 17532 | y d h m align) | |
| 17533 | (if havetime | |
| 17534 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | |
| 17535 | y 0 | |
| 17536 | d (floor (/ diff ds)) diff (mod diff ds) | |
| 17537 | h (floor (/ diff hs)) diff (mod diff hs) | |
| 17538 | m (floor (/ diff 60))) | |
| 17539 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | |
| 17540 | y 0 | |
| 17541 | d (floor (+ (/ diff ds) 0.5)) | |
| 17542 | h 0 m 0)) | |
| 17543 | (if (not to-buffer) | |
| 17544 | (message "%s" (org-make-tdiff-string y d h m)) | |
| 17545 | (if (org-at-table-p) | |
| 17546 | (progn | |
| 17547 | (goto-char match-end) | |
| 17548 | (setq align t) | |
| 17549 | (and (looking-at " *|") (goto-char (match-end 0)))) | |
| 17550 | (goto-char match-end)) | |
| 17551 | (when (looking-at | |
| 17552 | "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") | |
| 17553 | (replace-match "")) | |
| 17554 | (when negative (insert " -")) | |
| 17555 | (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) | |
| 17556 | (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) | |
| 17557 | (insert " " (format fh h m)))) | |
| 17558 | (when align (org-table-align)) | |
| 17559 | (message "Time difference inserted"))))) | |
| 17560 | ||
| 17561 | (defun org-make-tdiff-string (y d h m) | |
| 17562 | (let ((fmt "") | |
| 17563 | (l nil)) | |
| 17564 | (when (> y 0) | |
| 17565 | (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ")) | |
| 17566 | (push y l)) | |
| 17567 | (when (> d 0) | |
| 17568 | (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ")) | |
| 17569 | (push d l)) | |
| 17570 | (when (> h 0) | |
| 17571 | (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ")) | |
| 17572 | (push h l)) | |
| 17573 | (when (> m 0) | |
| 17574 | (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ")) | |
| 17575 | (push m l)) | |
| 17576 | (apply 'format fmt (nreverse l)))) | |
| 17577 | ||
| 17578 | (defun org-time-string-to-time (s) | |
| 17579 | "Convert timestamp string S into internal time." | |
| 17580 | (apply #'encode-time (org-parse-time-string s))) | |
| 17581 | ||
| 17582 | (defun org-time-string-to-seconds (s) | |
| 17583 | "Convert a timestamp string S into a number of seconds." | |
| 17584 | (float-time (org-time-string-to-time s))) | |
| 17585 | ||
| 17586 | (org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp") | |
| 17587 | ||
| 17588 | (defun org-time-string-to-absolute (s &optional daynr prefer buffer pos) | |
| 17589 | "Convert time stamp S to an absolute day number. | |
| 17590 | ||
| 17591 | If DAYNR in non-nil, and there is a specifier for a cyclic time | |
| 17592 | stamp, get the closest date to DAYNR. If PREFER is | |
| 17593 | `past' (respectively `future') return a date past (respectively | |
| 17594 | after) or equal to DAYNR. | |
| 17595 | ||
| 17596 | POS is the location of time stamp S, as a buffer position in | |
| 17597 | BUFFER. | |
| 17598 | ||
| 17599 | Diary sexp timestamps are matched against DAYNR, when non-nil. | |
| 17600 | If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is | |
| 17601 | signaled." | |
| 17602 | (cond | |
| 17603 | ((string-match "\\`%%\\((.*)\\)" s) | |
| 17604 | ;; Sexp timestamp: try to match DAYNR, if available, since we're | |
| 17605 | ;; only able to match individual dates. If it fails, raise an | |
| 17606 | ;; error. | |
| 17607 | (if (and daynr | |
| 17608 | (org-diary-sexp-entry | |
| 17609 | (match-string 1 s) "" (calendar-gregorian-from-absolute daynr))) | |
| 17610 | daynr | |
| 17611 | (signal 'org-diary-sexp-no-match (list s)))) | |
| 17612 | (daynr (org-closest-date s daynr prefer)) | |
| 17613 | (t (time-to-days | |
| 17614 | (condition-case errdata | |
| 17615 | (apply #'encode-time (org-parse-time-string s)) | |
| 17616 | (error (error "Bad timestamp `%s'%s\nError was: %s" | |
| 17617 | s | |
| 17618 | (if (not (and buffer pos)) "" | |
| 17619 | (format-message " at %d in buffer `%s'" pos buffer)) | |
| 17620 | (cdr errdata)))))))) | |
| 17621 | ||
| 17622 | (defun org-days-to-iso-week (days) | |
| 17623 | "Return the iso week number." | |
| 17624 | (require 'cal-iso) | |
| 17625 | (car (calendar-iso-from-absolute days))) | |
| 17626 | ||
| 17627 | (defun org-small-year-to-year (year) | |
| 17628 | "Convert 2-digit years into 4-digit years. | |
| 17629 | YEAR is expanded into one of the 30 next years, if possible, or | |
| 17630 | into a past one. Any year larger than 99 is returned unchanged." | |
| 17631 | (if (>= year 100) year | |
| 17632 | (let* ((current (string-to-number (format-time-string "%Y" (current-time)))) | |
| 17633 | (century (/ current 100)) | |
| 17634 | (offset (- year (% current 100)))) | |
| 17635 | (cond ((> offset 30) (+ (* (1- century) 100) year)) | |
| 17636 | ((> offset -70) (+ (* century 100) year)) | |
| 17637 | (t (+ (* (1+ century) 100) year)))))) | |
| 17638 | ||
| 17639 | (defun org-time-from-absolute (d) | |
| 17640 | "Return the time corresponding to date D. | |
| 17641 | D may be an absolute day number, or a calendar-type list (month day year)." | |
| 17642 | (when (numberp d) (setq d (calendar-gregorian-from-absolute d))) | |
| 17643 | (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) | |
| 17644 | ||
| 17645 | (defvar org-agenda-current-date) | |
| 17646 | (defun org-calendar-holiday () | |
| 17647 | "List of holidays, for Diary display in Org mode." | |
| 17648 | (require 'holidays) | |
| 17649 | (let ((hl (calendar-check-holidays org-agenda-current-date))) | |
| 17650 | (and hl (mapconcat #'identity hl "; ")))) | |
| 17651 | ||
| 17652 | (defun org-diary-sexp-entry (sexp entry d) | |
| 17653 | "Process a SEXP diary ENTRY for date D." | |
| 17654 | (require 'diary-lib) | |
| 17655 | ;; `org-anniversary' and alike expect ENTRY and DATE to be bound | |
| 17656 | ;; dynamically. | |
| 17657 | (let* ((sexp `(let ((entry ,entry) | |
| 17658 | (date ',d)) | |
| 17659 | ,(car (read-from-string sexp)))) | |
| 17660 | (result (if calendar-debug-sexp (eval sexp) | |
| 17661 | (condition-case nil | |
| 17662 | (eval sexp) | |
| 17663 | (error | |
| 17664 | (beep) | |
| 17665 | (message "Bad sexp at line %d in %s: %s" | |
| 17666 | (org-current-line) | |
| 17667 | (buffer-file-name) sexp) | |
| 17668 | (sleep-for 2)))))) | |
| 17669 | (cond ((stringp result) (split-string result "; ")) | |
| 17670 | ((and (consp result) | |
| 17671 | (not (consp (cdr result))) | |
| 17672 | (stringp (cdr result))) (cdr result)) | |
| 17673 | ((and (consp result) | |
| 17674 | (stringp (car result))) result) | |
| 17675 | (result entry)))) | |
| 17676 | ||
| 17677 | (defun org-diary-to-ical-string (frombuf) | |
| 17678 | "Get iCalendar entries from diary entries in buffer FROMBUF. | |
| 17679 | This uses the icalendar.el library." | |
| 17680 | (let* ((tmpdir temporary-file-directory) | |
| 17681 | (tmpfile (make-temp-name | |
| 17682 | (expand-file-name "orgics" tmpdir))) | |
| 17683 | buf rtn b e) | |
| 17684 | (with-current-buffer frombuf | |
| 17685 | (icalendar-export-region (point-min) (point-max) tmpfile) | |
| 17686 | (setq buf (find-buffer-visiting tmpfile)) | |
| 17687 | (set-buffer buf) | |
| 17688 | (goto-char (point-min)) | |
| 17689 | (when (re-search-forward "^BEGIN:VEVENT" nil t) | |
| 17690 | (setq b (match-beginning 0))) | |
| 17691 | (goto-char (point-max)) | |
| 17692 | (when (re-search-backward "^END:VEVENT" nil t) | |
| 17693 | (setq e (match-end 0))) | |
| 17694 | (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") ""))) | |
| 17695 | (kill-buffer buf) | |
| 17696 | (delete-file tmpfile) | |
| 17697 | rtn)) | |
| 17698 | ||
| 17699 | (defun org-closest-date (start current prefer) | |
| 17700 | "Return closest date to CURRENT starting from START. | |
| 17701 | ||
| 17702 | CURRENT and START are both time stamps. | |
| 17703 | ||
| 17704 | When PREFER is `past', return a date that is either CURRENT or | |
| 17705 | past. When PREFER is `future', return a date that is either | |
| 17706 | CURRENT or future. | |
| 17707 | ||
| 17708 | Only time stamps with a repeater are modified. Any other time | |
| 17709 | stamp stay unchanged. In any case, return value is an absolute | |
| 17710 | day number." | |
| 17711 | (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start)) | |
| 17712 | ;; No repeater. Do not shift time stamp. | |
| 17713 | (time-to-days (apply #'encode-time (org-parse-time-string start))) | |
| 17714 | (let ((value (string-to-number (match-string 1 start))) | |
| 17715 | (type (match-string 2 start))) | |
| 17716 | (if (= 0 value) | |
| 17717 | ;; Repeater with a 0-value is considered as void. | |
| 17718 | (time-to-days (apply #'encode-time (org-parse-time-string start))) | |
| 17719 | (let* ((base (org-date-to-gregorian start)) | |
| 17720 | (target (org-date-to-gregorian current)) | |
| 17721 | (sday (calendar-absolute-from-gregorian base)) | |
| 17722 | (cday (calendar-absolute-from-gregorian target)) | |
| 17723 | n1 n2) | |
| 17724 | ;; If START is already past CURRENT, just return START. | |
| 17725 | (if (<= cday sday) sday | |
| 17726 | ;; Compute closest date before (N1) and closest date past | |
| 17727 | ;; (N2) CURRENT. | |
| 17728 | (pcase type | |
| 17729 | ("h" | |
| 17730 | (let ((missing-hours | |
| 17731 | (mod (+ (- (* 24 (- cday sday)) | |
| 17732 | (nth 2 (org-parse-time-string start))) | |
| 17733 | org-extend-today-until) | |
| 17734 | value))) | |
| 17735 | (setf n1 (if (= missing-hours 0) cday | |
| 17736 | (- cday (1+ (/ missing-hours 24))))) | |
| 17737 | (setf n2 (+ cday (/ (- value missing-hours) 24))))) | |
| 17738 | ((or "d" "w") | |
| 17739 | (let ((value (if (equal type "w") (* 7 value) value))) | |
| 17740 | (setf n1 (+ sday (* value (/ (- cday sday) value)))) | |
| 17741 | (setf n2 (+ n1 value)))) | |
| 17742 | ("m" | |
| 17743 | (let* ((add-months | |
| 17744 | (lambda (d n) | |
| 17745 | ;; Add N months to gregorian date D, i.e., | |
| 17746 | ;; a list (MONTH DAY YEAR). Return a valid | |
| 17747 | ;; gregorian date. | |
| 17748 | (let ((m (+ (nth 0 d) n))) | |
| 17749 | (list (mod m 12) | |
| 17750 | (nth 1 d) | |
| 17751 | (+ (/ m 12) (nth 2 d)))))) | |
| 17752 | (months ; Complete months to TARGET. | |
| 17753 | (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base))) | |
| 17754 | (- (nth 0 target) (nth 0 base)) | |
| 17755 | ;; If START's day is greater than | |
| 17756 | ;; TARGET's, remove incomplete month. | |
| 17757 | (if (> (nth 1 target) (nth 1 base)) 0 -1)) | |
| 17758 | value) | |
| 17759 | value)) | |
| 17760 | (before (funcall add-months base months))) | |
| 17761 | (setf n1 (calendar-absolute-from-gregorian before)) | |
| 17762 | (setf n2 | |
| 17763 | (calendar-absolute-from-gregorian | |
| 17764 | (funcall add-months before value))))) | |
| 17765 | (_ | |
| 17766 | (let* ((d (nth 1 base)) | |
| 17767 | (m (nth 0 base)) | |
| 17768 | (y (nth 2 base)) | |
| 17769 | (years ; Complete years to TARGET. | |
| 17770 | (* (/ (- (nth 2 target) | |
| 17771 | y | |
| 17772 | ;; If START's month and day are | |
| 17773 | ;; greater than TARGET's, remove | |
| 17774 | ;; incomplete year. | |
| 17775 | (if (or (> (nth 0 target) m) | |
| 17776 | (and (= (nth 0 target) m) | |
| 17777 | (> (nth 1 target) d))) | |
| 17778 | 0 | |
| 17779 | 1)) | |
| 17780 | value) | |
| 17781 | value)) | |
| 17782 | (before (list m d (+ y years)))) | |
| 17783 | (setf n1 (calendar-absolute-from-gregorian before)) | |
| 17784 | (setf n2 (calendar-absolute-from-gregorian | |
| 17785 | (list m d (+ (nth 2 before) value))))))) | |
| 17786 | ;; Handle PREFER parameter, if any. | |
| 17787 | (cond | |
| 17788 | ((eq prefer 'past) (if (= cday n2) n2 n1)) | |
| 17789 | ((eq prefer 'future) (if (= cday n1) n1 n2)) | |
| 17790 | (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))))))))) | |
| 17791 | ||
| 17792 | (defun org-date-to-gregorian (d) | |
| 17793 | "Turn any specification of date D into a Gregorian date for the calendar." | |
| 17794 | (cond ((integerp d) (calendar-gregorian-from-absolute d)) | |
| 17795 | ((and (listp d) (= (length d) 3)) d) | |
| 17796 | ((stringp d) | |
| 17797 | (let ((d (org-parse-time-string d))) | |
| 17798 | (list (nth 4 d) (nth 3 d) (nth 5 d)))) | |
| 17799 | ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d))))) | |
| 17800 | ||
| 17801 | (defun org-parse-time-string (s &optional nodefault) | |
| 17802 | "Parse the standard Org time string. | |
| 17803 | ||
| 17804 | This should be a lot faster than the normal `parse-time-string'. | |
| 17805 | ||
| 17806 | If time is not given, defaults to 0:00. However, with optional | |
| 17807 | NODEFAULT, hour and minute fields will be nil if not given." | |
| 17808 | (cond ((string-match org-ts-regexp0 s) | |
| 17809 | (list 0 | |
| 17810 | (when (or (match-beginning 8) (not nodefault)) | |
| 17811 | (string-to-number (or (match-string 8 s) "0"))) | |
| 17812 | (when (or (match-beginning 7) (not nodefault)) | |
| 17813 | (string-to-number (or (match-string 7 s) "0"))) | |
| 17814 | (string-to-number (match-string 4 s)) | |
| 17815 | (string-to-number (match-string 3 s)) | |
| 17816 | (string-to-number (match-string 2 s)) | |
| 17817 | nil nil nil)) | |
| 17818 | ((string-match "^<[^>]+>$" s) | |
| 17819 | ;; FIXME: `decode-time' needs to be called with ZONE as its | |
| 17820 | ;; second argument. However, this requires at least Emacs | |
| 17821 | ;; 25.1. We can do it when we switch to this version as our | |
| 17822 | ;; minimal requirement. | |
| 17823 | (decode-time (seconds-to-time (org-matcher-time s)))) | |
| 17824 | (t (error "Not a standard Org time string: %s" s)))) | |
| 17825 | ||
| 17826 | (defun org-timestamp-up (&optional arg) | |
| 17827 | "Increase the date item at the cursor by one. | |
| 17828 | If the cursor is on the year, change the year. If it is on the month, | |
| 17829 | the day or the time, change that. If the cursor is on the enclosing | |
| 17830 | bracket, change the timestamp type. | |
| 17831 | With prefix ARG, change by that many units." | |
| 17832 | (interactive "p") | |
| 17833 | (org-timestamp-change (prefix-numeric-value arg) nil 'updown)) | |
| 17834 | ||
| 17835 | (defun org-timestamp-down (&optional arg) | |
| 17836 | "Decrease the date item at the cursor by one. | |
| 17837 | If the cursor is on the year, change the year. If it is on the month, | |
| 17838 | the day or the time, change that. If the cursor is on the enclosing | |
| 17839 | bracket, change the timestamp type. | |
| 17840 | With prefix ARG, change by that many units." | |
| 17841 | (interactive "p") | |
| 17842 | (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown)) | |
| 17843 | ||
| 17844 | (defun org-timestamp-up-day (&optional arg) | |
| 17845 | "Increase the date in the time stamp by one day. | |
| 17846 | With prefix ARG, change that many days." | |
| 17847 | (interactive "p") | |
| 17848 | (if (and (not (org-at-timestamp-p 'lax)) | |
| 17849 | (org-at-heading-p)) | |
| 17850 | (org-todo 'up) | |
| 17851 | (org-timestamp-change (prefix-numeric-value arg) 'day 'updown))) | |
| 17852 | ||
| 17853 | (defun org-timestamp-down-day (&optional arg) | |
| 17854 | "Decrease the date in the time stamp by one day. | |
| 17855 | With prefix ARG, change that many days." | |
| 17856 | (interactive "p") | |
| 17857 | (if (and (not (org-at-timestamp-p 'lax)) | |
| 17858 | (org-at-heading-p)) | |
| 17859 | (org-todo 'down) | |
| 17860 | (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) | |
| 17861 | ||
| 17862 | (defun org-at-timestamp-p (&optional extended) | |
| 17863 | "Non-nil if point is inside a timestamp. | |
| 17864 | ||
| 17865 | By default, the function only consider syntactically valid active | |
| 17866 | timestamps. However, the caller may have a broader definition | |
| 17867 | for timestamps. As a consequence, optional argument EXTENDED can | |
| 17868 | be set to the following values | |
| 17869 | ||
| 17870 | `inactive' | |
| 17871 | ||
| 17872 | Include also syntactically valid inactive timestamps. | |
| 17873 | ||
| 17874 | `agenda' | |
| 17875 | ||
| 17876 | Include timestamps allowed in Agenda, i.e., those in | |
| 17877 | properties drawers, planning lines and clock lines. | |
| 17878 | ||
| 17879 | `lax' | |
| 17880 | ||
| 17881 | Ignore context. The function matches any part of the | |
| 17882 | document looking like a timestamp. This includes comments, | |
| 17883 | example blocks... | |
| 17884 | ||
| 17885 | For backward-compatibility with Org 9.0, every other non-nil | |
| 17886 | value is equivalent to `inactive'. | |
| 17887 | ||
| 17888 | When at a timestamp, return the position of the point as a symbol | |
| 17889 | among `bracket', `after', `year', `month', `hour', `minute', | |
| 17890 | `day' or a number of character from the last know part of the | |
| 17891 | time stamp. | |
| 17892 | ||
| 17893 | When matching, the match groups are the following: | |
| 17894 | group 1: year | |
| 17895 | group 2: month | |
| 17896 | group 3: day number | |
| 17897 | group 4: day name | |
| 17898 | group 5: hours, if any | |
| 17899 | group 6: minutes, if any" | |
| 17900 | (let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2)) | |
| 17901 | (pos (point)) | |
| 17902 | (match? | |
| 17903 | (let ((boundaries (org-in-regexp regexp))) | |
| 17904 | (save-match-data | |
| 17905 | (cond ((null boundaries) nil) | |
| 17906 | ((eq extended 'lax) t) | |
| 17907 | (t | |
| 17908 | (or (and (eq extended 'agenda) | |
| 17909 | (or (org-at-planning-p) | |
| 17910 | (org-at-property-p) | |
| 17911 | (and (bound-and-true-p | |
| 17912 | org-agenda-include-inactive-timestamps) | |
| 17913 | (org-at-clock-log-p)))) | |
| 17914 | (eq 'timestamp | |
| 17915 | (save-excursion | |
| 17916 | (when (= pos (cdr boundaries)) (forward-char -1)) | |
| 17917 | (org-element-type (org-element-context))))))))))) | |
| 17918 | (cond | |
| 17919 | ((not match?) nil) | |
| 17920 | ((= pos (match-beginning 0)) 'bracket) | |
| 17921 | ;; Distinguish location right before the closing bracket from | |
| 17922 | ;; right after it. | |
| 17923 | ((= pos (1- (match-end 0))) 'bracket) | |
| 17924 | ((= pos (match-end 0)) 'after) | |
| 17925 | ((org-pos-in-match-range pos 2) 'year) | |
| 17926 | ((org-pos-in-match-range pos 3) 'month) | |
| 17927 | ((org-pos-in-match-range pos 7) 'hour) | |
| 17928 | ((org-pos-in-match-range pos 8) 'minute) | |
| 17929 | ((or (org-pos-in-match-range pos 4) | |
| 17930 | (org-pos-in-match-range pos 5)) 'day) | |
| 17931 | ((and (> pos (or (match-end 8) (match-end 5))) | |
| 17932 | (< pos (match-end 0))) | |
| 17933 | (- pos (or (match-end 8) (match-end 5)))) | |
| 17934 | (t 'day)))) | |
| 17935 | ||
| 17936 | (defun org-toggle-timestamp-type () | |
| 17937 | "Toggle the type (<active> or [inactive]) of a time stamp." | |
| 17938 | (interactive) | |
| 17939 | (when (org-at-timestamp-p 'lax) | |
| 17940 | (let ((beg (match-beginning 0)) (end (match-end 0)) | |
| 17941 | (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]")))) | |
| 17942 | (save-excursion | |
| 17943 | (goto-char beg) | |
| 17944 | (while (re-search-forward "[][<>]" end t) | |
| 17945 | (replace-match (cdr (assoc (char-after (match-beginning 0)) map)) | |
| 17946 | t t))) | |
| 17947 | (message "Timestamp is now %sactive" | |
| 17948 | (if (equal (char-after beg) ?<) "" "in"))))) | |
| 17949 | ||
| 17950 | (defun org-at-clock-log-p () | |
| 17951 | "Non-nil if point is on a clock log line." | |
| 17952 | (and (org-match-line org-clock-line-re) | |
| 17953 | (eq (org-element-type (save-match-data (org-element-at-point))) 'clock))) | |
| 17954 | ||
| 17955 | (defvar org-clock-history) ; defined in org-clock.el | |
| 17956 | (defvar org-clock-adjust-closest nil) ; defined in org-clock.el | |
| 17957 | (defun org-timestamp-change (n &optional what updown suppress-tmp-delay) | |
| 17958 | "Change the date in the time stamp at point. | |
| 17959 | The date will be changed by N times WHAT. WHAT can be `day', `month', | |
| 17960 | `year', `minute', `second'. If WHAT is not given, the cursor position | |
| 17961 | in the timestamp determines what will be changed. | |
| 17962 | When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." | |
| 17963 | (let ((origin (point)) | |
| 17964 | (timestamp? (org-at-timestamp-p 'lax)) | |
| 17965 | origin-cat | |
| 17966 | with-hm inactive | |
| 17967 | (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) | |
| 17968 | extra rem | |
| 17969 | ts time time0 fixnext clrgx) | |
| 17970 | (unless timestamp? (user-error "Not at a timestamp")) | |
| 17971 | (if (and (not what) (eq timestamp? 'bracket)) | |
| 17972 | (org-toggle-timestamp-type) | |
| 17973 | ;; Point isn't on brackets. Remember the part of the time-stamp | |
| 17974 | ;; the point was in. Indeed, size of time-stamps may change, | |
| 17975 | ;; but point must be kept in the same category nonetheless. | |
| 17976 | (setq origin-cat timestamp?) | |
| 17977 | (when (and (not what) (not (eq timestamp? 'day)) | |
| 17978 | org-display-custom-times | |
| 17979 | (get-text-property (point) 'display) | |
| 17980 | (not (get-text-property (1- (point)) 'display))) | |
| 17981 | (setq timestamp? 'day)) | |
| 17982 | (setq timestamp? (or what timestamp?) | |
| 17983 | inactive (= (char-after (match-beginning 0)) ?\[) | |
| 17984 | ts (match-string 0)) | |
| 17985 | (replace-match "") | |
| 17986 | (when (string-match | |
| 17987 | "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" | |
| 17988 | ts) | |
| 17989 | (setq extra (match-string 1 ts)) | |
| 17990 | (when suppress-tmp-delay | |
| 17991 | (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) | |
| 17992 | (when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) | |
| 17993 | (setq with-hm t)) | |
| 17994 | (setq time0 (org-parse-time-string ts)) | |
| 17995 | (when (and updown | |
| 17996 | (eq timestamp? 'minute) | |
| 17997 | (not current-prefix-arg)) | |
| 17998 | ;; This looks like s-up and s-down. Change by one rounding step. | |
| 17999 | (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) | |
| 18000 | (unless (= 0 (setq rem (% (nth 1 time0) dm))) | |
| 18001 | (setcar (cdr time0) (+ (nth 1 time0) | |
| 18002 | (if (> n 0) (- rem) (- dm rem)))))) | |
| 18003 | (setq time | |
| 18004 | (apply #'encode-time | |
| 18005 | (or (car time0) 0) | |
| 18006 | (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0)) | |
| 18007 | (+ (if (eq timestamp? 'hour) n 0) (nth 2 time0)) | |
| 18008 | (+ (if (eq timestamp? 'day) n 0) (nth 3 time0)) | |
| 18009 | (+ (if (eq timestamp? 'month) n 0) (nth 4 time0)) | |
| 18010 | (+ (if (eq timestamp? 'year) n 0) (nth 5 time0)) | |
| 18011 | (nthcdr 6 time0))) | |
| 18012 | (when (and (memq timestamp? '(hour minute)) | |
| 18013 | extra | |
| 18014 | (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) | |
| 18015 | (setq extra (org-modify-ts-extra | |
| 18016 | extra | |
| 18017 | (if (eq timestamp? 'hour) 2 5) | |
| 18018 | n dm))) | |
| 18019 | (when (integerp timestamp?) | |
| 18020 | (setq extra (org-modify-ts-extra extra timestamp? n dm))) | |
| 18021 | (when (eq what 'calendar) | |
| 18022 | (let ((cal-date (org-get-date-from-calendar))) | |
| 18023 | (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month | |
| 18024 | (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day | |
| 18025 | (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year | |
| 18026 | (setcar time0 (or (car time0) 0)) | |
| 18027 | (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) | |
| 18028 | (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) | |
| 18029 | (setq time (apply 'encode-time time0)))) | |
| 18030 | ;; Insert the new time-stamp, and ensure point stays in the same | |
| 18031 | ;; category as before (i.e. not after the last position in that | |
| 18032 | ;; category). | |
| 18033 | (let ((pos (point))) | |
| 18034 | ;; Stay before inserted string. `save-excursion' is of no use. | |
| 18035 | (setq org-last-changed-timestamp | |
| 18036 | (org-insert-time-stamp time with-hm inactive nil nil extra)) | |
| 18037 | (goto-char pos)) | |
| 18038 | (save-match-data | |
| 18039 | (looking-at org-ts-regexp3) | |
| 18040 | (goto-char | |
| 18041 | (pcase origin-cat | |
| 18042 | ;; `day' category ends before `hour' if any, or at the end | |
| 18043 | ;; of the day name. | |
| 18044 | (`day (min (or (match-beginning 7) (1- (match-end 5))) origin)) | |
| 18045 | (`hour (min (match-end 7) origin)) | |
| 18046 | (`minute (min (1- (match-end 8)) origin)) | |
| 18047 | ((pred integerp) (min (1- (match-end 0)) origin)) | |
| 18048 | ;; Point was right after the time-stamp. However, the | |
| 18049 | ;; time-stamp length might have changed, so refer to | |
| 18050 | ;; (match-end 0) instead. | |
| 18051 | (`after (match-end 0)) | |
| 18052 | ;; `year' and `month' have both fixed size: point couldn't | |
| 18053 | ;; have moved into another part. | |
| 18054 | (_ origin)))) | |
| 18055 | ;; Update clock if on a CLOCK line. | |
| 18056 | (org-clock-update-time-maybe) | |
| 18057 | ;; Maybe adjust the closest clock in `org-clock-history' | |
| 18058 | (when org-clock-adjust-closest | |
| 18059 | (if (not (and (org-at-clock-log-p) | |
| 18060 | (< 1 (length (delq nil (mapcar 'marker-position | |
| 18061 | org-clock-history)))))) | |
| 18062 | (message "No clock to adjust") | |
| 18063 | (cond ((save-excursion ; fix previous clock? | |
| 18064 | (re-search-backward org-ts-regexp0 nil t) | |
| 18065 | (looking-back (concat org-clock-string " \\[") | |
| 18066 | (line-beginning-position))) | |
| 18067 | (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$"))) | |
| 18068 | ((save-excursion ; fix next clock? | |
| 18069 | (re-search-backward org-ts-regexp0 nil t) | |
| 18070 | (looking-at (concat org-ts-regexp0 "\\] =>"))) | |
| 18071 | (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0)))) | |
| 18072 | (save-window-excursion | |
| 18073 | ;; Find closest clock to point, adjust the previous/next one in history | |
| 18074 | (let* ((p (save-excursion (org-back-to-heading t))) | |
| 18075 | (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history)) | |
| 18076 | (clfixnth | |
| 18077 | (+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100)))) | |
| 18078 | (clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history)))) | |
| 18079 | (if (not clfixpos) | |
| 18080 | (message "No clock to adjust") | |
| 18081 | (save-excursion | |
| 18082 | (org-goto-marker-or-bmk clfixpos) | |
| 18083 | (org-show-subtree) | |
| 18084 | (when (re-search-forward clrgx nil t) | |
| 18085 | (goto-char (match-beginning 1)) | |
| 18086 | (let (org-clock-adjust-closest) | |
| 18087 | (org-timestamp-change n timestamp? updown)) | |
| 18088 | (message "Clock adjusted in %s for heading: %s" | |
| 18089 | (file-name-nondirectory (buffer-file-name)) | |
| 18090 | (org-get-heading t t))))))))) | |
| 18091 | ;; Try to recenter the calendar window, if any. | |
| 18092 | (when (and org-calendar-follow-timestamp-change | |
| 18093 | (get-buffer-window "*Calendar*" t) | |
| 18094 | (memq timestamp? '(day month year))) | |
| 18095 | (org-recenter-calendar (time-to-days time)))))) | |
| 18096 | ||
| 18097 | (defun org-modify-ts-extra (s pos n dm) | |
| 18098 | "Change the different parts of the lead-time and repeat fields in timestamp." | |
| 18099 | (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4))) | |
| 18100 | ng h m new rem) | |
| 18101 | (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s) | |
| 18102 | (cond | |
| 18103 | ((or (org-pos-in-match-range pos 2) | |
| 18104 | (org-pos-in-match-range pos 3)) | |
| 18105 | (setq m (string-to-number (match-string 3 s)) | |
| 18106 | h (string-to-number (match-string 2 s))) | |
| 18107 | (if (org-pos-in-match-range pos 2) | |
| 18108 | (setq h (+ h n)) | |
| 18109 | (setq n (* dm (with-no-warnings (signum n)))) | |
| 18110 | (unless (= 0 (setq rem (% m dm))) | |
| 18111 | (setq m (+ m (if (> n 0) (- rem) (- dm rem))))) | |
| 18112 | (setq m (+ m n))) | |
| 18113 | (when (< m 0) (setq m (+ m 60) h (1- h))) | |
| 18114 | (when (> m 59) (setq m (- m 60) h (1+ h))) | |
| 18115 | (setq h (mod h 24)) | |
| 18116 | (setq ng 1 new (format "-%02d:%02d" h m))) | |
| 18117 | ((org-pos-in-match-range pos 6) | |
| 18118 | (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx)))) | |
| 18119 | ((org-pos-in-match-range pos 5) | |
| 18120 | (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s))))))) | |
| 18121 | ||
| 18122 | ((org-pos-in-match-range pos 9) | |
| 18123 | (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx)))) | |
| 18124 | ((org-pos-in-match-range pos 8) | |
| 18125 | (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s)))))))) | |
| 18126 | ||
| 18127 | (when ng | |
| 18128 | (setq s (concat | |
| 18129 | (substring s 0 (match-beginning ng)) | |
| 18130 | new | |
| 18131 | (substring s (match-end ng)))))) | |
| 18132 | s)) | |
| 18133 | ||
| 18134 | (defun org-recenter-calendar (d) | |
| 18135 | "If the calendar is visible, recenter it to date D." | |
| 18136 | (let ((cwin (get-buffer-window "*Calendar*" t))) | |
| 18137 | (when cwin | |
| 18138 | (let ((calendar-move-hook nil)) | |
| 18139 | (with-selected-window cwin | |
| 18140 | (calendar-goto-date | |
| 18141 | (if (listp d) d (calendar-gregorian-from-absolute d)))))))) | |
| 18142 | ||
| 18143 | (defun org-goto-calendar (&optional arg) | |
| 18144 | "Go to the Emacs calendar at the current date. | |
| 18145 | If there is a time stamp in the current line, go to that date. | |
| 18146 | A prefix ARG can be used to force the current date." | |
| 18147 | (interactive "P") | |
| 18148 | (let ((calendar-move-hook nil) | |
| 18149 | (calendar-view-holidays-initially-flag nil) | |
| 18150 | (calendar-view-diary-initially-flag nil) | |
| 18151 | diff) | |
| 18152 | (when (or (org-at-timestamp-p 'lax) | |
| 18153 | (org-match-line (concat ".*" org-ts-regexp))) | |
| 18154 | (let ((d1 (time-to-days (current-time))) | |
| 18155 | (d2 (time-to-days (org-time-string-to-time (match-string 1))))) | |
| 18156 | (setq diff (- d2 d1)))) | |
| 18157 | (calendar) | |
| 18158 | (calendar-goto-today) | |
| 18159 | (when (and diff (not arg)) (calendar-forward-day diff)))) | |
| 18160 | ||
| 18161 | (defun org-get-date-from-calendar () | |
| 18162 | "Return a list (month day year) of date at point in calendar." | |
| 18163 | (with-current-buffer "*Calendar*" | |
| 18164 | (save-match-data | |
| 18165 | (calendar-cursor-to-date)))) | |
| 18166 | ||
| 18167 | (defun org-date-from-calendar () | |
| 18168 | "Insert time stamp corresponding to cursor date in *Calendar* buffer. | |
| 18169 | If there is already a time stamp at the cursor position, update it." | |
| 18170 | (interactive) | |
| 18171 | (if (org-at-timestamp-p 'lax) | |
| 18172 | (org-timestamp-change 0 'calendar) | |
| 18173 | (let ((cal-date (org-get-date-from-calendar))) | |
| 18174 | (org-insert-time-stamp | |
| 18175 | (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) | |
| 18176 | ||
| 18177 | (defcustom org-effort-durations | |
| 18178 | `(("min" . 1) | |
| 18179 | ("h" . 60) | |
| 18180 | ("d" . ,(* 60 8)) | |
| 18181 | ("w" . ,(* 60 8 5)) | |
| 18182 | ("m" . ,(* 60 8 5 4)) | |
| 18183 | ("y" . ,(* 60 8 5 40))) | |
| 18184 | "Conversion factor to minutes for an effort modifier. | |
| 18185 | ||
| 18186 | Each entry has the form (MODIFIER . MINUTES). | |
| 18187 | ||
| 18188 | In an effort string, a number followed by MODIFIER is multiplied | |
| 18189 | by the specified number of MINUTES to obtain an effort in | |
| 18190 | minutes. | |
| 18191 | ||
| 18192 | For example, if the value of this variable is ((\"hours\" . 60)), then an | |
| 18193 | effort string \"2hours\" is equivalent to 120 minutes." | |
| 18194 | :group 'org-agenda | |
| 18195 | :version "26.1" | |
| 18196 | :package-version '(Org . "8.3") | |
| 18197 | :type '(alist :key-type (string :tag "Modifier") | |
| 18198 | :value-type (number :tag "Minutes"))) | |
| 18199 | ||
| 18200 | (defcustom org-image-actual-width t | |
| 18201 | "Should we use the actual width of images when inlining them? | |
| 18202 | ||
| 18203 | When set to t, always use the image width. | |
| 18204 | ||
| 18205 | When set to a number, use imagemagick (when available) to set | |
| 18206 | the image's width to this value. | |
| 18207 | ||
| 18208 | When set to a number in a list, try to get the width from any | |
| 18209 | #+ATTR.* keyword if it matches a width specification like | |
| 18210 | ||
| 18211 | #+ATTR_HTML: :width 300px | |
| 18212 | ||
| 18213 | and fall back on that number if none is found. | |
| 18214 | ||
| 18215 | When set to nil, try to get the width from an #+ATTR.* keyword | |
| 18216 | and fall back on the original width if none is found. | |
| 18217 | ||
| 18218 | This requires Emacs >= 24.1, build with imagemagick support." | |
| 18219 | :group 'org-appearance | |
| 18220 | :version "24.4" | |
| 18221 | :package-version '(Org . "8.0") | |
| 18222 | :type '(choice | |
| 18223 | (const :tag "Use the image width" t) | |
| 18224 | (integer :tag "Use a number of pixels") | |
| 18225 | (list :tag "Use #+ATTR* or a number of pixels" (integer)) | |
| 18226 | (const :tag "Use #+ATTR* or don't resize" nil))) | |
| 18227 | ||
| 18228 | (defcustom org-agenda-inhibit-startup nil | |
| 18229 | "Inhibit startup when preparing agenda buffers. | |
| 18230 | When this variable is t, the initialization of the Org agenda | |
| 18231 | buffers is inhibited: e.g. the visibility state is not set, the | |
| 18232 | tables are not re-aligned, etc." | |
| 18233 | :type 'boolean | |
| 18234 | :version "24.3" | |
| 18235 | :group 'org-agenda) | |
| 18236 | ||
| 18237 | (defcustom org-agenda-ignore-properties nil | |
| 18238 | "Avoid updating text properties when building the agenda. | |
| 18239 | Properties are used to prepare buffers for effort estimates, | |
| 18240 | appointments, statistics and subtree-local categories. | |
| 18241 | If you don't use these in the agenda, you can add them to this | |
| 18242 | list and agenda building will be a bit faster. | |
| 18243 | The value is a list, with zero or more of the symbols `effort', `appt', | |
| 18244 | `stats' or `category'." | |
| 18245 | :type '(set :greedy t | |
| 18246 | (const effort) | |
| 18247 | (const appt) | |
| 18248 | (const stats) | |
| 18249 | (const category)) | |
| 18250 | :version "26.1" | |
| 18251 | :package-version '(Org . "8.3") | |
| 18252 | :group 'org-agenda) | |
| 18253 | ||
| 18254 | ;;;; Files | |
| 18255 | ||
| 18256 | (defun org-save-all-org-buffers () | |
| 18257 | "Save all Org buffers without user confirmation." | |
| 18258 | (interactive) | |
| 18259 | (message "Saving all Org buffers...") | |
| 18260 | (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) | |
| 18261 | (when (featurep 'org-id) (org-id-locations-save)) | |
| 18262 | (message "Saving all Org buffers... done")) | |
| 18263 | ||
| 18264 | (defun org-revert-all-org-buffers () | |
| 18265 | "Revert all Org buffers. | |
| 18266 | Prompt for confirmation when there are unsaved changes. | |
| 18267 | Be sure you know what you are doing before letting this function | |
| 18268 | overwrite your changes. | |
| 18269 | ||
| 18270 | This function is useful in a setup where one tracks Org files | |
| 18271 | with a version control system, to revert on one machine after pulling | |
| 18272 | changes from another. I believe the procedure must be like this: | |
| 18273 | ||
| 18274 | 1. M-x org-save-all-org-buffers | |
| 18275 | 2. Pull changes from the other machine, resolve conflicts | |
| 18276 | 3. M-x org-revert-all-org-buffers" | |
| 18277 | (interactive) | |
| 18278 | (unless (yes-or-no-p "Revert all Org buffers from their files? ") | |
| 18279 | (user-error "Abort")) | |
| 18280 | (save-excursion | |
| 18281 | (save-window-excursion | |
| 18282 | (dolist (b (buffer-list)) | |
| 18283 | (when (and (with-current-buffer b (derived-mode-p 'org-mode)) | |
| 18284 | (with-current-buffer b buffer-file-name)) | |
| 18285 | (pop-to-buffer-same-window b) | |
| 18286 | (revert-buffer t 'no-confirm))) | |
| 18287 | (when (and (featurep 'org-id) org-id-track-globally) | |
| 18288 | (org-id-locations-load))))) | |
| 18289 | ||
| 18290 | ;;;; Agenda files | |
| 18291 | ||
| 18292 | ;;;###autoload | |
| 18293 | (defun org-switchb (&optional arg) | |
| 18294 | "Switch between Org buffers. | |
| 18295 | ||
| 18296 | With `\\[universal-argument]' prefix, restrict available buffers to files. | |
| 18297 | ||
| 18298 | With `\\[universal-argument] \\[universal-argument]' \ | |
| 18299 | prefix, restrict available buffers to agenda files." | |
| 18300 | (interactive "P") | |
| 18301 | (let ((blist (org-buffer-list | |
| 18302 | (cond ((equal arg '(4)) 'files) | |
| 18303 | ((equal arg '(16)) 'agenda))))) | |
| 18304 | (pop-to-buffer-same-window | |
| 18305 | (completing-read "Org buffer: " | |
| 18306 | (mapcar #'list (mapcar #'buffer-name blist)) | |
| 18307 | nil t)))) | |
| 18308 | ||
| 18309 | (defun org-buffer-list (&optional predicate exclude-tmp) | |
| 18310 | "Return a list of Org buffers. | |
| 18311 | PREDICATE can be `export', `files' or `agenda'. | |
| 18312 | ||
| 18313 | export restrict the list to Export buffers. | |
| 18314 | files restrict the list to buffers visiting Org files. | |
| 18315 | agenda restrict the list to buffers visiting agenda files. | |
| 18316 | ||
| 18317 | If EXCLUDE-TMP is non-nil, ignore temporary buffers." | |
| 18318 | (let* ((bfn nil) | |
| 18319 | (agenda-files (and (eq predicate 'agenda) | |
| 18320 | (mapcar 'file-truename (org-agenda-files t)))) | |
| 18321 | (filter | |
| 18322 | (cond | |
| 18323 | ((eq predicate 'files) | |
| 18324 | (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) | |
| 18325 | ((eq predicate 'export) | |
| 18326 | (lambda (b) (string-match "\\*Org .*Export" (buffer-name b)))) | |
| 18327 | ((eq predicate 'agenda) | |
| 18328 | (lambda (b) | |
| 18329 | (with-current-buffer b | |
| 18330 | (and (derived-mode-p 'org-mode) | |
| 18331 | (setq bfn (buffer-file-name b)) | |
| 18332 | (member (file-truename bfn) agenda-files))))) | |
| 18333 | (t (lambda (b) (with-current-buffer b | |
| 18334 | (or (derived-mode-p 'org-mode) | |
| 18335 | (string-match "\\*Org .*Export" | |
| 18336 | (buffer-name b))))))))) | |
| 18337 | (delq nil | |
| 18338 | (mapcar | |
| 18339 | (lambda(b) | |
| 18340 | (if (and (funcall filter b) | |
| 18341 | (or (not exclude-tmp) | |
| 18342 | (not (string-match "tmp" (buffer-name b))))) | |
| 18343 | b | |
| 18344 | nil)) | |
| 18345 | (buffer-list))))) | |
| 18346 | ||
| 18347 | (defun org-agenda-files (&optional unrestricted archives) | |
| 18348 | "Get the list of agenda files. | |
| 18349 | Optional UNRESTRICTED means return the full list even if a restriction | |
| 18350 | is currently in place. | |
| 18351 | When ARCHIVES is t, include all archive files that are really being | |
| 18352 | used by the agenda files. If ARCHIVE is `ifmode', do this only if | |
| 18353 | `org-agenda-archives-mode' is t." | |
| 18354 | (let ((files | |
| 18355 | (cond | |
| 18356 | ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) | |
| 18357 | ((stringp org-agenda-files) (org-read-agenda-file-list)) | |
| 18358 | ((listp org-agenda-files) org-agenda-files) | |
| 18359 | (t (error "Invalid value of `org-agenda-files'"))))) | |
| 18360 | (setq files (apply 'append | |
| 18361 | (mapcar (lambda (f) | |
| 18362 | (if (file-directory-p f) | |
| 18363 | (directory-files | |
| 18364 | f t org-agenda-file-regexp) | |
| 18365 | (list f))) | |
| 18366 | files))) | |
| 18367 | (when org-agenda-skip-unavailable-files | |
| 18368 | (setq files (delq nil | |
| 18369 | (mapcar (function | |
| 18370 | (lambda (file) | |
| 18371 | (and (file-readable-p file) file))) | |
| 18372 | files)))) | |
| 18373 | (when (or (eq archives t) | |
| 18374 | (and (eq archives 'ifmode) (eq org-agenda-archives-mode t))) | |
| 18375 | (setq files (org-add-archive-files files))) | |
| 18376 | files)) | |
| 18377 | ||
| 18378 | (defun org-agenda-file-p (&optional file) | |
| 18379 | "Return non-nil, if FILE is an agenda file. | |
| 18380 | If FILE is omitted, use the file associated with the current | |
| 18381 | buffer." | |
| 18382 | (let ((fname (or file (buffer-file-name)))) | |
| 18383 | (and fname | |
| 18384 | (member (file-truename fname) | |
| 18385 | (mapcar #'file-truename (org-agenda-files t)))))) | |
| 18386 | ||
| 18387 | (defun org-edit-agenda-file-list () | |
| 18388 | "Edit the list of agenda files. | |
| 18389 | Depending on setup, this either uses customize to edit the variable | |
| 18390 | `org-agenda-files', or it visits the file that is holding the list. In the | |
| 18391 | latter case, the buffer is set up in a way that saving it automatically kills | |
| 18392 | the buffer and restores the previous window configuration." | |
| 18393 | (interactive) | |
| 18394 | (if (stringp org-agenda-files) | |
| 18395 | (let ((cw (current-window-configuration))) | |
| 18396 | (find-file org-agenda-files) | |
| 18397 | (setq-local org-window-configuration cw) | |
| 18398 | (add-hook 'after-save-hook | |
| 18399 | (lambda () | |
| 18400 | (set-window-configuration | |
| 18401 | (prog1 org-window-configuration | |
| 18402 | (kill-buffer (current-buffer)))) | |
| 18403 | (org-install-agenda-files-menu) | |
| 18404 | (message "New agenda file list installed")) | |
| 18405 | nil 'local) | |
| 18406 | (message "%s" (substitute-command-keys | |
| 18407 | "Edit list and finish with \\[save-buffer]"))) | |
| 18408 | (customize-variable 'org-agenda-files))) | |
| 18409 | ||
| 18410 | (defun org-store-new-agenda-file-list (list) | |
| 18411 | "Set new value for the agenda file list and save it correctly." | |
| 18412 | (if (stringp org-agenda-files) | |
| 18413 | (let ((fe (org-read-agenda-file-list t)) b u) | |
| 18414 | (while (setq b (find-buffer-visiting org-agenda-files)) | |
| 18415 | (kill-buffer b)) | |
| 18416 | (with-temp-file org-agenda-files | |
| 18417 | (insert | |
| 18418 | (mapconcat | |
| 18419 | (lambda (f) ;; Keep un-expanded entries. | |
| 18420 | (if (setq u (assoc f fe)) | |
| 18421 | (cdr u) | |
| 18422 | f)) | |
| 18423 | list "\n") | |
| 18424 | "\n"))) | |
| 18425 | (let ((org-mode-hook nil) (org-inhibit-startup t) | |
| 18426 | (org-insert-mode-line-in-empty-file nil)) | |
| 18427 | (setq org-agenda-files list) | |
| 18428 | (customize-save-variable 'org-agenda-files org-agenda-files)))) | |
| 18429 | ||
| 18430 | (defun org-read-agenda-file-list (&optional pair-with-expansion) | |
| 18431 | "Read the list of agenda files from a file. | |
| 18432 | If PAIR-WITH-EXPANSION is t return pairs with un-expanded | |
| 18433 | filenames, used by `org-store-new-agenda-file-list' to write back | |
| 18434 | un-expanded file names." | |
| 18435 | (when (file-directory-p org-agenda-files) | |
| 18436 | (error "`org-agenda-files' cannot be a single directory")) | |
| 18437 | (when (stringp org-agenda-files) | |
| 18438 | (with-temp-buffer | |
| 18439 | (insert-file-contents org-agenda-files) | |
| 18440 | (mapcar | |
| 18441 | (lambda (f) | |
| 18442 | (let ((e (expand-file-name (substitute-in-file-name f) | |
| 18443 | org-directory))) | |
| 18444 | (if pair-with-expansion | |
| 18445 | (cons e f) | |
| 18446 | e))) | |
| 18447 | (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*"))))) | |
| 18448 | ||
| 18449 | ;;;###autoload | |
| 18450 | (defun org-cycle-agenda-files () | |
| 18451 | "Cycle through the files in `org-agenda-files'. | |
| 18452 | If the current buffer visits an agenda file, find the next one in the list. | |
| 18453 | If the current buffer does not, find the first agenda file." | |
| 18454 | (interactive) | |
| 18455 | (let* ((fs (or (org-agenda-files t) | |
| 18456 | (user-error "No agenda files"))) | |
| 18457 | (files (copy-sequence fs)) | |
| 18458 | (tcf (and buffer-file-name (file-truename buffer-file-name))) | |
| 18459 | file) | |
| 18460 | (when tcf | |
| 18461 | (while (and (setq file (pop files)) | |
| 18462 | (not (equal (file-truename file) tcf))))) | |
| 18463 | (find-file (car (or files fs))) | |
| 18464 | (when (buffer-base-buffer) (pop-to-buffer-same-window (buffer-base-buffer))))) | |
| 18465 | ||
| 18466 | (defun org-agenda-file-to-front (&optional to-end) | |
| 18467 | "Move/add the current file to the top of the agenda file list. | |
| 18468 | If the file is not present in the list, it is added to the front. If it is | |
| 18469 | present, it is moved there. With optional argument TO-END, add/move to the | |
| 18470 | end of the list." | |
| 18471 | (interactive "P") | |
| 18472 | (let ((org-agenda-skip-unavailable-files nil) | |
| 18473 | (file-alist (mapcar (lambda (x) | |
| 18474 | (cons (file-truename x) x)) | |
| 18475 | (org-agenda-files t))) | |
| 18476 | (ctf (file-truename | |
| 18477 | (or buffer-file-name | |
| 18478 | (user-error "Please save the current buffer to a file")))) | |
| 18479 | x had) | |
| 18480 | (setq x (assoc ctf file-alist) had x) | |
| 18481 | ||
| 18482 | (unless x (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) | |
| 18483 | (if to-end | |
| 18484 | (setq file-alist (append (delq x file-alist) (list x))) | |
| 18485 | (setq file-alist (cons x (delq x file-alist)))) | |
| 18486 | (org-store-new-agenda-file-list (mapcar 'cdr file-alist)) | |
| 18487 | (org-install-agenda-files-menu) | |
| 18488 | (message "File %s to %s of agenda file list" | |
| 18489 | (if had "moved" "added") (if to-end "end" "front")))) | |
| 18490 | ||
| 18491 | (defun org-remove-file (&optional file) | |
| 18492 | "Remove current file from the list of files in variable `org-agenda-files'. | |
| 18493 | These are the files which are being checked for agenda entries. | |
| 18494 | Optional argument FILE means use this file instead of the current." | |
| 18495 | (interactive) | |
| 18496 | (let* ((org-agenda-skip-unavailable-files nil) | |
| 18497 | (file (or file buffer-file-name | |
| 18498 | (user-error "Current buffer does not visit a file"))) | |
| 18499 | (true-file (file-truename file)) | |
| 18500 | (afile (abbreviate-file-name file)) | |
| 18501 | (files (delq nil (mapcar | |
| 18502 | (lambda (x) | |
| 18503 | (unless (equal true-file | |
| 18504 | (file-truename x)) | |
| 18505 | x)) | |
| 18506 | (org-agenda-files t))))) | |
| 18507 | (if (not (= (length files) (length (org-agenda-files t)))) | |
| 18508 | (progn | |
| 18509 | (org-store-new-agenda-file-list files) | |
| 18510 | (org-install-agenda-files-menu) | |
| 18511 | (message "Removed from Org Agenda list: %s" afile)) | |
| 18512 | (message "File was not in list: %s (not removed)" afile)))) | |
| 18513 | ||
| 18514 | (defun org-file-menu-entry (file) | |
| 18515 | (vector file (list 'find-file file) t)) | |
| 18516 | ||
| 18517 | (defun org-check-agenda-file (file) | |
| 18518 | "Make sure FILE exists. If not, ask user what to do." | |
| 18519 | (unless (file-exists-p file) | |
| 18520 | (message "Non-existent agenda file %s. [R]emove from list or [A]bort?" | |
| 18521 | (abbreviate-file-name file)) | |
| 18522 | (let ((r (downcase (read-char-exclusive)))) | |
| 18523 | (cond | |
| 18524 | ((equal r ?r) | |
| 18525 | (org-remove-file file) | |
| 18526 | (throw 'nextfile t)) | |
| 18527 | (t (user-error "Abort")))))) | |
| 18528 | ||
| 18529 | (defun org-get-agenda-file-buffer (file) | |
| 18530 | "Get an agenda buffer visiting FILE. | |
| 18531 | If the buffer needs to be created, add it to the list of buffers | |
| 18532 | which might be released later." | |
| 18533 | (let ((buf (org-find-base-buffer-visiting file))) | |
| 18534 | (if buf | |
| 18535 | buf ; just return it | |
| 18536 | ;; Make a new buffer and remember it | |
| 18537 | (setq buf (find-file-noselect file)) | |
| 18538 | (when buf (push buf org-agenda-new-buffers)) | |
| 18539 | buf))) | |
| 18540 | ||
| 18541 | (defun org-release-buffers (blist) | |
| 18542 | "Release all buffers in list, asking the user for confirmation when needed. | |
| 18543 | When a buffer is unmodified, it is just killed. When modified, it is saved | |
| 18544 | \(if the user agrees) and then killed." | |
| 18545 | (let (file) | |
| 18546 | (dolist (buf blist) | |
| 18547 | (setq file (buffer-file-name buf)) | |
| 18548 | (when (and (buffer-modified-p buf) | |
| 18549 | file | |
| 18550 | (y-or-n-p (format "Save file %s? " file))) | |
| 18551 | (with-current-buffer buf (save-buffer))) | |
| 18552 | (kill-buffer buf)))) | |
| 18553 | ||
| 18554 | (defun org-agenda-prepare-buffers (files) | |
| 18555 | "Create buffers for all agenda files, protect archived trees and comments." | |
| 18556 | (interactive) | |
| 18557 | (let ((pa '(:org-archived t)) | |
| 18558 | (pc '(:org-comment t)) | |
| 18559 | (pall '(:org-archived t :org-comment t)) | |
| 18560 | (inhibit-read-only t) | |
| 18561 | (org-inhibit-startup org-agenda-inhibit-startup) | |
| 18562 | (rea (concat ":" org-archive-tag ":")) | |
| 18563 | re pos) | |
| 18564 | (setq org-tag-alist-for-agenda nil | |
| 18565 | org-tag-groups-alist-for-agenda nil) | |
| 18566 | (save-excursion | |
| 18567 | (save-restriction | |
| 18568 | (dolist (file files) | |
| 18569 | (catch 'nextfile | |
| 18570 | (if (bufferp file) | |
| 18571 | (set-buffer file) | |
| 18572 | (org-check-agenda-file file) | |
| 18573 | (set-buffer (org-get-agenda-file-buffer file))) | |
| 18574 | (widen) | |
| 18575 | (org-set-regexps-and-options 'tags-only) | |
| 18576 | (setq pos (point)) | |
| 18577 | (or (memq 'category org-agenda-ignore-properties) | |
| 18578 | (org-refresh-category-properties)) | |
| 18579 | (or (memq 'stats org-agenda-ignore-properties) | |
| 18580 | (org-refresh-stats-properties)) | |
| 18581 | (or (memq 'effort org-agenda-ignore-properties) | |
| 18582 | (org-refresh-effort-properties)) | |
| 18583 | (or (memq 'appt org-agenda-ignore-properties) | |
| 18584 | (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)) | |
| 18585 | (setq org-todo-keywords-for-agenda | |
| 18586 | (append org-todo-keywords-for-agenda org-todo-keywords-1)) | |
| 18587 | (setq org-done-keywords-for-agenda | |
| 18588 | (append org-done-keywords-for-agenda org-done-keywords)) | |
| 18589 | (setq org-todo-keyword-alist-for-agenda | |
| 18590 | (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) | |
| 18591 | (setq org-tag-alist-for-agenda | |
| 18592 | (org--tag-add-to-alist | |
| 18593 | org-tag-alist-for-agenda | |
| 18594 | org-current-tag-alist)) | |
| 18595 | ;; Merge current file's tag groups into global | |
| 18596 | ;; `org-tag-groups-alist-for-agenda'. | |
| 18597 | (when org-group-tags | |
| 18598 | (dolist (alist org-tag-groups-alist) | |
| 18599 | (let ((old (assoc (car alist) org-tag-groups-alist-for-agenda))) | |
| 18600 | (if old | |
| 18601 | (setcdr old (org-uniquify (append (cdr old) (cdr alist)))) | |
| 18602 | (push alist org-tag-groups-alist-for-agenda))))) | |
| 18603 | (org-with-silent-modifications | |
| 18604 | (save-excursion | |
| 18605 | (remove-text-properties (point-min) (point-max) pall) | |
| 18606 | (when org-agenda-skip-archived-trees | |
| 18607 | (goto-char (point-min)) | |
| 18608 | (while (re-search-forward rea nil t) | |
| 18609 | (when (org-at-heading-p t) | |
| 18610 | (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) | |
| 18611 | (goto-char (point-min)) | |
| 18612 | (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string)) | |
| 18613 | (while (re-search-forward re nil t) | |
| 18614 | (when (save-match-data (org-in-commented-heading-p t)) | |
| 18615 | (add-text-properties | |
| 18616 | (match-beginning 0) (org-end-of-subtree t) pc))))) | |
| 18617 | (goto-char pos))))) | |
| 18618 | (setq org-todo-keywords-for-agenda | |
| 18619 | (org-uniquify org-todo-keywords-for-agenda)) | |
| 18620 | (setq org-todo-keyword-alist-for-agenda | |
| 18621 | (org-uniquify org-todo-keyword-alist-for-agenda)))) | |
| 18622 | ||
| 18623 | ||
| 18624 | ;;;; CDLaTeX minor mode | |
| 18625 | ||
| 18626 | (defvar org-cdlatex-mode-map (make-sparse-keymap) | |
| 18627 | "Keymap for the minor `org-cdlatex-mode'.") | |
| 18628 | ||
| 18629 | (org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret) | |
| 18630 | (org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) | |
| 18631 | (org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol) | |
| 18632 | (org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) | |
| 18633 | (org-defkey org-cdlatex-mode-map "\C-c{" 'org-cdlatex-environment-indent) | |
| 18634 | ||
| 18635 | (defvar org-cdlatex-texmathp-advice-is-done nil | |
| 18636 | "Flag remembering if we have applied the advice to texmathp already.") | |
| 18637 | ||
| 18638 | (define-minor-mode org-cdlatex-mode | |
| 18639 | "Toggle the minor `org-cdlatex-mode'. | |
| 18640 | This mode supports entering LaTeX environment and math in LaTeX fragments | |
| 18641 | in Org mode. | |
| 18642 | \\{org-cdlatex-mode-map}" | |
| 18643 | nil " OCDL" nil | |
| 18644 | (when org-cdlatex-mode | |
| 18645 | (require 'cdlatex) | |
| 18646 | (run-hooks 'cdlatex-mode-hook) | |
| 18647 | (cdlatex-compute-tables)) | |
| 18648 | (unless org-cdlatex-texmathp-advice-is-done | |
| 18649 | (setq org-cdlatex-texmathp-advice-is-done t) | |
| 18650 | (defadvice texmathp (around org-math-always-on activate) | |
| 18651 | "Always return t in Org buffers. | |
| 18652 | This is because we want to insert math symbols without dollars even outside | |
| 18653 | the LaTeX math segments. If Org mode thinks that point is actually inside | |
| 18654 | an embedded LaTeX fragment, let `texmathp' do its job. | |
| 18655 | `\\[org-cdlatex-mode-map]'" | |
| 18656 | (interactive) | |
| 18657 | (let (p) | |
| 18658 | (cond | |
| 18659 | ((not (derived-mode-p 'org-mode)) ad-do-it) | |
| 18660 | ((eq this-command 'cdlatex-math-symbol) | |
| 18661 | (setq ad-return-value t | |
| 18662 | texmathp-why '("cdlatex-math-symbol in org-mode" . 0))) | |
| 18663 | (t | |
| 18664 | (let ((p (org-inside-LaTeX-fragment-p))) | |
| 18665 | (if (and p (member (car p) (plist-get org-format-latex-options :matchers))) | |
| 18666 | (setq ad-return-value t | |
| 18667 | texmathp-why '("Org mode embedded math" . 0)) | |
| 18668 | (when p ad-do-it))))))))) | |
| 18669 | ||
| 18670 | (defun turn-on-org-cdlatex () | |
| 18671 | "Unconditionally turn on `org-cdlatex-mode'." | |
| 18672 | (org-cdlatex-mode 1)) | |
| 18673 | ||
| 18674 | (defun org-try-cdlatex-tab () | |
| 18675 | "Check if it makes sense to execute `cdlatex-tab', and do it if yes. | |
| 18676 | It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is | |
| 18677 | - inside a LaTeX fragment, or | |
| 18678 | - after the first word in a line, where an abbreviation expansion could | |
| 18679 | insert a LaTeX environment." | |
| 18680 | (when org-cdlatex-mode | |
| 18681 | (cond | |
| 18682 | ;; Before any word on the line: No expansion possible. | |
| 18683 | ((save-excursion (skip-chars-backward " \t") (bolp)) nil) | |
| 18684 | ;; Just after first word on the line: Expand it. Make sure it | |
| 18685 | ;; cannot happen on headlines, though. | |
| 18686 | ((save-excursion | |
| 18687 | (skip-chars-backward "a-zA-Z0-9*") | |
| 18688 | (skip-chars-backward " \t") | |
| 18689 | (and (bolp) (not (org-at-heading-p)))) | |
| 18690 | (cdlatex-tab) t) | |
| 18691 | ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) | |
| 18692 | ||
| 18693 | (defun org-cdlatex-underscore-caret (&optional _arg) | |
| 18694 | "Execute `cdlatex-sub-superscript' in LaTeX fragments. | |
| 18695 | Revert to the normal definition outside of these fragments." | |
| 18696 | (interactive "P") | |
| 18697 | (if (org-inside-LaTeX-fragment-p) | |
| 18698 | (call-interactively 'cdlatex-sub-superscript) | |
| 18699 | (let (org-cdlatex-mode) | |
| 18700 | (call-interactively (key-binding (vector last-input-event)))))) | |
| 18701 | ||
| 18702 | (defun org-cdlatex-math-modify (&optional _arg) | |
| 18703 | "Execute `cdlatex-math-modify' in LaTeX fragments. | |
| 18704 | Revert to the normal definition outside of these fragments." | |
| 18705 | (interactive "P") | |
| 18706 | (if (org-inside-LaTeX-fragment-p) | |
| 18707 | (call-interactively 'cdlatex-math-modify) | |
| 18708 | (let (org-cdlatex-mode) | |
| 18709 | (call-interactively (key-binding (vector last-input-event)))))) | |
| 18710 | ||
| 18711 | (defun org-cdlatex-environment-indent (&optional environment item) | |
| 18712 | "Execute `cdlatex-environment' and indent the inserted environment. | |
| 18713 | ||
| 18714 | ENVIRONMENT and ITEM are passed to `cdlatex-environment'. | |
| 18715 | ||
| 18716 | The inserted environment is indented to current indentation | |
| 18717 | unless point is at the beginning of the line, in which the | |
| 18718 | environment remains unintended." | |
| 18719 | (interactive) | |
| 18720 | ;; cdlatex-environment always return nil. Therefore, capture output | |
| 18721 | ;; first and determine if an environment was selected. | |
| 18722 | (let* ((beg (point-marker)) | |
| 18723 | (end (copy-marker (point) t)) | |
| 18724 | (inserted (progn | |
| 18725 | (ignore-errors (cdlatex-environment environment item)) | |
| 18726 | (< beg end))) | |
| 18727 | ;; Figure out how many lines to move forward after the | |
| 18728 | ;; environment has been inserted. | |
| 18729 | (lines (when inserted | |
| 18730 | (save-excursion | |
| 18731 | (- (cl-loop while (< beg (point)) | |
| 18732 | with x = 0 | |
| 18733 | do (forward-line -1) | |
| 18734 | (cl-incf x) | |
| 18735 | finally return x) | |
| 18736 | (if (progn (goto-char beg) | |
| 18737 | (and (progn (skip-chars-forward " \t") (eolp)) | |
| 18738 | (progn (skip-chars-backward " \t") (bolp)))) | |
| 18739 | 1 0))))) | |
| 18740 | (env (org-trim (delete-and-extract-region beg end)))) | |
| 18741 | (when inserted | |
| 18742 | ;; Get indentation of next line unless at column 0. | |
| 18743 | (let ((ind (if (bolp) 0 | |
| 18744 | (save-excursion | |
| 18745 | (org-return-indent) | |
| 18746 | (prog1 (org-get-indentation) | |
| 18747 | (when (progn (skip-chars-forward " \t") (eolp)) | |
| 18748 | (delete-region beg (point))))))) | |
| 18749 | (bol (progn (skip-chars-backward " \t") (bolp)))) | |
| 18750 | ;; Insert a newline before environment unless at column zero | |
| 18751 | ;; to "escape" the current line. Insert a newline if | |
| 18752 | ;; something is one the same line as \end{ENVIRONMENT}. | |
| 18753 | (insert | |
| 18754 | (concat (unless bol "\n") env | |
| 18755 | (when (and (skip-chars-forward " \t") (not (eolp))) "\n"))) | |
| 18756 | (unless (zerop ind) | |
| 18757 | (save-excursion | |
| 18758 | (goto-char beg) | |
| 18759 | (while (< (point) end) | |
| 18760 | (unless (eolp) (indent-line-to ind)) | |
| 18761 | (forward-line)))) | |
| 18762 | (goto-char beg) | |
| 18763 | (forward-line lines) | |
| 18764 | (indent-line-to ind))) | |
| 18765 | (set-marker beg nil) | |
| 18766 | (set-marker end nil))) | |
| 18767 | ||
| 18768 | ||
| 18769 | ;;;; LaTeX fragments | |
| 18770 | ||
| 18771 | (defun org-inside-LaTeX-fragment-p () | |
| 18772 | "Test if point is inside a LaTeX fragment. | |
| 18773 | I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing | |
| 18774 | sequence appearing also before point. | |
| 18775 | Even though the matchers for math are configurable, this function assumes | |
| 18776 | that \\begin, \\(, \\[, and $$ are always used. Only the single dollar | |
| 18777 | delimiters are skipped when they have been removed by customization. | |
| 18778 | The return value is nil, or a cons cell with the delimiter and the | |
| 18779 | position of this delimiter. | |
| 18780 | ||
| 18781 | This function does a reasonably good job, but can locally be fooled by | |
| 18782 | for example currency specifications. For example it will assume being in | |
| 18783 | inline math after \"$22.34\". The LaTeX fragment formatter will only format | |
| 18784 | fragments that are properly closed, but during editing, we have to live | |
| 18785 | with the uncertainty caused by missing closing delimiters. This function | |
| 18786 | looks only before point, not after." | |
| 18787 | (catch 'exit | |
| 18788 | (let ((pos (point)) | |
| 18789 | (dodollar (member "$" (plist-get org-format-latex-options :matchers))) | |
| 18790 | (lim (save-excursion (org-backward-paragraph) (point))) | |
| 18791 | dd-on str (start 0) m re) | |
| 18792 | (goto-char pos) | |
| 18793 | (when dodollar | |
| 18794 | (setq str (concat (buffer-substring lim (point)) "\000 X$.") | |
| 18795 | re (nth 1 (assoc "$" org-latex-regexps))) | |
| 18796 | (while (string-match re str start) | |
| 18797 | (cond | |
| 18798 | ((= (match-end 0) (length str)) | |
| 18799 | (throw 'exit (cons "$" (+ lim (match-beginning 0) 1)))) | |
| 18800 | ((= (match-end 0) (- (length str) 5)) | |
| 18801 | (throw 'exit nil)) | |
| 18802 | (t (setq start (match-end 0)))))) | |
| 18803 | (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t)) | |
| 18804 | (goto-char pos) | |
| 18805 | (and (match-beginning 1) (throw 'exit (cons (match-string 1) m))) | |
| 18806 | (and (match-beginning 2) (throw 'exit nil)) | |
| 18807 | ;; count $$ | |
| 18808 | (while (re-search-backward "\\$\\$" lim t) | |
| 18809 | (setq dd-on (not dd-on))) | |
| 18810 | (goto-char pos) | |
| 18811 | (when dd-on (cons "$$" m)))))) | |
| 18812 | ||
| 18813 | (defun org-inside-latex-macro-p () | |
| 18814 | "Is point inside a LaTeX macro or its arguments?" | |
| 18815 | (save-match-data | |
| 18816 | (org-in-regexp | |
| 18817 | "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) | |
| 18818 | ||
| 18819 | (defun org--format-latex-make-overlay (beg end image &optional imagetype) | |
| 18820 | "Build an overlay between BEG and END using IMAGE file. | |
| 18821 | Argument IMAGETYPE is the extension of the displayed image, | |
| 18822 | as a string. It defaults to \"png\"." | |
| 18823 | (let ((ov (make-overlay beg end)) | |
| 18824 | (imagetype (or (intern imagetype) 'png))) | |
| 18825 | (overlay-put ov 'org-overlay-type 'org-latex-overlay) | |
| 18826 | (overlay-put ov 'evaporate t) | |
| 18827 | (overlay-put ov | |
| 18828 | 'modification-hooks | |
| 18829 | (list (lambda (o _flag _beg _end &optional _l) | |
| 18830 | (delete-overlay o)))) | |
| 18831 | (overlay-put ov | |
| 18832 | 'display | |
| 18833 | (list 'image :type imagetype :file image :ascent 'center)))) | |
| 18834 | ||
| 18835 | (defun org--list-latex-overlays (&optional beg end) | |
| 18836 | "List all Org LaTeX overlays in current buffer. | |
| 18837 | Limit to overlays between BEG and END when those are provided." | |
| 18838 | (cl-remove-if-not | |
| 18839 | (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)) | |
| 18840 | (overlays-in (or beg (point-min)) (or end (point-max))))) | |
| 18841 | ||
| 18842 | (defun org-remove-latex-fragment-image-overlays (&optional beg end) | |
| 18843 | "Remove all overlays with LaTeX fragment images in current buffer. | |
| 18844 | When optional arguments BEG and END are non-nil, remove all | |
| 18845 | overlays between them instead. Return a non-nil value when some | |
| 18846 | overlays were removed, nil otherwise." | |
| 18847 | (let ((overlays (org--list-latex-overlays beg end))) | |
| 18848 | (mapc #'delete-overlay overlays) | |
| 18849 | overlays)) | |
| 18850 | ||
| 18851 | (defun org-toggle-latex-fragment (&optional arg) | |
| 18852 | "Preview the LaTeX fragment at point, or all locally or globally. | |
| 18853 | ||
| 18854 | If the cursor is on a LaTeX fragment, create the image and overlay | |
| 18855 | it over the source code, if there is none. Remove it otherwise. | |
| 18856 | If there is no fragment at point, display all fragments in the | |
| 18857 | current section. | |
| 18858 | ||
| 18859 | With prefix ARG, preview or clear image for all fragments in the | |
| 18860 | current subtree or in the whole buffer when used before the first | |
| 18861 | headline. With a prefix ARG `\\[universal-argument] \ | |
| 18862 | \\[universal-argument]' preview or clear images | |
| 18863 | for all fragments in the buffer." | |
| 18864 | (interactive "P") | |
| 18865 | (when (display-graphic-p) | |
| 18866 | (catch 'exit | |
| 18867 | (save-excursion | |
| 18868 | (let (beg end msg) | |
| 18869 | (cond | |
| 18870 | ((or (equal arg '(16)) | |
| 18871 | (and (equal arg '(4)) | |
| 18872 | (org-with-limited-levels (org-before-first-heading-p)))) | |
| 18873 | (if (org-remove-latex-fragment-image-overlays) | |
| 18874 | (progn (message "LaTeX fragments images removed from buffer") | |
| 18875 | (throw 'exit nil)) | |
| 18876 | (setq msg "Creating images for buffer..."))) | |
| 18877 | ((equal arg '(4)) | |
| 18878 | (org-with-limited-levels (org-back-to-heading t)) | |
| 18879 | (setq beg (point)) | |
| 18880 | (setq end (progn (org-end-of-subtree t) (point))) | |
| 18881 | (if (org-remove-latex-fragment-image-overlays beg end) | |
| 18882 | (progn | |
| 18883 | (message "LaTeX fragment images removed from subtree") | |
| 18884 | (throw 'exit nil)) | |
| 18885 | (setq msg "Creating images for subtree..."))) | |
| 18886 | ((let ((datum (org-element-context))) | |
| 18887 | (when (memq (org-element-type datum) | |
| 18888 | '(latex-environment latex-fragment)) | |
| 18889 | (setq beg (org-element-property :begin datum)) | |
| 18890 | (setq end (org-element-property :end datum)) | |
| 18891 | (if (org-remove-latex-fragment-image-overlays beg end) | |
| 18892 | (progn (message "LaTeX fragment image removed") | |
| 18893 | (throw 'exit nil)) | |
| 18894 | (setq msg "Creating image..."))))) | |
| 18895 | (t | |
| 18896 | (org-with-limited-levels | |
| 18897 | (setq beg (if (org-at-heading-p) (line-beginning-position) | |
| 18898 | (outline-previous-heading) | |
| 18899 | (point))) | |
| 18900 | (setq end (progn (outline-next-heading) (point))) | |
| 18901 | (if (org-remove-latex-fragment-image-overlays beg end) | |
| 18902 | (progn | |
| 18903 | (message "LaTeX fragment images removed from section") | |
| 18904 | (throw 'exit nil)) | |
| 18905 | (setq msg "Creating images for section..."))))) | |
| 18906 | (let ((file (buffer-file-name (buffer-base-buffer)))) | |
| 18907 | (org-format-latex | |
| 18908 | (concat org-preview-latex-image-directory "org-ltximg") | |
| 18909 | beg end | |
| 18910 | ;; Emacs cannot overlay images from remote hosts. Create | |
| 18911 | ;; it in `temporary-file-directory' instead. | |
| 18912 | (if (or (not file) (file-remote-p file)) | |
| 18913 | temporary-file-directory | |
| 18914 | default-directory) | |
| 18915 | 'overlays msg 'forbuffer org-preview-latex-default-process)) | |
| 18916 | (message (concat msg "done"))))))) | |
| 18917 | ||
| 18918 | (defun org-format-latex | |
| 18919 | (prefix &optional beg end dir overlays msg forbuffer processing-type) | |
| 18920 | "Replace LaTeX fragments with links to an image. | |
| 18921 | ||
| 18922 | The function takes care of creating the replacement image. | |
| 18923 | ||
| 18924 | Only consider fragments between BEG and END when those are | |
| 18925 | provided. | |
| 18926 | ||
| 18927 | When optional argument OVERLAYS is non-nil, display the image on | |
| 18928 | top of the fragment instead of replacing it. | |
| 18929 | ||
| 18930 | PROCESSING-TYPE is the conversion method to use, as a symbol. | |
| 18931 | ||
| 18932 | Some of the options can be changed using the variable | |
| 18933 | `org-format-latex-options', which see." | |
| 18934 | (when (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) | |
| 18935 | (unless (eq processing-type 'verbatim) | |
| 18936 | (let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}") | |
| 18937 | (cnt 0) | |
| 18938 | checkdir-flag) | |
| 18939 | (goto-char (or beg (point-min))) | |
| 18940 | ;; Optimize overlay creation: (info "(elisp) Managing Overlays"). | |
| 18941 | (when (and overlays (memq processing-type '(dvipng imagemagick))) | |
| 18942 | (overlay-recenter (or end (point-max)))) | |
| 18943 | (while (re-search-forward math-regexp end t) | |
| 18944 | (unless (and overlays | |
| 18945 | (eq (get-char-property (point) 'org-overlay-type) | |
| 18946 | 'org-latex-overlay)) | |
| 18947 | (let* ((context (org-element-context)) | |
| 18948 | (type (org-element-type context))) | |
| 18949 | (when (memq type '(latex-environment latex-fragment)) | |
| 18950 | (let ((block-type (eq type 'latex-environment)) | |
| 18951 | (value (org-element-property :value context)) | |
| 18952 | (beg (org-element-property :begin context)) | |
| 18953 | (end (save-excursion | |
| 18954 | (goto-char (org-element-property :end context)) | |
| 18955 | (skip-chars-backward " \r\t\n") | |
| 18956 | (point)))) | |
| 18957 | (cond | |
| 18958 | ((eq processing-type 'mathjax) | |
| 18959 | ;; Prepare for MathJax processing. | |
| 18960 | (if (not (string-match "\\`\\$\\$?" value)) | |
| 18961 | (goto-char end) | |
| 18962 | (delete-region beg end) | |
| 18963 | (if (string= (match-string 0 value) "$$") | |
| 18964 | (insert "\\[" (substring value 2 -2) "\\]") | |
| 18965 | (insert "\\(" (substring value 1 -1) "\\)")))) | |
| 18966 | ((assq processing-type org-preview-latex-process-alist) | |
| 18967 | ;; Process to an image. | |
| 18968 | (cl-incf cnt) | |
| 18969 | (goto-char beg) | |
| 18970 | (let* ((processing-info | |
| 18971 | (cdr (assq processing-type org-preview-latex-process-alist))) | |
| 18972 | (face (face-at-point)) | |
| 18973 | ;; Get the colors from the face at point. | |
| 18974 | (fg | |
| 18975 | (let ((color (plist-get org-format-latex-options | |
| 18976 | :foreground))) | |
| 18977 | (if (and forbuffer (eq color 'auto)) | |
| 18978 | (face-attribute face :foreground nil 'default) | |
| 18979 | color))) | |
| 18980 | (bg | |
| 18981 | (let ((color (plist-get org-format-latex-options | |
| 18982 | :background))) | |
| 18983 | (if (and forbuffer (eq color 'auto)) | |
| 18984 | (face-attribute face :background nil 'default) | |
| 18985 | color))) | |
| 18986 | (hash (sha1 (prin1-to-string | |
| 18987 | (list org-format-latex-header | |
| 18988 | org-latex-default-packages-alist | |
| 18989 | org-latex-packages-alist | |
| 18990 | org-format-latex-options | |
| 18991 | forbuffer value fg bg)))) | |
| 18992 | (imagetype (or (plist-get processing-info :image-output-type) "png")) | |
| 18993 | (absprefix (expand-file-name prefix dir)) | |
| 18994 | (linkfile (format "%s_%s.%s" prefix hash imagetype)) | |
| 18995 | (movefile (format "%s_%s.%s" absprefix hash imagetype)) | |
| 18996 | (sep (and block-type "\n\n")) | |
| 18997 | (link (concat sep "[[file:" linkfile "]]" sep)) | |
| 18998 | (options | |
| 18999 | (org-combine-plists | |
| 19000 | org-format-latex-options | |
| 19001 | `(:foreground ,fg :background ,bg)))) | |
| 19002 | (when msg (message msg cnt)) | |
| 19003 | (unless checkdir-flag ; Ensure the directory exists. | |
| 19004 | (setq checkdir-flag t) | |
| 19005 | (let ((todir (file-name-directory absprefix))) | |
| 19006 | (unless (file-directory-p todir) | |
| 19007 | (make-directory todir t)))) | |
| 19008 | (unless (file-exists-p movefile) | |
| 19009 | (org-create-formula-image | |
| 19010 | value movefile options forbuffer processing-type)) | |
| 19011 | (if overlays | |
| 19012 | (progn | |
| 19013 | (dolist (o (overlays-in beg end)) | |
| 19014 | (when (eq (overlay-get o 'org-overlay-type) | |
| 19015 | 'org-latex-overlay) | |
| 19016 | (delete-overlay o))) | |
| 19017 | (org--format-latex-make-overlay beg end movefile imagetype) | |
| 19018 | (goto-char end)) | |
| 19019 | (delete-region beg end) | |
| 19020 | (insert | |
| 19021 | (org-add-props link | |
| 19022 | (list 'org-latex-src | |
| 19023 | (replace-regexp-in-string "\"" "" value) | |
| 19024 | 'org-latex-src-embed-type | |
| 19025 | (if block-type 'paragraph 'character))))))) | |
| 19026 | ((eq processing-type 'mathml) | |
| 19027 | ;; Process to MathML. | |
| 19028 | (unless (org-format-latex-mathml-available-p) | |
| 19029 | (user-error "LaTeX to MathML converter not configured")) | |
| 19030 | (cl-incf cnt) | |
| 19031 | (when msg (message msg cnt)) | |
| 19032 | (goto-char beg) | |
| 19033 | (delete-region beg end) | |
| 19034 | (insert (org-format-latex-as-mathml | |
| 19035 | value block-type prefix dir))) | |
| 19036 | (t | |
| 19037 | (error "Unknown conversion process %s for LaTeX fragments" | |
| 19038 | processing-type))))))))))) | |
| 19039 | ||
| 19040 | (defun org-create-math-formula (latex-frag &optional mathml-file) | |
| 19041 | "Convert LATEX-FRAG to MathML and store it in MATHML-FILE. | |
| 19042 | Use `org-latex-to-mathml-convert-command'. If the conversion is | |
| 19043 | sucessful, return the portion between \"<math...> </math>\" | |
| 19044 | elements otherwise return nil. When MATHML-FILE is specified, | |
| 19045 | write the results in to that file. When invoked as an | |
| 19046 | interactive command, prompt for LATEX-FRAG, with initial value | |
| 19047 | set to the current active region and echo the results for user | |
| 19048 | inspection." | |
| 19049 | (interactive (list (let ((frag (when (org-region-active-p) | |
| 19050 | (buffer-substring-no-properties | |
| 19051 | (region-beginning) (region-end))))) | |
| 19052 | (read-string "LaTeX Fragment: " frag nil frag)))) | |
| 19053 | (unless latex-frag (user-error "Invalid LaTeX fragment")) | |
| 19054 | (let* ((tmp-in-file | |
| 19055 | (let ((file (file-relative-name | |
| 19056 | (make-temp-name (expand-file-name "ltxmathml-in"))))) | |
| 19057 | (write-region latex-frag nil file) | |
| 19058 | file)) | |
| 19059 | (tmp-out-file (file-relative-name | |
| 19060 | (make-temp-name (expand-file-name "ltxmathml-out")))) | |
| 19061 | (cmd (format-spec | |
| 19062 | org-latex-to-mathml-convert-command | |
| 19063 | `((?j . ,(and org-latex-to-mathml-jar-file | |
| 19064 | (shell-quote-argument | |
| 19065 | (expand-file-name | |
| 19066 | org-latex-to-mathml-jar-file)))) | |
| 19067 | (?I . ,(shell-quote-argument tmp-in-file)) | |
| 19068 | (?i . ,latex-frag) | |
| 19069 | (?o . ,(shell-quote-argument tmp-out-file))))) | |
| 19070 | mathml shell-command-output) | |
| 19071 | (when (called-interactively-p 'any) | |
| 19072 | (unless (org-format-latex-mathml-available-p) | |
| 19073 | (user-error "LaTeX to MathML converter not configured"))) | |
| 19074 | (message "Running %s" cmd) | |
| 19075 | (setq shell-command-output (shell-command-to-string cmd)) | |
| 19076 | (setq mathml | |
| 19077 | (when (file-readable-p tmp-out-file) | |
| 19078 | (with-current-buffer (find-file-noselect tmp-out-file t) | |
| 19079 | (goto-char (point-min)) | |
| 19080 | (when (re-search-forward | |
| 19081 | (format "<math[^>]*?%s[^>]*?>\\(.\\|\n\\)*</math>" | |
| 19082 | (regexp-quote | |
| 19083 | "xmlns=\"http://www.w3.org/1998/Math/MathML\"")) | |
| 19084 | nil t) | |
| 19085 | (prog1 (match-string 0) (kill-buffer)))))) | |
| 19086 | (cond | |
| 19087 | (mathml | |
| 19088 | (setq mathml | |
| 19089 | (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml)) | |
| 19090 | (when mathml-file | |
| 19091 | (write-region mathml nil mathml-file)) | |
| 19092 | (when (called-interactively-p 'any) | |
| 19093 | (message mathml))) | |
| 19094 | ((message "LaTeX to MathML conversion failed") | |
| 19095 | (message shell-command-output))) | |
| 19096 | (delete-file tmp-in-file) | |
| 19097 | (when (file-exists-p tmp-out-file) | |
| 19098 | (delete-file tmp-out-file)) | |
| 19099 | mathml)) | |
| 19100 | ||
| 19101 | (defun org-format-latex-as-mathml (latex-frag latex-frag-type | |
| 19102 | prefix &optional dir) | |
| 19103 | "Use `org-create-math-formula' but check local cache first." | |
| 19104 | (let* ((absprefix (expand-file-name prefix dir)) | |
| 19105 | (print-length nil) (print-level nil) | |
| 19106 | (formula-id (concat | |
| 19107 | "formula-" | |
| 19108 | (sha1 | |
| 19109 | (prin1-to-string | |
| 19110 | (list latex-frag | |
| 19111 | org-latex-to-mathml-convert-command))))) | |
| 19112 | (formula-cache (format "%s-%s.mathml" absprefix formula-id)) | |
| 19113 | (formula-cache-dir (file-name-directory formula-cache))) | |
| 19114 | ||
| 19115 | (unless (file-directory-p formula-cache-dir) | |
| 19116 | (make-directory formula-cache-dir t)) | |
| 19117 | ||
| 19118 | (unless (file-exists-p formula-cache) | |
| 19119 | (org-create-math-formula latex-frag formula-cache)) | |
| 19120 | ||
| 19121 | (if (file-exists-p formula-cache) | |
| 19122 | ;; Successful conversion. Return the link to MathML file. | |
| 19123 | (org-add-props | |
| 19124 | (format "[[file:%s]]" (file-relative-name formula-cache dir)) | |
| 19125 | (list 'org-latex-src (replace-regexp-in-string "\"" "" latex-frag) | |
| 19126 | 'org-latex-src-embed-type (if latex-frag-type | |
| 19127 | 'paragraph 'character))) | |
| 19128 | ;; Failed conversion. Return the LaTeX fragment verbatim | |
| 19129 | latex-frag))) | |
| 19130 | ||
| 19131 | (defun org--get-display-dpi () | |
| 19132 | "Get the DPI of the display. | |
| 19133 | The function assumes that the display has the same pixel width in | |
| 19134 | the horizontal and vertical directions." | |
| 19135 | (if (display-graphic-p) | |
| 19136 | (round (/ (display-pixel-height) | |
| 19137 | (/ (display-mm-height) 25.4))) | |
| 19138 | (error "Attempt to calculate the dpi of a non-graphic display"))) | |
| 19139 | ||
| 19140 | (defun org-create-formula-image | |
| 19141 | (string tofile options buffer &optional processing-type) | |
| 19142 | "Create an image from LaTeX source using external processes. | |
| 19143 | ||
| 19144 | The LaTeX STRING is saved to a temporary LaTeX file, then | |
| 19145 | converted to an image file by process PROCESSING-TYPE defined in | |
| 19146 | `org-preview-latex-process-alist'. A nil value defaults to | |
| 19147 | `org-preview-latex-default-process'. | |
| 19148 | ||
| 19149 | The generated image file is eventually moved to TOFILE. | |
| 19150 | ||
| 19151 | The OPTIONS argument controls the size, foreground color and | |
| 19152 | background color of the generated image. | |
| 19153 | ||
| 19154 | When BUFFER non-nil, this function is used for LaTeX previewing. | |
| 19155 | Otherwise, it is used to deal with LaTeX snippets showed in | |
| 19156 | a HTML file." | |
| 19157 | (let* ((processing-type (or processing-type | |
| 19158 | org-preview-latex-default-process)) | |
| 19159 | (processing-info | |
| 19160 | (cdr (assq processing-type org-preview-latex-process-alist))) | |
| 19161 | (programs (plist-get processing-info :programs)) | |
| 19162 | (error-message (or (plist-get processing-info :message) "")) | |
| 19163 | (use-xcolor (plist-get processing-info :use-xcolor)) | |
| 19164 | (image-input-type (plist-get processing-info :image-input-type)) | |
| 19165 | (image-output-type (plist-get processing-info :image-output-type)) | |
| 19166 | (post-clean (or (plist-get processing-info :post-clean) | |
| 19167 | '(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log" | |
| 19168 | ".svg" ".png" ".jpg" ".jpeg" ".out"))) | |
| 19169 | (latex-header | |
| 19170 | (or (plist-get processing-info :latex-header) | |
| 19171 | (org-latex-make-preamble | |
| 19172 | (org-export-get-environment (org-export-get-backend 'latex)) | |
| 19173 | org-format-latex-header | |
| 19174 | 'snippet))) | |
| 19175 | (latex-compiler (plist-get processing-info :latex-compiler)) | |
| 19176 | (image-converter (plist-get processing-info :image-converter)) | |
| 19177 | (tmpdir temporary-file-directory) | |
| 19178 | (texfilebase (make-temp-name | |
| 19179 | (expand-file-name "orgtex" tmpdir))) | |
| 19180 | (texfile (concat texfilebase ".tex")) | |
| 19181 | (image-size-adjust (or (plist-get processing-info :image-size-adjust) | |
| 19182 | '(1.0 . 1.0))) | |
| 19183 | (scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust)) | |
| 19184 | (or (plist-get options (if buffer :scale :html-scale)) 1.0))) | |
| 19185 | (dpi (* scale (if buffer (org--get-display-dpi) 140.0))) | |
| 19186 | (fg (or (plist-get options (if buffer :foreground :html-foreground)) | |
| 19187 | "Black")) | |
| 19188 | (bg (or (plist-get options (if buffer :background :html-background)) | |
| 19189 | "Transparent")) | |
| 19190 | (log-buf (get-buffer-create "*Org Preview LaTeX Output*")) | |
| 19191 | (resize-mini-windows nil)) ;Fix Emacs flicker when creating image. | |
| 19192 | (dolist (program programs) | |
| 19193 | (org-check-external-command program error-message)) | |
| 19194 | (if use-xcolor | |
| 19195 | (progn (if (eq fg 'default) | |
| 19196 | (setq fg (org-latex-color :foreground)) | |
| 19197 | (setq fg (org-latex-color-format fg))) | |
| 19198 | (if (eq bg 'default) | |
| 19199 | (setq bg (org-latex-color :background)) | |
| 19200 | (setq bg (org-latex-color-format | |
| 19201 | (if (string= bg "Transparent") "white" bg)))) | |
| 19202 | (with-temp-file texfile | |
| 19203 | (insert latex-header) | |
| 19204 | (insert "\n\\begin{document}\n" | |
| 19205 | "\\definecolor{fg}{rgb}{" fg "}\n" | |
| 19206 | "\\definecolor{bg}{rgb}{" bg "}\n" | |
| 19207 | "\n\\pagecolor{bg}\n" | |
| 19208 | "\n{\\color{fg}\n" | |
| 19209 | string | |
| 19210 | "\n}\n" | |
| 19211 | "\n\\end{document}\n"))) | |
| 19212 | (if (eq fg 'default) | |
| 19213 | (setq fg (org-dvipng-color :foreground)) | |
| 19214 | (unless (string= fg "Transparent") | |
| 19215 | (setq fg (org-dvipng-color-format fg)))) | |
| 19216 | (if (eq bg 'default) | |
| 19217 | (setq bg (org-dvipng-color :background)) | |
| 19218 | (unless (string= bg "Transparent") | |
| 19219 | (setq bg (org-dvipng-color-format bg)))) | |
| 19220 | (with-temp-file texfile | |
| 19221 | (insert latex-header) | |
| 19222 | (insert "\n\\begin{document}\n" string "\n\\end{document}\n"))) | |
| 19223 | ||
| 19224 | (let* ((err-msg (format "Please adjust `%s' part of \ | |
| 19225 | `org-preview-latex-process-alist'." | |
| 19226 | processing-type)) | |
| 19227 | (image-input-file | |
| 19228 | (org-compile-file | |
| 19229 | texfile latex-compiler image-input-type err-msg log-buf)) | |
| 19230 | (image-output-file | |
| 19231 | (org-compile-file | |
| 19232 | image-input-file image-converter image-output-type err-msg log-buf | |
| 19233 | `((?F . ,(shell-quote-argument fg)) | |
| 19234 | (?B . ,(shell-quote-argument bg)) | |
| 19235 | (?D . ,(shell-quote-argument (format "%s" dpi))) | |
| 19236 | (?S . ,(shell-quote-argument (format "%s" (/ dpi 140.0)))))))) | |
| 19237 | (copy-file image-output-file tofile 'replace) | |
| 19238 | (dolist (e post-clean) | |
| 19239 | (when (file-exists-p (concat texfilebase e)) | |
| 19240 | (delete-file (concat texfilebase e)))) | |
| 19241 | image-output-file))) | |
| 19242 | ||
| 19243 | (defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) | |
| 19244 | "Fill a LaTeX header template TPL. | |
| 19245 | In the template, the following place holders will be recognized: | |
| 19246 | ||
| 19247 | [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG | |
| 19248 | [NO-DEFAULT-PACKAGES] do not include DEF-PKG | |
| 19249 | [PACKAGES] \\usepackage statements for PKG | |
| 19250 | [NO-PACKAGES] do not include PKG | |
| 19251 | [EXTRA] the string EXTRA | |
| 19252 | [NO-EXTRA] do not include EXTRA | |
| 19253 | ||
| 19254 | For backward compatibility, if both the positive and the negative place | |
| 19255 | holder is missing, the positive one (without the \"NO-\") will be | |
| 19256 | assumed to be present at the end of the template. | |
| 19257 | DEF-PKG and PKG are assumed to be alists of options/packagename lists. | |
| 19258 | EXTRA is a string. | |
| 19259 | SNIPPETS-P indicates if this is run to create snippet images for HTML." | |
| 19260 | (let (rpl (end "")) | |
| 19261 | (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl) | |
| 19262 | (setq rpl (if (or (match-end 1) (not def-pkg)) | |
| 19263 | "" (org-latex-packages-to-string def-pkg snippets-p t)) | |
| 19264 | tpl (replace-match rpl t t tpl)) | |
| 19265 | (when def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) | |
| 19266 | ||
| 19267 | (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl) | |
| 19268 | (setq rpl (if (or (match-end 1) (not pkg)) | |
| 19269 | "" (org-latex-packages-to-string pkg snippets-p t)) | |
| 19270 | tpl (replace-match rpl t t tpl)) | |
| 19271 | (when pkg (setq end | |
| 19272 | (concat end "\n" | |
| 19273 | (org-latex-packages-to-string pkg snippets-p))))) | |
| 19274 | ||
| 19275 | (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl) | |
| 19276 | (setq rpl (if (or (match-end 1) (not extra)) | |
| 19277 | "" (concat extra "\n")) | |
| 19278 | tpl (replace-match rpl t t tpl)) | |
| 19279 | (when (and extra (string-match "\\S-" extra)) | |
| 19280 | (setq end (concat end "\n" extra)))) | |
| 19281 | ||
| 19282 | (if (string-match "\\S-" end) | |
| 19283 | (concat tpl "\n" end) | |
| 19284 | tpl))) | |
| 19285 | ||
| 19286 | (defun org-latex-packages-to-string (pkg &optional snippets-p newline) | |
| 19287 | "Turn an alist of packages into a string with the \\usepackage macros." | |
| 19288 | (setq pkg (mapconcat (lambda(p) | |
| 19289 | (cond | |
| 19290 | ((stringp p) p) | |
| 19291 | ((and snippets-p (>= (length p) 3) (not (nth 2 p))) | |
| 19292 | (format "%% Package %s omitted" (cadr p))) | |
| 19293 | ((equal "" (car p)) | |
| 19294 | (format "\\usepackage{%s}" (cadr p))) | |
| 19295 | (t | |
| 19296 | (format "\\usepackage[%s]{%s}" | |
| 19297 | (car p) (cadr p))))) | |
| 19298 | pkg | |
| 19299 | "\n")) | |
| 19300 | (if newline (concat pkg "\n") pkg)) | |
| 19301 | ||
| 19302 | (defun org-dvipng-color (attr) | |
| 19303 | "Return a RGB color specification for dvipng." | |
| 19304 | (org-dvipng-color-format (face-attribute 'default attr nil))) | |
| 19305 | ||
| 19306 | (defun org-dvipng-color-format (color-name) | |
| 19307 | "Convert COLOR-NAME to a RGB color value for dvipng." | |
| 19308 | (apply #'format "rgb %s %s %s" | |
| 19309 | (mapcar 'org-normalize-color | |
| 19310 | (color-values color-name)))) | |
| 19311 | ||
| 19312 | (defun org-latex-color (attr) | |
| 19313 | "Return a RGB color for the LaTeX color package." | |
| 19314 | (org-latex-color-format (face-attribute 'default attr nil))) | |
| 19315 | ||
| 19316 | (defun org-latex-color-format (color-name) | |
| 19317 | "Convert COLOR-NAME to a RGB color value." | |
| 19318 | (apply #'format "%s,%s,%s" | |
| 19319 | (mapcar 'org-normalize-color | |
| 19320 | (color-values color-name)))) | |
| 19321 | ||
| 19322 | (defun org-normalize-color (value) | |
| 19323 | "Return string to be used as color value for an RGB component." | |
| 19324 | (format "%g" (/ value 65535.0))) | |
| 19325 | ||
| 19326 | ||
| 19327 | ||
| 19328 | ;; Image display | |
| 19329 | ||
| 19330 | (defvar-local org-inline-image-overlays nil) | |
| 19331 | ||
| 19332 | (defun org-toggle-inline-images (&optional include-linked) | |
| 19333 | "Toggle the display of inline images. | |
| 19334 | INCLUDE-LINKED is passed to `org-display-inline-images'." | |
| 19335 | (interactive "P") | |
| 19336 | (if org-inline-image-overlays | |
| 19337 | (progn | |
| 19338 | (org-remove-inline-images) | |
| 19339 | (when (called-interactively-p 'interactive) | |
| 19340 | (message "Inline image display turned off"))) | |
| 19341 | (org-display-inline-images include-linked) | |
| 19342 | (when (called-interactively-p 'interactive) | |
| 19343 | (message (if org-inline-image-overlays | |
| 19344 | (format "%d images displayed inline" | |
| 19345 | (length org-inline-image-overlays)) | |
| 19346 | "No images to display inline"))))) | |
| 19347 | ||
| 19348 | (defun org-redisplay-inline-images () | |
| 19349 | "Refresh the display of inline images." | |
| 19350 | (interactive) | |
| 19351 | (if (not org-inline-image-overlays) | |
| 19352 | (org-toggle-inline-images) | |
| 19353 | (org-toggle-inline-images) | |
| 19354 | (org-toggle-inline-images))) | |
| 19355 | ||
| 19356 | (defun org-display-inline-images (&optional include-linked refresh beg end) | |
| 19357 | "Display inline images. | |
| 19358 | ||
| 19359 | An inline image is a link which follows either of these | |
| 19360 | conventions: | |
| 19361 | ||
| 19362 | 1. Its path is a file with an extension matching return value | |
| 19363 | from `image-file-name-regexp' and it has no contents. | |
| 19364 | ||
| 19365 | 2. Its description consists in a single link of the previous | |
| 19366 | type. | |
| 19367 | ||
| 19368 | When optional argument INCLUDE-LINKED is non-nil, also links with | |
| 19369 | a text description part will be inlined. This can be nice for | |
| 19370 | a quick look at those images, but it does not reflect what | |
| 19371 | exported files will look like. | |
| 19372 | ||
| 19373 | When optional argument REFRESH is non-nil, refresh existing | |
| 19374 | images between BEG and END. This will create new image displays | |
| 19375 | only if necessary. BEG and END default to the buffer | |
| 19376 | boundaries." | |
| 19377 | (interactive "P") | |
| 19378 | (when (display-graphic-p) | |
| 19379 | (unless refresh | |
| 19380 | (org-remove-inline-images) | |
| 19381 | (when (fboundp 'clear-image-cache) (clear-image-cache))) | |
| 19382 | (org-with-wide-buffer | |
| 19383 | (goto-char (or beg (point-min))) | |
| 19384 | (let* ((case-fold-search t) | |
| 19385 | (file-extension-re (image-file-name-regexp)) | |
| 19386 | (link-abbrevs (mapcar #'car | |
| 19387 | (append org-link-abbrev-alist-local | |
| 19388 | org-link-abbrev-alist))) | |
| 19389 | ;; Check absolute, relative file names and explicit | |
| 19390 | ;; "file:" links. Also check link abbreviations since | |
| 19391 | ;; some might expand to "file" links. | |
| 19392 | (file-types-re (format "[][]\\[\\(?:file\\|[./~]%s\\)" | |
| 19393 | (if (not link-abbrevs) "" | |
| 19394 | (format "\\|\\(?:%s:\\)" | |
| 19395 | (regexp-opt link-abbrevs)))))) | |
| 19396 | (while (re-search-forward file-types-re end t) | |
| 19397 | (let ((link (save-match-data (org-element-context)))) | |
| 19398 | ;; Check if we're at an inline image, i.e., an image file | |
| 19399 | ;; link without a description (unless INCLUDE-LINKED is | |
| 19400 | ;; non-nil). | |
| 19401 | (when (and (equal "file" (org-element-property :type link)) | |
| 19402 | (or include-linked | |
| 19403 | (null (org-element-contents link))) | |
| 19404 | (string-match-p file-extension-re | |
| 19405 | (org-element-property :path link))) | |
| 19406 | (let ((file (expand-file-name | |
| 19407 | (org-link-unescape | |
| 19408 | (org-element-property :path link))))) | |
| 19409 | (when (file-exists-p file) | |
| 19410 | (let ((width | |
| 19411 | ;; Apply `org-image-actual-width' specifications. | |
| 19412 | (cond | |
| 19413 | ((not (image-type-available-p 'imagemagick)) nil) | |
| 19414 | ((eq org-image-actual-width t) nil) | |
| 19415 | ((listp org-image-actual-width) | |
| 19416 | (or | |
| 19417 | ;; First try to find a width among | |
| 19418 | ;; attributes associated to the paragraph | |
| 19419 | ;; containing link. | |
| 19420 | (let ((paragraph | |
| 19421 | (let ((e link)) | |
| 19422 | (while (and (setq e (org-element-property | |
| 19423 | :parent e)) | |
| 19424 | (not (eq (org-element-type e) | |
| 19425 | 'paragraph)))) | |
| 19426 | e))) | |
| 19427 | (when paragraph | |
| 19428 | (save-excursion | |
| 19429 | (goto-char (org-element-property :begin paragraph)) | |
| 19430 | (when | |
| 19431 | (re-search-forward | |
| 19432 | "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)" | |
| 19433 | (org-element-property | |
| 19434 | :post-affiliated paragraph) | |
| 19435 | t) | |
| 19436 | (string-to-number (match-string 1)))))) | |
| 19437 | ;; Otherwise, fall-back to provided number. | |
| 19438 | (car org-image-actual-width))) | |
| 19439 | ((numberp org-image-actual-width) | |
| 19440 | org-image-actual-width))) | |
| 19441 | (old (get-char-property-and-overlay | |
| 19442 | (org-element-property :begin link) | |
| 19443 | 'org-image-overlay))) | |
| 19444 | (if (and (car-safe old) refresh) | |
| 19445 | (image-refresh (overlay-get (cdr old) 'display)) | |
| 19446 | (let ((image (create-image file | |
| 19447 | (and width 'imagemagick) | |
| 19448 | nil | |
| 19449 | :width width))) | |
| 19450 | (when image | |
| 19451 | (let ((ov (make-overlay | |
| 19452 | (org-element-property :begin link) | |
| 19453 | (progn | |
| 19454 | (goto-char | |
| 19455 | (org-element-property :end link)) | |
| 19456 | (skip-chars-backward " \t") | |
| 19457 | (point))))) | |
| 19458 | (overlay-put ov 'display image) | |
| 19459 | (overlay-put ov 'face 'default) | |
| 19460 | (overlay-put ov 'org-image-overlay t) | |
| 19461 | (overlay-put | |
| 19462 | ov 'modification-hooks | |
| 19463 | (list 'org-display-inline-remove-overlay)) | |
| 19464 | (push ov org-inline-image-overlays))))))))))))))) | |
| 19465 | ||
| 19466 | (defun org-display-inline-remove-overlay (ov after _beg _end &optional _len) | |
| 19467 | "Remove inline-display overlay if a corresponding region is modified." | |
| 19468 | (let ((inhibit-modification-hooks t)) | |
| 19469 | (when (and ov after) | |
| 19470 | (delete ov org-inline-image-overlays) | |
| 19471 | (delete-overlay ov)))) | |
| 19472 | ||
| 19473 | (defun org-remove-inline-images () | |
| 19474 | "Remove inline display of images." | |
| 19475 | (interactive) | |
| 19476 | (mapc #'delete-overlay org-inline-image-overlays) | |
| 19477 | (setq org-inline-image-overlays nil)) | |
| 19478 | ||
| 19479 | ;;;; Key bindings | |
| 19480 | ||
| 19481 | (defun org-remap (map &rest commands) | |
| 19482 | "In MAP, remap the functions given in COMMANDS. | |
| 19483 | COMMANDS is a list of alternating OLDDEF NEWDEF command names." | |
| 19484 | (let (new old) | |
| 19485 | (while commands | |
| 19486 | (setq old (pop commands) new (pop commands)) | |
| 19487 | (org-defkey map (vector 'remap old) new)))) | |
| 19488 | ||
| 19489 | ;; Outline functions from `outline-mode-prefix-map' | |
| 19490 | ;; that can be remapped in Org: | |
| 19491 | (define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree) | |
| 19492 | (define-key org-mode-map [remap outline-show-subtree] 'org-show-subtree) | |
| 19493 | (define-key org-mode-map [remap outline-forward-same-level] | |
| 19494 | 'org-forward-heading-same-level) | |
| 19495 | (define-key org-mode-map [remap outline-backward-same-level] | |
| 19496 | 'org-backward-heading-same-level) | |
| 19497 | (define-key org-mode-map [remap outline-show-branches] | |
| 19498 | 'org-kill-note-or-show-branches) | |
| 19499 | (define-key org-mode-map [remap outline-promote] 'org-promote-subtree) | |
| 19500 | (define-key org-mode-map [remap outline-demote] 'org-demote-subtree) | |
| 19501 | (define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret) | |
| 19502 | (define-key org-mode-map [remap outline-next-visible-heading] | |
| 19503 | 'org-next-visible-heading) | |
| 19504 | (define-key org-mode-map [remap outline-previous-visible-heading] | |
| 19505 | 'org-previous-visible-heading) | |
| 19506 | (define-key org-mode-map [remap show-children] 'org-show-children) | |
| 19507 | ||
| 19508 | ;; Outline functions from `outline-mode-prefix-map' that can not | |
| 19509 | ;; be remapped in Org: | |
| 19510 | ||
| 19511 | ;; - the column "key binding" shows whether the Outline function is still | |
| 19512 | ;; available in Org mode on the same key that it has been bound to in | |
| 19513 | ;; Outline mode: | |
| 19514 | ;; - "overridden": key used for a different functionality in Org mode | |
| 19515 | ;; - else: key still bound to the same Outline function in Org mode | |
| 19516 | ||
| 19517 | ;; | Outline function | key binding | Org replacement | | |
| 19518 | ;; |------------------------------------+-------------+--------------------------| | |
| 19519 | ;; | `outline-up-heading' | `C-c C-u' | still same function | | |
| 19520 | ;; | `outline-move-subtree-up' | overridden | better: org-shiftup | | |
| 19521 | ;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | | |
| 19522 | ;; | `show-entry' | overridden | no replacement | | |
| 19523 | ;; | `show-branches' | `C-c C-k' | still same function | | |
| 19524 | ;; | `show-subtree' | overridden | visibility cycling | | |
| 19525 | ;; | `show-all' | overridden | no replacement | | |
| 19526 | ;; | `hide-subtree' | overridden | visibility cycling | | |
| 19527 | ;; | `hide-body' | overridden | no replacement | | |
| 19528 | ;; | `hide-entry' | overridden | visibility cycling | | |
| 19529 | ;; | `hide-leaves' | overridden | no replacement | | |
| 19530 | ;; | `hide-sublevels' | overridden | no replacement | | |
| 19531 | ;; | `hide-other' | overridden | no replacement | | |
| 19532 | ||
| 19533 | ;; Make `C-c C-x' a prefix key | |
| 19534 | (org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) | |
| 19535 | ||
| 19536 | ;; TAB key with modifiers | |
| 19537 | (org-defkey org-mode-map "\C-i" 'org-cycle) | |
| 19538 | (org-defkey org-mode-map [(tab)] 'org-cycle) | |
| 19539 | (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) | |
| 19540 | (org-defkey org-mode-map "\M-\t" #'pcomplete) | |
| 19541 | ||
| 19542 | ;; The following line is necessary under Suse GNU/Linux | |
| 19543 | (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab) | |
| 19544 | (org-defkey org-mode-map [(shift tab)] 'org-shifttab) | |
| 19545 | (define-key org-mode-map [backtab] 'org-shifttab) | |
| 19546 | ||
| 19547 | (org-defkey org-mode-map [(shift return)] 'org-table-copy-down) | |
| 19548 | (org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) | |
| 19549 | (org-defkey org-mode-map (kbd "M-RET") #'org-meta-return) | |
| 19550 | ||
| 19551 | ;; Cursor keys with modifiers | |
| 19552 | (org-defkey org-mode-map [(meta left)] 'org-metaleft) | |
| 19553 | (org-defkey org-mode-map [(meta right)] 'org-metaright) | |
| 19554 | (org-defkey org-mode-map [(meta up)] 'org-metaup) | |
| 19555 | (org-defkey org-mode-map [(meta down)] 'org-metadown) | |
| 19556 | ||
| 19557 | (org-defkey org-mode-map [(control meta shift right)] 'org-increase-number-at-point) | |
| 19558 | (org-defkey org-mode-map [(control meta shift left)] 'org-decrease-number-at-point) | |
| 19559 | (org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft) | |
| 19560 | (org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright) | |
| 19561 | (org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup) | |
| 19562 | (org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown) | |
| 19563 | ||
| 19564 | (org-defkey org-mode-map [(shift up)] 'org-shiftup) | |
| 19565 | (org-defkey org-mode-map [(shift down)] 'org-shiftdown) | |
| 19566 | (org-defkey org-mode-map [(shift left)] 'org-shiftleft) | |
| 19567 | (org-defkey org-mode-map [(shift right)] 'org-shiftright) | |
| 19568 | ||
| 19569 | (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) | |
| 19570 | (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) | |
| 19571 | (org-defkey org-mode-map [(control shift up)] 'org-shiftcontrolup) | |
| 19572 | (org-defkey org-mode-map [(control shift down)] 'org-shiftcontroldown) | |
| 19573 | ||
| 19574 | ;; Babel keys | |
| 19575 | (define-key org-mode-map org-babel-key-prefix org-babel-map) | |
| 19576 | (dolist (pair org-babel-key-bindings) | |
| 19577 | (define-key org-babel-map (car pair) (cdr pair))) | |
| 19578 | ||
| 19579 | ;;; Extra keys for tty access. | |
| 19580 | ;; We only set them when really needed because otherwise the | |
| 19581 | ;; menus don't show the simple keys | |
| 19582 | ||
| 19583 | (when (or org-use-extra-keys (not window-system)) | |
| 19584 | (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down) | |
| 19585 | (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) | |
| 19586 | (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return) | |
| 19587 | (org-defkey org-mode-map [?\e (return)] 'org-meta-return) | |
| 19588 | (org-defkey org-mode-map [?\e (left)] 'org-metaleft) | |
| 19589 | (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft) | |
| 19590 | (org-defkey org-mode-map [?\e (right)] 'org-metaright) | |
| 19591 | (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright) | |
| 19592 | (org-defkey org-mode-map [?\e (up)] 'org-metaup) | |
| 19593 | (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup) | |
| 19594 | (org-defkey org-mode-map [?\e (down)] 'org-metadown) | |
| 19595 | (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown) | |
| 19596 | (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft) | |
| 19597 | (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright) | |
| 19598 | (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup) | |
| 19599 | (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown) | |
| 19600 | (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup) | |
| 19601 | (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown) | |
| 19602 | (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft) | |
| 19603 | (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) | |
| 19604 | (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) | |
| 19605 | (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft) | |
| 19606 | (org-defkey org-mode-map [?\e (tab)] #'pcomplete) | |
| 19607 | (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading) | |
| 19608 | (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) | |
| 19609 | (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) | |
| 19610 | (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup) | |
| 19611 | (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown)) | |
| 19612 | ||
| 19613 | ;; All the other keys | |
| 19614 | (org-remap org-mode-map | |
| 19615 | 'self-insert-command 'org-self-insert-command | |
| 19616 | 'delete-char 'org-delete-char | |
| 19617 | 'delete-backward-char 'org-delete-backward-char) | |
| 19618 | (org-defkey org-mode-map "|" 'org-force-self-insert) | |
| 19619 | ||
| 19620 | (org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up. | |
| 19621 | (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) | |
| 19622 | (if (boundp 'narrow-map) | |
| 19623 | (org-defkey narrow-map "s" 'org-narrow-to-subtree) | |
| 19624 | (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) | |
| 19625 | (if (boundp 'narrow-map) | |
| 19626 | (org-defkey narrow-map "b" 'org-narrow-to-block) | |
| 19627 | (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block)) | |
| 19628 | (if (boundp 'narrow-map) | |
| 19629 | (org-defkey narrow-map "e" 'org-narrow-to-element) | |
| 19630 | (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element)) | |
| 19631 | (org-defkey org-mode-map "\C-\M-t" 'org-transpose-element) | |
| 19632 | (org-defkey org-mode-map "\M-}" 'org-forward-element) | |
| 19633 | (org-defkey org-mode-map "\M-{" 'org-backward-element) | |
| 19634 | (org-defkey org-mode-map "\C-c\C-^" 'org-up-element) | |
| 19635 | (org-defkey org-mode-map "\C-c\C-_" 'org-down-element) | |
| 19636 | (org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level) | |
| 19637 | (org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level) | |
| 19638 | (org-defkey org-mode-map "\C-c\M-f" 'org-next-block) | |
| 19639 | (org-defkey org-mode-map "\C-c\M-b" 'org-previous-block) | |
| 19640 | (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) | |
| 19641 | (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-archive-subtree) | |
| 19642 | (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default) | |
| 19643 | (org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer) | |
| 19644 | (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) | |
| 19645 | (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) | |
| 19646 | (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) | |
| 19647 | (org-defkey org-mode-map "\C-c\C-xq" 'org-toggle-tags-groups) | |
| 19648 | (org-defkey org-mode-map "\C-c\C-j" 'org-goto) | |
| 19649 | (org-defkey org-mode-map "\C-c\C-t" 'org-todo) | |
| 19650 | (org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command) | |
| 19651 | (org-defkey org-mode-map "\C-c\C-s" 'org-schedule) | |
| 19652 | (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) | |
| 19653 | (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) | |
| 19654 | (org-defkey org-mode-map "\C-c\C-w" 'org-refile) | |
| 19655 | (org-defkey org-mode-map "\C-c\M-w" 'org-copy) | |
| 19656 | (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved | |
| 19657 | (org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. | |
| 19658 | (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) | |
| 19659 | (org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift) | |
| 19660 | (org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible) | |
| 19661 | (org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) | |
| 19662 | (org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content) | |
| 19663 | (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) | |
| 19664 | (org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) | |
| 19665 | (org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) | |
| 19666 | (org-defkey org-mode-map "\C-c\M-l" 'org-insert-last-stored-link) | |
| 19667 | (org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links) | |
| 19668 | (org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) | |
| 19669 | (org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) | |
| 19670 | (org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto) | |
| 19671 | (org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding | |
| 19672 | (org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved | |
| 19673 | (org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r. | |
| 19674 | (org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved | |
| 19675 | (org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range) | |
| 19676 | (org-defkey org-mode-map "\C-c>" 'org-goto-calendar) | |
| 19677 | (org-defkey org-mode-map "\C-c<" 'org-date-from-calendar) | |
| 19678 | (org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files) | |
| 19679 | (org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) | |
| 19680 | (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) | |
| 19681 | (org-defkey org-mode-map "\C-c]" 'org-remove-file) | |
| 19682 | (org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock) | |
| 19683 | (org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) | |
| 19684 | (org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) | |
| 19685 | (org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star) | |
| 19686 | (org-defkey org-mode-map "\C-c^" 'org-sort) | |
| 19687 | (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) | |
| 19688 | (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) | |
| 19689 | (org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies) | |
| 19690 | (org-defkey org-mode-map [remap open-line] 'org-open-line) | |
| 19691 | (org-defkey org-mode-map [remap comment-dwim] 'org-comment-dwim) | |
| 19692 | (org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph) | |
| 19693 | (org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph) | |
| 19694 | (org-defkey org-mode-map "\M-^" 'org-delete-indentation) | |
| 19695 | (org-defkey org-mode-map "\C-m" 'org-return) | |
| 19696 | (org-defkey org-mode-map "\C-j" 'org-return-indent) | |
| 19697 | (org-defkey org-mode-map "\C-c?" 'org-table-field-info) | |
| 19698 | (org-defkey org-mode-map "\C-c " 'org-table-blank-field) | |
| 19699 | (org-defkey org-mode-map "\C-c+" 'org-table-sum) | |
| 19700 | (org-defkey org-mode-map "\C-c=" 'org-table-eval-formula) | |
| 19701 | (org-defkey org-mode-map "\C-c'" 'org-edit-special) | |
| 19702 | (org-defkey org-mode-map "\C-c`" 'org-table-edit-field) | |
| 19703 | (org-defkey org-mode-map "\C-c\"a" 'orgtbl-ascii-plot) | |
| 19704 | (org-defkey org-mode-map "\C-c\"g" 'org-plot/gnuplot) | |
| 19705 | (org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) | |
| 19706 | (org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) | |
| 19707 | (org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el) | |
| 19708 | (org-defkey org-mode-map "\C-c\C-a" 'org-attach) | |
| 19709 | (org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) | |
| 19710 | (org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) | |
| 19711 | (org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch) | |
| 19712 | (org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width) | |
| 19713 | (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) | |
| 19714 | (org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) | |
| 19715 | (org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) | |
| 19716 | (org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) | |
| 19717 | (org-defkey org-mode-map "\C-c@" 'org-mark-subtree) | |
| 19718 | (org-defkey org-mode-map "\M-h" 'org-mark-element) | |
| 19719 | (org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree) | |
| 19720 | ;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree) | |
| 19721 | ||
| 19722 | (org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special) | |
| 19723 | (org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special) | |
| 19724 | (org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special) | |
| 19725 | ||
| 19726 | (org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) | |
| 19727 | (org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in) | |
| 19728 | (org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-in-last) | |
| 19729 | (org-defkey org-mode-map "\C-c\C-x\C-z" 'org-resolve-clocks) | |
| 19730 | (org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out) | |
| 19731 | (org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto) | |
| 19732 | (org-defkey org-mode-map "\C-c\C-x\C-q" 'org-clock-cancel) | |
| 19733 | (org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) | |
| 19734 | (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) | |
| 19735 | (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) | |
| 19736 | (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-toggle-latex-fragment) | |
| 19737 | (org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images) | |
| 19738 | (org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images) | |
| 19739 | (org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities) | |
| 19740 | (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) | |
| 19741 | (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) | |
| 19742 | (org-defkey org-mode-map "\C-c\C-xP" 'org-set-property-and-value) | |
| 19743 | (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) | |
| 19744 | (org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort) | |
| 19745 | (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) | |
| 19746 | (org-defkey org-mode-map "\C-c\C-xi" 'org-columns-insert-dblock) | |
| 19747 | (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) | |
| 19748 | ||
| 19749 | (org-defkey org-mode-map "\C-c\C-x." 'org-timer) | |
| 19750 | (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) | |
| 19751 | (org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start) | |
| 19752 | (org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop) | |
| 19753 | (org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue) | |
| 19754 | ||
| 19755 | (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) | |
| 19756 | ||
| 19757 | (define-key org-mode-map "\C-c\C-x!" 'org-reload) | |
| 19758 | ||
| 19759 | (define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all) | |
| 19760 | (define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox) | |
| 19761 | ||
| 19762 | (define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation) | |
| 19763 | ||
| 19764 | ||
| 19765 | (defconst org-speed-commands-default | |
| 19766 | '( | |
| 19767 | ("Outline Navigation") | |
| 19768 | ("n" . (org-speed-move-safe 'org-next-visible-heading)) | |
| 19769 | ("p" . (org-speed-move-safe 'org-previous-visible-heading)) | |
| 19770 | ("f" . (org-speed-move-safe 'org-forward-heading-same-level)) | |
| 19771 | ("b" . (org-speed-move-safe 'org-backward-heading-same-level)) | |
| 19772 | ("F" . org-next-block) | |
| 19773 | ("B" . org-previous-block) | |
| 19774 | ("u" . (org-speed-move-safe 'outline-up-heading)) | |
| 19775 | ("j" . org-goto) | |
| 19776 | ("g" . (org-refile t)) | |
| 19777 | ("Outline Visibility") | |
| 19778 | ("c" . org-cycle) | |
| 19779 | ("C" . org-shifttab) | |
| 19780 | (" " . org-display-outline-path) | |
| 19781 | ("s" . org-narrow-to-subtree) | |
| 19782 | ("=" . org-columns) | |
| 19783 | ("Outline Structure Editing") | |
| 19784 | ("U" . org-metaup) | |
| 19785 | ("D" . org-metadown) | |
| 19786 | ("r" . org-metaright) | |
| 19787 | ("l" . org-metaleft) | |
| 19788 | ("R" . org-shiftmetaright) | |
| 19789 | ("L" . org-shiftmetaleft) | |
| 19790 | ("i" . (progn (forward-char 1) (call-interactively | |
| 19791 | 'org-insert-heading-respect-content))) | |
| 19792 | ("^" . org-sort) | |
| 19793 | ("w" . org-refile) | |
| 19794 | ("a" . org-archive-subtree-default-with-confirmation) | |
| 19795 | ("@" . org-mark-subtree) | |
| 19796 | ("#" . org-toggle-comment) | |
| 19797 | ("Clock Commands") | |
| 19798 | ("I" . org-clock-in) | |
| 19799 | ("O" . org-clock-out) | |
| 19800 | ("Meta Data Editing") | |
| 19801 | ("t" . org-todo) | |
| 19802 | ("," . (org-priority)) | |
| 19803 | ("0" . (org-priority ?\ )) | |
| 19804 | ("1" . (org-priority ?A)) | |
| 19805 | ("2" . (org-priority ?B)) | |
| 19806 | ("3" . (org-priority ?C)) | |
| 19807 | (":" . org-set-tags-command) | |
| 19808 | ("e" . org-set-effort) | |
| 19809 | ("E" . org-inc-effort) | |
| 19810 | ("W" . (lambda(m) (interactive "sMinutes before warning: ") | |
| 19811 | (org-entry-put (point) "APPT_WARNTIME" m))) | |
| 19812 | ("Agenda Views etc") | |
| 19813 | ("v" . org-agenda) | |
| 19814 | ("/" . org-sparse-tree) | |
| 19815 | ("Misc") | |
| 19816 | ("o" . org-open-at-point) | |
| 19817 | ("?" . org-speed-command-help) | |
| 19818 | ("<" . (org-agenda-set-restriction-lock 'subtree)) | |
| 19819 | (">" . (org-agenda-remove-restriction-lock)) | |
| 19820 | ) | |
| 19821 | "The default speed commands.") | |
| 19822 | ||
| 19823 | (defun org-print-speed-command (e) | |
| 19824 | (if (> (length (car e)) 1) | |
| 19825 | (progn | |
| 19826 | (princ "\n") | |
| 19827 | (princ (car e)) | |
| 19828 | (princ "\n") | |
| 19829 | (princ (make-string (length (car e)) ?-)) | |
| 19830 | (princ "\n")) | |
| 19831 | (princ (car e)) | |
| 19832 | (princ " ") | |
| 19833 | (if (symbolp (cdr e)) | |
| 19834 | (princ (symbol-name (cdr e))) | |
| 19835 | (prin1 (cdr e))) | |
| 19836 | (princ "\n"))) | |
| 19837 | ||
| 19838 | (defun org-speed-command-help () | |
| 19839 | "Show the available speed commands." | |
| 19840 | (interactive) | |
| 19841 | (if (not org-use-speed-commands) | |
| 19842 | (user-error "Speed commands are not activated, customize `org-use-speed-commands'") | |
| 19843 | (with-output-to-temp-buffer "*Help*" | |
| 19844 | (princ "User-defined Speed commands\n===========================\n") | |
| 19845 | (mapc #'org-print-speed-command org-speed-commands-user) | |
| 19846 | (princ "\n") | |
| 19847 | (princ "Built-in Speed commands\n=======================\n") | |
| 19848 | (mapc #'org-print-speed-command org-speed-commands-default)) | |
| 19849 | (with-current-buffer "*Help*" | |
| 19850 | (setq truncate-lines t)))) | |
| 19851 | ||
| 19852 | (defun org-speed-move-safe (cmd) | |
| 19853 | "Execute CMD, but make sure that the cursor always ends up in a headline. | |
| 19854 | If not, return to the original position and throw an error." | |
| 19855 | (interactive) | |
| 19856 | (let ((pos (point))) | |
| 19857 | (call-interactively cmd) | |
| 19858 | (unless (and (bolp) (org-at-heading-p)) | |
| 19859 | (goto-char pos) | |
| 19860 | (error "Boundary reached while executing %s" cmd)))) | |
| 19861 | ||
| 19862 | (defvar org-self-insert-command-undo-counter 0) | |
| 19863 | ||
| 19864 | (defvar org-table-auto-blank-field) ; defined in org-table.el | |
| 19865 | (defvar org-speed-command nil) | |
| 19866 | ||
| 19867 | (defun org-speed-command-activate (keys) | |
| 19868 | "Hook for activating single-letter speed commands. | |
| 19869 | `org-speed-commands-default' specifies a minimal command set. | |
| 19870 | Use `org-speed-commands-user' for further customization." | |
| 19871 | (when (or (and (bolp) (looking-at org-outline-regexp)) | |
| 19872 | (and (functionp org-use-speed-commands) | |
| 19873 | (funcall org-use-speed-commands))) | |
| 19874 | (cdr (assoc keys (append org-speed-commands-user | |
| 19875 | org-speed-commands-default))))) | |
| 19876 | ||
| 19877 | (defun org-babel-speed-command-activate (keys) | |
| 19878 | "Hook for activating single-letter code block commands." | |
| 19879 | (when (and (bolp) (looking-at org-babel-src-block-regexp)) | |
| 19880 | (cdr (assoc keys org-babel-key-bindings)))) | |
| 19881 | ||
| 19882 | (defcustom org-speed-command-hook | |
| 19883 | '(org-speed-command-activate org-babel-speed-command-activate) | |
| 19884 | "Hook for activating speed commands at strategic locations. | |
| 19885 | Hook functions are called in sequence until a valid handler is | |
| 19886 | found. | |
| 19887 | ||
| 19888 | Each hook takes a single argument, a user-pressed command key | |
| 19889 | which is also a `self-insert-command' from the global map. | |
| 19890 | ||
| 19891 | Within the hook, examine the cursor position and the command key | |
| 19892 | and return nil or a valid handler as appropriate. Handler could | |
| 19893 | be one of an interactive command, a function, or a form. | |
| 19894 | ||
| 19895 | Set `org-use-speed-commands' to non-nil value to enable this | |
| 19896 | hook. The default setting is `org-speed-command-activate'." | |
| 19897 | :group 'org-structure | |
| 19898 | :version "24.1" | |
| 19899 | :type 'hook) | |
| 19900 | ||
| 19901 | (defun org-self-insert-command (N) | |
| 19902 | "Like `self-insert-command', use overwrite-mode for whitespace in tables. | |
| 19903 | If the cursor is in a table looking at whitespace, the whitespace is | |
| 19904 | overwritten, and the table is not marked as requiring realignment." | |
| 19905 | (interactive "p") | |
| 19906 | (org-check-before-invisible-edit 'insert) | |
| 19907 | (cond | |
| 19908 | ((and org-use-speed-commands | |
| 19909 | (let ((kv (this-command-keys-vector))) | |
| 19910 | (setq org-speed-command | |
| 19911 | (run-hook-with-args-until-success | |
| 19912 | 'org-speed-command-hook | |
| 19913 | (make-string 1 (aref kv (1- (length kv)))))))) | |
| 19914 | (cond | |
| 19915 | ((commandp org-speed-command) | |
| 19916 | (setq this-command org-speed-command) | |
| 19917 | (call-interactively org-speed-command)) | |
| 19918 | ((functionp org-speed-command) | |
| 19919 | (funcall org-speed-command)) | |
| 19920 | ((and org-speed-command (listp org-speed-command)) | |
| 19921 | (eval org-speed-command)) | |
| 19922 | (t (let (org-use-speed-commands) | |
| 19923 | (call-interactively 'org-self-insert-command))))) | |
| 19924 | ((and | |
| 19925 | (org-at-table-p) | |
| 19926 | (eq N 1) | |
| 19927 | (not (org-region-active-p)) | |
| 19928 | (progn | |
| 19929 | ;; Check if we blank the field, and if that triggers align. | |
| 19930 | (and (featurep 'org-table) org-table-auto-blank-field | |
| 19931 | (memq last-command | |
| 19932 | '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) | |
| 19933 | (if (or (eq (char-after) ?\s) (looking-at "[^|\n]* |")) | |
| 19934 | ;; Got extra space, this field does not determine | |
| 19935 | ;; column width. | |
| 19936 | (let (org-table-may-need-update) (org-table-blank-field)) | |
| 19937 | ;; No extra space, this field may determine column | |
| 19938 | ;; width. | |
| 19939 | (org-table-blank-field))) | |
| 19940 | t) | |
| 19941 | (looking-at "[^|\n]* \\( \\)|")) | |
| 19942 | ;; There is room for insertion without re-aligning the table. | |
| 19943 | (delete-region (match-beginning 1) (match-end 1)) | |
| 19944 | (self-insert-command N)) | |
| 19945 | (t | |
| 19946 | (setq org-table-may-need-update t) | |
| 19947 | (self-insert-command N) | |
| 19948 | (org-fix-tags-on-the-fly) | |
| 19949 | (when org-self-insert-cluster-for-undo | |
| 19950 | (if (not (eq last-command 'org-self-insert-command)) | |
| 19951 | (setq org-self-insert-command-undo-counter 1) | |
| 19952 | (if (>= org-self-insert-command-undo-counter 20) | |
| 19953 | (setq org-self-insert-command-undo-counter 1) | |
| 19954 | (and (> org-self-insert-command-undo-counter 0) | |
| 19955 | buffer-undo-list (listp buffer-undo-list) | |
| 19956 | (not (cadr buffer-undo-list)) ; remove nil entry | |
| 19957 | (setcdr buffer-undo-list (cddr buffer-undo-list))) | |
| 19958 | (setq org-self-insert-command-undo-counter | |
| 19959 | (1+ org-self-insert-command-undo-counter)))))))) | |
| 19960 | ||
| 19961 | (defun org-check-before-invisible-edit (kind) | |
| 19962 | "Check is editing if kind KIND would be dangerous with invisible text around. | |
| 19963 | The detailed reaction depends on the user option `org-catch-invisible-edits'." | |
| 19964 | ;; First, try to get out of here as quickly as possible, to reduce overhead | |
| 19965 | (when (and org-catch-invisible-edits | |
| 19966 | (or (not (boundp 'visible-mode)) (not visible-mode)) | |
| 19967 | (or (get-char-property (point) 'invisible) | |
| 19968 | (get-char-property (max (point-min) (1- (point))) 'invisible))) | |
| 19969 | ;; OK, we need to take a closer look. Do not consider | |
| 19970 | ;; invisibility obtained through text properties (e.g., link | |
| 19971 | ;; fontification), as it cannot be toggled. | |
| 19972 | (let* ((invisible-at-point | |
| 19973 | (pcase (get-char-property-and-overlay (point) 'invisible) | |
| 19974 | (`(,_ . ,(and (pred overlayp) o)) o))) | |
| 19975 | ;; Assume that point cannot land in the middle of an | |
| 19976 | ;; overlay, or between two overlays. | |
| 19977 | (invisible-before-point | |
| 19978 | (and (not invisible-at-point) | |
| 19979 | (not (bobp)) | |
| 19980 | (pcase (get-char-property-and-overlay (1- (point)) 'invisible) | |
| 19981 | (`(,_ . ,(and (pred overlayp) o)) o)))) | |
| 19982 | (border-and-ok-direction | |
| 19983 | (or | |
| 19984 | ;; Check if we are acting predictably before invisible | |
| 19985 | ;; text. | |
| 19986 | (and invisible-at-point | |
| 19987 | (memq kind '(insert delete-backward))) | |
| 19988 | ;; Check if we are acting predictably after invisible text | |
| 19989 | ;; This works not well, and I have turned it off. It seems | |
| 19990 | ;; better to always show and stop after invisible text. | |
| 19991 | ;; (and (not invisible-at-point) invisible-before-point | |
| 19992 | ;; (memq kind '(insert delete))) | |
| 19993 | ))) | |
| 19994 | (when (or invisible-at-point invisible-before-point) | |
| 19995 | (when (eq org-catch-invisible-edits 'error) | |
| 19996 | (user-error "Editing in invisible areas is prohibited, make them visible first")) | |
| 19997 | (if (and org-custom-properties-overlays | |
| 19998 | (y-or-n-p "Display invisible properties in this buffer? ")) | |
| 19999 | (org-toggle-custom-properties-visibility) | |
| 20000 | ;; Make the area visible | |
| 20001 | (save-excursion | |
| 20002 | (when invisible-before-point | |
| 20003 | (goto-char | |
| 20004 | (previous-single-char-property-change (point) 'invisible))) | |
| 20005 | ;; Remove whatever overlay is currently making yet-to-be | |
| 20006 | ;; edited text invisible. Also remove nested invisibility | |
| 20007 | ;; related overlays. | |
| 20008 | (delete-overlay (or invisible-at-point invisible-before-point)) | |
| 20009 | (let ((origin (if invisible-at-point (point) (1- (point))))) | |
| 20010 | (while (pcase (get-char-property-and-overlay origin 'invisible) | |
| 20011 | (`(,_ . ,(and (pred overlayp) o)) | |
| 20012 | (delete-overlay o) | |
| 20013 | t))))) | |
| 20014 | (cond | |
| 20015 | ((eq org-catch-invisible-edits 'show) | |
| 20016 | ;; That's it, we do the edit after showing | |
| 20017 | (message | |
| 20018 | "Unfolding invisible region around point before editing") | |
| 20019 | (sit-for 1)) | |
| 20020 | ((and (eq org-catch-invisible-edits 'smart) | |
| 20021 | border-and-ok-direction) | |
| 20022 | (message "Unfolding invisible region around point before editing")) | |
| 20023 | (t | |
| 20024 | ;; Don't do the edit, make the user repeat it in full visibility | |
| 20025 | (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) | |
| 20026 | ||
| 20027 | (defun org-fix-tags-on-the-fly () | |
| 20028 | "Align tags in headline at point. | |
| 20029 | Unlike to `org-set-tags', it ignores region and sorting." | |
| 20030 | (when (and (eq (char-after (line-beginning-position)) ?*) ;short-circuit | |
| 20031 | (org-at-heading-p)) | |
| 20032 | (let ((org-ignore-region t) | |
| 20033 | (org-tags-sort-function nil)) | |
| 20034 | (org-set-tags nil t)))) | |
| 20035 | ||
| 20036 | (defun org-delete-backward-char (N) | |
| 20037 | "Like `delete-backward-char', insert whitespace at field end in tables. | |
| 20038 | When deleting backwards, in tables this function will insert whitespace in | |
| 20039 | front of the next \"|\" separator, to keep the table aligned. The table will | |
| 20040 | still be marked for re-alignment if the field did fill the entire column, | |
| 20041 | because, in this case the deletion might narrow the column." | |
| 20042 | (interactive "p") | |
| 20043 | (save-match-data | |
| 20044 | (org-check-before-invisible-edit 'delete-backward) | |
| 20045 | (if (and (org-at-table-p) | |
| 20046 | (eq N 1) | |
| 20047 | (not (org-region-active-p)) | |
| 20048 | (string-match "|" (buffer-substring (point-at-bol) (point))) | |
| 20049 | (looking-at ".*?|")) | |
| 20050 | (let ((pos (point)) | |
| 20051 | (noalign (looking-at "[^|\n\r]* |")) | |
| 20052 | (c org-table-may-need-update)) | |
| 20053 | (backward-delete-char N) | |
| 20054 | (unless overwrite-mode | |
| 20055 | (skip-chars-forward "^|") | |
| 20056 | (insert " ") | |
| 20057 | (goto-char (1- pos))) | |
| 20058 | ;; noalign: if there were two spaces at the end, this field | |
| 20059 | ;; does not determine the width of the column. | |
| 20060 | (when noalign (setq org-table-may-need-update c))) | |
| 20061 | (backward-delete-char N) | |
| 20062 | (org-fix-tags-on-the-fly)))) | |
| 20063 | ||
| 20064 | (defun org-delete-char (N) | |
| 20065 | "Like `delete-char', but insert whitespace at field end in tables. | |
| 20066 | When deleting characters, in tables this function will insert whitespace in | |
| 20067 | front of the next \"|\" separator, to keep the table aligned. The table will | |
| 20068 | still be marked for re-alignment if the field did fill the entire column, | |
| 20069 | because, in this case the deletion might narrow the column." | |
| 20070 | (interactive "p") | |
| 20071 | (save-match-data | |
| 20072 | (org-check-before-invisible-edit 'delete) | |
| 20073 | (if (and (org-at-table-p) | |
| 20074 | (not (bolp)) | |
| 20075 | (not (= (char-after) ?|)) | |
| 20076 | (eq N 1)) | |
| 20077 | (if (looking-at ".*?|") | |
| 20078 | (let ((pos (point)) | |
| 20079 | (noalign (looking-at "[^|\n\r]* |")) | |
| 20080 | (c org-table-may-need-update)) | |
| 20081 | (replace-match | |
| 20082 | (concat (substring (match-string 0) 1 -1) " |") nil t) | |
| 20083 | (goto-char pos) | |
| 20084 | ;; noalign: if there were two spaces at the end, this field | |
| 20085 | ;; does not determine the width of the column. | |
| 20086 | (when noalign (setq org-table-may-need-update c))) | |
| 20087 | (delete-char N)) | |
| 20088 | (delete-char N) | |
| 20089 | (org-fix-tags-on-the-fly)))) | |
| 20090 | ||
| 20091 | ;; Make `delete-selection-mode' work with Org mode and Orgtbl mode | |
| 20092 | (put 'org-self-insert-command 'delete-selection | |
| 20093 | (lambda () | |
| 20094 | (not (run-hook-with-args-until-success | |
| 20095 | 'self-insert-uses-region-functions)))) | |
| 20096 | (put 'orgtbl-self-insert-command 'delete-selection | |
| 20097 | (lambda () | |
| 20098 | (not (run-hook-with-args-until-success | |
| 20099 | 'self-insert-uses-region-functions)))) | |
| 20100 | (put 'org-delete-char 'delete-selection 'supersede) | |
| 20101 | (put 'org-delete-backward-char 'delete-selection 'supersede) | |
| 20102 | (put 'org-yank 'delete-selection 'yank) | |
| 20103 | ||
| 20104 | ;; Make `flyspell-mode' delay after some commands | |
| 20105 | (put 'org-self-insert-command 'flyspell-delayed t) | |
| 20106 | (put 'orgtbl-self-insert-command 'flyspell-delayed t) | |
| 20107 | (put 'org-delete-char 'flyspell-delayed t) | |
| 20108 | (put 'org-delete-backward-char 'flyspell-delayed t) | |
| 20109 | ||
| 20110 | ;; Make pabbrev-mode expand after Org mode commands | |
| 20111 | (put 'org-self-insert-command 'pabbrev-expand-after-command t) | |
| 20112 | (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) | |
| 20113 | ||
| 20114 | (defun org-transpose-words () | |
| 20115 | "Transpose words for Org. | |
| 20116 | This uses the `org-mode-transpose-word-syntax-table' syntax | |
| 20117 | table, which interprets characters in `org-emphasis-alist' as | |
| 20118 | word constituents." | |
| 20119 | (interactive) | |
| 20120 | (with-syntax-table org-mode-transpose-word-syntax-table | |
| 20121 | (call-interactively 'transpose-words))) | |
| 20122 | (org-remap org-mode-map 'transpose-words 'org-transpose-words) | |
| 20123 | ||
| 20124 | (defvar org-ctrl-c-ctrl-c-hook nil | |
| 20125 | "Hook for functions attaching themselves to `C-c C-c'. | |
| 20126 | ||
| 20127 | This can be used to add additional functionality to the C-c C-c | |
| 20128 | key which executes context-dependent commands. This hook is run | |
| 20129 | before any other test, while `org-ctrl-c-ctrl-c-final-hook' is | |
| 20130 | run after the last test. | |
| 20131 | ||
| 20132 | Each function will be called with no arguments. The function | |
| 20133 | must check if the context is appropriate for it to act. If yes, | |
| 20134 | it should do its thing and then return a non-nil value. If the | |
| 20135 | context is wrong, just do nothing and return nil.") | |
| 20136 | ||
| 20137 | (defvar org-ctrl-c-ctrl-c-final-hook nil | |
| 20138 | "Hook for functions attaching themselves to `C-c C-c'. | |
| 20139 | ||
| 20140 | This can be used to add additional functionality to the C-c C-c | |
| 20141 | key which executes context-dependent commands. This hook is run | |
| 20142 | after any other test, while `org-ctrl-c-ctrl-c-hook' is run | |
| 20143 | before the first test. | |
| 20144 | ||
| 20145 | Each function will be called with no arguments. The function | |
| 20146 | must check if the context is appropriate for it to act. If yes, | |
| 20147 | it should do its thing and then return a non-nil value. If the | |
| 20148 | context is wrong, just do nothing and return nil.") | |
| 20149 | ||
| 20150 | (defvar org-tab-first-hook nil | |
| 20151 | "Hook for functions to attach themselves to TAB. | |
| 20152 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
| 20153 | This hook runs as the first action when TAB is pressed, even before | |
| 20154 | `org-cycle' messes around with the `outline-regexp' to cater for | |
| 20155 | inline tasks and plain list item folding. | |
| 20156 | If any function in this hook returns t, any other actions that | |
| 20157 | would have been caused by TAB (such as table field motion or visibility | |
| 20158 | cycling) will not occur.") | |
| 20159 | ||
| 20160 | (defvar org-tab-after-check-for-table-hook nil | |
| 20161 | "Hook for functions to attach themselves to TAB. | |
| 20162 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
| 20163 | This hook runs after it has been established that the cursor is not in a | |
| 20164 | table, but before checking if the cursor is in a headline or if global cycling | |
| 20165 | should be done. | |
| 20166 | If any function in this hook returns t, not other actions like visibility | |
| 20167 | cycling will be done.") | |
| 20168 | ||
| 20169 | (defvar org-tab-after-check-for-cycling-hook nil | |
| 20170 | "Hook for functions to attach themselves to TAB. | |
| 20171 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
| 20172 | This hook runs after it has been established that not table field motion and | |
| 20173 | not visibility should be done because of current context. This is probably | |
| 20174 | the place where a package like yasnippets can hook in.") | |
| 20175 | ||
| 20176 | (defvar org-tab-before-tab-emulation-hook nil | |
| 20177 | "Hook for functions to attach themselves to TAB. | |
| 20178 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
| 20179 | This hook runs after every other options for TAB have been exhausted, but | |
| 20180 | before indentation and \t insertion takes place.") | |
| 20181 | ||
| 20182 | (defvar org-metaleft-hook nil | |
| 20183 | "Hook for functions attaching themselves to `M-left'. | |
| 20184 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20185 | (defvar org-metaright-hook nil | |
| 20186 | "Hook for functions attaching themselves to `M-right'. | |
| 20187 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20188 | (defvar org-metaup-hook nil | |
| 20189 | "Hook for functions attaching themselves to `M-up'. | |
| 20190 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20191 | (defvar org-metadown-hook nil | |
| 20192 | "Hook for functions attaching themselves to `M-down'. | |
| 20193 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20194 | (defvar org-shiftmetaleft-hook nil | |
| 20195 | "Hook for functions attaching themselves to `M-S-left'. | |
| 20196 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20197 | (defvar org-shiftmetaright-hook nil | |
| 20198 | "Hook for functions attaching themselves to `M-S-right'. | |
| 20199 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20200 | (defvar org-shiftmetaup-hook nil | |
| 20201 | "Hook for functions attaching themselves to `M-S-up'. | |
| 20202 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20203 | (defvar org-shiftmetadown-hook nil | |
| 20204 | "Hook for functions attaching themselves to `M-S-down'. | |
| 20205 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20206 | (defvar org-metareturn-hook nil | |
| 20207 | "Hook for functions attaching themselves to `M-RET'. | |
| 20208 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20209 | (defvar org-shiftup-hook nil | |
| 20210 | "Hook for functions attaching themselves to `S-up'. | |
| 20211 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20212 | (defvar org-shiftup-final-hook nil | |
| 20213 | "Hook for functions attaching themselves to `S-up'. | |
| 20214 | This one runs after all other options except shift-select have been excluded. | |
| 20215 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20216 | (defvar org-shiftdown-hook nil | |
| 20217 | "Hook for functions attaching themselves to `S-down'. | |
| 20218 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20219 | (defvar org-shiftdown-final-hook nil | |
| 20220 | "Hook for functions attaching themselves to `S-down'. | |
| 20221 | This one runs after all other options except shift-select have been excluded. | |
| 20222 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20223 | (defvar org-shiftleft-hook nil | |
| 20224 | "Hook for functions attaching themselves to `S-left'. | |
| 20225 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20226 | (defvar org-shiftleft-final-hook nil | |
| 20227 | "Hook for functions attaching themselves to `S-left'. | |
| 20228 | This one runs after all other options except shift-select have been excluded. | |
| 20229 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20230 | (defvar org-shiftright-hook nil | |
| 20231 | "Hook for functions attaching themselves to `S-right'. | |
| 20232 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20233 | (defvar org-shiftright-final-hook nil | |
| 20234 | "Hook for functions attaching themselves to `S-right'. | |
| 20235 | This one runs after all other options except shift-select have been excluded. | |
| 20236 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
| 20237 | ||
| 20238 | (defun org-modifier-cursor-error () | |
| 20239 | "Throw an error, a modified cursor command was applied in wrong context." | |
| 20240 | (user-error "This command is active in special context like tables, headlines or items")) | |
| 20241 | ||
| 20242 | (defun org-shiftselect-error () | |
| 20243 | "Throw an error because Shift-Cursor command was applied in wrong context." | |
| 20244 | (if (and (boundp 'shift-select-mode) shift-select-mode) | |
| 20245 | (user-error "To use shift-selection with Org mode, customize `org-support-shift-select'") | |
| 20246 | (user-error "This command works only in special context like headlines or timestamps"))) | |
| 20247 | ||
| 20248 | (defun org-call-for-shift-select (cmd) | |
| 20249 | (let ((this-command-keys-shift-translated t)) | |
| 20250 | (call-interactively cmd))) | |
| 20251 | ||
| 20252 | (defun org-shifttab (&optional arg) | |
| 20253 | "Global visibility cycling or move to previous table field. | |
| 20254 | Call `org-table-previous-field' within a table. | |
| 20255 | When ARG is nil, cycle globally through visibility states. | |
| 20256 | When ARG is a numeric prefix, show contents of this level." | |
| 20257 | (interactive "P") | |
| 20258 | (cond | |
| 20259 | ((org-at-table-p) (call-interactively 'org-table-previous-field)) | |
| 20260 | ((integerp arg) | |
| 20261 | (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg))) | |
| 20262 | (message "Content view to level: %d" arg) | |
| 20263 | (org-content (prefix-numeric-value arg2)) | |
| 20264 | (org-cycle-show-empty-lines t) | |
| 20265 | (setq org-cycle-global-status 'overview))) | |
| 20266 | (t (call-interactively 'org-global-cycle)))) | |
| 20267 | ||
| 20268 | (defun org-shiftmetaleft () | |
| 20269 | "Promote subtree or delete table column. | |
| 20270 | Calls `org-promote-subtree', `org-outdent-item-tree', or | |
| 20271 | `org-table-delete-column', depending on context. See the | |
| 20272 | individual commands for more information." | |
| 20273 | (interactive) | |
| 20274 | (cond | |
| 20275 | ((run-hook-with-args-until-success 'org-shiftmetaleft-hook)) | |
| 20276 | ((org-at-table-p) (call-interactively 'org-table-delete-column)) | |
| 20277 | ((org-at-heading-p) (call-interactively 'org-promote-subtree)) | |
| 20278 | ((if (not (org-region-active-p)) (org-at-item-p) | |
| 20279 | (save-excursion (goto-char (region-beginning)) | |
| 20280 | (org-at-item-p))) | |
| 20281 | (call-interactively 'org-outdent-item-tree)) | |
| 20282 | (t (org-modifier-cursor-error)))) | |
| 20283 | ||
| 20284 | (defun org-shiftmetaright () | |
| 20285 | "Demote subtree or insert table column. | |
| 20286 | Calls `org-demote-subtree', `org-indent-item-tree', or | |
| 20287 | `org-table-insert-column', depending on context. See the | |
| 20288 | individual commands for more information." | |
| 20289 | (interactive) | |
| 20290 | (cond | |
| 20291 | ((run-hook-with-args-until-success 'org-shiftmetaright-hook)) | |
| 20292 | ((org-at-table-p) (call-interactively 'org-table-insert-column)) | |
| 20293 | ((org-at-heading-p) (call-interactively 'org-demote-subtree)) | |
| 20294 | ((if (not (org-region-active-p)) (org-at-item-p) | |
| 20295 | (save-excursion (goto-char (region-beginning)) | |
| 20296 | (org-at-item-p))) | |
| 20297 | (call-interactively 'org-indent-item-tree)) | |
| 20298 | (t (org-modifier-cursor-error)))) | |
| 20299 | ||
| 20300 | (defun org-shiftmetaup (&optional _arg) | |
| 20301 | "Drag the line at point up. | |
| 20302 | In a table, kill the current row. | |
| 20303 | On a clock timestamp, update the value of the timestamp like `S-<up>' | |
| 20304 | but also adjust the previous clocked item in the clock history. | |
| 20305 | Everywhere else, drag the line at point up." | |
| 20306 | (interactive "P") | |
| 20307 | (cond | |
| 20308 | ((run-hook-with-args-until-success 'org-shiftmetaup-hook)) | |
| 20309 | ((org-at-table-p) (call-interactively 'org-table-kill-row)) | |
| 20310 | ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) | |
| 20311 | (call-interactively 'org-timestamp-up))) | |
| 20312 | (t (call-interactively 'org-drag-line-backward)))) | |
| 20313 | ||
| 20314 | (defun org-shiftmetadown (&optional _arg) | |
| 20315 | "Drag the line at point down. | |
| 20316 | In a table, insert an empty row at the current line. | |
| 20317 | On a clock timestamp, update the value of the timestamp like `S-<down>' | |
| 20318 | but also adjust the previous clocked item in the clock history. | |
| 20319 | Everywhere else, drag the line at point down." | |
| 20320 | (interactive "P") | |
| 20321 | (cond | |
| 20322 | ((run-hook-with-args-until-success 'org-shiftmetadown-hook)) | |
| 20323 | ((org-at-table-p) (call-interactively 'org-table-insert-row)) | |
| 20324 | ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) | |
| 20325 | (call-interactively 'org-timestamp-down))) | |
| 20326 | (t (call-interactively 'org-drag-line-forward)))) | |
| 20327 | ||
| 20328 | (defsubst org-hidden-tree-error () | |
| 20329 | (user-error | |
| 20330 | "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>")) | |
| 20331 | ||
| 20332 | (defun org-metaleft (&optional _arg) | |
| 20333 | "Promote heading, list item at point or move table column left. | |
| 20334 | ||
| 20335 | Calls `org-do-promote', `org-outdent-item' or `org-table-move-column', | |
| 20336 | depending on context. With no specific context, calls the Emacs | |
| 20337 | default `backward-word'. See the individual commands for more | |
| 20338 | information. | |
| 20339 | ||
| 20340 | This function runs the hook `org-metaleft-hook' as a first step, | |
| 20341 | and returns at first non-nil value." | |
| 20342 | (interactive "P") | |
| 20343 | (cond | |
| 20344 | ((run-hook-with-args-until-success 'org-metaleft-hook)) | |
| 20345 | ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) | |
| 20346 | ((org-with-limited-levels | |
| 20347 | (or (org-at-heading-p) | |
| 20348 | (and (org-region-active-p) | |
| 20349 | (save-excursion | |
| 20350 | (goto-char (region-beginning)) | |
| 20351 | (org-at-heading-p))))) | |
| 20352 | (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) | |
| 20353 | (call-interactively 'org-do-promote)) | |
| 20354 | ;; At an inline task. | |
| 20355 | ((org-at-heading-p) | |
| 20356 | (call-interactively 'org-inlinetask-promote)) | |
| 20357 | ((or (org-at-item-p) | |
| 20358 | (and (org-region-active-p) | |
| 20359 | (save-excursion | |
| 20360 | (goto-char (region-beginning)) | |
| 20361 | (org-at-item-p)))) | |
| 20362 | (when (org-check-for-hidden 'items) (org-hidden-tree-error)) | |
| 20363 | (call-interactively 'org-outdent-item)) | |
| 20364 | (t (call-interactively 'backward-word)))) | |
| 20365 | ||
| 20366 | (defun org-metaright (&optional _arg) | |
| 20367 | "Demote heading, list item at point or move table column right. | |
| 20368 | ||
| 20369 | In front of a drawer or a block keyword, indent it correctly. | |
| 20370 | ||
| 20371 | Calls `org-do-demote', `org-indent-item', `org-table-move-column', | |
| 20372 | `org-indent-drawer' or `org-indent-block' depending on context. | |
| 20373 | With no specific context, calls the Emacs default `forward-word'. | |
| 20374 | See the individual commands for more information. | |
| 20375 | ||
| 20376 | This function runs the hook `org-metaright-hook' as a first step, | |
| 20377 | and returns at first non-nil value." | |
| 20378 | (interactive "P") | |
| 20379 | (cond | |
| 20380 | ((run-hook-with-args-until-success 'org-metaright-hook)) | |
| 20381 | ((org-at-table-p) (call-interactively 'org-table-move-column)) | |
| 20382 | ((org-at-drawer-p) (call-interactively 'org-indent-drawer)) | |
| 20383 | ((org-at-block-p) (call-interactively 'org-indent-block)) | |
| 20384 | ((org-with-limited-levels | |
| 20385 | (or (org-at-heading-p) | |
| 20386 | (and (org-region-active-p) | |
| 20387 | (save-excursion | |
| 20388 | (goto-char (region-beginning)) | |
| 20389 | (org-at-heading-p))))) | |
| 20390 | (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) | |
| 20391 | (call-interactively 'org-do-demote)) | |
| 20392 | ;; At an inline task. | |
| 20393 | ((org-at-heading-p) | |
| 20394 | (call-interactively 'org-inlinetask-demote)) | |
| 20395 | ((or (org-at-item-p) | |
| 20396 | (and (org-region-active-p) | |
| 20397 | (save-excursion | |
| 20398 | (goto-char (region-beginning)) | |
| 20399 | (org-at-item-p)))) | |
| 20400 | (when (org-check-for-hidden 'items) (org-hidden-tree-error)) | |
| 20401 | (call-interactively 'org-indent-item)) | |
| 20402 | (t (call-interactively 'forward-word)))) | |
| 20403 | ||
| 20404 | (defun org-check-for-hidden (what) | |
| 20405 | "Check if there are hidden headlines/items in the current visual line. | |
| 20406 | WHAT can be either `headlines' or `items'. If the current line is | |
| 20407 | an outline or item heading and it has a folded subtree below it, | |
| 20408 | this function returns t, nil otherwise." | |
| 20409 | (let ((re (cond | |
| 20410 | ((eq what 'headlines) org-outline-regexp-bol) | |
| 20411 | ((eq what 'items) (org-item-beginning-re)) | |
| 20412 | (t (error "This should not happen")))) | |
| 20413 | beg end) | |
| 20414 | (save-excursion | |
| 20415 | (catch 'exit | |
| 20416 | (unless (org-region-active-p) | |
| 20417 | (setq beg (point-at-bol)) | |
| 20418 | (beginning-of-line 2) | |
| 20419 | (while (and (not (eobp)) ;; this is like `next-line' | |
| 20420 | (get-char-property (1- (point)) 'invisible)) | |
| 20421 | (beginning-of-line 2)) | |
| 20422 | (setq end (point)) | |
| 20423 | (goto-char beg) | |
| 20424 | (goto-char (point-at-eol)) | |
| 20425 | (setq end (max end (point))) | |
| 20426 | (while (re-search-forward re end t) | |
| 20427 | (when (get-char-property (match-beginning 0) 'invisible) | |
| 20428 | (throw 'exit t)))) | |
| 20429 | nil)))) | |
| 20430 | ||
| 20431 | (defun org-metaup (&optional _arg) | |
| 20432 | "Move subtree up or move table row up. | |
| 20433 | Calls `org-move-subtree-up' or `org-table-move-row' or | |
| 20434 | `org-move-item-up', depending on context. See the individual commands | |
| 20435 | for more information." | |
| 20436 | (interactive "P") | |
| 20437 | (cond | |
| 20438 | ((run-hook-with-args-until-success 'org-metaup-hook)) | |
| 20439 | ((org-region-active-p) | |
| 20440 | (let* ((a (min (region-beginning) (region-end))) | |
| 20441 | (b (1- (max (region-beginning) (region-end)))) | |
| 20442 | (c (save-excursion (goto-char a) | |
| 20443 | (move-beginning-of-line 0))) | |
| 20444 | (d (save-excursion (goto-char a) | |
| 20445 | (move-end-of-line 0) (point)))) | |
| 20446 | (transpose-regions a b c d) | |
| 20447 | (goto-char c))) | |
| 20448 | ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) | |
| 20449 | ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) | |
| 20450 | ((org-at-item-p) (call-interactively 'org-move-item-up)) | |
| 20451 | (t (org-drag-element-backward)))) | |
| 20452 | ||
| 20453 | (defun org-metadown (&optional _arg) | |
| 20454 | "Move subtree down or move table row down. | |
| 20455 | Calls `org-move-subtree-down' or `org-table-move-row' or | |
| 20456 | `org-move-item-down', depending on context. See the individual | |
| 20457 | commands for more information." | |
| 20458 | (interactive "P") | |
| 20459 | (cond | |
| 20460 | ((run-hook-with-args-until-success 'org-metadown-hook)) | |
| 20461 | ((org-region-active-p) | |
| 20462 | (let* ((a (min (region-beginning) (region-end))) | |
| 20463 | (b (max (region-beginning) (region-end))) | |
| 20464 | (c (save-excursion (goto-char b) | |
| 20465 | (move-beginning-of-line 1))) | |
| 20466 | (d (save-excursion (goto-char b) | |
| 20467 | (move-end-of-line 1) (1+ (point))))) | |
| 20468 | (transpose-regions a b c d) | |
| 20469 | (goto-char d))) | |
| 20470 | ((org-at-table-p) (call-interactively 'org-table-move-row)) | |
| 20471 | ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) | |
| 20472 | ((org-at-item-p) (call-interactively 'org-move-item-down)) | |
| 20473 | (t (org-drag-element-forward)))) | |
| 20474 | ||
| 20475 | (defun org-shiftup (&optional arg) | |
| 20476 | "Increase item in timestamp or increase priority of current headline. | |
| 20477 | Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', | |
| 20478 | depending on context. See the individual commands for more information." | |
| 20479 | (interactive "P") | |
| 20480 | (cond | |
| 20481 | ((run-hook-with-args-until-success 'org-shiftup-hook)) | |
| 20482 | ((and org-support-shift-select (org-region-active-p)) | |
| 20483 | (org-call-for-shift-select 'previous-line)) | |
| 20484 | ((org-at-timestamp-p 'lax) | |
| 20485 | (call-interactively (if org-edit-timestamp-down-means-later | |
| 20486 | 'org-timestamp-down 'org-timestamp-up))) | |
| 20487 | ((and (not (eq org-support-shift-select 'always)) | |
| 20488 | org-enable-priority-commands | |
| 20489 | (org-at-heading-p)) | |
| 20490 | (call-interactively 'org-priority-up)) | |
| 20491 | ((and (not org-support-shift-select) (org-at-item-p)) | |
| 20492 | (call-interactively 'org-previous-item)) | |
| 20493 | ((org-clocktable-try-shift 'up arg)) | |
| 20494 | ((run-hook-with-args-until-success 'org-shiftup-final-hook)) | |
| 20495 | (org-support-shift-select | |
| 20496 | (org-call-for-shift-select 'previous-line)) | |
| 20497 | (t (org-shiftselect-error)))) | |
| 20498 | ||
| 20499 | (defun org-shiftdown (&optional arg) | |
| 20500 | "Decrease item in timestamp or decrease priority of current headline. | |
| 20501 | Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' | |
| 20502 | depending on context. See the individual commands for more information." | |
| 20503 | (interactive "P") | |
| 20504 | (cond | |
| 20505 | ((run-hook-with-args-until-success 'org-shiftdown-hook)) | |
| 20506 | ((and org-support-shift-select (org-region-active-p)) | |
| 20507 | (org-call-for-shift-select 'next-line)) | |
| 20508 | ((org-at-timestamp-p 'lax) | |
| 20509 | (call-interactively (if org-edit-timestamp-down-means-later | |
| 20510 | 'org-timestamp-up 'org-timestamp-down))) | |
| 20511 | ((and (not (eq org-support-shift-select 'always)) | |
| 20512 | org-enable-priority-commands | |
| 20513 | (org-at-heading-p)) | |
| 20514 | (call-interactively 'org-priority-down)) | |
| 20515 | ((and (not org-support-shift-select) (org-at-item-p)) | |
| 20516 | (call-interactively 'org-next-item)) | |
| 20517 | ((org-clocktable-try-shift 'down arg)) | |
| 20518 | ((run-hook-with-args-until-success 'org-shiftdown-final-hook)) | |
| 20519 | (org-support-shift-select | |
| 20520 | (org-call-for-shift-select 'next-line)) | |
| 20521 | (t (org-shiftselect-error)))) | |
| 20522 | ||
| 20523 | (defun org-shiftright (&optional arg) | |
| 20524 | "Cycle the thing at point or in the current line, depending on context. | |
| 20525 | Depending on context, this does one of the following: | |
| 20526 | ||
| 20527 | - switch a timestamp at point one day into the future | |
| 20528 | - on a headline, switch to the next TODO keyword. | |
| 20529 | - on an item, switch entire list to the next bullet type | |
| 20530 | - on a property line, switch to the next allowed value | |
| 20531 | - on a clocktable definition line, move time block into the future" | |
| 20532 | (interactive "P") | |
| 20533 | (cond | |
| 20534 | ((run-hook-with-args-until-success 'org-shiftright-hook)) | |
| 20535 | ((and org-support-shift-select (org-region-active-p)) | |
| 20536 | (org-call-for-shift-select 'forward-char)) | |
| 20537 | ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-up-day)) | |
| 20538 | ((and (not (eq org-support-shift-select 'always)) | |
| 20539 | (org-at-heading-p)) | |
| 20540 | (let ((org-inhibit-logging | |
| 20541 | (not org-treat-S-cursor-todo-selection-as-state-change)) | |
| 20542 | (org-inhibit-blocking | |
| 20543 | (not org-treat-S-cursor-todo-selection-as-state-change))) | |
| 20544 | (org-call-with-arg 'org-todo 'right))) | |
| 20545 | ((or (and org-support-shift-select | |
| 20546 | (not (eq org-support-shift-select 'always)) | |
| 20547 | (org-at-item-bullet-p)) | |
| 20548 | (and (not org-support-shift-select) (org-at-item-p))) | |
| 20549 | (org-call-with-arg 'org-cycle-list-bullet nil)) | |
| 20550 | ((and (not (eq org-support-shift-select 'always)) | |
| 20551 | (org-at-property-p)) | |
| 20552 | (call-interactively 'org-property-next-allowed-value)) | |
| 20553 | ((org-clocktable-try-shift 'right arg)) | |
| 20554 | ((run-hook-with-args-until-success 'org-shiftright-final-hook)) | |
| 20555 | (org-support-shift-select | |
| 20556 | (org-call-for-shift-select 'forward-char)) | |
| 20557 | (t (org-shiftselect-error)))) | |
| 20558 | ||
| 20559 | (defun org-shiftleft (&optional arg) | |
| 20560 | "Cycle the thing at point or in the current line, depending on context. | |
| 20561 | Depending on context, this does one of the following: | |
| 20562 | ||
| 20563 | - switch a timestamp at point one day into the past | |
| 20564 | - on a headline, switch to the previous TODO keyword. | |
| 20565 | - on an item, switch entire list to the previous bullet type | |
| 20566 | - on a property line, switch to the previous allowed value | |
| 20567 | - on a clocktable definition line, move time block into the past" | |
| 20568 | (interactive "P") | |
| 20569 | (cond | |
| 20570 | ((run-hook-with-args-until-success 'org-shiftleft-hook)) | |
| 20571 | ((and org-support-shift-select (org-region-active-p)) | |
| 20572 | (org-call-for-shift-select 'backward-char)) | |
| 20573 | ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-down-day)) | |
| 20574 | ((and (not (eq org-support-shift-select 'always)) | |
| 20575 | (org-at-heading-p)) | |
| 20576 | (let ((org-inhibit-logging | |
| 20577 | (not org-treat-S-cursor-todo-selection-as-state-change)) | |
| 20578 | (org-inhibit-blocking | |
| 20579 | (not org-treat-S-cursor-todo-selection-as-state-change))) | |
| 20580 | (org-call-with-arg 'org-todo 'left))) | |
| 20581 | ((or (and org-support-shift-select | |
| 20582 | (not (eq org-support-shift-select 'always)) | |
| 20583 | (org-at-item-bullet-p)) | |
| 20584 | (and (not org-support-shift-select) (org-at-item-p))) | |
| 20585 | (org-call-with-arg 'org-cycle-list-bullet 'previous)) | |
| 20586 | ((and (not (eq org-support-shift-select 'always)) | |
| 20587 | (org-at-property-p)) | |
| 20588 | (call-interactively 'org-property-previous-allowed-value)) | |
| 20589 | ((org-clocktable-try-shift 'left arg)) | |
| 20590 | ((run-hook-with-args-until-success 'org-shiftleft-final-hook)) | |
| 20591 | (org-support-shift-select | |
| 20592 | (org-call-for-shift-select 'backward-char)) | |
| 20593 | (t (org-shiftselect-error)))) | |
| 20594 | ||
| 20595 | (defun org-shiftcontrolright () | |
| 20596 | "Switch to next TODO set." | |
| 20597 | (interactive) | |
| 20598 | (cond | |
| 20599 | ((and org-support-shift-select (org-region-active-p)) | |
| 20600 | (org-call-for-shift-select 'forward-word)) | |
| 20601 | ((and (not (eq org-support-shift-select 'always)) | |
| 20602 | (org-at-heading-p)) | |
| 20603 | (org-call-with-arg 'org-todo 'nextset)) | |
| 20604 | (org-support-shift-select | |
| 20605 | (org-call-for-shift-select 'forward-word)) | |
| 20606 | (t (org-shiftselect-error)))) | |
| 20607 | ||
| 20608 | (defun org-shiftcontrolleft () | |
| 20609 | "Switch to previous TODO set." | |
| 20610 | (interactive) | |
| 20611 | (cond | |
| 20612 | ((and org-support-shift-select (org-region-active-p)) | |
| 20613 | (org-call-for-shift-select 'backward-word)) | |
| 20614 | ((and (not (eq org-support-shift-select 'always)) | |
| 20615 | (org-at-heading-p)) | |
| 20616 | (org-call-with-arg 'org-todo 'previousset)) | |
| 20617 | (org-support-shift-select | |
| 20618 | (org-call-for-shift-select 'backward-word)) | |
| 20619 | (t (org-shiftselect-error)))) | |
| 20620 | ||
| 20621 | (defun org-shiftcontrolup (&optional n) | |
| 20622 | "Change timestamps synchronously up in CLOCK log lines. | |
| 20623 | Optional argument N tells to change by that many units." | |
| 20624 | (interactive "P") | |
| 20625 | (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax)) | |
| 20626 | (let (org-support-shift-select) | |
| 20627 | (org-clock-timestamps-up n)) | |
| 20628 | (user-error "Not at a clock log"))) | |
| 20629 | ||
| 20630 | (defun org-shiftcontroldown (&optional n) | |
| 20631 | "Change timestamps synchronously down in CLOCK log lines. | |
| 20632 | Optional argument N tells to change by that many units." | |
| 20633 | (interactive "P") | |
| 20634 | (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax)) | |
| 20635 | (let (org-support-shift-select) | |
| 20636 | (org-clock-timestamps-down n)) | |
| 20637 | (user-error "Not at a clock log"))) | |
| 20638 | ||
| 20639 | (defun org-increase-number-at-point (&optional inc) | |
| 20640 | "Increment the number at point. | |
| 20641 | With an optional prefix numeric argument INC, increment using | |
| 20642 | this numeric value." | |
| 20643 | (interactive "p") | |
| 20644 | (if (not (number-at-point)) | |
| 20645 | (user-error "Not on a number") | |
| 20646 | (unless inc (setq inc 1)) | |
| 20647 | (let ((pos (point)) | |
| 20648 | (beg (skip-chars-backward "-+^/*0-9eE.")) | |
| 20649 | (end (skip-chars-forward "-+^/*0-9eE^.")) nap) | |
| 20650 | (setq nap (buffer-substring-no-properties | |
| 20651 | (+ pos beg) (+ pos beg end))) | |
| 20652 | (delete-region (+ pos beg) (+ pos beg end)) | |
| 20653 | (insert (calc-eval (concat (number-to-string inc) "+" nap)))) | |
| 20654 | (when (org-at-table-p) | |
| 20655 | (org-table-align) | |
| 20656 | (org-table-end-of-field 1)))) | |
| 20657 | ||
| 20658 | (defun org-decrease-number-at-point (&optional inc) | |
| 20659 | "Decrement the number at point. | |
| 20660 | With an optional prefix numeric argument INC, decrement using | |
| 20661 | this numeric value." | |
| 20662 | (interactive "p") | |
| 20663 | (org-increase-number-at-point (- (or inc 1)))) | |
| 20664 | ||
| 20665 | (defun org-ctrl-c-ret () | |
| 20666 | "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." | |
| 20667 | (interactive) | |
| 20668 | (cond | |
| 20669 | ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) | |
| 20670 | (t (call-interactively 'org-insert-heading)))) | |
| 20671 | ||
| 20672 | (defun org-find-visible () | |
| 20673 | (let ((s (point))) | |
| 20674 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) | |
| 20675 | (get-char-property s 'invisible))) | |
| 20676 | s)) | |
| 20677 | (defun org-find-invisible () | |
| 20678 | (let ((s (point))) | |
| 20679 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) | |
| 20680 | (not (get-char-property s 'invisible)))) | |
| 20681 | s)) | |
| 20682 | ||
| 20683 | (defun org-copy-visible (beg end) | |
| 20684 | "Copy the visible parts of the region." | |
| 20685 | (interactive "r") | |
| 20686 | (let ((result "")) | |
| 20687 | (while (/= beg end) | |
| 20688 | (when (get-char-property beg 'invisible) | |
| 20689 | (setq beg (next-single-char-property-change beg 'invisible nil end))) | |
| 20690 | (let ((next (next-single-char-property-change beg 'invisible nil end))) | |
| 20691 | (setq result (concat result (buffer-substring beg next))) | |
| 20692 | (setq beg next))) | |
| 20693 | (kill-new result))) | |
| 20694 | ||
| 20695 | (defun org-copy-special () | |
| 20696 | "Copy region in table or copy current subtree. | |
| 20697 | Calls `org-table-copy-region' or `org-copy-subtree', depending on | |
| 20698 | context. See the individual commands for more information." | |
| 20699 | (interactive) | |
| 20700 | (call-interactively | |
| 20701 | (if (org-at-table-p) #'org-table-copy-region #'org-copy-subtree))) | |
| 20702 | ||
| 20703 | (defun org-cut-special () | |
| 20704 | "Cut region in table or cut current subtree. | |
| 20705 | Calls `org-table-cut-region' or `org-cut-subtree', depending on | |
| 20706 | context. See the individual commands for more information." | |
| 20707 | (interactive) | |
| 20708 | (call-interactively | |
| 20709 | (if (org-at-table-p) #'org-table-cut-region #'org-cut-subtree))) | |
| 20710 | ||
| 20711 | (defun org-paste-special (arg) | |
| 20712 | "Paste rectangular region into table, or past subtree relative to level. | |
| 20713 | Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. | |
| 20714 | See the individual commands for more information." | |
| 20715 | (interactive "P") | |
| 20716 | (if (org-at-table-p) | |
| 20717 | (org-table-paste-rectangle) | |
| 20718 | (org-paste-subtree arg))) | |
| 20719 | ||
| 20720 | (defun org-edit-special (&optional arg) | |
| 20721 | "Call a special editor for the element at point. | |
| 20722 | When at a table, call the formula editor with `org-table-edit-formulas'. | |
| 20723 | When in a source code block, call `org-edit-src-code'. | |
| 20724 | When in a fixed-width region, call `org-edit-fixed-width-region'. | |
| 20725 | When in an export block, call `org-edit-export-block'. | |
| 20726 | When in a LaTeX environment, call `org-edit-latex-environment'. | |
| 20727 | When at an #+INCLUDE keyword, visit the included file. | |
| 20728 | When at a footnote reference, call `org-edit-footnote-reference' | |
| 20729 | On a link, call `ffap' to visit the link at point. | |
| 20730 | Otherwise, return a user error." | |
| 20731 | (interactive "P") | |
| 20732 | (let ((element (org-element-at-point))) | |
| 20733 | (barf-if-buffer-read-only) | |
| 20734 | (pcase (org-element-type element) | |
| 20735 | (`src-block | |
| 20736 | (if (not arg) (org-edit-src-code) | |
| 20737 | (let* ((info (org-babel-get-src-block-info)) | |
| 20738 | (lang (nth 0 info)) | |
| 20739 | (params (nth 2 info)) | |
| 20740 | (session (cdr (assq :session params)))) | |
| 20741 | (if (not session) (org-edit-src-code) | |
| 20742 | ;; At a src-block with a session and function called with | |
| 20743 | ;; an ARG: switch to the buffer related to the inferior | |
| 20744 | ;; process. | |
| 20745 | (switch-to-buffer | |
| 20746 | (funcall (intern (concat "org-babel-prep-session:" lang)) | |
| 20747 | session params)))))) | |
| 20748 | (`keyword | |
| 20749 | (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE")) | |
| 20750 | (org-open-link-from-string | |
| 20751 | (format "[[%s]]" | |
| 20752 | (expand-file-name | |
| 20753 | (let ((value (org-element-property :value element))) | |
| 20754 | (cond ((org-file-url-p value) | |
| 20755 | (user-error "The file is specified as a URL, cannot be edited")) | |
| 20756 | ((not (org-string-nw-p value)) | |
| 20757 | (user-error "No file to edit")) | |
| 20758 | ((string-match "\\`\"\\(.*?\\)\"" value) | |
| 20759 | (match-string 1 value)) | |
| 20760 | ((string-match "\\`[^ \t\"]\\S-*" value) | |
| 20761 | (match-string 0 value)) | |
| 20762 | (t (user-error "No valid file specified"))))))) | |
| 20763 | (user-error "No special environment to edit here"))) | |
| 20764 | (`table | |
| 20765 | (if (eq (org-element-property :type element) 'table.el) | |
| 20766 | (org-edit-table.el) | |
| 20767 | (call-interactively 'org-table-edit-formulas))) | |
| 20768 | ;; Only Org tables contain `table-row' type elements. | |
| 20769 | (`table-row (call-interactively 'org-table-edit-formulas)) | |
| 20770 | (`example-block (org-edit-src-code)) | |
| 20771 | (`export-block (org-edit-export-block)) | |
| 20772 | (`fixed-width (org-edit-fixed-width-region)) | |
| 20773 | (`latex-environment (org-edit-latex-environment)) | |
| 20774 | (_ | |
| 20775 | ;; No notable element at point. Though, we may be at a link or | |
| 20776 | ;; a footnote reference, which are objects. Thus, scan deeper. | |
| 20777 | (let ((context (org-element-context element))) | |
| 20778 | (pcase (org-element-type context) | |
| 20779 | (`footnote-reference (org-edit-footnote-reference)) | |
| 20780 | (`inline-src-block (org-edit-inline-src-code)) | |
| 20781 | (`link (call-interactively #'ffap)) | |
| 20782 | (_ (user-error "No special environment to edit here")))))))) | |
| 20783 | ||
| 20784 | (defvar org-table-coordinate-overlays) ; defined in org-table.el | |
| 20785 | (defun org-ctrl-c-ctrl-c (&optional arg) | |
| 20786 | "Set tags in headline, or update according to changed information at point. | |
| 20787 | ||
| 20788 | This command does many different things, depending on context: | |
| 20789 | ||
| 20790 | - If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location, | |
| 20791 | this is what we do. | |
| 20792 | ||
| 20793 | - If the cursor is on a statistics cookie, update it. | |
| 20794 | ||
| 20795 | - If the cursor is in a headline, prompt for tags and insert them | |
| 20796 | into the current line, aligned to `org-tags-column'. When called | |
| 20797 | with prefix arg, realign all tags in the current buffer. | |
| 20798 | ||
| 20799 | - If the cursor is in one of the special #+KEYWORD lines, this | |
| 20800 | triggers scanning the buffer for these lines and updating the | |
| 20801 | information. | |
| 20802 | ||
| 20803 | - If the cursor is inside a table, realign the table. This command | |
| 20804 | works even if the automatic table editor has been turned off. | |
| 20805 | ||
| 20806 | - If the cursor is on a #+TBLFM line, re-apply the formulas to | |
| 20807 | the entire table. | |
| 20808 | ||
| 20809 | - If the cursor is at a footnote reference or definition, jump to | |
| 20810 | the corresponding definition or references, respectively. | |
| 20811 | ||
| 20812 | - If the cursor is a the beginning of a dynamic block, update it. | |
| 20813 | ||
| 20814 | - If the current buffer is a capture buffer, close note and file it. | |
| 20815 | ||
| 20816 | - If the cursor is on a <<<target>>>, update radio targets and | |
| 20817 | corresponding links in this buffer. | |
| 20818 | ||
| 20819 | - If the cursor is on a numbered item in a plain list, renumber the | |
| 20820 | ordered list. | |
| 20821 | ||
| 20822 | - If the cursor is on a checkbox, toggle it. | |
| 20823 | ||
| 20824 | - If the cursor is on a code block, evaluate it. The variable | |
| 20825 | `org-confirm-babel-evaluate' can be used to control prompting | |
| 20826 | before code block evaluation, by default every code block | |
| 20827 | evaluation requires confirmation. Code block evaluation can be | |
| 20828 | inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." | |
| 20829 | (interactive "P") | |
| 20830 | (cond | |
| 20831 | ((or (bound-and-true-p org-clock-overlays) org-occur-highlights) | |
| 20832 | (when (boundp 'org-clock-overlays) (org-clock-remove-overlays)) | |
| 20833 | (org-remove-occur-highlights) | |
| 20834 | (message "Temporary highlights/overlays removed from current buffer")) | |
| 20835 | ((and (local-variable-p 'org-finish-function) | |
| 20836 | (fboundp org-finish-function)) | |
| 20837 | (funcall org-finish-function)) | |
| 20838 | ((org-babel-hash-at-point)) | |
| 20839 | ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) | |
| 20840 | (t | |
| 20841 | (let* ((context | |
| 20842 | (org-element-lineage | |
| 20843 | (org-element-context) | |
| 20844 | ;; Limit to supported contexts. | |
| 20845 | '(babel-call clock dynamic-block footnote-definition | |
| 20846 | footnote-reference inline-babel-call inline-src-block | |
| 20847 | inlinetask item keyword node-property paragraph | |
| 20848 | plain-list planning property-drawer radio-target | |
| 20849 | src-block statistics-cookie table table-cell table-row | |
| 20850 | timestamp) | |
| 20851 | t)) | |
| 20852 | (type (org-element-type context))) | |
| 20853 | ;; For convenience: at the first line of a paragraph on the same | |
| 20854 | ;; line as an item, apply function on that item instead. | |
| 20855 | (when (eq type 'paragraph) | |
| 20856 | (let ((parent (org-element-property :parent context))) | |
| 20857 | (when (and (eq (org-element-type parent) 'item) | |
| 20858 | (= (line-beginning-position) | |
| 20859 | (org-element-property :begin parent))) | |
| 20860 | (setq context parent) | |
| 20861 | (setq type 'item)))) | |
| 20862 | ;; Act according to type of element or object at point. | |
| 20863 | ;; | |
| 20864 | ;; Do nothing on a blank line, except if it is contained in | |
| 20865 | ;; a src block. Hence, we first check if point is in such | |
| 20866 | ;; a block and then if it is at a blank line. | |
| 20867 | (pcase type | |
| 20868 | ((or `inline-src-block `src-block) | |
| 20869 | (unless org-babel-no-eval-on-ctrl-c-ctrl-c | |
| 20870 | (org-babel-eval-wipe-error-buffer) | |
| 20871 | (org-babel-execute-src-block | |
| 20872 | current-prefix-arg (org-babel-get-src-block-info nil context)))) | |
| 20873 | ((guard (org-match-line "[ \t]*$")) | |
| 20874 | (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) | |
| 20875 | (user-error | |
| 20876 | (substitute-command-keys | |
| 20877 | "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))) | |
| 20878 | ((or `babel-call `inline-babel-call) | |
| 20879 | (let ((info (org-babel-lob-get-info context))) | |
| 20880 | (when info (org-babel-execute-src-block nil info)))) | |
| 20881 | (`clock (org-clock-update-time-maybe)) | |
| 20882 | (`dynamic-block | |
| 20883 | (save-excursion | |
| 20884 | (goto-char (org-element-property :post-affiliated context)) | |
| 20885 | (org-update-dblock))) | |
| 20886 | (`footnote-definition | |
| 20887 | (goto-char (org-element-property :post-affiliated context)) | |
| 20888 | (call-interactively 'org-footnote-action)) | |
| 20889 | (`footnote-reference (call-interactively #'org-footnote-action)) | |
| 20890 | ((or `headline `inlinetask) | |
| 20891 | (save-excursion (goto-char (org-element-property :begin context)) | |
| 20892 | (call-interactively #'org-set-tags))) | |
| 20893 | (`item | |
| 20894 | ;; At an item: `C-u C-u' sets checkbox to "[-]" | |
| 20895 | ;; unconditionally, whereas `C-u' will toggle its presence. | |
| 20896 | ;; Without a universal argument, if the item has a checkbox, | |
| 20897 | ;; toggle it. Otherwise repair the list. | |
| 20898 | (let* ((box (org-element-property :checkbox context)) | |
| 20899 | (struct (org-element-property :structure context)) | |
| 20900 | (old-struct (copy-tree struct)) | |
| 20901 | (parents (org-list-parents-alist struct)) | |
| 20902 | (prevs (org-list-prevs-alist struct)) | |
| 20903 | (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) | |
| 20904 | (org-list-set-checkbox | |
| 20905 | (org-element-property :begin context) struct | |
| 20906 | (cond ((equal arg '(16)) "[-]") | |
| 20907 | ((and (not box) (equal arg '(4))) "[ ]") | |
| 20908 | ((or (not box) (equal arg '(4))) nil) | |
| 20909 | ((eq box 'on) "[ ]") | |
| 20910 | (t "[X]"))) | |
| 20911 | ;; Mimic `org-list-write-struct' but with grabbing a return | |
| 20912 | ;; value from `org-list-struct-fix-box'. | |
| 20913 | (org-list-struct-fix-ind struct parents 2) | |
| 20914 | (org-list-struct-fix-item-end struct) | |
| 20915 | (org-list-struct-fix-bul struct prevs) | |
| 20916 | (org-list-struct-fix-ind struct parents) | |
| 20917 | (let ((block-item | |
| 20918 | (org-list-struct-fix-box struct parents prevs orderedp))) | |
| 20919 | (if (and box (equal struct old-struct)) | |
| 20920 | (if (equal arg '(16)) | |
| 20921 | (message "Checkboxes already reset") | |
| 20922 | (user-error "Cannot toggle this checkbox: %s" | |
| 20923 | (if (eq box 'on) | |
| 20924 | "all subitems checked" | |
| 20925 | "unchecked subitems"))) | |
| 20926 | (org-list-struct-apply-struct struct old-struct) | |
| 20927 | (org-update-checkbox-count-maybe)) | |
| 20928 | (when block-item | |
| 20929 | (message "Checkboxes were removed due to empty box at line %d" | |
| 20930 | (org-current-line block-item)))))) | |
| 20931 | (`keyword | |
| 20932 | (let ((org-inhibit-startup-visibility-stuff t) | |
| 20933 | (org-startup-align-all-tables nil)) | |
| 20934 | (when (boundp 'org-table-coordinate-overlays) | |
| 20935 | (mapc #'delete-overlay org-table-coordinate-overlays) | |
| 20936 | (setq org-table-coordinate-overlays nil)) | |
| 20937 | (org-save-outline-visibility 'use-markers (org-mode-restart))) | |
| 20938 | (message "Local setup has been refreshed")) | |
| 20939 | (`plain-list | |
| 20940 | ;; At a plain list, with a double C-u argument, set | |
| 20941 | ;; checkboxes of each item to "[-]", whereas a single one | |
| 20942 | ;; will toggle their presence according to the state of the | |
| 20943 | ;; first item in the list. Without an argument, repair the | |
| 20944 | ;; list. | |
| 20945 | (let* ((begin (org-element-property :contents-begin context)) | |
| 20946 | (beginm (move-marker (make-marker) begin)) | |
| 20947 | (struct (org-element-property :structure context)) | |
| 20948 | (old-struct (copy-tree struct)) | |
| 20949 | (first-box (save-excursion | |
| 20950 | (goto-char begin) | |
| 20951 | (looking-at org-list-full-item-re) | |
| 20952 | (match-string-no-properties 3))) | |
| 20953 | (new-box (cond ((equal arg '(16)) "[-]") | |
| 20954 | ((equal arg '(4)) (unless first-box "[ ]")) | |
| 20955 | ((equal first-box "[X]") "[ ]") | |
| 20956 | (t "[X]")))) | |
| 20957 | (cond | |
| 20958 | (arg | |
| 20959 | (dolist (pos | |
| 20960 | (org-list-get-all-items | |
| 20961 | begin struct (org-list-prevs-alist struct))) | |
| 20962 | (org-list-set-checkbox pos struct new-box))) | |
| 20963 | ((and first-box (eq (point) begin)) | |
| 20964 | ;; For convenience, when point is at bol on the first | |
| 20965 | ;; item of the list and no argument is provided, simply | |
| 20966 | ;; toggle checkbox of that item, if any. | |
| 20967 | (org-list-set-checkbox begin struct new-box))) | |
| 20968 | (org-list-write-struct | |
| 20969 | struct (org-list-parents-alist struct) old-struct) | |
| 20970 | (org-update-checkbox-count-maybe) | |
| 20971 | (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) | |
| 20972 | ((or `property-drawer `node-property) | |
| 20973 | (call-interactively #'org-property-action)) | |
| 20974 | (`radio-target | |
| 20975 | (call-interactively #'org-update-radio-target-regexp)) | |
| 20976 | (`statistics-cookie | |
| 20977 | (call-interactively #'org-update-statistics-cookies)) | |
| 20978 | ((or `table `table-cell `table-row) | |
| 20979 | ;; At a table, recalculate every field and align it. Also | |
| 20980 | ;; send the table if necessary. If the table has | |
| 20981 | ;; a `table.el' type, just give up. At a table row or cell, | |
| 20982 | ;; maybe recalculate line but always align table. | |
| 20983 | (if (eq (org-element-property :type context) 'table.el) | |
| 20984 | (message "%s" (substitute-command-keys "\\<org-mode-map>\ | |
| 20985 | Use `\\[org-edit-special]' to edit table.el tables")) | |
| 20986 | (if (or (eq type 'table) | |
| 20987 | ;; Check if point is at a TBLFM line. | |
| 20988 | (and (eq type 'table-row) | |
| 20989 | (= (point) (org-element-property :end context)))) | |
| 20990 | (save-excursion | |
| 20991 | (if (org-at-TBLFM-p) | |
| 20992 | (progn (require 'org-table) | |
| 20993 | (org-table-calc-current-TBLFM)) | |
| 20994 | (goto-char (org-element-property :contents-begin context)) | |
| 20995 | (org-call-with-arg 'org-table-recalculate (or arg t)) | |
| 20996 | (orgtbl-send-table 'maybe))) | |
| 20997 | (org-table-maybe-eval-formula) | |
| 20998 | (cond (arg (call-interactively #'org-table-recalculate)) | |
| 20999 | ((org-table-maybe-recalculate-line)) | |
| 21000 | (t (org-table-align)))))) | |
| 21001 | ((or `timestamp (and `planning (guard (org-at-timestamp-p 'lax)))) | |
| 21002 | (org-timestamp-change 0 'day)) | |
| 21003 | ((and `nil (guard (org-at-heading-p))) | |
| 21004 | ;; When point is on an unsupported object type, we can miss | |
| 21005 | ;; the fact that it also is at a heading. Handle it here. | |
| 21006 | (call-interactively #'org-set-tags)) | |
| 21007 | ((guard | |
| 21008 | (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook))) | |
| 21009 | (_ | |
| 21010 | (user-error | |
| 21011 | (substitute-command-keys | |
| 21012 | "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))))))) | |
| 21013 | ||
| 21014 | (defun org-mode-restart () | |
| 21015 | (interactive) | |
| 21016 | (let ((indent-status (bound-and-true-p org-indent-mode))) | |
| 21017 | (funcall major-mode) | |
| 21018 | (hack-local-variables) | |
| 21019 | (when (and indent-status (not (bound-and-true-p org-indent-mode))) | |
| 21020 | (org-indent-mode -1)) | |
| 21021 | (org-reset-file-cache)) | |
| 21022 | (message "%s restarted" major-mode)) | |
| 21023 | ||
| 21024 | (defun org-kill-note-or-show-branches () | |
| 21025 | "Abort storing current note, or call `outline-show-branches'." | |
| 21026 | (interactive) | |
| 21027 | (if (not org-finish-function) | |
| 21028 | (save-excursion | |
| 21029 | (save-restriction | |
| 21030 | (org-narrow-to-subtree) | |
| 21031 | (org-flag-subtree t) | |
| 21032 | (call-interactively 'outline-show-branches) | |
| 21033 | (org-hide-archived-subtrees (point-min) (point-max)))) | |
| 21034 | (let ((org-note-abort t)) | |
| 21035 | (funcall org-finish-function)))) | |
| 21036 | ||
| 21037 | (defun org-delete-indentation (&optional arg) | |
| 21038 | "Join current line to previous and fix whitespace at join. | |
| 21039 | ||
| 21040 | If previous line is a headline add to headline title. Otherwise | |
| 21041 | the function calls `delete-indentation'. | |
| 21042 | ||
| 21043 | With a non-nil optional argument, join it to the following one." | |
| 21044 | (interactive "*P") | |
| 21045 | (if (save-excursion | |
| 21046 | (beginning-of-line (if arg 1 0)) | |
| 21047 | (let ((case-fold-search nil)) | |
| 21048 | (looking-at org-complex-heading-regexp))) | |
| 21049 | ;; At headline. | |
| 21050 | (let ((tags-column (when (match-beginning 5) | |
| 21051 | (save-excursion (goto-char (match-beginning 5)) | |
| 21052 | (current-column)))) | |
| 21053 | (string (concat " " (progn (when arg (forward-line 1)) | |
| 21054 | (org-trim (delete-and-extract-region | |
| 21055 | (line-beginning-position) | |
| 21056 | (line-end-position))))))) | |
| 21057 | (unless (bobp) (delete-region (point) (1- (point)))) | |
| 21058 | (goto-char (or (match-end 4) | |
| 21059 | (match-beginning 5) | |
| 21060 | (match-end 0))) | |
| 21061 | (skip-chars-backward " \t") | |
| 21062 | (save-excursion (insert string)) | |
| 21063 | ;; Adjust alignment of tags. | |
| 21064 | (cond | |
| 21065 | ((not tags-column)) ;no tags | |
| 21066 | (org-auto-align-tags (org-set-tags nil t)) | |
| 21067 | (t (org--align-tags-here tags-column)))) ;preserve tags column | |
| 21068 | (delete-indentation arg))) | |
| 21069 | ||
| 21070 | (defun org-open-line (n) | |
| 21071 | "Insert a new row in tables, call `open-line' elsewhere. | |
| 21072 | If `org-special-ctrl-o' is nil, just call `open-line' everywhere. | |
| 21073 | As a special case, when a document starts with a table, allow to | |
| 21074 | call `open-line' on the very first character." | |
| 21075 | (interactive "*p") | |
| 21076 | (if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p)) | |
| 21077 | (org-table-insert-row) | |
| 21078 | (open-line n))) | |
| 21079 | ||
| 21080 | (defun org-return (&optional indent) | |
| 21081 | "Goto next table row or insert a newline. | |
| 21082 | ||
| 21083 | Calls `org-table-next-row' or `newline', depending on context. | |
| 21084 | ||
| 21085 | When optional INDENT argument is non-nil, call | |
| 21086 | `newline-and-indent' instead of `newline'. | |
| 21087 | ||
| 21088 | When `org-return-follows-link' is non-nil and point is on | |
| 21089 | a timestamp or a link, call `org-open-at-point'. However, it | |
| 21090 | will not happen if point is in a table or on a \"dead\" | |
| 21091 | object (e.g., within a comment). In these case, you need to use | |
| 21092 | `org-open-at-point' directly." | |
| 21093 | (interactive) | |
| 21094 | (let ((context (if org-return-follows-link (org-element-context) | |
| 21095 | (org-element-at-point)))) | |
| 21096 | (cond | |
| 21097 | ;; In a table, call `org-table-next-row'. However, before first | |
| 21098 | ;; column or after last one, split the table. | |
| 21099 | ((or (and (eq (org-element-type context) 'table) | |
| 21100 | (>= (point) (org-element-property :contents-begin context)) | |
| 21101 | (< (point) (org-element-property :contents-end context))) | |
| 21102 | (org-element-lineage context '(table-row table-cell) t)) | |
| 21103 | (if (or (looking-at-p "[ \t]*$") | |
| 21104 | (save-excursion (skip-chars-backward " \t") (bolp))) | |
| 21105 | (insert "\n") | |
| 21106 | (org-table-justify-field-maybe) | |
| 21107 | (call-interactively #'org-table-next-row))) | |
| 21108 | ;; On a link or a timestamp, call `org-open-at-point' if | |
| 21109 | ;; `org-return-follows-link' allows it. Tolerate fuzzy | |
| 21110 | ;; locations, e.g., in a comment, as `org-open-at-point'. | |
| 21111 | ((and org-return-follows-link | |
| 21112 | (or (and (eq 'link (org-element-type context)) | |
| 21113 | ;; Ensure point is not on the white spaces after | |
| 21114 | ;; the link. | |
| 21115 | (let ((origin (point))) | |
| 21116 | (org-with-point-at (org-element-property :end context) | |
| 21117 | (skip-chars-backward " \t") | |
| 21118 | (> (point) origin)))) | |
| 21119 | (org-in-regexp org-ts-regexp-both nil t) | |
| 21120 | (org-in-regexp org-tsr-regexp-both nil t) | |
| 21121 | (org-in-regexp org-any-link-re nil t))) | |
| 21122 | (call-interactively #'org-open-at-point)) | |
| 21123 | ;; Insert newline in heading, but preserve tags. | |
| 21124 | ((and (not (bolp)) | |
| 21125 | (save-excursion (beginning-of-line) | |
| 21126 | (let ((case-fold-search nil)) | |
| 21127 | (looking-at org-complex-heading-regexp)))) | |
| 21128 | ;; At headline. Split line. However, if point is on keyword, | |
| 21129 | ;; priority cookie or tags, do not break any of them: add | |
| 21130 | ;; a newline after the headline instead. | |
| 21131 | (let ((tags-column (and (match-beginning 5) | |
| 21132 | (save-excursion (goto-char (match-beginning 5)) | |
| 21133 | (current-column)))) | |
| 21134 | (string | |
| 21135 | (when (and (match-end 4) (org-point-in-group (point) 4)) | |
| 21136 | (delete-and-extract-region (point) (match-end 4))))) | |
| 21137 | ;; Adjust tag alignment. | |
| 21138 | (cond | |
| 21139 | ((not (and tags-column string))) | |
| 21140 | (org-auto-align-tags (org-set-tags nil t)) | |
| 21141 | (t (org--align-tags-here tags-column))) ;preserve tags column | |
| 21142 | (end-of-line) | |
| 21143 | (org-show-entry) | |
| 21144 | (if indent (newline-and-indent) (newline)) | |
| 21145 | (when string (save-excursion (insert (org-trim string)))))) | |
| 21146 | ;; In a list, make sure indenting keeps trailing text within. | |
| 21147 | ((and indent | |
| 21148 | (not (eolp)) | |
| 21149 | (org-element-lineage context '(item))) | |
| 21150 | (let ((trailing-data | |
| 21151 | (delete-and-extract-region (point) (line-end-position)))) | |
| 21152 | (newline-and-indent) | |
| 21153 | (save-excursion (insert trailing-data)))) | |
| 21154 | (t | |
| 21155 | ;; Do not auto-fill when point is in an Org property drawer. | |
| 21156 | (let ((auto-fill-function (and (not (org-at-property-p)) | |
| 21157 | auto-fill-function))) | |
| 21158 | (if indent | |
| 21159 | (newline-and-indent) | |
| 21160 | (newline))))))) | |
| 21161 | ||
| 21162 | (defun org-return-indent () | |
| 21163 | "Goto next table row or insert a newline and indent. | |
| 21164 | Calls `org-table-next-row' or `newline-and-indent', depending on | |
| 21165 | context. See the individual commands for more information." | |
| 21166 | (interactive) | |
| 21167 | (org-return t)) | |
| 21168 | ||
| 21169 | (defun org-ctrl-c-star () | |
| 21170 | "Compute table, or change heading status of lines. | |
| 21171 | Calls `org-table-recalculate' or `org-toggle-heading', | |
| 21172 | depending on context." | |
| 21173 | (interactive) | |
| 21174 | (cond | |
| 21175 | ((org-at-table-p) | |
| 21176 | (call-interactively 'org-table-recalculate)) | |
| 21177 | (t | |
| 21178 | ;; Convert all lines in region to list items | |
| 21179 | (call-interactively 'org-toggle-heading)))) | |
| 21180 | ||
| 21181 | (defun org-ctrl-c-minus () | |
| 21182 | "Insert separator line in table or modify bullet status of line. | |
| 21183 | Also turns a plain line or a region of lines into list items. | |
| 21184 | Calls `org-table-insert-hline', `org-toggle-item', or | |
| 21185 | `org-cycle-list-bullet', depending on context." | |
| 21186 | (interactive) | |
| 21187 | (cond | |
| 21188 | ((org-at-table-p) | |
| 21189 | (call-interactively 'org-table-insert-hline)) | |
| 21190 | ((org-region-active-p) | |
| 21191 | (call-interactively 'org-toggle-item)) | |
| 21192 | ((org-in-item-p) | |
| 21193 | (call-interactively 'org-cycle-list-bullet)) | |
| 21194 | (t | |
| 21195 | (call-interactively 'org-toggle-item)))) | |
| 21196 | ||
| 21197 | (defun org-toggle-heading (&optional nstars) | |
| 21198 | "Convert headings to normal text, or items or text to headings. | |
| 21199 | If there is no active region, only convert the current line. | |
| 21200 | ||
| 21201 | With a `\\[universal-argument]' prefix, convert the whole list at | |
| 21202 | point into heading. | |
| 21203 | ||
| 21204 | In a region: | |
| 21205 | ||
| 21206 | - If the first non blank line is a headline, remove the stars | |
| 21207 | from all headlines in the region. | |
| 21208 | ||
| 21209 | - If it is a normal line, turn each and every normal line (i.e., | |
| 21210 | not an heading or an item) in the region into headings. If you | |
| 21211 | want to convert only the first line of this region, use one | |
| 21212 | universal prefix argument. | |
| 21213 | ||
| 21214 | - If it is a plain list item, turn all plain list items into headings. | |
| 21215 | ||
| 21216 | When converting a line into a heading, the number of stars is chosen | |
| 21217 | such that the lines become children of the current entry. However, | |
| 21218 | when a numeric prefix argument is given, its value determines the | |
| 21219 | number of stars to add." | |
| 21220 | (interactive "P") | |
| 21221 | (let ((skip-blanks | |
| 21222 | (function | |
| 21223 | ;; Return beginning of first non-blank line, starting from | |
| 21224 | ;; line at POS. | |
| 21225 | (lambda (pos) | |
| 21226 | (save-excursion | |
| 21227 | (goto-char pos) | |
| 21228 | (while (org-at-comment-p) (forward-line)) | |
| 21229 | (skip-chars-forward " \r\t\n") | |
| 21230 | (point-at-bol))))) | |
| 21231 | beg end toggled) | |
| 21232 | ;; Determine boundaries of changes. If a universal prefix has | |
| 21233 | ;; been given, put the list in a region. If region ends at a bol, | |
| 21234 | ;; do not consider the last line to be in the region. | |
| 21235 | ||
| 21236 | (when (and current-prefix-arg (org-at-item-p)) | |
| 21237 | (when (listp current-prefix-arg) (setq current-prefix-arg 1)) | |
| 21238 | (org-mark-element)) | |
| 21239 | ||
| 21240 | (if (org-region-active-p) | |
| 21241 | (setq beg (funcall skip-blanks (region-beginning)) | |
| 21242 | end (copy-marker (save-excursion | |
| 21243 | (goto-char (region-end)) | |
| 21244 | (if (bolp) (point) (point-at-eol))))) | |
| 21245 | (setq beg (funcall skip-blanks (point-at-bol)) | |
| 21246 | end (copy-marker (point-at-eol)))) | |
| 21247 | ;; Ensure inline tasks don't count as headings. | |
| 21248 | (org-with-limited-levels | |
| 21249 | (save-excursion | |
| 21250 | (goto-char beg) | |
| 21251 | (cond | |
| 21252 | ;; Case 1. Started at an heading: de-star headings. | |
| 21253 | ((org-at-heading-p) | |
| 21254 | (while (< (point) end) | |
| 21255 | (when (org-at-heading-p t) | |
| 21256 | (looking-at org-outline-regexp) (replace-match "") | |
| 21257 | (setq toggled t)) | |
| 21258 | (forward-line))) | |
| 21259 | ;; Case 2. Started at an item: change items into headlines. | |
| 21260 | ;; One star will be added by `org-list-to-subtree'. | |
| 21261 | ((org-at-item-p) | |
| 21262 | (while (< (point) end) | |
| 21263 | (when (org-at-item-p) | |
| 21264 | ;; Pay attention to cases when region ends before list. | |
| 21265 | (let* ((struct (org-list-struct)) | |
| 21266 | (list-end | |
| 21267 | (min (org-list-get-bottom-point struct) (1+ end)))) | |
| 21268 | (save-restriction | |
| 21269 | (narrow-to-region (point) list-end) | |
| 21270 | (insert (org-list-to-subtree (org-list-to-lisp t)) "\n"))) | |
| 21271 | (setq toggled t)) | |
| 21272 | (forward-line))) | |
| 21273 | ;; Case 3. Started at normal text: make every line an heading, | |
| 21274 | ;; skipping headlines and items. | |
| 21275 | (t (let* ((stars | |
| 21276 | (make-string | |
| 21277 | (if (numberp nstars) nstars (or (org-current-level) 0)) ?*)) | |
| 21278 | (add-stars | |
| 21279 | (cond (nstars "") ; stars from prefix only | |
| 21280 | ((equal stars "") "*") ; before first heading | |
| 21281 | (org-odd-levels-only "**") ; inside heading, odd | |
| 21282 | (t "*"))) ; inside heading, oddeven | |
| 21283 | (rpl (concat stars add-stars " ")) | |
| 21284 | (lend (when (listp nstars) (save-excursion (end-of-line) (point))))) | |
| 21285 | (while (< (point) (if (equal nstars '(4)) lend end)) | |
| 21286 | (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) | |
| 21287 | (looking-at "\\([ \t]*\\)\\(\\S-\\)")) | |
| 21288 | (replace-match (concat rpl (match-string 2))) (setq toggled t)) | |
| 21289 | (forward-line))))))) | |
| 21290 | (unless toggled (message "Cannot toggle heading from here")))) | |
| 21291 | ||
| 21292 | (defun org-meta-return (&optional arg) | |
| 21293 | "Insert a new heading or wrap a region in a table. | |
| 21294 | Calls `org-insert-heading', `org-insert-item' or | |
| 21295 | `org-table-wrap-region', depending on context. When called with | |
| 21296 | an argument, unconditionally call `org-insert-heading'." | |
| 21297 | (interactive "P") | |
| 21298 | (org-check-before-invisible-edit 'insert) | |
| 21299 | (or (run-hook-with-args-until-success 'org-metareturn-hook) | |
| 21300 | (call-interactively (cond (arg #'org-insert-heading) | |
| 21301 | ((org-at-table-p) #'org-table-wrap-region) | |
| 21302 | ((org-in-item-p) #'org-insert-item) | |
| 21303 | (t #'org-insert-heading))))) | |
| 21304 | ||
| 21305 | ;;; Menu entries | |
| 21306 | ||
| 21307 | (defsubst org-in-subtree-not-table-p () | |
| 21308 | "Are we in a subtree and not in a table?" | |
| 21309 | (and (not (org-before-first-heading-p)) | |
| 21310 | (not (org-at-table-p)))) | |
| 21311 | ||
| 21312 | ;; Define the Org mode menus | |
| 21313 | (easy-menu-define org-tbl-menu org-mode-map "Tbl menu" | |
| 21314 | '("Tbl" | |
| 21315 | ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)] | |
| 21316 | ["Next Field" org-cycle (org-at-table-p)] | |
| 21317 | ["Previous Field" org-shifttab (org-at-table-p)] | |
| 21318 | ["Next Row" org-return (org-at-table-p)] | |
| 21319 | "--" | |
| 21320 | ["Blank Field" org-table-blank-field (org-at-table-p)] | |
| 21321 | ["Edit Field" org-table-edit-field (org-at-table-p)] | |
| 21322 | ["Copy Field from Above" org-table-copy-down (org-at-table-p)] | |
| 21323 | "--" | |
| 21324 | ("Column" | |
| 21325 | ["Move Column Left" org-metaleft (org-at-table-p)] | |
| 21326 | ["Move Column Right" org-metaright (org-at-table-p)] | |
| 21327 | ["Delete Column" org-shiftmetaleft (org-at-table-p)] | |
| 21328 | ["Insert Column" org-shiftmetaright (org-at-table-p)]) | |
| 21329 | ("Row" | |
| 21330 | ["Move Row Up" org-metaup (org-at-table-p)] | |
| 21331 | ["Move Row Down" org-metadown (org-at-table-p)] | |
| 21332 | ["Delete Row" org-shiftmetaup (org-at-table-p)] | |
| 21333 | ["Insert Row" org-shiftmetadown (org-at-table-p)] | |
| 21334 | ["Sort lines in region" org-table-sort-lines (org-at-table-p)] | |
| 21335 | "--" | |
| 21336 | ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) | |
| 21337 | ("Rectangle" | |
| 21338 | ["Copy Rectangle" org-copy-special (org-at-table-p)] | |
| 21339 | ["Cut Rectangle" org-cut-special (org-at-table-p)] | |
| 21340 | ["Paste Rectangle" org-paste-special (org-at-table-p)] | |
| 21341 | ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) | |
| 21342 | "--" | |
| 21343 | ("Calculate" | |
| 21344 | ["Set Column Formula" org-table-eval-formula (org-at-table-p)] | |
| 21345 | ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] | |
| 21346 | ["Edit Formulas" org-edit-special (org-at-table-p)] | |
| 21347 | "--" | |
| 21348 | ["Recalculate line" org-table-recalculate (org-at-table-p)] | |
| 21349 | ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] | |
| 21350 | ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] | |
| 21351 | "--" | |
| 21352 | ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] | |
| 21353 | "--" | |
| 21354 | ["Sum Column/Rectangle" org-table-sum | |
| 21355 | (or (org-at-table-p) (org-region-active-p))] | |
| 21356 | ["Which Column?" org-table-current-column (org-at-table-p)]) | |
| 21357 | ["Debug Formulas" | |
| 21358 | org-table-toggle-formula-debugger | |
| 21359 | :style toggle :selected (bound-and-true-p org-table-formula-debug)] | |
| 21360 | ["Show Col/Row Numbers" | |
| 21361 | org-table-toggle-coordinate-overlays | |
| 21362 | :style toggle | |
| 21363 | :selected (bound-and-true-p org-table-overlay-coordinates)] | |
| 21364 | "--" | |
| 21365 | ["Create" org-table-create (not (org-at-table-p))] | |
| 21366 | ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] | |
| 21367 | ["Import from File" org-table-import (not (org-at-table-p))] | |
| 21368 | ["Export to File" org-table-export (org-at-table-p)] | |
| 21369 | "--" | |
| 21370 | ["Create/Convert from/to table.el" org-table-create-with-table.el t] | |
| 21371 | "--" | |
| 21372 | ("Plot" | |
| 21373 | ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"] | |
| 21374 | ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"]))) | |
| 21375 | ||
| 21376 | (easy-menu-define org-org-menu org-mode-map "Org menu" | |
| 21377 | '("Org" | |
| 21378 | ("Show/Hide" | |
| 21379 | ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))] | |
| 21380 | ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] | |
| 21381 | ["Sparse Tree..." org-sparse-tree t] | |
| 21382 | ["Reveal Context" org-reveal t] | |
| 21383 | ["Show All" outline-show-all t] | |
| 21384 | "--" | |
| 21385 | ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) | |
| 21386 | "--" | |
| 21387 | ["New Heading" org-insert-heading t] | |
| 21388 | ("Navigate Headings" | |
| 21389 | ["Up" outline-up-heading t] | |
| 21390 | ["Next" outline-next-visible-heading t] | |
| 21391 | ["Previous" outline-previous-visible-heading t] | |
| 21392 | ["Next Same Level" outline-forward-same-level t] | |
| 21393 | ["Previous Same Level" outline-backward-same-level t] | |
| 21394 | "--" | |
| 21395 | ["Jump" org-goto t]) | |
| 21396 | ("Edit Structure" | |
| 21397 | ["Refile Subtree" org-refile (org-in-subtree-not-table-p)] | |
| 21398 | "--" | |
| 21399 | ["Move Subtree Up" org-metaup (org-at-heading-p)] | |
| 21400 | ["Move Subtree Down" org-metadown (org-at-heading-p)] | |
| 21401 | "--" | |
| 21402 | ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)] | |
| 21403 | ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)] | |
| 21404 | ["Paste Subtree" org-paste-special (not (org-at-table-p))] | |
| 21405 | "--" | |
| 21406 | ["Clone subtree, shift time" org-clone-subtree-with-time-shift t] | |
| 21407 | "--" | |
| 21408 | ["Copy visible text" org-copy-visible t] | |
| 21409 | "--" | |
| 21410 | ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)] | |
| 21411 | ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)] | |
| 21412 | ["Demote Heading" org-metaright (org-in-subtree-not-table-p)] | |
| 21413 | ["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)] | |
| 21414 | "--" | |
| 21415 | ["Sort Region/Children" org-sort t] | |
| 21416 | "--" | |
| 21417 | ["Convert to odd levels" org-convert-to-odd-levels t] | |
| 21418 | ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) | |
| 21419 | ("Editing" | |
| 21420 | ["Emphasis..." org-emphasize t] | |
| 21421 | ["Edit Source Example" org-edit-special t] | |
| 21422 | "--" | |
| 21423 | ["Footnote new/jump" org-footnote-action t] | |
| 21424 | ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"]) | |
| 21425 | ("Archive" | |
| 21426 | ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)] | |
| 21427 | "--" | |
| 21428 | ["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)] | |
| 21429 | ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)] | |
| 21430 | ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)] | |
| 21431 | ) | |
| 21432 | "--" | |
| 21433 | ("Hyperlinks" | |
| 21434 | ["Store Link (Global)" org-store-link t] | |
| 21435 | ["Find existing link to here" org-occur-link-in-agenda-files t] | |
| 21436 | ["Insert Link" org-insert-link t] | |
| 21437 | ["Follow Link" org-open-at-point t] | |
| 21438 | "--" | |
| 21439 | ["Next link" org-next-link t] | |
| 21440 | ["Previous link" org-previous-link t] | |
| 21441 | "--" | |
| 21442 | ["Descriptive Links" | |
| 21443 | org-toggle-link-display | |
| 21444 | :style radio | |
| 21445 | :selected org-descriptive-links | |
| 21446 | ] | |
| 21447 | ["Literal Links" | |
| 21448 | org-toggle-link-display | |
| 21449 | :style radio | |
| 21450 | :selected (not org-descriptive-links)]) | |
| 21451 | "--" | |
| 21452 | ("TODO Lists" | |
| 21453 | ["TODO/DONE/-" org-todo t] | |
| 21454 | ("Select keyword" | |
| 21455 | ["Next keyword" org-shiftright (org-at-heading-p)] | |
| 21456 | ["Previous keyword" org-shiftleft (org-at-heading-p)] | |
| 21457 | ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))] | |
| 21458 | ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))] | |
| 21459 | ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]) | |
| 21460 | ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"] | |
| 21461 | ["Global TODO list" org-todo-list :active t :keys "\\[org-agenda] t"] | |
| 21462 | "--" | |
| 21463 | ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies) | |
| 21464 | :selected org-enforce-todo-dependencies :style toggle :active t] | |
| 21465 | "Settings for tree at point" | |
| 21466 | ["Do Children sequentially" org-toggle-ordered-property :style radio | |
| 21467 | :selected (org-entry-get nil "ORDERED") | |
| 21468 | :active org-enforce-todo-dependencies :keys "C-c C-x o"] | |
| 21469 | ["Do Children parallel" org-toggle-ordered-property :style radio | |
| 21470 | :selected (not (org-entry-get nil "ORDERED")) | |
| 21471 | :active org-enforce-todo-dependencies :keys "C-c C-x o"] | |
| 21472 | "--" | |
| 21473 | ["Set Priority" org-priority t] | |
| 21474 | ["Priority Up" org-shiftup t] | |
| 21475 | ["Priority Down" org-shiftdown t] | |
| 21476 | "--" | |
| 21477 | ["Get news from all feeds" org-feed-update-all t] | |
| 21478 | ["Go to the inbox of a feed..." org-feed-goto-inbox t] | |
| 21479 | ["Customize feeds" (customize-variable 'org-feed-alist) t]) | |
| 21480 | ("TAGS and Properties" | |
| 21481 | ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))] | |
| 21482 | ["Change tag in region" org-change-tag-in-region (org-region-active-p)] | |
| 21483 | "--" | |
| 21484 | ["Set property" org-set-property (not (org-before-first-heading-p))] | |
| 21485 | ["Column view of properties" org-columns t] | |
| 21486 | ["Insert Column View DBlock" org-columns-insert-dblock t]) | |
| 21487 | ("Dates and Scheduling" | |
| 21488 | ["Timestamp" org-time-stamp (not (org-before-first-heading-p))] | |
| 21489 | ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))] | |
| 21490 | ("Change Date" | |
| 21491 | ["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)] | |
| 21492 | ["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)] | |
| 21493 | ["1 ... Later" org-shiftup (org-at-timestamp-p 'lax)] | |
| 21494 | ["1 ... Earlier" org-shiftdown (org-at-timestamp-p 'lax)]) | |
| 21495 | ["Compute Time Range" org-evaluate-time-range t] | |
| 21496 | ["Schedule Item" org-schedule (not (org-before-first-heading-p))] | |
| 21497 | ["Deadline" org-deadline (not (org-before-first-heading-p))] | |
| 21498 | "--" | |
| 21499 | ["Custom time format" org-toggle-time-stamp-overlays | |
| 21500 | :style radio :selected org-display-custom-times] | |
| 21501 | "--" | |
| 21502 | ["Goto Calendar" org-goto-calendar t] | |
| 21503 | ["Date from Calendar" org-date-from-calendar t] | |
| 21504 | "--" | |
| 21505 | ["Start/Restart Timer" org-timer-start t] | |
| 21506 | ["Pause/Continue Timer" org-timer-pause-or-continue t] | |
| 21507 | ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"] | |
| 21508 | ["Insert Timer String" org-timer t] | |
| 21509 | ["Insert Timer Item" org-timer-item t]) | |
| 21510 | ("Logging work" | |
| 21511 | ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"] | |
| 21512 | ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"] | |
| 21513 | ["Clock out" org-clock-out t] | |
| 21514 | ["Clock cancel" org-clock-cancel t] | |
| 21515 | "--" | |
| 21516 | ["Mark as default task" org-clock-mark-default-task t] | |
| 21517 | ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"] | |
| 21518 | ["Goto running clock" org-clock-goto t] | |
| 21519 | "--" | |
| 21520 | ["Display times" org-clock-display t] | |
| 21521 | ["Create clock table" org-clock-report t] | |
| 21522 | "--" | |
| 21523 | ["Record DONE time" | |
| 21524 | (progn (setq org-log-done (not org-log-done)) | |
| 21525 | (message "Switching to %s will %s record a timestamp" | |
| 21526 | (car org-done-keywords) | |
| 21527 | (if org-log-done "automatically" "not"))) | |
| 21528 | :style toggle :selected org-log-done]) | |
| 21529 | "--" | |
| 21530 | ["Agenda Command..." org-agenda t] | |
| 21531 | ["Set Restriction Lock" org-agenda-set-restriction-lock t] | |
| 21532 | ("File List for Agenda") | |
| 21533 | ("Special views current file" | |
| 21534 | ["TODO Tree" org-show-todo-tree t] | |
| 21535 | ["Check Deadlines" org-check-deadlines t] | |
| 21536 | ["Tags/Property tree" org-match-sparse-tree t]) | |
| 21537 | "--" | |
| 21538 | ["Export/Publish..." org-export-dispatch t] | |
| 21539 | ("LaTeX" | |
| 21540 | ["Org CDLaTeX mode" org-cdlatex-mode :active (require 'cdlatex nil t) | |
| 21541 | :style toggle :selected org-cdlatex-mode] | |
| 21542 | ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] | |
| 21543 | ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] | |
| 21544 | ["Modify math symbol" org-cdlatex-math-modify | |
| 21545 | (org-inside-LaTeX-fragment-p)] | |
| 21546 | ["Insert citation" org-reftex-citation t]) | |
| 21547 | "--" | |
| 21548 | ("MobileOrg" | |
| 21549 | ["Push Files and Views" org-mobile-push t] | |
| 21550 | ["Get Captured and Flagged" org-mobile-pull t] | |
| 21551 | ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"] | |
| 21552 | "--" | |
| 21553 | ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) | |
| 21554 | "--" | |
| 21555 | ("Documentation" | |
| 21556 | ["Show Version" org-version t] | |
| 21557 | ["Info Documentation" org-info t]) | |
| 21558 | ("Customize" | |
| 21559 | ["Browse Org Group" org-customize t] | |
| 21560 | "--" | |
| 21561 | ["Expand This Menu" org-create-customize-menu | |
| 21562 | (fboundp 'customize-menu-create)]) | |
| 21563 | ["Send bug report" org-submit-bug-report t] | |
| 21564 | "--" | |
| 21565 | ("Refresh/Reload" | |
| 21566 | ["Refresh setup current buffer" org-mode-restart t] | |
| 21567 | ["Reload Org (after update)" org-reload t] | |
| 21568 | ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x !"]) | |
| 21569 | )) | |
| 21570 | ||
| 21571 | (defun org-info (&optional node) | |
| 21572 | "Read documentation for Org in the info system. | |
| 21573 | With optional NODE, go directly to that node." | |
| 21574 | (interactive) | |
| 21575 | (info (format "(org)%s" (or node "")))) | |
| 21576 | ||
| 21577 | ;;;###autoload | |
| 21578 | (defun org-submit-bug-report () | |
| 21579 | "Submit a bug report on Org via mail. | |
| 21580 | ||
| 21581 | Don't hesitate to report any problems or inaccurate documentation. | |
| 21582 | ||
| 21583 | If you don't have setup sending mail from (X)Emacs, please copy the | |
| 21584 | output buffer into your mail program, as it gives us important | |
| 21585 | information about your Org version and configuration." | |
| 21586 | (interactive) | |
| 21587 | (require 'reporter) | |
| 21588 | (defvar reporter-prompt-for-summary-p) | |
| 21589 | (org-load-modules-maybe) | |
| 21590 | (org-require-autoloaded-modules) | |
| 21591 | (let ((reporter-prompt-for-summary-p "Bug report subject: ")) | |
| 21592 | (reporter-submit-bug-report | |
| 21593 | "emacs-orgmode@gnu.org" | |
| 21594 | (org-version nil 'full) | |
| 21595 | (let (list) | |
| 21596 | (save-window-excursion | |
| 21597 | (pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) | |
| 21598 | (delete-other-windows) | |
| 21599 | (erase-buffer) | |
| 21600 | (insert "You are about to submit a bug report to the Org mailing list. | |
| 21601 | ||
| 21602 | We would like to add your full Org and Outline configuration to the | |
| 21603 | bug report. This greatly simplifies the work of the maintainer and | |
| 21604 | other experts on the mailing list. | |
| 21605 | ||
| 21606 | HOWEVER, some variables you have customized may contain private | |
| 21607 | information. The names of customers, colleagues, or friends, might | |
| 21608 | appear in the form of file names, tags, todo states, or search strings. | |
| 21609 | If you answer yes to the prompt, you might want to check and remove | |
| 21610 | such private information before sending the email.") | |
| 21611 | (add-text-properties (point-min) (point-max) '(face org-warning)) | |
| 21612 | (when (yes-or-no-p "Include your Org configuration ") | |
| 21613 | (mapatoms | |
| 21614 | (lambda (v) | |
| 21615 | (and (boundp v) | |
| 21616 | (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v)) | |
| 21617 | (or (and (symbol-value v) | |
| 21618 | (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v))) | |
| 21619 | (and | |
| 21620 | (get v 'custom-type) (get v 'standard-value) | |
| 21621 | (not (equal (symbol-value v) (eval (car (get v 'standard-value))))))) | |
| 21622 | (push v list))))) | |
| 21623 | (kill-buffer (get-buffer "*Warn about privacy*")) | |
| 21624 | list)) | |
| 21625 | nil nil | |
| 21626 | "Remember to cover the basics, that is, what you expected to happen and | |
| 21627 | what in fact did happen. You don't know how to make a good report? See | |
| 21628 | ||
| 21629 | https://orgmode.org/manual/Feedback.html#Feedback | |
| 21630 | ||
| 21631 | Your bug report will be posted to the Org mailing list. | |
| 21632 | ------------------------------------------------------------------------") | |
| 21633 | (save-excursion | |
| 21634 | (when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t) | |
| 21635 | (replace-match "\\1Bug: \\3 [\\2]"))))) | |
| 21636 | ||
| 21637 | ||
| 21638 | (defun org-install-agenda-files-menu () | |
| 21639 | (let ((bl (buffer-list))) | |
| 21640 | (save-excursion | |
| 21641 | (while bl | |
| 21642 | (set-buffer (pop bl)) | |
| 21643 | (when (derived-mode-p 'org-mode) (setq bl nil))) | |
| 21644 | (when (derived-mode-p 'org-mode) | |
| 21645 | (easy-menu-change | |
| 21646 | '("Org") "File List for Agenda" | |
| 21647 | (append | |
| 21648 | (list | |
| 21649 | ["Edit File List" (org-edit-agenda-file-list) t] | |
| 21650 | ["Add/Move Current File to Front of List" org-agenda-file-to-front t] | |
| 21651 | ["Remove Current File from List" org-remove-file t] | |
| 21652 | ["Cycle through agenda files" org-cycle-agenda-files t] | |
| 21653 | ["Occur in all agenda files" org-occur-in-agenda-files t] | |
| 21654 | "--") | |
| 21655 | (mapcar 'org-file-menu-entry | |
| 21656 | ;; Prevent initialization from failing. | |
| 21657 | (ignore-errors (org-agenda-files t))))))))) | |
| 21658 | ||
| 21659 | ;;;; Documentation | |
| 21660 | ||
| 21661 | (defun org-require-autoloaded-modules () | |
| 21662 | (interactive) | |
| 21663 | (mapc #'require | |
| 21664 | '(org-agenda org-archive org-attach org-clock org-colview org-id | |
| 21665 | org-table org-timer))) | |
| 21666 | ||
| 21667 | ;;;###autoload | |
| 21668 | (defun org-reload (&optional uncompiled) | |
| 21669 | "Reload all Org Lisp files. | |
| 21670 | With prefix arg UNCOMPILED, load the uncompiled versions." | |
| 21671 | (interactive "P") | |
| 21672 | (require 'loadhist) | |
| 21673 | (let* ((org-dir (org-find-library-dir "org")) | |
| 21674 | (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir)) | |
| 21675 | (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?") | |
| 21676 | (remove-re (format "\\`%s\\'" | |
| 21677 | (regexp-opt '("org" "org-loaddefs" "org-version")))) | |
| 21678 | (feats (delete-dups | |
| 21679 | (mapcar 'file-name-sans-extension | |
| 21680 | (mapcar 'file-name-nondirectory | |
| 21681 | (delq nil | |
| 21682 | (mapcar 'feature-file | |
| 21683 | features)))))) | |
| 21684 | (lfeat (append | |
| 21685 | (sort | |
| 21686 | (setq feats | |
| 21687 | (delq nil (mapcar | |
| 21688 | (lambda (f) | |
| 21689 | (if (and (string-match feature-re f) | |
| 21690 | (not (string-match remove-re f))) | |
| 21691 | f nil)) | |
| 21692 | feats))) | |
| 21693 | 'string-lessp) | |
| 21694 | (list "org-version" "org"))) | |
| 21695 | (load-suffixes (when (boundp 'load-suffixes) load-suffixes)) | |
| 21696 | (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes)) | |
| 21697 | load-uncore load-misses) | |
| 21698 | (setq load-misses | |
| 21699 | (delq 't | |
| 21700 | (mapcar (lambda (f) | |
| 21701 | (or (org-load-noerror-mustsuffix (concat org-dir f)) | |
| 21702 | (and (string= org-dir contrib-dir) | |
| 21703 | (org-load-noerror-mustsuffix (concat contrib-dir f))) | |
| 21704 | (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f)) | |
| 21705 | (add-to-list 'load-uncore f 'append) | |
| 21706 | 't) | |
| 21707 | f)) | |
| 21708 | lfeat))) | |
| 21709 | (when load-uncore | |
| 21710 | (message "The following feature%s found in load-path, please check if that's correct:\n%s" | |
| 21711 | (if (> (length load-uncore) 1) "s were" " was") load-uncore)) | |
| 21712 | (if load-misses | |
| 21713 | (message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" | |
| 21714 | (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full)) | |
| 21715 | (message "Successfully reloaded Org\n%s" (org-version nil 'full))))) | |
| 21716 | ||
| 21717 | ;;;###autoload | |
| 21718 | (defun org-customize () | |
| 21719 | "Call the customize function with org as argument." | |
| 21720 | (interactive) | |
| 21721 | (org-load-modules-maybe) | |
| 21722 | (org-require-autoloaded-modules) | |
| 21723 | (customize-browse 'org)) | |
| 21724 | ||
| 21725 | (defun org-create-customize-menu () | |
| 21726 | "Create a full customization menu for Org mode, insert it into the menu." | |
| 21727 | (interactive) | |
| 21728 | (org-load-modules-maybe) | |
| 21729 | (org-require-autoloaded-modules) | |
| 21730 | (if (fboundp 'customize-menu-create) | |
| 21731 | (progn | |
| 21732 | (easy-menu-change | |
| 21733 | '("Org") "Customize" | |
| 21734 | `(["Browse Org group" org-customize t] | |
| 21735 | "--" | |
| 21736 | ,(customize-menu-create 'org) | |
| 21737 | ["Set" Custom-set t] | |
| 21738 | ["Save" Custom-save t] | |
| 21739 | ["Reset to Current" Custom-reset-current t] | |
| 21740 | ["Reset to Saved" Custom-reset-saved t] | |
| 21741 | ["Reset to Standard Settings" Custom-reset-standard t])) | |
| 21742 | (message "\"Org\"-menu now contains full customization menu")) | |
| 21743 | (error "Cannot expand menu (outdated version of cus-edit.el)"))) | |
| 21744 | ||
| 21745 | ;;;; Miscellaneous stuff | |
| 21746 | ||
| 21747 | ;;; Generally useful functions | |
| 21748 | ||
| 21749 | (defun org-get-at-eol (property n) | |
| 21750 | "Get text property PROPERTY at the end of line less N characters." | |
| 21751 | (get-text-property (- (point-at-eol) n) property)) | |
| 21752 | ||
| 21753 | (defun org-find-text-property-in-string (prop s) | |
| 21754 | "Return the first non-nil value of property PROP in string S." | |
| 21755 | (or (get-text-property 0 prop s) | |
| 21756 | (get-text-property (or (next-single-property-change 0 prop s) 0) | |
| 21757 | prop s))) | |
| 21758 | ||
| 21759 | (defun org-display-warning (message) | |
| 21760 | "Display the given MESSAGE as a warning." | |
| 21761 | (display-warning 'org message :warning)) | |
| 21762 | ||
| 21763 | (defun org-eval (form) | |
| 21764 | "Eval FORM and return result." | |
| 21765 | (condition-case error | |
| 21766 | (eval form) | |
| 21767 | (error (format "%%![Error: %s]" error)))) | |
| 21768 | ||
| 21769 | (defun org-in-clocktable-p () | |
| 21770 | "Check if the cursor is in a clocktable." | |
| 21771 | (let ((pos (point)) start) | |
| 21772 | (save-excursion | |
| 21773 | (end-of-line 1) | |
| 21774 | (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t) | |
| 21775 | (setq start (match-beginning 0)) | |
| 21776 | (re-search-forward "^[ \t]*#\\+END:.*" nil t) | |
| 21777 | (>= (match-end 0) pos) | |
| 21778 | start)))) | |
| 21779 | ||
| 21780 | (defun org-in-verbatim-emphasis () | |
| 21781 | (save-match-data | |
| 21782 | (and (org-in-regexp org-verbatim-re 2) | |
| 21783 | (>= (point) (match-beginning 3)) | |
| 21784 | (<= (point) (match-end 4))))) | |
| 21785 | ||
| 21786 | (defun org-overlay-display (ovl text &optional face evap) | |
| 21787 | "Make overlay OVL display TEXT with face FACE." | |
| 21788 | (overlay-put ovl 'display text) | |
| 21789 | (if face (overlay-put ovl 'face face)) | |
| 21790 | (if evap (overlay-put ovl 'evaporate t))) | |
| 21791 | ||
| 21792 | (defun org-overlay-before-string (ovl text &optional face evap) | |
| 21793 | "Make overlay OVL display TEXT with face FACE." | |
| 21794 | (if face (org-add-props text nil 'face face)) | |
| 21795 | (overlay-put ovl 'before-string text) | |
| 21796 | (if evap (overlay-put ovl 'evaporate t))) | |
| 21797 | ||
| 21798 | (defun org-find-overlays (prop &optional pos delete) | |
| 21799 | "Find all overlays specifying PROP at POS or point. | |
| 21800 | If DELETE is non-nil, delete all those overlays." | |
| 21801 | (let (found) | |
| 21802 | (dolist (ov (overlays-at (or pos (point))) found) | |
| 21803 | (cond ((not (overlay-get ov prop))) | |
| 21804 | (delete (delete-overlay ov)) | |
| 21805 | (t (push ov found)))))) | |
| 21806 | ||
| 21807 | (defun org-goto-marker-or-bmk (marker &optional bookmark) | |
| 21808 | "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." | |
| 21809 | (if (and marker (marker-buffer marker) | |
| 21810 | (buffer-live-p (marker-buffer marker))) | |
| 21811 | (progn | |
| 21812 | (pop-to-buffer-same-window (marker-buffer marker)) | |
| 21813 | (when (or (> marker (point-max)) (< marker (point-min))) | |
| 21814 | (widen)) | |
| 21815 | (goto-char marker) | |
| 21816 | (org-show-context 'org-goto)) | |
| 21817 | (if bookmark | |
| 21818 | (bookmark-jump bookmark) | |
| 21819 | (error "Cannot find location")))) | |
| 21820 | ||
| 21821 | (defun org-quote-csv-field (s) | |
| 21822 | "Quote field for inclusion in CSV material." | |
| 21823 | (if (string-match "[\",]" s) | |
| 21824 | (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") | |
| 21825 | s)) | |
| 21826 | ||
| 21827 | (defun org-force-self-insert (N) | |
| 21828 | "Needed to enforce self-insert under remapping." | |
| 21829 | (interactive "p") | |
| 21830 | (self-insert-command N)) | |
| 21831 | ||
| 21832 | (defun org-shorten-string (s maxlength) | |
| 21833 | "Shorten string S so that it is no longer than MAXLENGTH characters. | |
| 21834 | If the string is shorter or has length MAXLENGTH, just return the | |
| 21835 | original string. If it is longer, the functions finds a space in the | |
| 21836 | string, breaks this string off at that locations and adds three dots | |
| 21837 | as ellipsis. Including the ellipsis, the string will not be longer | |
| 21838 | than MAXLENGTH. If finding a good breaking point in the string does | |
| 21839 | not work, the string is just chopped off in the middle of a word | |
| 21840 | if necessary." | |
| 21841 | (if (<= (length s) maxlength) | |
| 21842 | s | |
| 21843 | (let* ((n (max (- maxlength 4) 1)) | |
| 21844 | (re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)"))) | |
| 21845 | (if (string-match re s) | |
| 21846 | (concat (match-string 1 s) "...") | |
| 21847 | (concat (substring s 0 (max (- maxlength 3) 0)) "..."))))) | |
| 21848 | ||
| 21849 | (defun org-get-indentation (&optional line) | |
| 21850 | "Get the indentation of the current line, interpreting tabs. | |
| 21851 | When LINE is given, assume it represents a line and compute its indentation." | |
| 21852 | (if line | |
| 21853 | (when (string-match "^ *" (org-remove-tabs line)) | |
| 21854 | (match-end 0)) | |
| 21855 | (save-excursion | |
| 21856 | (beginning-of-line 1) | |
| 21857 | (skip-chars-forward " \t") | |
| 21858 | (current-column)))) | |
| 21859 | ||
| 21860 | (defun org-get-string-indentation (s) | |
| 21861 | "What indentation has S due to SPACE and TAB at the beginning of the string?" | |
| 21862 | (let ((n -1) (i 0) (w tab-width) c) | |
| 21863 | (catch 'exit | |
| 21864 | (while (< (setq n (1+ n)) (length s)) | |
| 21865 | (setq c (aref s n)) | |
| 21866 | (cond ((= c ?\ ) (setq i (1+ i))) | |
| 21867 | ((= c ?\t) (setq i (* (/ (+ w i) w) w))) | |
| 21868 | (t (throw 'exit t))))) | |
| 21869 | i)) | |
| 21870 | ||
| 21871 | (defun org-remove-tabs (s &optional width) | |
| 21872 | "Replace tabulators in S with spaces. | |
| 21873 | Assumes that s is a single line, starting in column 0." | |
| 21874 | (setq width (or width tab-width)) | |
| 21875 | (while (string-match "\t" s) | |
| 21876 | (setq s (replace-match | |
| 21877 | (make-string | |
| 21878 | (- (* width (/ (+ (match-beginning 0) width) width)) | |
| 21879 | (match-beginning 0)) ?\ ) | |
| 21880 | t t s))) | |
| 21881 | s) | |
| 21882 | ||
| 21883 | (defun org-fix-indentation (line ind) | |
| 21884 | "Fix indentation in LINE. | |
| 21885 | IND is a cons cell with target and minimum indentation. | |
| 21886 | If the current indentation in LINE is smaller than the minimum, | |
| 21887 | leave it alone. If it is larger than ind, set it to the target." | |
| 21888 | (let* ((l (org-remove-tabs line)) | |
| 21889 | (i (org-get-indentation l)) | |
| 21890 | (i1 (car ind)) (i2 (cdr ind))) | |
| 21891 | (when (>= i i2) (setq l (substring line i2))) | |
| 21892 | (if (> i1 0) | |
| 21893 | (concat (make-string i1 ?\ ) l) | |
| 21894 | l))) | |
| 21895 | ||
| 21896 | (defun org-remove-indentation (code &optional n) | |
| 21897 | "Remove maximum common indentation in string CODE and return it. | |
| 21898 | N may optionally be the number of columns to remove. Return CODE | |
| 21899 | as-is if removal failed." | |
| 21900 | (with-temp-buffer | |
| 21901 | (insert code) | |
| 21902 | (if (org-do-remove-indentation n) (buffer-string) code))) | |
| 21903 | ||
| 21904 | (defun org-do-remove-indentation (&optional n) | |
| 21905 | "Remove the maximum common indentation from the buffer. | |
| 21906 | When optional argument N is a positive integer, remove exactly | |
| 21907 | that much characters from indentation, if possible. Return nil | |
| 21908 | if it fails." | |
| 21909 | (catch :exit | |
| 21910 | (goto-char (point-min)) | |
| 21911 | ;; Find maximum common indentation, if not specified. | |
| 21912 | (let ((n (or n | |
| 21913 | (let ((min-ind (point-max))) | |
| 21914 | (save-excursion | |
| 21915 | (while (re-search-forward "^[ \t]*\\S-" nil t) | |
| 21916 | (let ((ind (1- (current-column)))) | |
| 21917 | (if (zerop ind) (throw :exit nil) | |
| 21918 | (setq min-ind (min min-ind ind)))))) | |
| 21919 | min-ind)))) | |
| 21920 | (if (zerop n) (throw :exit nil) | |
| 21921 | ;; Remove exactly N indentation, but give up if not possible. | |
| 21922 | (while (not (eobp)) | |
| 21923 | (let ((ind (progn (skip-chars-forward " \t") (current-column)))) | |
| 21924 | (cond ((eolp) (delete-region (line-beginning-position) (point))) | |
| 21925 | ((< ind n) (throw :exit nil)) | |
| 21926 | (t (indent-line-to (- ind n)))) | |
| 21927 | (forward-line))) | |
| 21928 | ;; Signal success. | |
| 21929 | t)))) | |
| 21930 | ||
| 21931 | (defun org-fill-template (template alist) | |
| 21932 | "Find each %key of ALIST in TEMPLATE and replace it." | |
| 21933 | (let ((case-fold-search nil)) | |
| 21934 | (dolist (entry (sort (copy-sequence alist) | |
| 21935 | (lambda (a b) (< (length (car a)) (length (car b)))))) | |
| 21936 | (setq template | |
| 21937 | (replace-regexp-in-string | |
| 21938 | (concat "%" (regexp-quote (car entry))) | |
| 21939 | (or (cdr entry) "") template t t))) | |
| 21940 | template)) | |
| 21941 | ||
| 21942 | (defun org-base-buffer (buffer) | |
| 21943 | "Return the base buffer of BUFFER, if it has one. Else return the buffer." | |
| 21944 | (if (not buffer) | |
| 21945 | buffer | |
| 21946 | (or (buffer-base-buffer buffer) | |
| 21947 | buffer))) | |
| 21948 | ||
| 21949 | (defun org-wrap (string &optional width lines) | |
| 21950 | "Wrap string to either a number of lines, or a width in characters. | |
| 21951 | If WIDTH is non-nil, the string is wrapped to that width, however many lines | |
| 21952 | that costs. If there is a word longer than WIDTH, the text is actually | |
| 21953 | wrapped to the length of that word. | |
| 21954 | IF WIDTH is nil and LINES is non-nil, the string is forced into at most that | |
| 21955 | many lines, whatever width that takes. | |
| 21956 | The return value is a list of lines, without newlines at the end." | |
| 21957 | (let* ((words (split-string string)) | |
| 21958 | (maxword (apply 'max (mapcar 'org-string-width words))) | |
| 21959 | w ll) | |
| 21960 | (cond (width | |
| 21961 | (org-do-wrap words (max maxword width))) | |
| 21962 | (lines | |
| 21963 | (setq w maxword) | |
| 21964 | (setq ll (org-do-wrap words maxword)) | |
| 21965 | (if (<= (length ll) lines) | |
| 21966 | ll | |
| 21967 | (setq ll words) | |
| 21968 | (while (> (length ll) lines) | |
| 21969 | (setq w (1+ w)) | |
| 21970 | (setq ll (org-do-wrap words w))) | |
| 21971 | ll)) | |
| 21972 | (t (error "Cannot wrap this"))))) | |
| 21973 | ||
| 21974 | (defun org-do-wrap (words width) | |
| 21975 | "Create lines of maximum width WIDTH (in characters) from word list WORDS." | |
| 21976 | (let (lines line) | |
| 21977 | (while words | |
| 21978 | (setq line (pop words)) | |
| 21979 | (while (and words (< (+ (length line) (length (car words))) width)) | |
| 21980 | (setq line (concat line " " (pop words)))) | |
| 21981 | (setq lines (push line lines))) | |
| 21982 | (nreverse lines))) | |
| 21983 | ||
| 21984 | (defun org-quote-vert (s) | |
| 21985 | "Replace \"|\" with \"\\vert\"." | |
| 21986 | (while (string-match "|" s) | |
| 21987 | (setq s (replace-match "\\vert" t t s))) | |
| 21988 | s) | |
| 21989 | ||
| 21990 | (defun org-uuidgen-p (s) | |
| 21991 | "Is S an ID created by UUIDGEN?" | |
| 21992 | (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) | |
| 21993 | ||
| 21994 | (defun org-in-src-block-p (&optional inside) | |
| 21995 | "Whether point is in a code source block. | |
| 21996 | When INSIDE is non-nil, don't consider we are within a src block | |
| 21997 | when point is at #+BEGIN_SRC or #+END_SRC." | |
| 21998 | (let ((case-fold-search t)) | |
| 21999 | (or (and (eq (get-char-property (point) 'src-block) t)) | |
| 22000 | (and (not inside) | |
| 22001 | (save-match-data | |
| 22002 | (save-excursion | |
| 22003 | (beginning-of-line) | |
| 22004 | (looking-at ".*#\\+\\(begin\\|end\\)_src"))))))) | |
| 22005 | ||
| 22006 | (defun org-context () | |
| 22007 | "Return a list of contexts of the current cursor position. | |
| 22008 | If several contexts apply, all are returned. | |
| 22009 | Each context entry is a list with a symbol naming the context, and | |
| 22010 | two positions indicating start and end of the context. Possible | |
| 22011 | contexts are: | |
| 22012 | ||
| 22013 | :headline anywhere in a headline | |
| 22014 | :headline-stars on the leading stars in a headline | |
| 22015 | :todo-keyword on a TODO keyword (including DONE) in a headline | |
| 22016 | :tags on the TAGS in a headline | |
| 22017 | :priority on the priority cookie in a headline | |
| 22018 | :item on the first line of a plain list item | |
| 22019 | :item-bullet on the bullet/number of a plain list item | |
| 22020 | :checkbox on the checkbox in a plain list item | |
| 22021 | :table in an Org table | |
| 22022 | :table-special on a special filed in a table | |
| 22023 | :table-table in a table.el table | |
| 22024 | :clocktable in a clocktable | |
| 22025 | :src-block in a source block | |
| 22026 | :link on a hyperlink | |
| 22027 | :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT. | |
| 22028 | :target on a <<target>> | |
| 22029 | :radio-target on a <<<radio-target>>> | |
| 22030 | :latex-fragment on a LaTeX fragment | |
| 22031 | :latex-preview on a LaTeX fragment with overlaid preview image | |
| 22032 | ||
| 22033 | This function expects the position to be visible because it uses font-lock | |
| 22034 | faces as a help to recognize the following contexts: :table-special, :link, | |
| 22035 | and :keyword." | |
| 22036 | (let* ((f (get-text-property (point) 'face)) | |
| 22037 | (faces (if (listp f) f (list f))) | |
| 22038 | (case-fold-search t) | |
| 22039 | (p (point)) clist o) | |
| 22040 | ;; First the large context | |
| 22041 | (cond | |
| 22042 | ((org-at-heading-p t) | |
| 22043 | (push (list :headline (point-at-bol) (point-at-eol)) clist) | |
| 22044 | (when (progn | |
| 22045 | (beginning-of-line 1) | |
| 22046 | (looking-at org-todo-line-tags-regexp)) | |
| 22047 | (push (org-point-in-group p 1 :headline-stars) clist) | |
| 22048 | (push (org-point-in-group p 2 :todo-keyword) clist) | |
| 22049 | (push (org-point-in-group p 4 :tags) clist)) | |
| 22050 | (goto-char p) | |
| 22051 | (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1)) | |
| 22052 | (when (looking-at "\\[#[A-Z0-9]\\]") | |
| 22053 | (push (org-point-in-group p 0 :priority) clist))) | |
| 22054 | ||
| 22055 | ((org-at-item-p) | |
| 22056 | (push (org-point-in-group p 2 :item-bullet) clist) | |
| 22057 | (push (list :item (point-at-bol) | |
| 22058 | (save-excursion (org-end-of-item) (point))) | |
| 22059 | clist) | |
| 22060 | (and (org-at-item-checkbox-p) | |
| 22061 | (push (org-point-in-group p 0 :checkbox) clist))) | |
| 22062 | ||
| 22063 | ((org-at-table-p) | |
| 22064 | (push (list :table (org-table-begin) (org-table-end)) clist) | |
| 22065 | (when (memq 'org-formula faces) | |
| 22066 | (push (list :table-special | |
| 22067 | (previous-single-property-change p 'face) | |
| 22068 | (next-single-property-change p 'face)) clist))) | |
| 22069 | ((org-at-table-p 'any) | |
| 22070 | (push (list :table-table) clist))) | |
| 22071 | (goto-char p) | |
| 22072 | ||
| 22073 | (let ((case-fold-search t)) | |
| 22074 | ;; New the "medium" contexts: clocktables, source blocks | |
| 22075 | (cond ((org-in-clocktable-p) | |
| 22076 | (push (list :clocktable | |
| 22077 | (and (or (looking-at "[ \t]*\\(#\\+BEGIN: clocktable\\)") | |
| 22078 | (re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t)) | |
| 22079 | (match-beginning 1)) | |
| 22080 | (and (re-search-forward "[ \t]*#\\+END:?" nil t) | |
| 22081 | (match-end 0))) clist)) | |
| 22082 | ((org-in-src-block-p) | |
| 22083 | (push (list :src-block | |
| 22084 | (and (or (looking-at "[ \t]*\\(#\\+BEGIN_SRC\\)") | |
| 22085 | (re-search-backward "[ \t]*\\(#+BEGIN_SRC\\)" nil t)) | |
| 22086 | (match-beginning 1)) | |
| 22087 | (and (search-forward "#+END_SRC" nil t) | |
| 22088 | (match-beginning 0))) clist)))) | |
| 22089 | (goto-char p) | |
| 22090 | ||
| 22091 | ;; Now the small context | |
| 22092 | (cond | |
| 22093 | ((org-at-timestamp-p) | |
| 22094 | (push (org-point-in-group p 0 :timestamp) clist)) | |
| 22095 | ((memq 'org-link faces) | |
| 22096 | (push (list :link | |
| 22097 | (previous-single-property-change p 'face) | |
| 22098 | (next-single-property-change p 'face)) clist)) | |
| 22099 | ((memq 'org-special-keyword faces) | |
| 22100 | (push (list :keyword | |
| 22101 | (previous-single-property-change p 'face) | |
| 22102 | (next-single-property-change p 'face)) clist)) | |
| 22103 | ((org-at-target-p) | |
| 22104 | (push (org-point-in-group p 0 :target) clist) | |
| 22105 | (goto-char (1- (match-beginning 0))) | |
| 22106 | (when (looking-at org-radio-target-regexp) | |
| 22107 | (push (org-point-in-group p 0 :radio-target) clist)) | |
| 22108 | (goto-char p)) | |
| 22109 | ((setq o (cl-some | |
| 22110 | (lambda (o) | |
| 22111 | (and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay) | |
| 22112 | o)) | |
| 22113 | (overlays-at (point)))) | |
| 22114 | (push (list :latex-fragment | |
| 22115 | (overlay-start o) (overlay-end o)) clist) | |
| 22116 | (push (list :latex-preview | |
| 22117 | (overlay-start o) (overlay-end o)) clist)) | |
| 22118 | ((org-inside-LaTeX-fragment-p) | |
| 22119 | ;; FIXME: positions wrong. | |
| 22120 | (push (list :latex-fragment (point) (point)) clist))) | |
| 22121 | ||
| 22122 | (setq clist (nreverse (delq nil clist))) | |
| 22123 | clist)) | |
| 22124 | ||
| 22125 | (defun org-in-regexp (regexp &optional nlines visually) | |
| 22126 | "Check if point is inside a match of REGEXP. | |
| 22127 | ||
| 22128 | Normally only the current line is checked, but you can include | |
| 22129 | NLINES extra lines around point into the search. If VISUALLY is | |
| 22130 | set, require that the cursor is not after the match but really | |
| 22131 | on, so that the block visually is on the match. | |
| 22132 | ||
| 22133 | Return nil or a cons cell (BEG . END) where BEG and END are, | |
| 22134 | respectively, the positions at the beginning and the end of the | |
| 22135 | match." | |
| 22136 | (catch :exit | |
| 22137 | (let ((pos (point)) | |
| 22138 | (eol (line-end-position (if nlines (1+ nlines) 1)))) | |
| 22139 | (save-excursion | |
| 22140 | (beginning-of-line (- 1 (or nlines 0))) | |
| 22141 | (while (and (re-search-forward regexp eol t) | |
| 22142 | (<= (match-beginning 0) pos)) | |
| 22143 | (let ((end (match-end 0))) | |
| 22144 | (when (or (> end pos) (and (= end pos) (not visually))) | |
| 22145 | (throw :exit (cons (match-beginning 0) (match-end 0)))))))))) | |
| 22146 | ||
| 22147 | (defun org-between-regexps-p (start-re end-re &optional lim-up lim-down) | |
| 22148 | "Non-nil when point is between matches of START-RE and END-RE. | |
| 22149 | ||
| 22150 | Also return a non-nil value when point is on one of the matches. | |
| 22151 | ||
| 22152 | Optional arguments LIM-UP and LIM-DOWN bound the search; they are | |
| 22153 | buffer positions. Default values are the positions of headlines | |
| 22154 | surrounding the point. | |
| 22155 | ||
| 22156 | The functions returns a cons cell whose car (resp. cdr) is the | |
| 22157 | position before START-RE (resp. after END-RE)." | |
| 22158 | (save-match-data | |
| 22159 | (let ((pos (point)) | |
| 22160 | (limit-up (or lim-up (save-excursion (outline-previous-heading)))) | |
| 22161 | (limit-down (or lim-down (save-excursion (outline-next-heading)))) | |
| 22162 | beg end) | |
| 22163 | (save-excursion | |
| 22164 | ;; Point is on a block when on START-RE or if START-RE can be | |
| 22165 | ;; found before it... | |
| 22166 | (and (or (org-in-regexp start-re) | |
| 22167 | (re-search-backward start-re limit-up t)) | |
| 22168 | (setq beg (match-beginning 0)) | |
| 22169 | ;; ... and END-RE after it... | |
| 22170 | (goto-char (match-end 0)) | |
| 22171 | (re-search-forward end-re limit-down t) | |
| 22172 | (> (setq end (match-end 0)) pos) | |
| 22173 | ;; ... without another START-RE in-between. | |
| 22174 | (goto-char (match-beginning 0)) | |
| 22175 | (not (re-search-backward start-re (1+ beg) t)) | |
| 22176 | ;; Return value. | |
| 22177 | (cons beg end)))))) | |
| 22178 | ||
| 22179 | (defun org-in-block-p (names) | |
| 22180 | "Non-nil when point belongs to a block whose name belongs to NAMES. | |
| 22181 | ||
| 22182 | NAMES is a list of strings containing names of blocks. | |
| 22183 | ||
| 22184 | Return first block name matched, or nil. Beware that in case of | |
| 22185 | nested blocks, the returned name may not belong to the closest | |
| 22186 | block from point." | |
| 22187 | (save-match-data | |
| 22188 | (catch 'exit | |
| 22189 | (let ((case-fold-search t) | |
| 22190 | (lim-up (save-excursion (outline-previous-heading))) | |
| 22191 | (lim-down (save-excursion (outline-next-heading)))) | |
| 22192 | (dolist (name names) | |
| 22193 | (let ((n (regexp-quote name))) | |
| 22194 | (when (org-between-regexps-p | |
| 22195 | (concat "^[ \t]*#\\+begin_" n) | |
| 22196 | (concat "^[ \t]*#\\+end_" n) | |
| 22197 | lim-up lim-down) | |
| 22198 | (throw 'exit n))))) | |
| 22199 | nil))) | |
| 22200 | ||
| 22201 | (defun org-occur-in-agenda-files (regexp &optional _nlines) | |
| 22202 | "Call `multi-occur' with buffers for all agenda files." | |
| 22203 | (interactive "sOrg-files matching: ") | |
| 22204 | (let* ((files (org-agenda-files)) | |
| 22205 | (tnames (mapcar #'file-truename files)) | |
| 22206 | (extra org-agenda-text-search-extra-files)) | |
| 22207 | (when (eq (car extra) 'agenda-archives) | |
| 22208 | (setq extra (cdr extra)) | |
| 22209 | (setq files (org-add-archive-files files))) | |
| 22210 | (dolist (f extra) | |
| 22211 | (unless (member (file-truename f) tnames) | |
| 22212 | (unless (member f files) (setq files (append files (list f)))) | |
| 22213 | (setq tnames (append tnames (list (file-truename f)))))) | |
| 22214 | (multi-occur | |
| 22215 | (mapcar (lambda (x) | |
| 22216 | (with-current-buffer | |
| 22217 | ;; FIXME: Why not just (find-file-noselect x)? | |
| 22218 | ;; Is it to avoid the "revert buffer" prompt? | |
| 22219 | (or (get-file-buffer x) (find-file-noselect x)) | |
| 22220 | (widen) | |
| 22221 | (current-buffer))) | |
| 22222 | files) | |
| 22223 | regexp))) | |
| 22224 | ||
| 22225 | (add-hook 'occur-mode-find-occurrence-hook | |
| 22226 | (lambda () (when (derived-mode-p 'org-mode) (org-reveal)))) | |
| 22227 | ||
| 22228 | (defun org-occur-link-in-agenda-files () | |
| 22229 | "Create a link and search for it in the agendas. | |
| 22230 | The link is not stored in `org-stored-links', it is just created | |
| 22231 | for the search purpose." | |
| 22232 | (interactive) | |
| 22233 | (let ((link (condition-case nil | |
| 22234 | (org-store-link nil) | |
| 22235 | (error "Unable to create a link to here")))) | |
| 22236 | (org-occur-in-agenda-files (regexp-quote link)))) | |
| 22237 | ||
| 22238 | (defun org-reverse-string (string) | |
| 22239 | "Return the reverse of STRING." | |
| 22240 | (apply 'string (reverse (string-to-list string)))) | |
| 22241 | ||
| 22242 | ;; defsubst org-uniquify must be defined before first use | |
| 22243 | ||
| 22244 | (defun org-uniquify-alist (alist) | |
| 22245 | "Merge elements of ALIST with the same key. | |
| 22246 | ||
| 22247 | For example, in this alist: | |
| 22248 | ||
| 22249 | \(org-uniquify-alist \\='((a 1) (b 2) (a 3))) | |
| 22250 | => \\='((a 1 3) (b 2)) | |
| 22251 | ||
| 22252 | merge (a 1) and (a 3) into (a 1 3). | |
| 22253 | ||
| 22254 | The function returns the new ALIST." | |
| 22255 | (let (rtn) | |
| 22256 | (dolist (e alist rtn) | |
| 22257 | (let (n) | |
| 22258 | (if (not (assoc (car e) rtn)) | |
| 22259 | (push e rtn) | |
| 22260 | (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) | |
| 22261 | (setq rtn (assq-delete-all (car e) rtn)) | |
| 22262 | (push n rtn)))))) | |
| 22263 | ||
| 22264 | (defun org-delete-all (elts list) | |
| 22265 | "Remove all elements in ELTS from LIST. | |
| 22266 | Comparison is done with `equal'. It is a destructive operation | |
| 22267 | that may remove elements by altering the list structure." | |
| 22268 | (while elts | |
| 22269 | (setq list (delete (pop elts) list))) | |
| 22270 | list) | |
| 22271 | ||
| 22272 | (defun org-back-over-empty-lines () | |
| 22273 | "Move backwards over whitespace, to the beginning of the first empty line. | |
| 22274 | Returns the number of empty lines passed." | |
| 22275 | (let ((pos (point))) | |
| 22276 | (if (cdr (assq 'heading org-blank-before-new-entry)) | |
| 22277 | (skip-chars-backward " \t\n\r") | |
| 22278 | (unless (eobp) | |
| 22279 | (forward-line -1))) | |
| 22280 | (beginning-of-line 2) | |
| 22281 | (goto-char (min (point) pos)) | |
| 22282 | (count-lines (point) pos))) | |
| 22283 | ||
| 22284 | (defun org-skip-whitespace () | |
| 22285 | (skip-chars-forward " \t\n\r")) | |
| 22286 | ||
| 22287 | (defun org-point-in-group (point group &optional context) | |
| 22288 | "Check if POINT is in match-group GROUP. | |
| 22289 | If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the | |
| 22290 | match. If the match group does not exist or point is not inside it, | |
| 22291 | return nil." | |
| 22292 | (and (match-beginning group) | |
| 22293 | (>= point (match-beginning group)) | |
| 22294 | (<= point (match-end group)) | |
| 22295 | (if context | |
| 22296 | (list context (match-beginning group) (match-end group)) | |
| 22297 | t))) | |
| 22298 | ||
| 22299 | (defun org-switch-to-buffer-other-window (&rest args) | |
| 22300 | "Switch to buffer in a second window on the current frame. | |
| 22301 | In particular, do not allow pop-up frames. | |
| 22302 | Returns the newly created buffer." | |
| 22303 | (org-no-popups | |
| 22304 | (apply 'switch-to-buffer-other-window args))) | |
| 22305 | ||
| 22306 | (defun org-combine-plists (&rest plists) | |
| 22307 | "Create a single property list from all plists in PLISTS. | |
| 22308 | The process starts by copying the first list, and then setting properties | |
| 22309 | from the other lists. Settings in the last list are the most significant | |
| 22310 | ones and overrule settings in the other lists." | |
| 22311 | (let ((rtn (copy-sequence (pop plists))) | |
| 22312 | p v ls) | |
| 22313 | (while plists | |
| 22314 | (setq ls (pop plists)) | |
| 22315 | (while ls | |
| 22316 | (setq p (pop ls) v (pop ls)) | |
| 22317 | (setq rtn (plist-put rtn p v)))) | |
| 22318 | rtn)) | |
| 22319 | ||
| 22320 | (defun org-replace-escapes (string table) | |
| 22321 | "Replace %-escapes in STRING with values in TABLE. | |
| 22322 | TABLE is an association list with keys like \"%a\" and string values. | |
| 22323 | The sequences in STRING may contain normal field width and padding information, | |
| 22324 | for example \"%-5s\". Replacements happen in the sequence given by TABLE, | |
| 22325 | so values can contain further %-escapes if they are define later in TABLE." | |
| 22326 | (let ((tbl (copy-alist table)) | |
| 22327 | (case-fold-search nil) | |
| 22328 | (pchg 0) | |
| 22329 | re rpl) | |
| 22330 | (dolist (e tbl) | |
| 22331 | (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) | |
| 22332 | (when (and (cdr e) (string-match re (cdr e))) | |
| 22333 | (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0))) | |
| 22334 | (safe "SREF")) | |
| 22335 | (add-text-properties 0 3 (list 'sref sref) safe) | |
| 22336 | (setcdr e (replace-match safe t t (cdr e))))) | |
| 22337 | (while (string-match re string) | |
| 22338 | (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") | |
| 22339 | (cdr e))) | |
| 22340 | (setq string (replace-match rpl t t string)))) | |
| 22341 | (while (setq pchg (next-property-change pchg string)) | |
| 22342 | (let ((sref (get-text-property pchg 'sref string))) | |
| 22343 | (when (and sref (string-match "SREF" string pchg)) | |
| 22344 | (setq string (replace-match sref t t string))))) | |
| 22345 | string)) | |
| 22346 | ||
| 22347 | (defun org-find-base-buffer-visiting (file) | |
| 22348 | "Like `find-buffer-visiting' but always return the base buffer and | |
| 22349 | not an indirect buffer." | |
| 22350 | (let ((buf (or (get-file-buffer file) | |
| 22351 | (find-buffer-visiting file)))) | |
| 22352 | (if buf | |
| 22353 | (or (buffer-base-buffer buf) buf) | |
| 22354 | nil))) | |
| 22355 | ||
| 22356 | ;;; TODO: Only called once, from ox-odt which should probably use | |
| 22357 | ;;; org-export-inline-image-p or something. | |
| 22358 | (defun org-file-image-p (file) | |
| 22359 | "Return non-nil if FILE is an image." | |
| 22360 | (save-match-data | |
| 22361 | (string-match (image-file-name-regexp) file))) | |
| 22362 | ||
| 22363 | (defun org-get-cursor-date (&optional with-time) | |
| 22364 | "Return the date at cursor in as a time. | |
| 22365 | This works in the calendar and in the agenda, anywhere else it just | |
| 22366 | returns the current time. | |
| 22367 | If WITH-TIME is non-nil, returns the time of the event at point (in | |
| 22368 | the agenda) or the current time of the day." | |
| 22369 | (let (date day defd tp hod mod) | |
| 22370 | (when with-time | |
| 22371 | (setq tp (get-text-property (point) 'time)) | |
| 22372 | (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) | |
| 22373 | (setq hod (string-to-number (match-string 1 tp)) | |
| 22374 | mod (string-to-number (match-string 2 tp)))) | |
| 22375 | (or tp (let ((now (decode-time))) | |
| 22376 | (setq hod (nth 2 now) | |
| 22377 | mod (nth 1 now))))) | |
| 22378 | (cond | |
| 22379 | ((eq major-mode 'calendar-mode) | |
| 22380 | (setq date (calendar-cursor-to-date) | |
| 22381 | defd (encode-time 0 (or mod 0) (or hod 0) | |
| 22382 | (nth 1 date) (nth 0 date) (nth 2 date)))) | |
| 22383 | ((eq major-mode 'org-agenda-mode) | |
| 22384 | (setq day (get-text-property (point) 'day)) | |
| 22385 | (when day | |
| 22386 | (setq date (calendar-gregorian-from-absolute day) | |
| 22387 | defd (encode-time 0 (or mod 0) (or hod 0) | |
| 22388 | (nth 1 date) (nth 0 date) (nth 2 date)))))) | |
| 22389 | (or defd (current-time)))) | |
| 22390 | ||
| 22391 | (defun org-mark-subtree (&optional up) | |
| 22392 | "Mark the current subtree. | |
| 22393 | This puts point at the start of the current subtree, and mark at | |
| 22394 | the end. If a numeric prefix UP is given, move up into the | |
| 22395 | hierarchy of headlines by UP levels before marking the subtree." | |
| 22396 | (interactive "P") | |
| 22397 | (org-with-limited-levels | |
| 22398 | (cond ((org-at-heading-p) (beginning-of-line)) | |
| 22399 | ((org-before-first-heading-p) (user-error "Not in a subtree")) | |
| 22400 | (t (outline-previous-visible-heading 1)))) | |
| 22401 | (when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up))) | |
| 22402 | (if (called-interactively-p 'any) | |
| 22403 | (call-interactively 'org-mark-element) | |
| 22404 | (org-mark-element))) | |
| 22405 | ||
| 22406 | (defun org-file-newer-than-p (file time) | |
| 22407 | "Non-nil if FILE is newer than TIME. | |
| 22408 | FILE is a filename, as a string, TIME is a list of integers, as | |
| 22409 | returned by, e.g., `current-time'." | |
| 22410 | (and (file-exists-p file) | |
| 22411 | ;; Only compare times up to whole seconds as some file-systems | |
| 22412 | ;; (e.g. HFS+) do not retain any finer granularity. As | |
| 22413 | ;; a consequence, make sure we return non-nil when the two | |
| 22414 | ;; times are equal. | |
| 22415 | (not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2) | |
| 22416 | (cl-subseq time 0 2))))) | |
| 22417 | ||
| 22418 | (defun org-compile-file (source process ext &optional err-msg log-buf spec) | |
| 22419 | "Compile a SOURCE file using PROCESS. | |
| 22420 | ||
| 22421 | PROCESS is either a function or a list of shell commands, as | |
| 22422 | strings. EXT is a file extension, without the leading dot, as | |
| 22423 | a string. It is used to check if the process actually succeeded. | |
| 22424 | ||
| 22425 | PROCESS must create a file with the same base name and directory | |
| 22426 | as SOURCE, but ending with EXT. The function then returns its | |
| 22427 | filename. Otherwise, it raises an error. The error message can | |
| 22428 | then be refined by providing string ERR-MSG, which is appended to | |
| 22429 | the standard message. | |
| 22430 | ||
| 22431 | If PROCESS is a function, it is called with a single argument: | |
| 22432 | the SOURCE file. | |
| 22433 | ||
| 22434 | If it is a list of commands, each of them is called using | |
| 22435 | `shell-command'. By default, in each command, %b, %f, %F, %o and | |
| 22436 | %O are replaced with, respectively, SOURCE base name, name, full | |
| 22437 | name, directory and absolute output file name. It is possible, | |
| 22438 | however, to use more place-holders by specifying them in optional | |
| 22439 | argument SPEC, as an alist following the pattern | |
| 22440 | ||
| 22441 | (CHARACTER . REPLACEMENT-STRING). | |
| 22442 | ||
| 22443 | When PROCESS is a list of commands, optional argument LOG-BUF can | |
| 22444 | be set to a buffer or a buffer name. `shell-command' then uses | |
| 22445 | it for output." | |
| 22446 | (let* ((base-name (file-name-base source)) | |
| 22447 | (full-name (file-truename source)) | |
| 22448 | (out-dir (or (file-name-directory source) "./")) | |
| 22449 | (output (expand-file-name (concat base-name "." ext) out-dir)) | |
| 22450 | (time (current-time)) | |
| 22451 | (err-msg (if (stringp err-msg) (concat ". " err-msg) ""))) | |
| 22452 | (save-window-excursion | |
| 22453 | (pcase process | |
| 22454 | ((pred functionp) (funcall process (shell-quote-argument source))) | |
| 22455 | ((pred consp) | |
| 22456 | (let ((log-buf (and log-buf (get-buffer-create log-buf))) | |
| 22457 | (spec (append spec | |
| 22458 | `((?b . ,(shell-quote-argument base-name)) | |
| 22459 | (?f . ,(shell-quote-argument source)) | |
| 22460 | (?F . ,(shell-quote-argument full-name)) | |
| 22461 | (?o . ,(shell-quote-argument out-dir)) | |
| 22462 | (?O . ,(shell-quote-argument output)))))) | |
| 22463 | (dolist (command process) | |
| 22464 | (shell-command (format-spec command spec) log-buf)) | |
| 22465 | (when log-buf (with-current-buffer log-buf (compilation-mode))))) | |
| 22466 | (_ (error "No valid command to process %S%s" source err-msg)))) | |
| 22467 | ;; Check for process failure. Output file is expected to be | |
| 22468 | ;; located in the same directory as SOURCE. | |
| 22469 | (unless (org-file-newer-than-p output time) | |
| 22470 | (error (format "File %S wasn't produced%s" output err-msg))) | |
| 22471 | output)) | |
| 22472 | ||
| 22473 | ;;; Indentation | |
| 22474 | ||
| 22475 | (defvar org-element-greater-elements) | |
| 22476 | (defun org--get-expected-indentation (element contentsp) | |
| 22477 | "Expected indentation column for current line, according to ELEMENT. | |
| 22478 | ELEMENT is an element containing point. CONTENTSP is non-nil | |
| 22479 | when indentation is to be computed according to contents of | |
| 22480 | ELEMENT." | |
| 22481 | (let ((type (org-element-type element)) | |
| 22482 | (start (org-element-property :begin element)) | |
| 22483 | (post-affiliated (org-element-property :post-affiliated element))) | |
| 22484 | (org-with-wide-buffer | |
| 22485 | (cond | |
| 22486 | (contentsp | |
| 22487 | (cl-case type | |
| 22488 | ((diary-sexp footnote-definition) 0) | |
| 22489 | ((headline inlinetask nil) | |
| 22490 | (if (not org-adapt-indentation) 0 | |
| 22491 | (let ((level (org-current-level))) | |
| 22492 | (if level (1+ level) 0)))) | |
| 22493 | ((item plain-list) (org-list-item-body-column post-affiliated)) | |
| 22494 | (t | |
| 22495 | (goto-char start) | |
| 22496 | (org-get-indentation)))) | |
| 22497 | ((memq type '(headline inlinetask nil)) | |
| 22498 | (if (org-match-line "[ \t]*$") | |
| 22499 | (org--get-expected-indentation element t) | |
| 22500 | 0)) | |
| 22501 | ((memq type '(diary-sexp footnote-definition)) 0) | |
| 22502 | ;; First paragraph of a footnote definition or an item. | |
| 22503 | ;; Indent like parent. | |
| 22504 | ((< (line-beginning-position) start) | |
| 22505 | (org--get-expected-indentation | |
| 22506 | (org-element-property :parent element) t)) | |
| 22507 | ;; At first line: indent according to previous sibling, if any, | |
| 22508 | ;; ignoring footnote definitions and inline tasks, or parent's | |
| 22509 | ;; contents. | |
| 22510 | ((= (line-beginning-position) start) | |
| 22511 | (catch 'exit | |
| 22512 | (while t | |
| 22513 | (if (= (point-min) start) (throw 'exit 0) | |
| 22514 | (goto-char (1- start)) | |
| 22515 | (let* ((previous (org-element-at-point)) | |
| 22516 | (parent previous)) | |
| 22517 | (while (and parent (<= (org-element-property :end parent) start)) | |
| 22518 | (setq previous parent | |
| 22519 | parent (org-element-property :parent parent))) | |
| 22520 | (cond | |
| 22521 | ((not previous) (throw 'exit 0)) | |
| 22522 | ((> (org-element-property :end previous) start) | |
| 22523 | (throw 'exit (org--get-expected-indentation previous t))) | |
| 22524 | ((memq (org-element-type previous) | |
| 22525 | '(footnote-definition inlinetask)) | |
| 22526 | (setq start (org-element-property :begin previous))) | |
| 22527 | (t (goto-char (org-element-property :begin previous)) | |
| 22528 | (throw 'exit | |
| 22529 | (if (bolp) (org-get-indentation) | |
| 22530 | ;; At first paragraph in an item or | |
| 22531 | ;; a footnote definition. | |
| 22532 | (org--get-expected-indentation | |
| 22533 | (org-element-property :parent previous) t)))))))))) | |
| 22534 | ;; Otherwise, move to the first non-blank line above. | |
| 22535 | (t | |
| 22536 | (beginning-of-line) | |
| 22537 | (let ((pos (point))) | |
| 22538 | (skip-chars-backward " \r\t\n") | |
| 22539 | (cond | |
| 22540 | ;; Two blank lines end a footnote definition or a plain | |
| 22541 | ;; list. When we indent an empty line after them, the | |
| 22542 | ;; containing list or footnote definition is over, so it | |
| 22543 | ;; qualifies as a previous sibling. Therefore, we indent | |
| 22544 | ;; like its first line. | |
| 22545 | ((and (memq type '(footnote-definition plain-list)) | |
| 22546 | (> (count-lines (point) pos) 2)) | |
| 22547 | (goto-char start) | |
| 22548 | (org-get-indentation)) | |
| 22549 | ;; Line above is the first one of a paragraph at the | |
| 22550 | ;; beginning of an item or a footnote definition. Indent | |
| 22551 | ;; like parent. | |
| 22552 | ((< (line-beginning-position) start) | |
| 22553 | (org--get-expected-indentation | |
| 22554 | (org-element-property :parent element) t)) | |
| 22555 | ;; Line above is the beginning of an element, i.e., point | |
| 22556 | ;; was originally on the blank lines between element's start | |
| 22557 | ;; and contents. | |
| 22558 | ((= (line-beginning-position) post-affiliated) | |
| 22559 | (org--get-expected-indentation element t)) | |
| 22560 | ;; POS is after contents in a greater element. Indent like | |
| 22561 | ;; the beginning of the element. | |
| 22562 | ((and (memq type org-element-greater-elements) | |
| 22563 | (let ((cend (org-element-property :contents-end element))) | |
| 22564 | (and cend (<= cend pos)))) | |
| 22565 | ;; As a special case, if point is at the end of a footnote | |
| 22566 | ;; definition or an item, indent like the very last element | |
| 22567 | ;; within. If that last element is an item, indent like | |
| 22568 | ;; its contents. | |
| 22569 | (if (memq type '(footnote-definition item plain-list)) | |
| 22570 | (let ((last (org-element-at-point))) | |
| 22571 | (goto-char pos) | |
| 22572 | (org--get-expected-indentation | |
| 22573 | last (eq (org-element-type last) 'item))) | |
| 22574 | (goto-char start) | |
| 22575 | (org-get-indentation))) | |
| 22576 | ;; In any other case, indent like the current line. | |
| 22577 | (t (org-get-indentation))))))))) | |
| 22578 | ||
| 22579 | (defun org--align-node-property () | |
| 22580 | "Align node property at point. | |
| 22581 | Alignment is done according to `org-property-format', which see." | |
| 22582 | (when (save-excursion | |
| 22583 | (beginning-of-line) | |
| 22584 | (looking-at org-property-re)) | |
| 22585 | (replace-match | |
| 22586 | (concat (match-string 4) | |
| 22587 | (org-trim | |
| 22588 | (format org-property-format (match-string 1) (match-string 3)))) | |
| 22589 | t t))) | |
| 22590 | ||
| 22591 | (defun org-indent-line () | |
| 22592 | "Indent line depending on context. | |
| 22593 | ||
| 22594 | Indentation is done according to the following rules: | |
| 22595 | ||
| 22596 | - Footnote definitions, diary sexps, headlines and inline tasks | |
| 22597 | have to start at column 0. | |
| 22598 | ||
| 22599 | - On the very first line of an element, consider, in order, the | |
| 22600 | next rules until one matches: | |
| 22601 | ||
| 22602 | 1. If there's a sibling element before, ignoring footnote | |
| 22603 | definitions and inline tasks, indent like its first line. | |
| 22604 | ||
| 22605 | 2. If element has a parent, indent like its contents. More | |
| 22606 | precisely, if parent is an item, indent after the | |
| 22607 | description part, if any, or the bullet (see | |
| 22608 | `org-list-description-max-indent'). Else, indent like | |
| 22609 | parent's first line. | |
| 22610 | ||
| 22611 | 3. Otherwise, indent relatively to current level, if | |
| 22612 | `org-adapt-indentation' is non-nil, or to left margin. | |
| 22613 | ||
| 22614 | - On a blank line at the end of an element, indent according to | |
| 22615 | the type of the element. More precisely | |
| 22616 | ||
| 22617 | 1. If element is a plain list, an item, or a footnote | |
| 22618 | definition, indent like the very last element within. | |
| 22619 | ||
| 22620 | 2. If element is a paragraph, indent like its last non blank | |
| 22621 | line. | |
| 22622 | ||
| 22623 | 3. Otherwise, indent like its very first line. | |
| 22624 | ||
| 22625 | - In the code part of a source block, use language major mode | |
| 22626 | to indent current line if `org-src-tab-acts-natively' is | |
| 22627 | non-nil. If it is nil, do nothing. | |
| 22628 | ||
| 22629 | - Otherwise, indent like the first non-blank line above. | |
| 22630 | ||
| 22631 | The function doesn't indent an item as it could break the whole | |
| 22632 | list structure. Instead, use \\<org-mode-map>`\\[org-shiftmetaleft]' or \ | |
| 22633 | `\\[org-shiftmetaright]'. | |
| 22634 | ||
| 22635 | Also align node properties according to `org-property-format'." | |
| 22636 | (interactive) | |
| 22637 | (cond | |
| 22638 | (orgstruct-is-++ | |
| 22639 | (let ((indent-line-function | |
| 22640 | (cl-cadadr (assq 'indent-line-function org-fb-vars)))) | |
| 22641 | (indent-according-to-mode))) | |
| 22642 | ((org-at-heading-p) 'noindent) | |
| 22643 | (t | |
| 22644 | (let* ((element (save-excursion (beginning-of-line) (org-element-at-point))) | |
| 22645 | (type (org-element-type element))) | |
| 22646 | (cond ((and (memq type '(plain-list item)) | |
| 22647 | (= (line-beginning-position) | |
| 22648 | (org-element-property :post-affiliated element))) | |
| 22649 | 'noindent) | |
| 22650 | ((and (eq type 'latex-environment) | |
| 22651 | (>= (point) (org-element-property :post-affiliated element)) | |
| 22652 | (< (point) (org-with-wide-buffer | |
| 22653 | (goto-char (org-element-property :end element)) | |
| 22654 | (skip-chars-backward " \r\t\n") | |
| 22655 | (line-beginning-position 2)))) | |
| 22656 | 'noindent) | |
| 22657 | ((and (eq type 'src-block) | |
| 22658 | org-src-tab-acts-natively | |
| 22659 | (> (line-beginning-position) | |
| 22660 | (org-element-property :post-affiliated element)) | |
| 22661 | (< (line-beginning-position) | |
| 22662 | (org-with-wide-buffer | |
| 22663 | (goto-char (org-element-property :end element)) | |
| 22664 | (skip-chars-backward " \r\t\n") | |
| 22665 | (line-beginning-position)))) | |
| 22666 | (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))) | |
| 22667 | (t | |
| 22668 | (let ((column (org--get-expected-indentation element nil))) | |
| 22669 | ;; Preserve current column. | |
| 22670 | (if (<= (current-column) (current-indentation)) | |
| 22671 | (indent-line-to column) | |
| 22672 | (save-excursion (indent-line-to column)))) | |
| 22673 | ;; Align node property. Also preserve current column. | |
| 22674 | (when (eq type 'node-property) | |
| 22675 | (let ((column (current-column))) | |
| 22676 | (org--align-node-property) | |
| 22677 | (org-move-to-column column))))))))) | |
| 22678 | ||
| 22679 | (defun org-indent-region (start end) | |
| 22680 | "Indent each non-blank line in the region. | |
| 22681 | Called from a program, START and END specify the region to | |
| 22682 | indent. The function will not indent contents of example blocks, | |
| 22683 | verse blocks and export blocks as leading white spaces are | |
| 22684 | assumed to be significant there." | |
| 22685 | (interactive "r") | |
| 22686 | (save-excursion | |
| 22687 | (goto-char start) | |
| 22688 | (skip-chars-forward " \r\t\n") | |
| 22689 | (unless (eobp) (beginning-of-line)) | |
| 22690 | (let ((indent-to | |
| 22691 | (lambda (ind pos) | |
| 22692 | ;; Set IND as indentation for all lines between point and | |
| 22693 | ;; POS. Blank lines are ignored. Leave point after POS | |
| 22694 | ;; once done. | |
| 22695 | (let ((limit (copy-marker pos))) | |
| 22696 | (while (< (point) limit) | |
| 22697 | (unless (looking-at-p "[ \t]*$") (indent-line-to ind)) | |
| 22698 | (forward-line)) | |
| 22699 | (set-marker limit nil)))) | |
| 22700 | (end (copy-marker end))) | |
| 22701 | (while (< (point) end) | |
| 22702 | (if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line) | |
| 22703 | (let* ((element (org-element-at-point)) | |
| 22704 | (type (org-element-type element)) | |
| 22705 | (element-end (copy-marker (org-element-property :end element))) | |
| 22706 | (ind (org--get-expected-indentation element nil))) | |
| 22707 | (cond | |
| 22708 | ;; Element indented as a single block. Example blocks | |
| 22709 | ;; preserving indentation are a special case since the | |
| 22710 | ;; "contents" must not be indented whereas the block | |
| 22711 | ;; boundaries can. | |
| 22712 | ((or (memq type '(export-block latex-environment)) | |
| 22713 | (and (eq type 'example-block) | |
| 22714 | (not | |
| 22715 | (or org-src-preserve-indentation | |
| 22716 | (org-element-property :preserve-indent element))))) | |
| 22717 | (let ((offset (- ind (org-get-indentation)))) | |
| 22718 | (unless (zerop offset) | |
| 22719 | (indent-rigidly (org-element-property :begin element) | |
| 22720 | (org-element-property :end element) | |
| 22721 | offset))) | |
| 22722 | (goto-char element-end)) | |
| 22723 | ;; Elements indented line wise. Be sure to exclude | |
| 22724 | ;; example blocks (preserving indentation) and source | |
| 22725 | ;; blocks from this category as they are treated | |
| 22726 | ;; specially later. | |
| 22727 | ((or (memq type '(paragraph table table-row)) | |
| 22728 | (not (or (org-element-property :contents-begin element) | |
| 22729 | (memq type '(example-block src-block))))) | |
| 22730 | (when (eq type 'node-property) | |
| 22731 | (org--align-node-property) | |
| 22732 | (beginning-of-line)) | |
| 22733 | (funcall indent-to ind (min element-end end))) | |
| 22734 | ;; Elements consisting of three parts: before the | |
| 22735 | ;; contents, the contents, and after the contents. The | |
| 22736 | ;; contents are treated specially, according to the | |
| 22737 | ;; element type, or not indented at all. Other parts are | |
| 22738 | ;; indented as a single block. | |
| 22739 | (t | |
| 22740 | (let* ((post (copy-marker | |
| 22741 | (org-element-property :post-affiliated element))) | |
| 22742 | (cbeg | |
| 22743 | (copy-marker | |
| 22744 | (cond | |
| 22745 | ((not (org-element-property :contents-begin element)) | |
| 22746 | ;; Fake contents for source blocks. | |
| 22747 | (org-with-wide-buffer | |
| 22748 | (goto-char post) | |
| 22749 | (line-beginning-position 2))) | |
| 22750 | ((memq type '(footnote-definition item plain-list)) | |
| 22751 | ;; Contents in these elements could start on | |
| 22752 | ;; the same line as the beginning of the | |
| 22753 | ;; element. Make sure we start indenting | |
| 22754 | ;; from the second line. | |
| 22755 | (org-with-wide-buffer | |
| 22756 | (goto-char post) | |
| 22757 | (end-of-line) | |
| 22758 | (skip-chars-forward " \r\t\n") | |
| 22759 | (if (eobp) (point) (line-beginning-position)))) | |
| 22760 | (t (org-element-property :contents-begin element))))) | |
| 22761 | (cend (copy-marker | |
| 22762 | (or (org-element-property :contents-end element) | |
| 22763 | ;; Fake contents for source blocks. | |
| 22764 | (org-with-wide-buffer | |
| 22765 | (goto-char element-end) | |
| 22766 | (skip-chars-backward " \r\t\n") | |
| 22767 | (line-beginning-position))) | |
| 22768 | t))) | |
| 22769 | ;; Do not change items indentation individually as it | |
| 22770 | ;; might break the list as a whole. On the other | |
| 22771 | ;; hand, when at a plain list, indent it as a whole. | |
| 22772 | (cond ((eq type 'plain-list) | |
| 22773 | (let ((offset (- ind (org-get-indentation)))) | |
| 22774 | (unless (zerop offset) | |
| 22775 | (indent-rigidly (org-element-property :begin element) | |
| 22776 | (org-element-property :end element) | |
| 22777 | offset)) | |
| 22778 | (goto-char cbeg))) | |
| 22779 | ((eq type 'item) (goto-char cbeg)) | |
| 22780 | (t (funcall indent-to ind (min cbeg end)))) | |
| 22781 | (when (< (point) end) | |
| 22782 | (cl-case type | |
| 22783 | ((example-block verse-block)) | |
| 22784 | (src-block | |
| 22785 | ;; In a source block, indent source code | |
| 22786 | ;; according to language major mode, but only if | |
| 22787 | ;; `org-src-tab-acts-natively' is non-nil. | |
| 22788 | (when (and (< (point) end) org-src-tab-acts-natively) | |
| 22789 | (ignore-errors | |
| 22790 | (org-babel-do-in-edit-buffer | |
| 22791 | (indent-region (point-min) (point-max)))))) | |
| 22792 | (t (org-indent-region (point) (min cend end)))) | |
| 22793 | (goto-char (min cend end)) | |
| 22794 | (when (< (point) end) | |
| 22795 | (funcall indent-to ind (min element-end end)))) | |
| 22796 | (set-marker post nil) | |
| 22797 | (set-marker cbeg nil) | |
| 22798 | (set-marker cend nil)))) | |
| 22799 | (set-marker element-end nil)))) | |
| 22800 | (set-marker end nil)))) | |
| 22801 | ||
| 22802 | (defun org-indent-drawer () | |
| 22803 | "Indent the drawer at point." | |
| 22804 | (interactive) | |
| 22805 | (unless (save-excursion | |
| 22806 | (beginning-of-line) | |
| 22807 | (looking-at-p org-drawer-regexp)) | |
| 22808 | (user-error "Not at a drawer")) | |
| 22809 | (let ((element (org-element-at-point))) | |
| 22810 | (unless (memq (org-element-type element) '(drawer property-drawer)) | |
| 22811 | (user-error "Not at a drawer")) | |
| 22812 | (org-with-wide-buffer | |
| 22813 | (org-indent-region (org-element-property :begin element) | |
| 22814 | (org-element-property :end element)))) | |
| 22815 | (message "Drawer at point indented")) | |
| 22816 | ||
| 22817 | (defun org-indent-block () | |
| 22818 | "Indent the block at point." | |
| 22819 | (interactive) | |
| 22820 | (unless (save-excursion | |
| 22821 | (beginning-of-line) | |
| 22822 | (let ((case-fold-search t)) | |
| 22823 | (looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_"))) | |
| 22824 | (user-error "Not at a block")) | |
| 22825 | (let ((element (org-element-at-point))) | |
| 22826 | (unless (memq (org-element-type element) | |
| 22827 | '(comment-block center-block dynamic-block example-block | |
| 22828 | export-block quote-block special-block | |
| 22829 | src-block verse-block)) | |
| 22830 | (user-error "Not at a block")) | |
| 22831 | (org-with-wide-buffer | |
| 22832 | (org-indent-region (org-element-property :begin element) | |
| 22833 | (org-element-property :end element)))) | |
| 22834 | (message "Block at point indented")) | |
| 22835 | ||
| 22836 | ||
| 22837 | ;;; Filling | |
| 22838 | ||
| 22839 | ;; We use our own fill-paragraph and auto-fill functions. | |
| 22840 | ||
| 22841 | ;; `org-fill-paragraph' relies on adaptive filling and context | |
| 22842 | ;; checking. Appropriate `fill-prefix' is computed with | |
| 22843 | ;; `org-adaptive-fill-function'. | |
| 22844 | ||
| 22845 | ;; `org-auto-fill-function' takes care of auto-filling. It calls | |
| 22846 | ;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with | |
| 22847 | ;; `org-adaptive-fill-function' value. Internally, | |
| 22848 | ;; `org-comment-line-break-function' breaks the line. | |
| 22849 | ||
| 22850 | ;; `org-setup-filling' installs filling and auto-filling related | |
| 22851 | ;; variables during `org-mode' initialization. | |
| 22852 | ||
| 22853 | (defun org-setup-filling () | |
| 22854 | (require 'org-element) | |
| 22855 | ;; Prevent auto-fill from inserting unwanted new items. | |
| 22856 | (when (boundp 'fill-nobreak-predicate) | |
| 22857 | (setq-local | |
| 22858 | fill-nobreak-predicate | |
| 22859 | (org-uniquify | |
| 22860 | (append fill-nobreak-predicate | |
| 22861 | '(org-fill-line-break-nobreak-p | |
| 22862 | org-fill-n-macro-as-item-nobreak-p | |
| 22863 | org-fill-paragraph-with-timestamp-nobreak-p))))) | |
| 22864 | (let ((paragraph-ending (substring org-element-paragraph-separate 1))) | |
| 22865 | (setq-local paragraph-start paragraph-ending) | |
| 22866 | (setq-local paragraph-separate paragraph-ending)) | |
| 22867 | (setq-local fill-paragraph-function 'org-fill-paragraph) | |
| 22868 | (setq-local auto-fill-inhibit-regexp nil) | |
| 22869 | (setq-local adaptive-fill-function 'org-adaptive-fill-function) | |
| 22870 | (setq-local normal-auto-fill-function 'org-auto-fill-function) | |
| 22871 | (setq-local comment-line-break-function 'org-comment-line-break-function)) | |
| 22872 | ||
| 22873 | (defun org-fill-line-break-nobreak-p () | |
| 22874 | "Non-nil when a new line at point would create an Org line break." | |
| 22875 | (save-excursion | |
| 22876 | (skip-chars-backward "[ \t]") | |
| 22877 | (skip-chars-backward "\\\\") | |
| 22878 | (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)"))) | |
| 22879 | ||
| 22880 | (defun org-fill-paragraph-with-timestamp-nobreak-p () | |
| 22881 | "Non-nil when a new line at point would split a timestamp." | |
| 22882 | (and (org-at-timestamp-p 'lax) | |
| 22883 | (not (looking-at org-ts-regexp-both)))) | |
| 22884 | ||
| 22885 | (defun org-fill-n-macro-as-item-nobreak-p () | |
| 22886 | "Non-nil when a new line at point would create a new list." | |
| 22887 | ;; During export, a "n" macro followed by a dot or a closing | |
| 22888 | ;; parenthesis can end up being parsed as a new list item. | |
| 22889 | (looking-at-p "[ \t]*{{{n\\(?:([^\n)]*)\\)?}}}[.)]\\(?:$\\| \\)")) | |
| 22890 | ||
| 22891 | (declare-function message-in-body-p "message" ()) | |
| 22892 | (defvar orgtbl-line-start-regexp) ; From org-table.el | |
| 22893 | (defun org-adaptive-fill-function () | |
| 22894 | "Compute a fill prefix for the current line. | |
| 22895 | Return fill prefix, as a string, or nil if current line isn't | |
| 22896 | meant to be filled. For convenience, if `adaptive-fill-regexp' | |
| 22897 | matches in paragraphs or comments, use it." | |
| 22898 | (catch 'exit | |
| 22899 | (when (derived-mode-p 'message-mode) | |
| 22900 | (save-excursion | |
| 22901 | (beginning-of-line) | |
| 22902 | (cond ((not (message-in-body-p)) (throw 'exit nil)) | |
| 22903 | ((looking-at-p org-table-line-regexp) (throw 'exit nil)) | |
| 22904 | ((looking-at message-cite-prefix-regexp) | |
| 22905 | (throw 'exit (match-string-no-properties 0))) | |
| 22906 | ((looking-at org-outline-regexp) | |
| 22907 | (throw 'exit (make-string (length (match-string 0)) ?\s)))))) | |
| 22908 | (org-with-wide-buffer | |
| 22909 | (unless (org-at-heading-p) | |
| 22910 | (let* ((p (line-beginning-position)) | |
| 22911 | (element (save-excursion | |
| 22912 | (beginning-of-line) | |
| 22913 | (org-element-at-point))) | |
| 22914 | (type (org-element-type element)) | |
| 22915 | (post-affiliated (org-element-property :post-affiliated element))) | |
| 22916 | (unless (< p post-affiliated) | |
| 22917 | (cl-case type | |
| 22918 | (comment | |
| 22919 | (save-excursion | |
| 22920 | (beginning-of-line) | |
| 22921 | (looking-at "[ \t]*") | |
| 22922 | (concat (match-string 0) "# "))) | |
| 22923 | (footnote-definition "") | |
| 22924 | ((item plain-list) | |
| 22925 | (make-string (org-list-item-body-column post-affiliated) ?\s)) | |
| 22926 | (paragraph | |
| 22927 | ;; Fill prefix is usually the same as the current line, | |
| 22928 | ;; unless the paragraph is at the beginning of an item. | |
| 22929 | (let ((parent (org-element-property :parent element))) | |
| 22930 | (save-excursion | |
| 22931 | (beginning-of-line) | |
| 22932 | (cond ((eq (org-element-type parent) 'item) | |
| 22933 | (make-string (org-list-item-body-column | |
| 22934 | (org-element-property :begin parent)) | |
| 22935 | ?\s)) | |
| 22936 | ((and adaptive-fill-regexp | |
| 22937 | ;; Locally disable | |
| 22938 | ;; `adaptive-fill-function' to let | |
| 22939 | ;; `fill-context-prefix' handle | |
| 22940 | ;; `adaptive-fill-regexp' variable. | |
| 22941 | (let (adaptive-fill-function) | |
| 22942 | (fill-context-prefix | |
| 22943 | post-affiliated | |
| 22944 | (org-element-property :end element))))) | |
| 22945 | ((looking-at "[ \t]+") (match-string 0)) | |
| 22946 | (t ""))))) | |
| 22947 | (comment-block | |
| 22948 | ;; Only fill contents if P is within block boundaries. | |
| 22949 | (let* ((cbeg (save-excursion (goto-char post-affiliated) | |
| 22950 | (forward-line) | |
| 22951 | (point))) | |
| 22952 | (cend (save-excursion | |
| 22953 | (goto-char (org-element-property :end element)) | |
| 22954 | (skip-chars-backward " \r\t\n") | |
| 22955 | (line-beginning-position)))) | |
| 22956 | (when (and (>= p cbeg) (< p cend)) | |
| 22957 | (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) | |
| 22958 | (match-string 0) | |
| 22959 | ""))))))))))) | |
| 22960 | ||
| 22961 | (declare-function message-goto-body "message" ()) | |
| 22962 | (defvar message-cite-prefix-regexp) ; From message.el | |
| 22963 | ||
| 22964 | (defun org-fill-element (&optional justify) | |
| 22965 | "Fill element at point, when applicable. | |
| 22966 | ||
| 22967 | This function only applies to comment blocks, comments, example | |
| 22968 | blocks and paragraphs. Also, as a special case, re-align table | |
| 22969 | when point is at one. | |
| 22970 | ||
| 22971 | If JUSTIFY is non-nil (interactively, with prefix argument), | |
| 22972 | justify as well. If `sentence-end-double-space' is non-nil, then | |
| 22973 | period followed by one space does not end a sentence, so don't | |
| 22974 | break a line there. The variable `fill-column' controls the | |
| 22975 | width for filling. | |
| 22976 | ||
| 22977 | For convenience, when point is at a plain list, an item or | |
| 22978 | a footnote definition, try to fill the first paragraph within." | |
| 22979 | (with-syntax-table org-mode-transpose-word-syntax-table | |
| 22980 | ;; Move to end of line in order to get the first paragraph within | |
| 22981 | ;; a plain list or a footnote definition. | |
| 22982 | (let ((element (save-excursion (end-of-line) (org-element-at-point)))) | |
| 22983 | ;; First check if point is in a blank line at the beginning of | |
| 22984 | ;; the buffer. In that case, ignore filling. | |
| 22985 | (cl-case (org-element-type element) | |
| 22986 | ;; Use major mode filling function is src blocks. | |
| 22987 | (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) | |
| 22988 | ;; Align Org tables, leave table.el tables as-is. | |
| 22989 | (table-row (org-table-align) t) | |
| 22990 | (table | |
| 22991 | (when (eq (org-element-property :type element) 'org) | |
| 22992 | (save-excursion | |
| 22993 | (goto-char (org-element-property :post-affiliated element)) | |
| 22994 | (org-table-align))) | |
| 22995 | t) | |
| 22996 | (paragraph | |
| 22997 | ;; Paragraphs may contain `line-break' type objects. | |
| 22998 | (let ((beg (max (point-min) | |
| 22999 | (org-element-property :contents-begin element))) | |
| 23000 | (end (min (point-max) | |
| 23001 | (org-element-property :contents-end element)))) | |
| 23002 | ;; Do nothing if point is at an affiliated keyword. | |
| 23003 | (if (< (line-end-position) beg) t | |
| 23004 | (when (derived-mode-p 'message-mode) | |
| 23005 | ;; In `message-mode', do not fill following citation | |
| 23006 | ;; in current paragraph nor text before message body. | |
| 23007 | (let ((body-start (save-excursion (message-goto-body)))) | |
| 23008 | (when body-start (setq beg (max body-start beg)))) | |
| 23009 | (when (save-excursion | |
| 23010 | (re-search-forward | |
| 23011 | (concat "^" message-cite-prefix-regexp) end t)) | |
| 23012 | (setq end (match-beginning 0)))) | |
| 23013 | ;; Fill paragraph, taking line breaks into account. | |
| 23014 | (save-excursion | |
| 23015 | (goto-char beg) | |
| 23016 | (let ((cuts (list beg))) | |
| 23017 | (while (re-search-forward "\\\\\\\\[ \t]*\n" end t) | |
| 23018 | (when (eq 'line-break | |
| 23019 | (org-element-type | |
| 23020 | (save-excursion (backward-char) | |
| 23021 | (org-element-context)))) | |
| 23022 | (push (point) cuts))) | |
| 23023 | (dolist (c (delq end cuts)) | |
| 23024 | (fill-region-as-paragraph c end justify) | |
| 23025 | (setq end c)))) | |
| 23026 | t))) | |
| 23027 | ;; Contents of `comment-block' type elements should be | |
| 23028 | ;; filled as plain text, but only if point is within block | |
| 23029 | ;; markers. | |
| 23030 | (comment-block | |
| 23031 | (let* ((case-fold-search t) | |
| 23032 | (beg (save-excursion | |
| 23033 | (goto-char (org-element-property :begin element)) | |
| 23034 | (re-search-forward "^[ \t]*#\\+begin_comment" nil t) | |
| 23035 | (forward-line) | |
| 23036 | (point))) | |
| 23037 | (end (save-excursion | |
| 23038 | (goto-char (org-element-property :end element)) | |
| 23039 | (re-search-backward "^[ \t]*#\\+end_comment" nil t) | |
| 23040 | (line-beginning-position)))) | |
| 23041 | (if (or (< (point) beg) (> (point) end)) t | |
| 23042 | (fill-region-as-paragraph | |
| 23043 | (save-excursion (end-of-line) | |
| 23044 | (re-search-backward "^[ \t]*$" beg 'move) | |
| 23045 | (line-beginning-position)) | |
| 23046 | (save-excursion (beginning-of-line) | |
| 23047 | (re-search-forward "^[ \t]*$" end 'move) | |
| 23048 | (line-beginning-position)) | |
| 23049 | justify)))) | |
| 23050 | ;; Fill comments. | |
| 23051 | (comment | |
| 23052 | (let ((begin (org-element-property :post-affiliated element)) | |
| 23053 | (end (org-element-property :end element))) | |
| 23054 | (when (and (>= (point) begin) (<= (point) end)) | |
| 23055 | (let ((begin (save-excursion | |
| 23056 | (end-of-line) | |
| 23057 | (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) | |
| 23058 | (progn (forward-line) (point)) | |
| 23059 | begin))) | |
| 23060 | (end (save-excursion | |
| 23061 | (end-of-line) | |
| 23062 | (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) | |
| 23063 | (1- (line-beginning-position)) | |
| 23064 | (skip-chars-backward " \r\t\n") | |
| 23065 | (line-end-position))))) | |
| 23066 | ;; Do not fill comments when at a blank line. | |
| 23067 | (when (> end begin) | |
| 23068 | (let ((fill-prefix | |
| 23069 | (save-excursion | |
| 23070 | (beginning-of-line) | |
| 23071 | (looking-at "[ \t]*#") | |
| 23072 | (let ((comment-prefix (match-string 0))) | |
| 23073 | (goto-char (match-end 0)) | |
| 23074 | (if (looking-at adaptive-fill-regexp) | |
| 23075 | (concat comment-prefix (match-string 0)) | |
| 23076 | (concat comment-prefix " ")))))) | |
| 23077 | (save-excursion | |
| 23078 | (fill-region-as-paragraph begin end justify)))))) | |
| 23079 | t)) | |
| 23080 | ;; Ignore every other element. | |
| 23081 | (otherwise t))))) | |
| 23082 | ||
| 23083 | (defun org-fill-paragraph (&optional justify region) | |
| 23084 | "Fill element at point, when applicable. | |
| 23085 | ||
| 23086 | This function only applies to comment blocks, comments, example | |
| 23087 | blocks and paragraphs. Also, as a special case, re-align table | |
| 23088 | when point is at one. | |
| 23089 | ||
| 23090 | For convenience, when point is at a plain list, an item or | |
| 23091 | a footnote definition, try to fill the first paragraph within. | |
| 23092 | ||
| 23093 | If JUSTIFY is non-nil (interactively, with prefix argument), | |
| 23094 | justify as well. If `sentence-end-double-space' is non-nil, then | |
| 23095 | period followed by one space does not end a sentence, so don't | |
| 23096 | break a line there. The variable `fill-column' controls the | |
| 23097 | width for filling. | |
| 23098 | ||
| 23099 | The REGION argument is non-nil if called interactively; in that | |
| 23100 | case, if Transient Mark mode is enabled and the mark is active, | |
| 23101 | fill each of the elements in the active region, instead of just | |
| 23102 | filling the current element." | |
| 23103 | (interactive (progn | |
| 23104 | (barf-if-buffer-read-only) | |
| 23105 | (list (if current-prefix-arg 'full) t))) | |
| 23106 | (cond | |
| 23107 | ((and (derived-mode-p 'message-mode) | |
| 23108 | (or (not (message-in-body-p)) | |
| 23109 | (save-excursion (move-beginning-of-line 1) | |
| 23110 | (looking-at message-cite-prefix-regexp)))) | |
| 23111 | ;; First ensure filling is correct in message-mode. | |
| 23112 | (let ((fill-paragraph-function | |
| 23113 | (cl-cadadr (assq 'fill-paragraph-function org-fb-vars))) | |
| 23114 | (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars))) | |
| 23115 | (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars))) | |
| 23116 | (paragraph-separate | |
| 23117 | (cl-cadadr (assq 'paragraph-separate org-fb-vars)))) | |
| 23118 | (fill-paragraph nil))) | |
| 23119 | ((and region transient-mark-mode mark-active | |
| 23120 | (not (eq (region-beginning) (region-end)))) | |
| 23121 | (let ((origin (point-marker)) | |
| 23122 | (start (region-beginning))) | |
| 23123 | (unwind-protect | |
| 23124 | (progn | |
| 23125 | (goto-char (region-end)) | |
| 23126 | (while (> (point) start) | |
| 23127 | (org-backward-paragraph) | |
| 23128 | (org-fill-element justify))) | |
| 23129 | (goto-char origin) | |
| 23130 | (set-marker origin nil)))) | |
| 23131 | (t (org-fill-element justify)))) | |
| 23132 | (org-remap org-mode-map 'fill-paragraph 'org-fill-paragraph) | |
| 23133 | ||
| 23134 | (defun org-auto-fill-function () | |
| 23135 | "Auto-fill function." | |
| 23136 | ;; Check if auto-filling is meaningful. | |
| 23137 | (let ((fc (current-fill-column))) | |
| 23138 | (when (and fc (> (current-column) fc)) | |
| 23139 | (let* ((fill-prefix (org-adaptive-fill-function)) | |
| 23140 | ;; Enforce empty fill prefix, if required. Otherwise, it | |
| 23141 | ;; will be computed again. | |
| 23142 | (adaptive-fill-mode (not (equal fill-prefix "")))) | |
| 23143 | (when fill-prefix (do-auto-fill)))))) | |
| 23144 | ||
| 23145 | (defun org-comment-line-break-function (&optional soft) | |
| 23146 | "Break line at point and indent, continuing comment if within one. | |
| 23147 | The inserted newline is marked hard if variable | |
| 23148 | `use-hard-newlines' is true, unless optional argument SOFT is | |
| 23149 | non-nil." | |
| 23150 | (if soft (insert-and-inherit ?\n) (newline 1)) | |
| 23151 | (save-excursion (forward-char -1) (delete-horizontal-space)) | |
| 23152 | (delete-horizontal-space) | |
| 23153 | (indent-to-left-margin) | |
| 23154 | (insert-before-markers-and-inherit fill-prefix)) | |
| 23155 | ||
| 23156 | ||
| 23157 | ;;; Fixed Width Areas | |
| 23158 | ||
| 23159 | (defun org-toggle-fixed-width () | |
| 23160 | "Toggle fixed-width markup. | |
| 23161 | ||
| 23162 | Add or remove fixed-width markup on current line, whenever it | |
| 23163 | makes sense. Return an error otherwise. | |
| 23164 | ||
| 23165 | If a region is active and if it contains only fixed-width areas | |
| 23166 | or blank lines, remove all fixed-width markup in it. If the | |
| 23167 | region contains anything else, convert all non-fixed-width lines | |
| 23168 | to fixed-width ones. | |
| 23169 | ||
| 23170 | Blank lines at the end of the region are ignored unless the | |
| 23171 | region only contains such lines." | |
| 23172 | (interactive) | |
| 23173 | (if (not (org-region-active-p)) | |
| 23174 | ;; No region: | |
| 23175 | ;; | |
| 23176 | ;; Remove fixed width marker only in a fixed-with element. | |
| 23177 | ;; | |
| 23178 | ;; Add fixed width maker in paragraphs, in blank lines after | |
| 23179 | ;; elements or at the beginning of a headline or an inlinetask, | |
| 23180 | ;; and before any one-line elements (e.g., a clock). | |
| 23181 | (progn | |
| 23182 | (beginning-of-line) | |
| 23183 | (let* ((element (org-element-at-point)) | |
| 23184 | (type (org-element-type element))) | |
| 23185 | (cond | |
| 23186 | ((and (eq type 'fixed-width) | |
| 23187 | (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)")) | |
| 23188 | (replace-match | |
| 23189 | "" nil nil nil (if (= (line-end-position) (match-end 0)) 0 1))) | |
| 23190 | ((and (memq type '(babel-call clock comment diary-sexp headline | |
| 23191 | horizontal-rule keyword paragraph | |
| 23192 | planning)) | |
| 23193 | (<= (org-element-property :post-affiliated element) (point))) | |
| 23194 | (skip-chars-forward " \t") | |
| 23195 | (insert ": ")) | |
| 23196 | ((and (looking-at-p "[ \t]*$") | |
| 23197 | (or (eq type 'inlinetask) | |
| 23198 | (save-excursion | |
| 23199 | (skip-chars-forward " \r\t\n") | |
| 23200 | (<= (org-element-property :end element) (point))))) | |
| 23201 | (delete-region (point) (line-end-position)) | |
| 23202 | (org-indent-line) | |
| 23203 | (insert ": ")) | |
| 23204 | (t (user-error "Cannot insert a fixed-width line here"))))) | |
| 23205 | ;; Region active. | |
| 23206 | (let* ((begin (save-excursion | |
| 23207 | (goto-char (region-beginning)) | |
| 23208 | (line-beginning-position))) | |
| 23209 | (end (copy-marker | |
| 23210 | (save-excursion | |
| 23211 | (goto-char (region-end)) | |
| 23212 | (unless (eolp) (beginning-of-line)) | |
| 23213 | (if (save-excursion (re-search-backward "\\S-" begin t)) | |
| 23214 | (progn (skip-chars-backward " \r\t\n") (point)) | |
| 23215 | (point))))) | |
| 23216 | (all-fixed-width-p | |
| 23217 | (catch 'not-all-p | |
| 23218 | (save-excursion | |
| 23219 | (goto-char begin) | |
| 23220 | (skip-chars-forward " \r\t\n") | |
| 23221 | (when (eobp) (throw 'not-all-p nil)) | |
| 23222 | (while (< (point) end) | |
| 23223 | (let ((element (org-element-at-point))) | |
| 23224 | (if (eq (org-element-type element) 'fixed-width) | |
| 23225 | (goto-char (org-element-property :end element)) | |
| 23226 | (throw 'not-all-p nil)))) | |
| 23227 | t)))) | |
| 23228 | (if all-fixed-width-p | |
| 23229 | (save-excursion | |
| 23230 | (goto-char begin) | |
| 23231 | (while (< (point) end) | |
| 23232 | (when (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)") | |
| 23233 | (replace-match | |
| 23234 | "" nil nil nil | |
| 23235 | (if (= (line-end-position) (match-end 0)) 0 1))) | |
| 23236 | (forward-line))) | |
| 23237 | (let ((min-ind (point-max))) | |
| 23238 | ;; Find minimum indentation across all lines. | |
| 23239 | (save-excursion | |
| 23240 | (goto-char begin) | |
| 23241 | (if (not (save-excursion (re-search-forward "\\S-" end t))) | |
| 23242 | (setq min-ind 0) | |
| 23243 | (catch 'zerop | |
| 23244 | (while (< (point) end) | |
| 23245 | (unless (looking-at-p "[ \t]*$") | |
| 23246 | (let ((ind (org-get-indentation))) | |
| 23247 | (setq min-ind (min min-ind ind)) | |
| 23248 | (when (zerop ind) (throw 'zerop t)))) | |
| 23249 | (forward-line))))) | |
| 23250 | ;; Loop over all lines and add fixed-width markup everywhere | |
| 23251 | ;; but in fixed-width lines. | |
| 23252 | (save-excursion | |
| 23253 | (goto-char begin) | |
| 23254 | (while (< (point) end) | |
| 23255 | (cond | |
| 23256 | ((org-at-heading-p) | |
| 23257 | (insert ": ") | |
| 23258 | (forward-line) | |
| 23259 | (while (and (< (point) end) (looking-at-p "[ \t]*$")) | |
| 23260 | (insert ":") | |
| 23261 | (forward-line))) | |
| 23262 | ((looking-at-p "[ \t]*:\\( \\|$\\)") | |
| 23263 | (let* ((element (org-element-at-point)) | |
| 23264 | (element-end (org-element-property :end element))) | |
| 23265 | (if (eq (org-element-type element) 'fixed-width) | |
| 23266 | (progn (goto-char element-end) | |
| 23267 | (skip-chars-backward " \r\t\n") | |
| 23268 | (forward-line)) | |
| 23269 | (let ((limit (min end element-end))) | |
| 23270 | (while (< (point) limit) | |
| 23271 | (org-move-to-column min-ind t) | |
| 23272 | (insert ": ") | |
| 23273 | (forward-line)))))) | |
| 23274 | (t | |
| 23275 | (org-move-to-column min-ind t) | |
| 23276 | (insert ": ") | |
| 23277 | (forward-line))))))) | |
| 23278 | (set-marker end nil)))) | |
| 23279 | ||
| 23280 | ||
| 23281 | ;;; Comments | |
| 23282 | ||
| 23283 | ;; Org comments syntax is quite complex. It requires the entire line | |
| 23284 | ;; to be just a comment. Also, even with the right syntax at the | |
| 23285 | ;; beginning of line, some elements (e.g., verse-block or | |
| 23286 | ;; example-block) don't accept comments. Usual Emacs comment commands | |
| 23287 | ;; cannot cope with those requirements. Therefore, Org replaces them. | |
| 23288 | ||
| 23289 | ;; Org still relies on `comment-dwim', but cannot trust | |
| 23290 | ;; `comment-only-p'. So, `comment-region-function' and | |
| 23291 | ;; `uncomment-region-function' both point | |
| 23292 | ;; to`org-comment-or-uncomment-region'. Eventually, | |
| 23293 | ;; `org-insert-comment' takes care of insertion of comments at the | |
| 23294 | ;; beginning of line. | |
| 23295 | ||
| 23296 | ;; `org-setup-comments-handling' install comments related variables | |
| 23297 | ;; during `org-mode' initialization. | |
| 23298 | ||
| 23299 | (defun org-setup-comments-handling () | |
| 23300 | (interactive) | |
| 23301 | (setq-local comment-use-syntax nil) | |
| 23302 | (setq-local comment-start "# ") | |
| 23303 | (setq-local comment-start-skip "^\\s-*#\\(?: \\|$\\)") | |
| 23304 | (setq-local comment-insert-comment-function 'org-insert-comment) | |
| 23305 | (setq-local comment-region-function 'org-comment-or-uncomment-region) | |
| 23306 | (setq-local uncomment-region-function 'org-comment-or-uncomment-region)) | |
| 23307 | ||
| 23308 | (defun org-insert-comment () | |
| 23309 | "Insert an empty comment above current line. | |
| 23310 | If the line is empty, insert comment at its beginning. When | |
| 23311 | point is within a source block, comment according to the related | |
| 23312 | major mode." | |
| 23313 | (if (let ((element (org-element-at-point))) | |
| 23314 | (and (eq (org-element-type element) 'src-block) | |
| 23315 | (< (save-excursion | |
| 23316 | (goto-char (org-element-property :post-affiliated element)) | |
| 23317 | (line-end-position)) | |
| 23318 | (point)) | |
| 23319 | (> (save-excursion | |
| 23320 | (goto-char (org-element-property :end element)) | |
| 23321 | (skip-chars-backward " \r\t\n") | |
| 23322 | (line-beginning-position)) | |
| 23323 | (point)))) | |
| 23324 | (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim)) | |
| 23325 | (beginning-of-line) | |
| 23326 | (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol)) | |
| 23327 | (open-line 1)) | |
| 23328 | (org-indent-line) | |
| 23329 | (insert "# "))) | |
| 23330 | ||
| 23331 | (defvar comment-empty-lines) ; From newcomment.el. | |
| 23332 | (defun org-comment-or-uncomment-region (beg end &rest _) | |
| 23333 | "Comment or uncomment each non-blank line in the region. | |
| 23334 | Uncomment each non-blank line between BEG and END if it only | |
| 23335 | contains commented lines. Otherwise, comment them. If region is | |
| 23336 | strictly within a source block, use appropriate comment syntax." | |
| 23337 | (if (let ((element (org-element-at-point))) | |
| 23338 | (and (eq (org-element-type element) 'src-block) | |
| 23339 | (< (save-excursion | |
| 23340 | (goto-char (org-element-property :post-affiliated element)) | |
| 23341 | (line-end-position)) | |
| 23342 | beg) | |
| 23343 | (>= (save-excursion | |
| 23344 | (goto-char (org-element-property :end element)) | |
| 23345 | (skip-chars-backward " \r\t\n") | |
| 23346 | (line-beginning-position)) | |
| 23347 | end))) | |
| 23348 | ;; Translate region boundaries for the Org buffer to the source | |
| 23349 | ;; buffer. | |
| 23350 | (let ((offset (- end beg))) | |
| 23351 | (save-excursion | |
| 23352 | (goto-char beg) | |
| 23353 | (org-babel-do-in-edit-buffer | |
| 23354 | (comment-or-uncomment-region (point) (+ offset (point)))))) | |
| 23355 | (save-restriction | |
| 23356 | ;; Restrict region | |
| 23357 | (narrow-to-region (save-excursion (goto-char beg) | |
| 23358 | (skip-chars-forward " \r\t\n" end) | |
| 23359 | (line-beginning-position)) | |
| 23360 | (save-excursion (goto-char end) | |
| 23361 | (skip-chars-backward " \r\t\n" beg) | |
| 23362 | (line-end-position))) | |
| 23363 | (let ((uncommentp | |
| 23364 | ;; UNCOMMENTP is non-nil when every non blank line between | |
| 23365 | ;; BEG and END is a comment. | |
| 23366 | (save-excursion | |
| 23367 | (goto-char (point-min)) | |
| 23368 | (while (and (not (eobp)) | |
| 23369 | (let ((element (org-element-at-point))) | |
| 23370 | (and (eq (org-element-type element) 'comment) | |
| 23371 | (goto-char (min (point-max) | |
| 23372 | (org-element-property | |
| 23373 | :end element))))))) | |
| 23374 | (eobp)))) | |
| 23375 | (if uncommentp | |
| 23376 | ;; Only blank lines and comments in region: uncomment it. | |
| 23377 | (save-excursion | |
| 23378 | (goto-char (point-min)) | |
| 23379 | (while (not (eobp)) | |
| 23380 | (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") | |
| 23381 | (replace-match "" nil nil nil 1)) | |
| 23382 | (forward-line))) | |
| 23383 | ;; Comment each line in region. | |
| 23384 | (let ((min-indent (point-max))) | |
| 23385 | ;; First find the minimum indentation across all lines. | |
| 23386 | (save-excursion | |
| 23387 | (goto-char (point-min)) | |
| 23388 | (while (and (not (eobp)) (not (zerop min-indent))) | |
| 23389 | (unless (looking-at "[ \t]*$") | |
| 23390 | (setq min-indent (min min-indent (current-indentation)))) | |
| 23391 | (forward-line))) | |
| 23392 | ;; Then loop over all lines. | |
| 23393 | (save-excursion | |
| 23394 | (goto-char (point-min)) | |
| 23395 | (while (not (eobp)) | |
| 23396 | (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) | |
| 23397 | ;; Don't get fooled by invisible text (e.g. link path) | |
| 23398 | ;; when moving to column MIN-INDENT. | |
| 23399 | (let ((buffer-invisibility-spec nil)) | |
| 23400 | (org-move-to-column min-indent t)) | |
| 23401 | (insert comment-start)) | |
| 23402 | (forward-line))))))))) | |
| 23403 | ||
| 23404 | (defun org-comment-dwim (_arg) | |
| 23405 | "Call `comment-dwim' within a source edit buffer if needed." | |
| 23406 | (interactive "*P") | |
| 23407 | (if (org-in-src-block-p) | |
| 23408 | (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim)) | |
| 23409 | (call-interactively 'comment-dwim))) | |
| 23410 | ||
| 23411 | ||
| 23412 | ;;; Timestamps API | |
| 23413 | ||
| 23414 | ;; This section contains tools to operate on timestamp objects, as | |
| 23415 | ;; returned by, e.g. `org-element-context'. | |
| 23416 | ||
| 23417 | (defun org-timestamp--to-internal-time (timestamp &optional end) | |
| 23418 | "Encode TIMESTAMP object into Emacs internal time. | |
| 23419 | Use end of date range or time range when END is non-nil." | |
| 23420 | (apply #'encode-time | |
| 23421 | (cons 0 | |
| 23422 | (mapcar | |
| 23423 | (lambda (prop) (or (org-element-property prop timestamp) 0)) | |
| 23424 | (if end '(:minute-end :hour-end :day-end :month-end :year-end) | |
| 23425 | '(:minute-start :hour-start :day-start :month-start | |
| 23426 | :year-start)))))) | |
| 23427 | ||
| 23428 | (defun org-timestamp-has-time-p (timestamp) | |
| 23429 | "Non-nil when TIMESTAMP has a time specified." | |
| 23430 | (org-element-property :hour-start timestamp)) | |
| 23431 | ||
| 23432 | (defun org-timestamp-format (timestamp format &optional end utc) | |
| 23433 | "Format a TIMESTAMP object into a string. | |
| 23434 | ||
| 23435 | FORMAT is a format specifier to be passed to | |
| 23436 | `format-time-string'. | |
| 23437 | ||
| 23438 | When optional argument END is non-nil, use end of date-range or | |
| 23439 | time-range, if possible. | |
| 23440 | ||
| 23441 | When optional argument UTC is non-nil, time will be expressed as | |
| 23442 | Universal Time." | |
| 23443 | (format-time-string | |
| 23444 | format (org-timestamp--to-internal-time timestamp end) | |
| 23445 | (and utc t))) | |
| 23446 | ||
| 23447 | (defun org-timestamp-split-range (timestamp &optional end) | |
| 23448 | "Extract a TIMESTAMP object from a date or time range. | |
| 23449 | ||
| 23450 | END, when non-nil, means extract the end of the range. | |
| 23451 | Otherwise, extract its start. | |
| 23452 | ||
| 23453 | Return a new timestamp object." | |
| 23454 | (let ((type (org-element-property :type timestamp))) | |
| 23455 | (if (memq type '(active inactive diary)) timestamp | |
| 23456 | (let ((split-ts (org-element-copy timestamp))) | |
| 23457 | ;; Set new type. | |
| 23458 | (org-element-put-property | |
| 23459 | split-ts :type (if (eq type 'active-range) 'active 'inactive)) | |
| 23460 | ;; Copy start properties over end properties if END is | |
| 23461 | ;; non-nil. Otherwise, copy end properties over `start' ones. | |
| 23462 | (let ((p-alist '((:minute-start . :minute-end) | |
| 23463 | (:hour-start . :hour-end) | |
| 23464 | (:day-start . :day-end) | |
| 23465 | (:month-start . :month-end) | |
| 23466 | (:year-start . :year-end)))) | |
| 23467 | (dolist (p-cell p-alist) | |
| 23468 | (org-element-put-property | |
| 23469 | split-ts | |
| 23470 | (funcall (if end #'car #'cdr) p-cell) | |
| 23471 | (org-element-property | |
| 23472 | (funcall (if end #'cdr #'car) p-cell) split-ts))) | |
| 23473 | ;; Eventually refresh `:raw-value'. | |
| 23474 | (org-element-put-property split-ts :raw-value nil) | |
| 23475 | (org-element-put-property | |
| 23476 | split-ts :raw-value (org-element-interpret-data split-ts))))))) | |
| 23477 | ||
| 23478 | (defun org-timestamp-translate (timestamp &optional boundary) | |
| 23479 | "Translate TIMESTAMP object to custom format. | |
| 23480 | ||
| 23481 | Format string is defined in `org-time-stamp-custom-formats', | |
| 23482 | which see. | |
| 23483 | ||
| 23484 | When optional argument BOUNDARY is non-nil, it is either the | |
| 23485 | symbol `start' or `end'. In this case, only translate the | |
| 23486 | starting or ending part of TIMESTAMP if it is a date or time | |
| 23487 | range. Otherwise, translate both parts. | |
| 23488 | ||
| 23489 | Return timestamp as-is if `org-display-custom-times' is nil or if | |
| 23490 | it has a `diary' type." | |
| 23491 | (let ((type (org-element-property :type timestamp))) | |
| 23492 | (if (or (not org-display-custom-times) (eq type 'diary)) | |
| 23493 | (org-element-interpret-data timestamp) | |
| 23494 | (let ((fmt (funcall (if (org-timestamp-has-time-p timestamp) #'cdr #'car) | |
| 23495 | org-time-stamp-custom-formats))) | |
| 23496 | (if (and (not boundary) (memq type '(active-range inactive-range))) | |
| 23497 | (concat (org-timestamp-format timestamp fmt) | |
| 23498 | "--" | |
| 23499 | (org-timestamp-format timestamp fmt t)) | |
| 23500 | (org-timestamp-format timestamp fmt (eq boundary 'end))))))) | |
| 23501 | ||
| 23502 | ||
| 23503 | ||
| 23504 | ;;; Other stuff. | |
| 23505 | ||
| 23506 | (defvar reftex-docstruct-symbol) | |
| 23507 | (defvar org--rds) | |
| 23508 | ||
| 23509 | (defun org-reftex-citation () | |
| 23510 | "Use reftex-citation to insert a citation into the buffer. | |
| 23511 | This looks for a line like | |
| 23512 | ||
| 23513 | #+BIBLIOGRAPHY: foo plain option:-d | |
| 23514 | ||
| 23515 | and derives from it that foo.bib is the bibliography file relevant | |
| 23516 | for this document. It then installs the necessary environment for RefTeX | |
| 23517 | to work in this buffer and calls `reftex-citation' to insert a citation | |
| 23518 | into the buffer. | |
| 23519 | ||
| 23520 | Export of such citations to both LaTeX and HTML is handled by the contributed | |
| 23521 | package ox-bibtex by Taru Karttunen." | |
| 23522 | (interactive) | |
| 23523 | (let ((reftex-docstruct-symbol 'org--rds) | |
| 23524 | org--rds bib) | |
| 23525 | (org-with-wide-buffer | |
| 23526 | (let ((case-fold-search t) | |
| 23527 | (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)")) | |
| 23528 | (if (not (save-excursion | |
| 23529 | (or (re-search-forward re nil t) | |
| 23530 | (re-search-backward re nil t)))) | |
| 23531 | (user-error "No bibliography defined in file") | |
| 23532 | (setq bib (concat (match-string 1) ".bib") | |
| 23533 | org--rds (list (list 'bib bib)))))) | |
| 23534 | (call-interactively 'reftex-citation))) | |
| 23535 | ||
| 23536 | ;;;; Functions extending outline functionality | |
| 23537 | ||
| 23538 | (defun org-beginning-of-line (&optional n) | |
| 23539 | "Go to the beginning of the current visible line. | |
| 23540 | ||
| 23541 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore | |
| 23542 | tags on the first attempt, and only move to after the tags when | |
| 23543 | the cursor is already beyond the end of the headline. | |
| 23544 | ||
| 23545 | With argument N not nil or 1, move forward N - 1 lines first." | |
| 23546 | (interactive "^p") | |
| 23547 | (let ((origin (point)) | |
| 23548 | (special (pcase org-special-ctrl-a/e | |
| 23549 | (`(,C-a . ,_) C-a) (_ org-special-ctrl-a/e))) | |
| 23550 | deactivate-mark) | |
| 23551 | ;; First move to a visible line. | |
| 23552 | (if (bound-and-true-p visual-line-mode) | |
| 23553 | (beginning-of-visual-line n) | |
| 23554 | (move-beginning-of-line n) | |
| 23555 | ;; `move-beginning-of-line' may leave point after invisible | |
| 23556 | ;; characters if line starts with such of these (e.g., with | |
| 23557 | ;; a link at column 0). Really move to the beginning of the | |
| 23558 | ;; current visible line. | |
| 23559 | (beginning-of-line)) | |
| 23560 | (cond | |
| 23561 | ;; No special behavior. Point is already at the beginning of | |
| 23562 | ;; a line, logical or visual. | |
| 23563 | ((not special)) | |
| 23564 | ;; `beginning-of-visual-line' left point before logical beginning | |
| 23565 | ;; of line: point is at the beginning of a visual line. Bail | |
| 23566 | ;; out. | |
| 23567 | ((and (bound-and-true-p visual-line-mode) (not (bolp)))) | |
| 23568 | ((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp)) | |
| 23569 | ;; At a headline, special position is before the title, but | |
| 23570 | ;; after any TODO keyword or priority cookie. | |
| 23571 | (let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) | |
| 23572 | (line-end-position))) | |
| 23573 | (bol (point))) | |
| 23574 | (if (eq special 'reversed) | |
| 23575 | (when (and (= origin bol) (eq last-command this-command)) | |
| 23576 | (goto-char refpos)) | |
| 23577 | (when (or (> origin refpos) (= origin bol)) | |
| 23578 | (goto-char refpos))))) | |
| 23579 | ((and (looking-at org-list-full-item-re) | |
| 23580 | (memq (org-element-type (save-match-data (org-element-at-point))) | |
| 23581 | '(item plain-list))) | |
| 23582 | ;; Set special position at first white space character after | |
| 23583 | ;; bullet, and check-box, if any. | |
| 23584 | (let ((after-bullet | |
| 23585 | (let ((box (match-end 3))) | |
| 23586 | (cond ((not box) (match-end 1)) | |
| 23587 | ((eq (char-after box) ?\s) (1+ box)) | |
| 23588 | (t box))))) | |
| 23589 | (if (eq special 'reversed) | |
| 23590 | (when (and (= (point) origin) (eq last-command this-command)) | |
| 23591 | (goto-char after-bullet)) | |
| 23592 | (when (or (> origin after-bullet) (= (point) origin)) | |
| 23593 | (goto-char after-bullet))))) | |
| 23594 | ;; No special context. Point is already at beginning of line. | |
| 23595 | (t nil)))) | |
| 23596 | ||
| 23597 | (defun org-end-of-line (&optional n) | |
| 23598 | "Go to the end of the line, but before ellipsis, if any. | |
| 23599 | ||
| 23600 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore | |
| 23601 | tags on the first attempt, and only move to after the tags when | |
| 23602 | the cursor is already beyond the end of the headline. | |
| 23603 | ||
| 23604 | With argument N not nil or 1, move forward N - 1 lines first." | |
| 23605 | (interactive "^p") | |
| 23606 | (let ((origin (point)) | |
| 23607 | (special (pcase org-special-ctrl-a/e | |
| 23608 | (`(,_ . ,C-e) C-e) (_ org-special-ctrl-a/e))) | |
| 23609 | deactivate-mark) | |
| 23610 | ;; First move to a visible line. | |
| 23611 | (if (bound-and-true-p visual-line-mode) | |
| 23612 | (beginning-of-visual-line n) | |
| 23613 | (move-beginning-of-line n)) | |
| 23614 | (cond | |
| 23615 | ;; At a headline, with tags. | |
| 23616 | ((and special | |
| 23617 | (save-excursion | |
| 23618 | (beginning-of-line) | |
| 23619 | (let ((case-fold-search nil)) | |
| 23620 | (looking-at org-complex-heading-regexp))) | |
| 23621 | (match-end 5)) | |
| 23622 | (let ((tags (save-excursion | |
| 23623 | (goto-char (match-beginning 5)) | |
| 23624 | (skip-chars-backward " \t") | |
| 23625 | (point))) | |
| 23626 | (visual-end (and (bound-and-true-p visual-line-mode) | |
| 23627 | (save-excursion | |
| 23628 | (end-of-visual-line) | |
| 23629 | (point))))) | |
| 23630 | ;; If `end-of-visual-line' brings us before end of line or | |
| 23631 | ;; even tags, i.e., the headline spans over multiple visual | |
| 23632 | ;; lines, move there. | |
| 23633 | (cond ((and visual-end | |
| 23634 | (< visual-end tags) | |
| 23635 | (<= origin visual-end)) | |
| 23636 | (goto-char visual-end)) | |
| 23637 | ((eq special 'reversed) | |
| 23638 | (if (and (= origin (line-end-position)) | |
| 23639 | (eq this-command last-command)) | |
| 23640 | (goto-char tags) | |
| 23641 | (end-of-line))) | |
| 23642 | (t | |
| 23643 | (if (or (< origin tags) (= origin (line-end-position))) | |
| 23644 | (goto-char tags) | |
| 23645 | (end-of-line)))))) | |
| 23646 | ((bound-and-true-p visual-line-mode) | |
| 23647 | (let ((bol (line-beginning-position))) | |
| 23648 | (end-of-visual-line) | |
| 23649 | ;; If `end-of-visual-line' gets us past the ellipsis at the | |
| 23650 | ;; end of a line, backtrack and use `end-of-line' instead. | |
| 23651 | (when (/= bol (line-beginning-position)) | |
| 23652 | (goto-char bol) | |
| 23653 | (end-of-line)))) | |
| 23654 | (t (end-of-line))))) | |
| 23655 | ||
| 23656 | (define-key org-mode-map "\C-a" 'org-beginning-of-line) | |
| 23657 | (define-key org-mode-map "\C-e" 'org-end-of-line) | |
| 23658 | ||
| 23659 | (defun org-backward-sentence (&optional _arg) | |
| 23660 | "Go to beginning of sentence, or beginning of table field. | |
| 23661 | This will call `backward-sentence' or `org-table-beginning-of-field', | |
| 23662 | depending on context." | |
| 23663 | (interactive) | |
| 23664 | (let* ((element (org-element-at-point)) | |
| 23665 | (contents-begin (org-element-property :contents-begin element)) | |
| 23666 | (table (org-element-lineage element '(table) t))) | |
| 23667 | (if (and table | |
| 23668 | (> (point) contents-begin) | |
| 23669 | (<= (point) (org-element-property :contents-end table))) | |
| 23670 | (call-interactively #'org-table-beginning-of-field) | |
| 23671 | (save-restriction | |
| 23672 | (when (and contents-begin | |
| 23673 | (< (point-min) contents-begin) | |
| 23674 | (> (point) contents-begin)) | |
| 23675 | (narrow-to-region contents-begin | |
| 23676 | (org-element-property :contents-end element))) | |
| 23677 | (call-interactively #'backward-sentence))))) | |
| 23678 | ||
| 23679 | (defun org-forward-sentence (&optional _arg) | |
| 23680 | "Go to end of sentence, or end of table field. | |
| 23681 | This will call `forward-sentence' or `org-table-end-of-field', | |
| 23682 | depending on context." | |
| 23683 | (interactive) | |
| 23684 | (if (and (org-at-heading-p) | |
| 23685 | (save-restriction (skip-chars-forward " \t") (not (eolp)))) | |
| 23686 | (save-restriction | |
| 23687 | (narrow-to-region (line-beginning-position) (line-end-position)) | |
| 23688 | (call-interactively #'forward-sentence)) | |
| 23689 | (let* ((element (org-element-at-point)) | |
| 23690 | (contents-end (org-element-property :contents-end element)) | |
| 23691 | (table (org-element-lineage element '(table) t))) | |
| 23692 | (if (and table | |
| 23693 | (>= (point) (org-element-property :contents-begin table)) | |
| 23694 | (< (point) contents-end)) | |
| 23695 | (call-interactively #'org-table-end-of-field) | |
| 23696 | (save-restriction | |
| 23697 | (when (and contents-end | |
| 23698 | (> (point-max) contents-end) | |
| 23699 | ;; Skip blank lines between elements. | |
| 23700 | (< (org-element-property :end element) | |
| 23701 | (save-excursion (goto-char contents-end) | |
| 23702 | (skip-chars-forward " \r\t\n")))) | |
| 23703 | (narrow-to-region (org-element-property :contents-begin element) | |
| 23704 | contents-end)) | |
| 23705 | ;; End of heading is considered as the end of a sentence. | |
| 23706 | (let ((sentence-end (concat (sentence-end) "\\|^\\*+ .*$"))) | |
| 23707 | (call-interactively #'forward-sentence))))))) | |
| 23708 | ||
| 23709 | (define-key org-mode-map "\M-a" 'org-backward-sentence) | |
| 23710 | (define-key org-mode-map "\M-e" 'org-forward-sentence) | |
| 23711 | ||
| 23712 | (defun org-kill-line (&optional _arg) | |
| 23713 | "Kill line, to tags or end of line." | |
| 23714 | (interactive) | |
| 23715 | (cond | |
| 23716 | ((or (not org-special-ctrl-k) | |
| 23717 | (bolp) | |
| 23718 | (not (org-at-heading-p))) | |
| 23719 | (when (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) | |
| 23720 | org-ctrl-k-protect-subtree | |
| 23721 | (or (eq org-ctrl-k-protect-subtree 'error) | |
| 23722 | (not (y-or-n-p "Kill hidden subtree along with headline? ")))) | |
| 23723 | (user-error | |
| 23724 | (substitute-command-keys | |
| 23725 | "`\\[org-kill-line]' aborted as it would kill a hidden subtree"))) | |
| 23726 | (call-interactively | |
| 23727 | (if (bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) | |
| 23728 | ((looking-at ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$") | |
| 23729 | (kill-region (point) (match-beginning 1)) | |
| 23730 | (org-set-tags nil t)) | |
| 23731 | (t (kill-region (point) (point-at-eol))))) | |
| 23732 | ||
| 23733 | (define-key org-mode-map "\C-k" 'org-kill-line) | |
| 23734 | ||
| 23735 | (defun org-yank (&optional arg) | |
| 23736 | "Yank. If the kill is a subtree, treat it specially. | |
| 23737 | This command will look at the current kill and check if is a single | |
| 23738 | subtree, or a series of subtrees[1]. If it passes the test, and if the | |
| 23739 | cursor is at the beginning of a line or after the stars of a currently | |
| 23740 | empty headline, then the yank is handled specially. How exactly depends | |
| 23741 | on the value of the following variables. | |
| 23742 | ||
| 23743 | `org-yank-folded-subtrees' | |
| 23744 | By default, this variable is non-nil, which results in | |
| 23745 | subtree(s) being folded after insertion, except if doing so | |
| 23746 | would swallow text after the yanked text. | |
| 23747 | ||
| 23748 | `org-yank-adjusted-subtrees' | |
| 23749 | When non-nil (the default value is nil), the subtree will be | |
| 23750 | promoted or demoted in order to fit into the local outline tree | |
| 23751 | structure, which means that the level will be adjusted so that it | |
| 23752 | becomes the smaller one of the two *visible* surrounding headings. | |
| 23753 | ||
| 23754 | Any prefix to this command will cause `yank' to be called directly with | |
| 23755 | no special treatment. In particular, a simple `\\[universal-argument]' prefix \ | |
| 23756 | will just | |
| 23757 | plainly yank the text as it is. | |
| 23758 | ||
| 23759 | \[1] The test checks if the first non-white line is a heading | |
| 23760 | and if there are no other headings with fewer stars." | |
| 23761 | (interactive "P") | |
| 23762 | (org-yank-generic 'yank arg)) | |
| 23763 | ||
| 23764 | (defun org-yank-generic (command arg) | |
| 23765 | "Perform some yank-like command. | |
| 23766 | ||
| 23767 | This function implements the behavior described in the `org-yank' | |
| 23768 | documentation. However, it has been generalized to work for any | |
| 23769 | interactive command with similar behavior." | |
| 23770 | ||
| 23771 | ;; pretend to be command COMMAND | |
| 23772 | (setq this-command command) | |
| 23773 | ||
| 23774 | (if arg | |
| 23775 | (call-interactively command) | |
| 23776 | ||
| 23777 | (let ((subtreep ; is kill a subtree, and the yank position appropriate? | |
| 23778 | (and (org-kill-is-subtree-p) | |
| 23779 | (or (bolp) | |
| 23780 | (and (looking-at "[ \t]*$") | |
| 23781 | (string-match | |
| 23782 | "\\`\\*+\\'" | |
| 23783 | (buffer-substring (point-at-bol) (point))))))) | |
| 23784 | swallowp) | |
| 23785 | (cond | |
| 23786 | ((and subtreep org-yank-folded-subtrees) | |
| 23787 | (let ((beg (point)) | |
| 23788 | end) | |
| 23789 | (if (and subtreep org-yank-adjusted-subtrees) | |
| 23790 | (org-paste-subtree nil nil 'for-yank) | |
| 23791 | (call-interactively command)) | |
| 23792 | ||
| 23793 | (setq end (point)) | |
| 23794 | (goto-char beg) | |
| 23795 | (when (and (bolp) subtreep | |
| 23796 | (not (setq swallowp | |
| 23797 | (org-yank-folding-would-swallow-text beg end)))) | |
| 23798 | (org-with-limited-levels | |
| 23799 | (or (looking-at org-outline-regexp) | |
| 23800 | (re-search-forward org-outline-regexp-bol end t)) | |
| 23801 | (while (and (< (point) end) (looking-at org-outline-regexp)) | |
| 23802 | (outline-hide-subtree) | |
| 23803 | (org-cycle-show-empty-lines 'folded) | |
| 23804 | (condition-case nil | |
| 23805 | (outline-forward-same-level 1) | |
| 23806 | (error (goto-char end)))))) | |
| 23807 | (when swallowp | |
| 23808 | (message | |
| 23809 | "Inserted text not folded because that would swallow text")) | |
| 23810 | ||
| 23811 | (goto-char end) | |
| 23812 | (skip-chars-forward " \t\n\r") | |
| 23813 | (beginning-of-line 1) | |
| 23814 | (push-mark beg 'nomsg))) | |
| 23815 | ((and subtreep org-yank-adjusted-subtrees) | |
| 23816 | (let ((beg (point-at-bol))) | |
| 23817 | (org-paste-subtree nil nil 'for-yank) | |
| 23818 | (push-mark beg 'nomsg))) | |
| 23819 | (t | |
| 23820 | (call-interactively command)))))) | |
| 23821 | ||
| 23822 | (defun org-yank-folding-would-swallow-text (beg end) | |
| 23823 | "Would hide-subtree at BEG swallow any text after END?" | |
| 23824 | (let (level) | |
| 23825 | (org-with-limited-levels | |
| 23826 | (save-excursion | |
| 23827 | (goto-char beg) | |
| 23828 | (when (or (looking-at org-outline-regexp) | |
| 23829 | (re-search-forward org-outline-regexp-bol end t)) | |
| 23830 | (setq level (org-outline-level))) | |
| 23831 | (goto-char end) | |
| 23832 | (skip-chars-forward " \t\r\n\v\f") | |
| 23833 | (not (or (eobp) | |
| 23834 | (and (bolp) (looking-at-p org-outline-regexp) | |
| 23835 | (<= (org-outline-level) level)))))))) | |
| 23836 | ||
| 23837 | (define-key org-mode-map "\C-y" 'org-yank) | |
| 23838 | ||
| 23839 | (defun org-truely-invisible-p () | |
| 23840 | "Check if point is at a character currently not visible. | |
| 23841 | This version does not only check the character property, but also | |
| 23842 | `visible-mode'." | |
| 23843 | (unless (bound-and-true-p visible-mode) | |
| 23844 | (org-invisible-p))) | |
| 23845 | ||
| 23846 | (defun org-invisible-p2 () | |
| 23847 | "Check if point is at a character currently not visible. | |
| 23848 | ||
| 23849 | If the point is at EOL (and not at the beginning of a buffer too), | |
| 23850 | move it back by one char before doing this check." | |
| 23851 | (save-excursion | |
| 23852 | (when (and (eolp) (not (bobp))) | |
| 23853 | (backward-char 1)) | |
| 23854 | (org-invisible-p))) | |
| 23855 | ||
| 23856 | (defun org-back-to-heading (&optional invisible-ok) | |
| 23857 | "Call `outline-back-to-heading', but provide a better error message." | |
| 23858 | (condition-case nil | |
| 23859 | (outline-back-to-heading invisible-ok) | |
| 23860 | (error (error "Before first headline at position %d in buffer %s" | |
| 23861 | (point) (current-buffer))))) | |
| 23862 | ||
| 23863 | (defun org-before-first-heading-p () | |
| 23864 | "Before first heading?" | |
| 23865 | (save-excursion | |
| 23866 | (end-of-line) | |
| 23867 | (null (re-search-backward org-outline-regexp-bol nil t)))) | |
| 23868 | ||
| 23869 | (defun org-at-heading-p (&optional ignored) | |
| 23870 | (outline-on-heading-p t)) | |
| 23871 | ||
| 23872 | (defun org-in-commented-heading-p (&optional no-inheritance) | |
| 23873 | "Non-nil if point is under a commented heading. | |
| 23874 | This function also checks ancestors of the current headline, | |
| 23875 | unless optional argument NO-INHERITANCE is non-nil." | |
| 23876 | (cond | |
| 23877 | ((org-before-first-heading-p) nil) | |
| 23878 | ((let ((headline (nth 4 (org-heading-components)))) | |
| 23879 | (and headline | |
| 23880 | (let ((case-fold-search nil)) | |
| 23881 | (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)") | |
| 23882 | headline))))) | |
| 23883 | (no-inheritance nil) | |
| 23884 | (t | |
| 23885 | (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p)))))) | |
| 23886 | ||
| 23887 | (defun org-at-comment-p nil | |
| 23888 | "Is cursor in a commented line?" | |
| 23889 | (save-excursion | |
| 23890 | (save-match-data | |
| 23891 | (beginning-of-line) | |
| 23892 | (looking-at "^[ \t]*# ")))) | |
| 23893 | ||
| 23894 | (defun org-at-drawer-p nil | |
| 23895 | "Is cursor at a drawer keyword?" | |
| 23896 | (save-excursion | |
| 23897 | (move-beginning-of-line 1) | |
| 23898 | (looking-at org-drawer-regexp))) | |
| 23899 | ||
| 23900 | (defun org-at-block-p nil | |
| 23901 | "Is cursor at a block keyword?" | |
| 23902 | (save-excursion | |
| 23903 | (move-beginning-of-line 1) | |
| 23904 | (looking-at org-block-regexp))) | |
| 23905 | ||
| 23906 | (defun org-point-at-end-of-empty-headline () | |
| 23907 | "If point is at the end of an empty headline, return t, else nil. | |
| 23908 | If the heading only contains a TODO keyword, it is still still considered | |
| 23909 | empty." | |
| 23910 | (let ((case-fold-search nil)) | |
| 23911 | (and (looking-at "[ \t]*$") | |
| 23912 | org-todo-line-regexp | |
| 23913 | (save-excursion | |
| 23914 | (beginning-of-line) | |
| 23915 | (looking-at org-todo-line-regexp) | |
| 23916 | (string= (match-string 3) ""))))) | |
| 23917 | ||
| 23918 | (defun org-at-heading-or-item-p () | |
| 23919 | (or (org-at-heading-p) (org-at-item-p))) | |
| 23920 | ||
| 23921 | (defun org-at-target-p () | |
| 23922 | (or (org-in-regexp org-radio-target-regexp) | |
| 23923 | (org-in-regexp org-target-regexp))) | |
| 23924 | ;; Compatibility alias with Org versions < 7.8.03 | |
| 23925 | (defalias 'org-on-target-p 'org-at-target-p) | |
| 23926 | ||
| 23927 | (defun org-up-heading-all (arg) | |
| 23928 | "Move to the heading line of which the present line is a subheading. | |
| 23929 | This function considers both visible and invisible heading lines. | |
| 23930 | With argument, move up ARG levels." | |
| 23931 | (outline-up-heading arg t)) | |
| 23932 | ||
| 23933 | (defun org-up-heading-safe () | |
| 23934 | "Move to the heading line of which the present line is a subheading. | |
| 23935 | This version will not throw an error. It will return the level of the | |
| 23936 | headline found, or nil if no higher level is found. | |
| 23937 | ||
| 23938 | Also, this function will be a lot faster than `outline-up-heading', | |
| 23939 | because it relies on stars being the outline starters. This can really | |
| 23940 | make a significant difference in outlines with very many siblings." | |
| 23941 | (when (ignore-errors (org-back-to-heading t)) | |
| 23942 | (let ((level-up (1- (funcall outline-level)))) | |
| 23943 | (and (> level-up 0) | |
| 23944 | (re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t) | |
| 23945 | (funcall outline-level))))) | |
| 23946 | ||
| 23947 | (defun org-first-sibling-p () | |
| 23948 | "Is this heading the first child of its parents?" | |
| 23949 | (interactive) | |
| 23950 | (let ((re org-outline-regexp-bol) | |
| 23951 | level l) | |
| 23952 | (unless (org-at-heading-p t) | |
| 23953 | (user-error "Not at a heading")) | |
| 23954 | (setq level (funcall outline-level)) | |
| 23955 | (save-excursion | |
| 23956 | (if (not (re-search-backward re nil t)) | |
| 23957 | t | |
| 23958 | (setq l (funcall outline-level)) | |
| 23959 | (< l level))))) | |
| 23960 | ||
| 23961 | (defun org-goto-sibling (&optional previous) | |
| 23962 | "Goto the next sibling, even if it is invisible. | |
| 23963 | When PREVIOUS is set, go to the previous sibling instead. Returns t | |
| 23964 | when a sibling was found. When none is found, return nil and don't | |
| 23965 | move point." | |
| 23966 | (let ((fun (if previous 're-search-backward 're-search-forward)) | |
| 23967 | (pos (point)) | |
| 23968 | (re org-outline-regexp-bol) | |
| 23969 | level l) | |
| 23970 | (when (ignore-errors (org-back-to-heading t)) | |
| 23971 | (setq level (funcall outline-level)) | |
| 23972 | (catch 'exit | |
| 23973 | (or previous (forward-char 1)) | |
| 23974 | (while (funcall fun re nil t) | |
| 23975 | (setq l (funcall outline-level)) | |
| 23976 | (when (< l level) (goto-char pos) (throw 'exit nil)) | |
| 23977 | (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) | |
| 23978 | (goto-char pos) | |
| 23979 | nil)))) | |
| 23980 | ||
| 23981 | (defun org-show-siblings () | |
| 23982 | "Show all siblings of the current headline." | |
| 23983 | (save-excursion | |
| 23984 | (while (org-goto-sibling) (org-flag-heading nil))) | |
| 23985 | (save-excursion | |
| 23986 | (while (org-goto-sibling 'previous) | |
| 23987 | (org-flag-heading nil)))) | |
| 23988 | ||
| 23989 | (defun org-goto-first-child () | |
| 23990 | "Goto the first child, even if it is invisible. | |
| 23991 | Return t when a child was found. Otherwise don't move point and | |
| 23992 | return nil." | |
| 23993 | (let (level (pos (point)) (re org-outline-regexp-bol)) | |
| 23994 | (when (ignore-errors (org-back-to-heading t)) | |
| 23995 | (setq level (outline-level)) | |
| 23996 | (forward-char 1) | |
| 23997 | (if (and (re-search-forward re nil t) (> (outline-level) level)) | |
| 23998 | (progn (goto-char (match-beginning 0)) t) | |
| 23999 | (goto-char pos) nil)))) | |
| 24000 | ||
| 24001 | (defun org-show-hidden-entry () | |
| 24002 | "Show an entry where even the heading is hidden." | |
| 24003 | (save-excursion | |
| 24004 | (org-show-entry))) | |
| 24005 | ||
| 24006 | (defun org-flag-heading (flag &optional entry) | |
| 24007 | "Flag the current heading. FLAG non-nil means make invisible. | |
| 24008 | When ENTRY is non-nil, show the entire entry." | |
| 24009 | (save-excursion | |
| 24010 | (org-back-to-heading t) | |
| 24011 | ;; Check if we should show the entire entry | |
| 24012 | (if entry | |
| 24013 | (progn | |
| 24014 | (org-show-entry) | |
| 24015 | (save-excursion | |
| 24016 | (and (outline-next-heading) | |
| 24017 | (org-flag-heading nil)))) | |
| 24018 | (outline-flag-region (max (point-min) (1- (point))) | |
| 24019 | (save-excursion (outline-end-of-heading) (point)) | |
| 24020 | flag)))) | |
| 24021 | ||
| 24022 | (defun org-get-next-sibling () | |
| 24023 | "Move to next heading of the same level, and return point. | |
| 24024 | If there is no such heading, return nil. | |
| 24025 | This is like outline-next-sibling, but invisible headings are ok." | |
| 24026 | (let ((level (funcall outline-level))) | |
| 24027 | (outline-next-heading) | |
| 24028 | (while (and (not (eobp)) (> (funcall outline-level) level)) | |
| 24029 | (outline-next-heading)) | |
| 24030 | (unless (or (eobp) (< (funcall outline-level) level)) | |
| 24031 | (point)))) | |
| 24032 | ||
| 24033 | (defun org-get-last-sibling () | |
| 24034 | "Move to previous heading of the same level, and return point. | |
| 24035 | If there is no such heading, return nil." | |
| 24036 | (let ((opoint (point)) | |
| 24037 | (level (funcall outline-level))) | |
| 24038 | (outline-previous-heading) | |
| 24039 | (when (and (/= (point) opoint) (outline-on-heading-p t)) | |
| 24040 | (while (and (> (funcall outline-level) level) | |
| 24041 | (not (bobp))) | |
| 24042 | (outline-previous-heading)) | |
| 24043 | (unless (< (funcall outline-level) level) | |
| 24044 | (point))))) | |
| 24045 | ||
| 24046 | (defun org-end-of-subtree (&optional invisible-ok to-heading) | |
| 24047 | "Goto to the end of a subtree." | |
| 24048 | ;; This contains an exact copy of the original function, but it uses | |
| 24049 | ;; `org-back-to-heading', to make it work also in invisible | |
| 24050 | ;; trees. And is uses an invisible-ok argument. | |
| 24051 | ;; Under Emacs this is not needed, but the old outline.el needs this fix. | |
| 24052 | ;; Furthermore, when used inside Org, finding the end of a large subtree | |
| 24053 | ;; with many children and grandchildren etc, this can be much faster | |
| 24054 | ;; than the outline version. | |
| 24055 | (org-back-to-heading invisible-ok) | |
| 24056 | (let ((first t) | |
| 24057 | (level (funcall outline-level))) | |
| 24058 | (if (and (derived-mode-p 'org-mode) (< level 1000)) | |
| 24059 | ;; A true heading (not a plain list item), in Org | |
| 24060 | ;; This means we can easily find the end by looking | |
| 24061 | ;; only for the right number of stars. Using a regexp to do | |
| 24062 | ;; this is so much faster than using a Lisp loop. | |
| 24063 | (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} "))) | |
| 24064 | (forward-char 1) | |
| 24065 | (and (re-search-forward re nil 'move) (beginning-of-line 1))) | |
| 24066 | ;; something else, do it the slow way | |
| 24067 | (while (and (not (eobp)) | |
| 24068 | (or first (> (funcall outline-level) level))) | |
| 24069 | (setq first nil) | |
| 24070 | (outline-next-heading))) | |
| 24071 | (unless to-heading | |
| 24072 | (when (memq (preceding-char) '(?\n ?\^M)) | |
| 24073 | ;; Go to end of line before heading | |
| 24074 | (forward-char -1) | |
| 24075 | (when (memq (preceding-char) '(?\n ?\^M)) | |
| 24076 | ;; leave blank line before heading | |
| 24077 | (forward-char -1))))) | |
| 24078 | (point)) | |
| 24079 | ||
| 24080 | (defun org-end-of-meta-data (&optional full) | |
| 24081 | "Skip planning line and properties drawer in current entry. | |
| 24082 | When optional argument FULL is non-nil, also skip empty lines, | |
| 24083 | clocking lines and regular drawers at the beginning of the | |
| 24084 | entry." | |
| 24085 | (org-back-to-heading t) | |
| 24086 | (forward-line) | |
| 24087 | (when (looking-at-p org-planning-line-re) (forward-line)) | |
| 24088 | (when (looking-at org-property-drawer-re) | |
| 24089 | (goto-char (match-end 0)) | |
| 24090 | (forward-line)) | |
| 24091 | (when (and full (not (org-at-heading-p))) | |
| 24092 | (catch 'exit | |
| 24093 | (let ((end (save-excursion (outline-next-heading) (point))) | |
| 24094 | (re (concat "[ \t]*$" "\\|" org-clock-line-re))) | |
| 24095 | (while (not (eobp)) | |
| 24096 | (cond ((looking-at-p org-drawer-regexp) | |
| 24097 | (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t) | |
| 24098 | (forward-line) | |
| 24099 | (throw 'exit t))) | |
| 24100 | ((looking-at-p re) (forward-line)) | |
| 24101 | (t (throw 'exit t)))))))) | |
| 24102 | ||
| 24103 | (defun org-forward-heading-same-level (arg &optional invisible-ok) | |
| 24104 | "Move forward to the ARG'th subheading at same level as this one. | |
| 24105 | Stop at the first and last subheadings of a superior heading. | |
| 24106 | Normally this only looks at visible headings, but when INVISIBLE-OK is | |
| 24107 | non-nil it will also look at invisible ones." | |
| 24108 | (interactive "p") | |
| 24109 | (let ((backward? (and arg (< arg 0)))) | |
| 24110 | (if (org-before-first-heading-p) | |
| 24111 | (if backward? (goto-char (point-min)) (outline-next-heading)) | |
| 24112 | (org-back-to-heading invisible-ok) | |
| 24113 | (unless backward? (end-of-line)) ;do not match current headline | |
| 24114 | (let ((level (- (match-end 0) (match-beginning 0) 1)) | |
| 24115 | (f (if backward? #'re-search-backward #'re-search-forward)) | |
| 24116 | (count (if arg (abs arg) 1)) | |
| 24117 | (result (point))) | |
| 24118 | (while (and (> count 0) | |
| 24119 | (funcall f org-outline-regexp-bol nil 'move)) | |
| 24120 | (let ((l (- (match-end 0) (match-beginning 0) 1))) | |
| 24121 | (cond ((< l level) (setq count 0)) | |
| 24122 | ((and (= l level) | |
| 24123 | (or invisible-ok | |
| 24124 | (not (org-invisible-p | |
| 24125 | (line-beginning-position))))) | |
| 24126 | (cl-decf count) | |
| 24127 | (when (= l level) (setq result (point))))))) | |
| 24128 | (goto-char result)) | |
| 24129 | (beginning-of-line)))) | |
| 24130 | ||
| 24131 | (defun org-backward-heading-same-level (arg &optional invisible-ok) | |
| 24132 | "Move backward to the ARG'th subheading at same level as this one. | |
| 24133 | Stop at the first and last subheadings of a superior heading." | |
| 24134 | (interactive "p") | |
| 24135 | (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) | |
| 24136 | ||
| 24137 | (defun org-next-visible-heading (arg) | |
| 24138 | "Move to the next visible heading. | |
| 24139 | ||
| 24140 | This function wraps `outline-next-visible-heading' with | |
| 24141 | `org-with-limited-levels' in order to skip over inline tasks and | |
| 24142 | respect customization of `org-odd-levels-only'." | |
| 24143 | (interactive "p") | |
| 24144 | (org-with-limited-levels | |
| 24145 | (outline-next-visible-heading arg))) | |
| 24146 | ||
| 24147 | (defun org-previous-visible-heading (arg) | |
| 24148 | "Move to the previous visible heading. | |
| 24149 | ||
| 24150 | This function wraps `outline-previous-visible-heading' with | |
| 24151 | `org-with-limited-levels' in order to skip over inline tasks and | |
| 24152 | respect customization of `org-odd-levels-only'." | |
| 24153 | (interactive "p") | |
| 24154 | (org-with-limited-levels | |
| 24155 | (outline-previous-visible-heading arg))) | |
| 24156 | ||
| 24157 | (defun org-next-block (arg &optional backward block-regexp) | |
| 24158 | "Jump to the next block. | |
| 24159 | ||
| 24160 | With a prefix argument ARG, jump forward ARG many blocks. | |
| 24161 | ||
| 24162 | When BACKWARD is non-nil, jump to the previous block. | |
| 24163 | ||
| 24164 | When BLOCK-REGEXP is non-nil, use this regexp to find blocks. | |
| 24165 | Match data is set according to this regexp when the function | |
| 24166 | returns. | |
| 24167 | ||
| 24168 | Return point at beginning of the opening line of found block. | |
| 24169 | Throw an error if no block is found." | |
| 24170 | (interactive "p") | |
| 24171 | (let ((re (or block-regexp "^[ \t]*#\\+BEGIN")) | |
| 24172 | (case-fold-search t) | |
| 24173 | (search-fn (if backward #'re-search-backward #'re-search-forward)) | |
| 24174 | (count (or arg 1)) | |
| 24175 | (origin (point)) | |
| 24176 | last-element) | |
| 24177 | (if backward (beginning-of-line) (end-of-line)) | |
| 24178 | (while (and (> count 0) (funcall search-fn re nil t)) | |
| 24179 | (let ((element (save-excursion | |
| 24180 | (goto-char (match-beginning 0)) | |
| 24181 | (save-match-data (org-element-at-point))))) | |
| 24182 | (when (and (memq (org-element-type element) | |
| 24183 | '(center-block comment-block dynamic-block | |
| 24184 | example-block export-block quote-block | |
| 24185 | special-block src-block verse-block)) | |
| 24186 | (<= (match-beginning 0) | |
| 24187 | (org-element-property :post-affiliated element))) | |
| 24188 | (setq last-element element) | |
| 24189 | (cl-decf count)))) | |
| 24190 | (if (= count 0) | |
| 24191 | (prog1 (goto-char (org-element-property :post-affiliated last-element)) | |
| 24192 | (save-match-data (org-show-context))) | |
| 24193 | (goto-char origin) | |
| 24194 | (user-error "No %s code blocks" (if backward "previous" "further"))))) | |
| 24195 | ||
| 24196 | (defun org-previous-block (arg &optional block-regexp) | |
| 24197 | "Jump to the previous block. | |
| 24198 | With a prefix argument ARG, jump backward ARG many source blocks. | |
| 24199 | When BLOCK-REGEXP is non-nil, use this regexp to find blocks." | |
| 24200 | (interactive "p") | |
| 24201 | (org-next-block arg t block-regexp)) | |
| 24202 | ||
| 24203 | (defun org-forward-paragraph () | |
| 24204 | "Move forward to beginning of next paragraph or equivalent. | |
| 24205 | ||
| 24206 | The function moves point to the beginning of the next visible | |
| 24207 | structural element, which can be a paragraph, a table, a list | |
| 24208 | item, etc. It also provides some special moves for convenience: | |
| 24209 | ||
| 24210 | - On an affiliated keyword, jump to the beginning of the | |
| 24211 | relative element. | |
| 24212 | - On an item or a footnote definition, move to the second | |
| 24213 | element inside, if any. | |
| 24214 | - On a table or a property drawer, jump after it. | |
| 24215 | - On a verse or source block, stop after blank lines." | |
| 24216 | (interactive) | |
| 24217 | (unless (eobp) | |
| 24218 | (let* ((deactivate-mark nil) | |
| 24219 | (element (org-element-at-point)) | |
| 24220 | (type (org-element-type element)) | |
| 24221 | (post-affiliated (org-element-property :post-affiliated element)) | |
| 24222 | (contents-begin (org-element-property :contents-begin element)) | |
| 24223 | (contents-end (org-element-property :contents-end element)) | |
| 24224 | (end (let ((end (org-element-property :end element)) (parent element)) | |
| 24225 | (while (and (setq parent (org-element-property :parent parent)) | |
| 24226 | (= (org-element-property :contents-end parent) end)) | |
| 24227 | (setq end (org-element-property :end parent))) | |
| 24228 | end))) | |
| 24229 | (cond ((not element) | |
| 24230 | (skip-chars-forward " \r\t\n") | |
| 24231 | (or (eobp) (beginning-of-line))) | |
| 24232 | ;; On affiliated keywords, move to element's beginning. | |
| 24233 | ((< (point) post-affiliated) | |
| 24234 | (goto-char post-affiliated)) | |
| 24235 | ;; At a table row, move to the end of the table. Similarly, | |
| 24236 | ;; at a node property, move to the end of the property | |
| 24237 | ;; drawer. | |
| 24238 | ((memq type '(node-property table-row)) | |
| 24239 | (goto-char (org-element-property | |
| 24240 | :end (org-element-property :parent element)))) | |
| 24241 | ((memq type '(property-drawer table)) (goto-char end)) | |
| 24242 | ;; Consider blank lines as separators in verse and source | |
| 24243 | ;; blocks to ease editing. | |
| 24244 | ((memq type '(src-block verse-block)) | |
| 24245 | (when (eq type 'src-block) | |
| 24246 | (setq contents-end | |
| 24247 | (save-excursion (goto-char end) | |
| 24248 | (skip-chars-backward " \r\t\n") | |
| 24249 | (line-beginning-position)))) | |
| 24250 | (beginning-of-line) | |
| 24251 | (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n")) | |
| 24252 | (if (not (re-search-forward "^[ \t]*$" contents-end t)) | |
| 24253 | (goto-char end) | |
| 24254 | (skip-chars-forward " \r\t\n") | |
| 24255 | (if (= (point) contents-end) (goto-char end) | |
| 24256 | (beginning-of-line)))) | |
| 24257 | ;; With no contents, just skip element. | |
| 24258 | ((not contents-begin) (goto-char end)) | |
| 24259 | ;; If contents are invisible, skip the element altogether. | |
| 24260 | ((org-invisible-p (line-end-position)) | |
| 24261 | (cl-case type | |
| 24262 | (headline | |
| 24263 | (org-with-limited-levels (outline-next-visible-heading 1))) | |
| 24264 | ;; At a plain list, make sure we move to the next item | |
| 24265 | ;; instead of skipping the whole list. | |
| 24266 | (plain-list (forward-char) | |
| 24267 | (org-forward-paragraph)) | |
| 24268 | (otherwise (goto-char end)))) | |
| 24269 | ((>= (point) contents-end) (goto-char end)) | |
| 24270 | ((>= (point) contents-begin) | |
| 24271 | ;; This can only happen on paragraphs and plain lists. | |
| 24272 | (cl-case type | |
| 24273 | (paragraph (goto-char end)) | |
| 24274 | ;; At a plain list, try to move to second element in | |
| 24275 | ;; first item, if possible. | |
| 24276 | (plain-list (end-of-line) | |
| 24277 | (org-forward-paragraph)))) | |
| 24278 | ;; When contents start on the middle of a line (e.g. in | |
| 24279 | ;; items and footnote definitions), try to reach first | |
| 24280 | ;; element starting after current line. | |
| 24281 | ((> (line-end-position) contents-begin) | |
| 24282 | (end-of-line) | |
| 24283 | (org-forward-paragraph)) | |
| 24284 | (t (goto-char contents-begin)))))) | |
| 24285 | ||
| 24286 | (defun org-backward-paragraph () | |
| 24287 | "Move backward to start of previous paragraph or equivalent. | |
| 24288 | ||
| 24289 | The function moves point to the beginning of the current | |
| 24290 | structural element, which can be a paragraph, a table, a list | |
| 24291 | item, etc., or to the beginning of the previous visible one if | |
| 24292 | point is already there. It also provides some special moves for | |
| 24293 | convenience: | |
| 24294 | ||
| 24295 | - On an affiliated keyword, jump to the first one. | |
| 24296 | - On a table or a property drawer, move to its beginning. | |
| 24297 | - On comment, example, export, src and verse blocks, stop | |
| 24298 | before blank lines." | |
| 24299 | (interactive) | |
| 24300 | (unless (bobp) | |
| 24301 | (let* ((deactivate-mark nil) | |
| 24302 | (element (org-element-at-point)) | |
| 24303 | (type (org-element-type element)) | |
| 24304 | (contents-end (org-element-property :contents-end element)) | |
| 24305 | (post-affiliated (org-element-property :post-affiliated element)) | |
| 24306 | (begin (org-element-property :begin element)) | |
| 24307 | (special? ;blocks handled specially | |
| 24308 | (memq type '(comment-block example-block export-block src-block | |
| 24309 | verse-block))) | |
| 24310 | (contents-begin | |
| 24311 | (if special? | |
| 24312 | ;; These types have no proper contents. Fake line | |
| 24313 | ;; below the block opening line as contents beginning. | |
| 24314 | (save-excursion (goto-char begin) (line-beginning-position 2)) | |
| 24315 | (org-element-property :contents-begin element)))) | |
| 24316 | (cond | |
| 24317 | ((not element) (goto-char (point-min))) | |
| 24318 | ((= (point) begin) | |
| 24319 | (backward-char) | |
| 24320 | (org-backward-paragraph)) | |
| 24321 | ((<= (point) post-affiliated) (goto-char begin)) | |
| 24322 | ;; Special behavior: on a table or a property drawer, move to | |
| 24323 | ;; its beginning. | |
| 24324 | ((memq type '(node-property table-row)) | |
| 24325 | (goto-char (org-element-property | |
| 24326 | :post-affiliated (org-element-property :parent element)))) | |
| 24327 | (special? | |
| 24328 | (if (<= (point) contents-begin) (goto-char post-affiliated) | |
| 24329 | ;; Inside a verse block, see blank lines as paragraph | |
| 24330 | ;; separators. | |
| 24331 | (let ((origin (point))) | |
| 24332 | (skip-chars-backward " \r\t\n" contents-begin) | |
| 24333 | (when (re-search-backward "^[ \t]*$" contents-begin 'move) | |
| 24334 | (skip-chars-forward " \r\t\n" origin) | |
| 24335 | (if (= (point) origin) (goto-char contents-begin) | |
| 24336 | (beginning-of-line)))))) | |
| 24337 | ((eq type 'paragraph) (goto-char contents-begin) | |
| 24338 | ;; When at first paragraph in an item or a footnote definition, | |
| 24339 | ;; move directly to beginning of line. | |
| 24340 | (let ((parent-contents | |
| 24341 | (org-element-property | |
| 24342 | :contents-begin (org-element-property :parent element)))) | |
| 24343 | (when (and parent-contents (= parent-contents contents-begin)) | |
| 24344 | (beginning-of-line)))) | |
| 24345 | ;; At the end of a greater element, move to the beginning of | |
| 24346 | ;; the last element within. | |
| 24347 | ((and contents-end (>= (point) contents-end)) | |
| 24348 | (goto-char (1- contents-end)) | |
| 24349 | (org-backward-paragraph)) | |
| 24350 | (t (goto-char (or post-affiliated begin)))) | |
| 24351 | ;; Ensure we never leave point invisible. | |
| 24352 | (when (org-invisible-p (point)) (beginning-of-visual-line))))) | |
| 24353 | ||
| 24354 | (defun org-forward-element () | |
| 24355 | "Move forward by one element. | |
| 24356 | Move to the next element at the same level, when possible." | |
| 24357 | (interactive) | |
| 24358 | (cond ((eobp) (user-error "Cannot move further down")) | |
| 24359 | ((org-with-limited-levels (org-at-heading-p)) | |
| 24360 | (let ((origin (point))) | |
| 24361 | (goto-char (org-end-of-subtree nil t)) | |
| 24362 | (unless (org-with-limited-levels (org-at-heading-p)) | |
| 24363 | (goto-char origin) | |
| 24364 | (user-error "Cannot move further down")))) | |
| 24365 | (t | |
| 24366 | (let* ((elem (org-element-at-point)) | |
| 24367 | (end (org-element-property :end elem)) | |
| 24368 | (parent (org-element-property :parent elem))) | |
| 24369 | (cond ((and parent (= (org-element-property :contents-end parent) end)) | |
| 24370 | (goto-char (org-element-property :end parent))) | |
| 24371 | ((integer-or-marker-p end) (goto-char end)) | |
| 24372 | (t (message "No element at point"))))))) | |
| 24373 | ||
| 24374 | (defun org-backward-element () | |
| 24375 | "Move backward by one element. | |
| 24376 | Move to the previous element at the same level, when possible." | |
| 24377 | (interactive) | |
| 24378 | (cond ((bobp) (user-error "Cannot move further up")) | |
| 24379 | ((org-with-limited-levels (org-at-heading-p)) | |
| 24380 | ;; At a headline, move to the previous one, if any, or stay | |
| 24381 | ;; here. | |
| 24382 | (let ((origin (point))) | |
| 24383 | (org-with-limited-levels (org-backward-heading-same-level 1)) | |
| 24384 | ;; When current headline has no sibling above, move to its | |
| 24385 | ;; parent. | |
| 24386 | (when (= (point) origin) | |
| 24387 | (or (org-with-limited-levels (org-up-heading-safe)) | |
| 24388 | (progn (goto-char origin) | |
| 24389 | (user-error "Cannot move further up")))))) | |
| 24390 | (t | |
| 24391 | (let* ((elem (org-element-at-point)) | |
| 24392 | (beg (org-element-property :begin elem))) | |
| 24393 | (cond | |
| 24394 | ;; Move to beginning of current element if point isn't | |
| 24395 | ;; there already. | |
| 24396 | ((null beg) (message "No element at point")) | |
| 24397 | ((/= (point) beg) (goto-char beg)) | |
| 24398 | (t (goto-char beg) | |
| 24399 | (skip-chars-backward " \r\t\n") | |
| 24400 | (unless (bobp) | |
| 24401 | (let ((prev (org-element-at-point))) | |
| 24402 | (goto-char (org-element-property :begin prev)) | |
| 24403 | (while (and (setq prev (org-element-property :parent prev)) | |
| 24404 | (<= (org-element-property :end prev) beg)) | |
| 24405 | (goto-char (org-element-property :begin prev))))))))))) | |
| 24406 | ||
| 24407 | (defun org-up-element () | |
| 24408 | "Move to upper element." | |
| 24409 | (interactive) | |
| 24410 | (if (org-with-limited-levels (org-at-heading-p)) | |
| 24411 | (unless (org-up-heading-safe) (user-error "No surrounding element")) | |
| 24412 | (let* ((elem (org-element-at-point)) | |
| 24413 | (parent (org-element-property :parent elem))) | |
| 24414 | (if parent (goto-char (org-element-property :begin parent)) | |
| 24415 | (if (org-with-limited-levels (org-before-first-heading-p)) | |
| 24416 | (user-error "No surrounding element") | |
| 24417 | (org-with-limited-levels (org-back-to-heading))))))) | |
| 24418 | ||
| 24419 | (defun org-down-element () | |
| 24420 | "Move to inner element." | |
| 24421 | (interactive) | |
| 24422 | (let ((element (org-element-at-point))) | |
| 24423 | (cond | |
| 24424 | ((memq (org-element-type element) '(plain-list table)) | |
| 24425 | (goto-char (org-element-property :contents-begin element)) | |
| 24426 | (forward-char)) | |
| 24427 | ((memq (org-element-type element) org-element-greater-elements) | |
| 24428 | ;; If contents are hidden, first disclose them. | |
| 24429 | (when (org-invisible-p (line-end-position)) (org-cycle)) | |
| 24430 | (goto-char (or (org-element-property :contents-begin element) | |
| 24431 | (user-error "No content for this element")))) | |
| 24432 | (t (user-error "No inner element"))))) | |
| 24433 | ||
| 24434 | (defun org-drag-element-backward () | |
| 24435 | "Move backward element at point." | |
| 24436 | (interactive) | |
| 24437 | (let ((elem (or (org-element-at-point) | |
| 24438 | (user-error "No element at point")))) | |
| 24439 | (if (eq (org-element-type elem) 'headline) | |
| 24440 | ;; Preserve point when moving a whole tree, even if point was | |
| 24441 | ;; on blank lines below the headline. | |
| 24442 | (let ((offset (skip-chars-backward " \t\n"))) | |
| 24443 | (unwind-protect (org-move-subtree-up) | |
| 24444 | (forward-char (- offset)))) | |
| 24445 | (let ((prev-elem | |
| 24446 | (save-excursion | |
| 24447 | (goto-char (org-element-property :begin elem)) | |
| 24448 | (skip-chars-backward " \r\t\n") | |
| 24449 | (unless (bobp) | |
| 24450 | (let* ((beg (org-element-property :begin elem)) | |
| 24451 | (prev (org-element-at-point)) | |
| 24452 | (up prev)) | |
| 24453 | (while (and (setq up (org-element-property :parent up)) | |
| 24454 | (<= (org-element-property :end up) beg)) | |
| 24455 | (setq prev up)) | |
| 24456 | prev))))) | |
| 24457 | ;; Error out if no previous element or previous element is | |
| 24458 | ;; a parent of the current one. | |
| 24459 | (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) | |
| 24460 | (user-error "Cannot drag element backward") | |
| 24461 | (let ((pos (point))) | |
| 24462 | (org-element-swap-A-B prev-elem elem) | |
| 24463 | (goto-char (+ (org-element-property :begin prev-elem) | |
| 24464 | (- pos (org-element-property :begin elem)))))))))) | |
| 24465 | ||
| 24466 | (defun org-drag-element-forward () | |
| 24467 | "Move forward element at point." | |
| 24468 | (interactive) | |
| 24469 | (let* ((pos (point)) | |
| 24470 | (elem (or (org-element-at-point) | |
| 24471 | (user-error "No element at point")))) | |
| 24472 | (when (= (point-max) (org-element-property :end elem)) | |
| 24473 | (user-error "Cannot drag element forward")) | |
| 24474 | (goto-char (org-element-property :end elem)) | |
| 24475 | (let ((next-elem (org-element-at-point))) | |
| 24476 | (when (or (org-element-nested-p elem next-elem) | |
| 24477 | (and (eq (org-element-type next-elem) 'headline) | |
| 24478 | (not (eq (org-element-type elem) 'headline)))) | |
| 24479 | (goto-char pos) | |
| 24480 | (user-error "Cannot drag element forward")) | |
| 24481 | ;; Compute new position of point: it's shifted by NEXT-ELEM | |
| 24482 | ;; body's length (without final blanks) and by the length of | |
| 24483 | ;; blanks between ELEM and NEXT-ELEM. | |
| 24484 | (let ((size-next (- (save-excursion | |
| 24485 | (goto-char (org-element-property :end next-elem)) | |
| 24486 | (skip-chars-backward " \r\t\n") | |
| 24487 | (forward-line) | |
| 24488 | ;; Small correction if buffer doesn't end | |
| 24489 | ;; with a newline character. | |
| 24490 | (if (and (eolp) (not (bolp))) (1+ (point)) (point))) | |
| 24491 | (org-element-property :begin next-elem))) | |
| 24492 | (size-blank (- (org-element-property :end elem) | |
| 24493 | (save-excursion | |
| 24494 | (goto-char (org-element-property :end elem)) | |
| 24495 | (skip-chars-backward " \r\t\n") | |
| 24496 | (forward-line) | |
| 24497 | (point))))) | |
| 24498 | (org-element-swap-A-B elem next-elem) | |
| 24499 | (goto-char (+ pos size-next size-blank)))))) | |
| 24500 | ||
| 24501 | (defun org-drag-line-forward (arg) | |
| 24502 | "Drag the line at point ARG lines forward." | |
| 24503 | (interactive "p") | |
| 24504 | (dotimes (_ (abs arg)) | |
| 24505 | (let ((c (current-column))) | |
| 24506 | (if (< 0 arg) | |
| 24507 | (progn | |
| 24508 | (beginning-of-line 2) | |
| 24509 | (transpose-lines 1) | |
| 24510 | (beginning-of-line 0)) | |
| 24511 | (transpose-lines 1) | |
| 24512 | (beginning-of-line -1)) | |
| 24513 | (org-move-to-column c)))) | |
| 24514 | ||
| 24515 | (defun org-drag-line-backward (arg) | |
| 24516 | "Drag the line at point ARG lines backward." | |
| 24517 | (interactive "p") | |
| 24518 | (org-drag-line-forward (- arg))) | |
| 24519 | ||
| 24520 | (defun org-mark-element () | |
| 24521 | "Put point at beginning of this element, mark at end. | |
| 24522 | ||
| 24523 | Interactively, if this command is repeated or (in Transient Mark | |
| 24524 | mode) if the mark is active, it marks the next element after the | |
| 24525 | ones already marked." | |
| 24526 | (interactive) | |
| 24527 | (let (deactivate-mark) | |
| 24528 | (if (and (called-interactively-p 'any) | |
| 24529 | (or (and (eq last-command this-command) (mark t)) | |
| 24530 | (and transient-mark-mode mark-active))) | |
| 24531 | (set-mark | |
| 24532 | (save-excursion | |
| 24533 | (goto-char (mark)) | |
| 24534 | (goto-char (org-element-property :end (org-element-at-point))))) | |
| 24535 | (let ((element (org-element-at-point))) | |
| 24536 | (end-of-line) | |
| 24537 | (push-mark (org-element-property :end element) t t) | |
| 24538 | (goto-char (org-element-property :begin element)))))) | |
| 24539 | ||
| 24540 | (defun org-narrow-to-element () | |
| 24541 | "Narrow buffer to current element." | |
| 24542 | (interactive) | |
| 24543 | (let ((elem (org-element-at-point))) | |
| 24544 | (cond | |
| 24545 | ((eq (car elem) 'headline) | |
| 24546 | (narrow-to-region | |
| 24547 | (org-element-property :begin elem) | |
| 24548 | (org-element-property :end elem))) | |
| 24549 | ((memq (car elem) org-element-greater-elements) | |
| 24550 | (narrow-to-region | |
| 24551 | (org-element-property :contents-begin elem) | |
| 24552 | (org-element-property :contents-end elem))) | |
| 24553 | (t | |
| 24554 | (narrow-to-region | |
| 24555 | (org-element-property :begin elem) | |
| 24556 | (org-element-property :end elem)))))) | |
| 24557 | ||
| 24558 | (defun org-transpose-element () | |
| 24559 | "Transpose current and previous elements, keeping blank lines between. | |
| 24560 | Point is moved after both elements." | |
| 24561 | (interactive) | |
| 24562 | (org-skip-whitespace) | |
| 24563 | (let ((end (org-element-property :end (org-element-at-point)))) | |
| 24564 | (org-drag-element-backward) | |
| 24565 | (goto-char end))) | |
| 24566 | ||
| 24567 | (defun org-unindent-buffer () | |
| 24568 | "Un-indent the visible part of the buffer. | |
| 24569 | Relative indentation (between items, inside blocks, etc.) isn't | |
| 24570 | modified." | |
| 24571 | (interactive) | |
| 24572 | (unless (eq major-mode 'org-mode) | |
| 24573 | (user-error "Cannot un-indent a buffer not in Org mode")) | |
| 24574 | (letrec ((parse-tree (org-element-parse-buffer 'greater-element)) | |
| 24575 | (unindent-tree | |
| 24576 | (lambda (contents) | |
| 24577 | (dolist (element (reverse contents)) | |
| 24578 | (if (memq (org-element-type element) '(headline section)) | |
| 24579 | (funcall unindent-tree (org-element-contents element)) | |
| 24580 | (save-excursion | |
| 24581 | (save-restriction | |
| 24582 | (narrow-to-region | |
| 24583 | (org-element-property :begin element) | |
| 24584 | (org-element-property :end element)) | |
| 24585 | (org-do-remove-indentation)))))))) | |
| 24586 | (funcall unindent-tree (org-element-contents parse-tree)))) | |
| 24587 | ||
| 24588 | (defun org-show-children (&optional level) | |
| 24589 | "Show all direct subheadings of this heading. | |
| 24590 | Prefix arg LEVEL is how many levels below the current level | |
| 24591 | should be shown. Default is enough to cause the following | |
| 24592 | heading to appear." | |
| 24593 | (interactive "p") | |
| 24594 | ;; If `orgstruct-mode' is active, use the slower version. | |
| 24595 | (if orgstruct-mode (call-interactively #'outline-show-children) | |
| 24596 | (save-excursion | |
| 24597 | (org-back-to-heading t) | |
| 24598 | (let* ((current-level (funcall outline-level)) | |
| 24599 | (max-level (org-get-valid-level | |
| 24600 | current-level | |
| 24601 | (if level (prefix-numeric-value level) 1))) | |
| 24602 | (end (save-excursion (org-end-of-subtree t t))) | |
| 24603 | (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") | |
| 24604 | (past-first-child nil) | |
| 24605 | ;; Make sure to skip inlinetasks. | |
| 24606 | (re (format regexp-fmt | |
| 24607 | current-level | |
| 24608 | (cond | |
| 24609 | ((not (featurep 'org-inlinetask)) "") | |
| 24610 | (org-odd-levels-only (- (* 2 org-inlinetask-min-level) | |
| 24611 | 3)) | |
| 24612 | (t (1- org-inlinetask-min-level)))))) | |
| 24613 | ;; Display parent heading. | |
| 24614 | (outline-flag-region (line-end-position 0) (line-end-position) nil) | |
| 24615 | (forward-line) | |
| 24616 | ;; Display children. First child may be deeper than expected | |
| 24617 | ;; MAX-LEVEL. Since we want to display it anyway, adjust | |
| 24618 | ;; MAX-LEVEL accordingly. | |
| 24619 | (while (re-search-forward re end t) | |
| 24620 | (unless past-first-child | |
| 24621 | (setq re (format regexp-fmt | |
| 24622 | current-level | |
| 24623 | (max (funcall outline-level) max-level))) | |
| 24624 | (setq past-first-child t)) | |
| 24625 | (outline-flag-region | |
| 24626 | (line-end-position 0) (line-end-position) nil)))))) | |
| 24627 | ||
| 24628 | (defun org-show-subtree () | |
| 24629 | "Show everything after this heading at deeper levels." | |
| 24630 | (interactive) | |
| 24631 | (outline-flag-region | |
| 24632 | (point) | |
| 24633 | (save-excursion | |
| 24634 | (org-end-of-subtree t t)) | |
| 24635 | nil)) | |
| 24636 | ||
| 24637 | (defun org-show-entry () | |
| 24638 | "Show the body directly following this heading. | |
| 24639 | Show the heading too, if it is currently invisible." | |
| 24640 | (interactive) | |
| 24641 | (save-excursion | |
| 24642 | (ignore-errors | |
| 24643 | (org-back-to-heading t) | |
| 24644 | (outline-flag-region | |
| 24645 | (max (point-min) (1- (point))) | |
| 24646 | (save-excursion | |
| 24647 | (if (re-search-forward | |
| 24648 | (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) | |
| 24649 | (match-beginning 1) | |
| 24650 | (point-max))) | |
| 24651 | nil) | |
| 24652 | (org-cycle-hide-drawers 'children)))) | |
| 24653 | ||
| 24654 | (defun org-make-options-regexp (kwds &optional extra) | |
| 24655 | "Make a regular expression for keyword lines. | |
| 24656 | KWDS is a list of keywords, as strings. Optional argument EXTRA, | |
| 24657 | when non-nil, is a regexp matching keywords names." | |
| 24658 | (concat "^[ \t]*#\\+\\(" | |
| 24659 | (regexp-opt kwds) | |
| 24660 | (and extra (concat (and kwds "\\|") extra)) | |
| 24661 | "\\):[ \t]*\\(.*\\)")) | |
| 24662 | ||
| 24663 | ;;;; Integration with and fixes for other packages | |
| 24664 | ||
| 24665 | ;;; Imenu support | |
| 24666 | ||
| 24667 | (defvar-local org-imenu-markers nil | |
| 24668 | "All markers currently used by Imenu.") | |
| 24669 | ||
| 24670 | (defun org-imenu-new-marker (&optional pos) | |
| 24671 | "Return a new marker for use by Imenu, and remember the marker." | |
| 24672 | (let ((m (make-marker))) | |
| 24673 | (move-marker m (or pos (point))) | |
| 24674 | (push m org-imenu-markers) | |
| 24675 | m)) | |
| 24676 | ||
| 24677 | (defun org-imenu-get-tree () | |
| 24678 | "Produce the index for Imenu." | |
| 24679 | (dolist (x org-imenu-markers) (move-marker x nil)) | |
| 24680 | (setq org-imenu-markers nil) | |
| 24681 | (let* ((case-fold-search nil) | |
| 24682 | (n org-imenu-depth) | |
| 24683 | (re (concat "^" (org-get-limited-outline-regexp))) | |
| 24684 | (subs (make-vector (1+ n) nil)) | |
| 24685 | (last-level 0) | |
| 24686 | m level head0 head) | |
| 24687 | (org-with-wide-buffer | |
| 24688 | (goto-char (point-max)) | |
| 24689 | (while (re-search-backward re nil t) | |
| 24690 | (setq level (org-reduced-level (funcall outline-level))) | |
| 24691 | (when (and (<= level n) | |
| 24692 | (looking-at org-complex-heading-regexp) | |
| 24693 | (setq head0 (match-string-no-properties 4))) | |
| 24694 | (setq head (org-link-display-format head0) | |
| 24695 | m (org-imenu-new-marker)) | |
| 24696 | (org-add-props head nil 'org-imenu-marker m 'org-imenu t) | |
| 24697 | (if (>= level last-level) | |
| 24698 | (push (cons head m) (aref subs level)) | |
| 24699 | (push (cons head (aref subs (1+ level))) (aref subs level)) | |
| 24700 | (cl-loop for i from (1+ level) to n do (aset subs i nil))) | |
| 24701 | (setq last-level level)))) | |
| 24702 | (aref subs 1))) | |
| 24703 | ||
| 24704 | (eval-after-load "imenu" | |
| 24705 | '(progn | |
| 24706 | (add-hook 'imenu-after-jump-hook | |
| 24707 | (lambda () | |
| 24708 | (when (derived-mode-p 'org-mode) | |
| 24709 | (org-show-context 'org-goto)))))) | |
| 24710 | ||
| 24711 | (defun org-link-display-format (s) | |
| 24712 | "Replace links in string S with their description. | |
| 24713 | If there is no description, use the link target." | |
| 24714 | (save-match-data | |
| 24715 | (replace-regexp-in-string | |
| 24716 | org-bracket-link-analytic-regexp | |
| 24717 | (lambda (m) | |
| 24718 | (if (match-end 5) (match-string 5 m) | |
| 24719 | (concat (match-string 1 m) (match-string 3 m)))) | |
| 24720 | s nil t))) | |
| 24721 | ||
| 24722 | (defun org-toggle-link-display () | |
| 24723 | "Toggle the literal or descriptive display of links." | |
| 24724 | (interactive) | |
| 24725 | (if org-descriptive-links | |
| 24726 | (progn (org-remove-from-invisibility-spec '(org-link)) | |
| 24727 | (org-restart-font-lock) | |
| 24728 | (setq org-descriptive-links nil)) | |
| 24729 | (progn (add-to-invisibility-spec '(org-link)) | |
| 24730 | (org-restart-font-lock) | |
| 24731 | (setq org-descriptive-links t)))) | |
| 24732 | ||
| 24733 | ;; Speedbar support | |
| 24734 | ||
| 24735 | (defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1) | |
| 24736 | "Overlay marking the agenda restriction line in speedbar.") | |
| 24737 | (overlay-put org-speedbar-restriction-lock-overlay | |
| 24738 | 'face 'org-agenda-restriction-lock) | |
| 24739 | (overlay-put org-speedbar-restriction-lock-overlay | |
| 24740 | 'help-echo "Agendas are currently limited to this item.") | |
| 24741 | (delete-overlay org-speedbar-restriction-lock-overlay) | |
| 24742 | ||
| 24743 | (defun org-speedbar-set-agenda-restriction () | |
| 24744 | "Restrict future agenda commands to the location at point in speedbar. | |
| 24745 | To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'." | |
| 24746 | (interactive) | |
| 24747 | (require 'org-agenda) | |
| 24748 | (let (p m tp np dir txt) | |
| 24749 | (cond | |
| 24750 | ((setq p (text-property-any (point-at-bol) (point-at-eol) | |
| 24751 | 'org-imenu t)) | |
| 24752 | (setq m (get-text-property p 'org-imenu-marker)) | |
| 24753 | (with-current-buffer (marker-buffer m) | |
| 24754 | (goto-char m) | |
| 24755 | (org-agenda-set-restriction-lock 'subtree))) | |
| 24756 | ((setq p (text-property-any (point-at-bol) (point-at-eol) | |
| 24757 | 'speedbar-function 'speedbar-find-file)) | |
| 24758 | (setq tp (previous-single-property-change | |
| 24759 | (1+ p) 'speedbar-function) | |
| 24760 | np (next-single-property-change | |
| 24761 | tp 'speedbar-function) | |
| 24762 | dir (speedbar-line-directory) | |
| 24763 | txt (buffer-substring-no-properties (or tp (point-min)) | |
| 24764 | (or np (point-max)))) | |
| 24765 | (with-current-buffer (find-file-noselect | |
| 24766 | (let ((default-directory dir)) | |
| 24767 | (expand-file-name txt))) | |
| 24768 | (unless (derived-mode-p 'org-mode) | |
| 24769 | (user-error "Cannot restrict to non-Org mode file")) | |
| 24770 | (org-agenda-set-restriction-lock 'file))) | |
| 24771 | (t (user-error "Don't know how to restrict Org mode agenda"))) | |
| 24772 | (move-overlay org-speedbar-restriction-lock-overlay | |
| 24773 | (point-at-bol) (point-at-eol)) | |
| 24774 | (setq current-prefix-arg nil) | |
| 24775 | (org-agenda-maybe-redo))) | |
| 24776 | ||
| 24777 | (defvar speedbar-file-key-map) | |
| 24778 | (declare-function speedbar-add-supported-extension "speedbar" (extension)) | |
| 24779 | (eval-after-load "speedbar" | |
| 24780 | '(progn | |
| 24781 | (speedbar-add-supported-extension ".org") | |
| 24782 | (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction) | |
| 24783 | (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction) | |
| 24784 | (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) | |
| 24785 | (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) | |
| 24786 | (add-hook 'speedbar-visiting-tag-hook | |
| 24787 | (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto)))))) | |
| 24788 | ||
| 24789 | ;;; Fixes and Hacks for problems with other packages | |
| 24790 | ||
| 24791 | (defun org--flyspell-object-check-p (element) | |
| 24792 | "Non-nil when Flyspell can check object at point. | |
| 24793 | ELEMENT is the element at point." | |
| 24794 | (let ((object (save-excursion | |
| 24795 | (when (looking-at-p "\\>") (backward-char)) | |
| 24796 | (org-element-context element)))) | |
| 24797 | (cl-case (org-element-type object) | |
| 24798 | ;; Prevent checks in links due to keybinding conflict with | |
| 24799 | ;; Flyspell. | |
| 24800 | ((code entity export-snippet inline-babel-call | |
| 24801 | inline-src-block line-break latex-fragment link macro | |
| 24802 | statistics-cookie target timestamp verbatim) | |
| 24803 | nil) | |
| 24804 | (footnote-reference | |
| 24805 | ;; Only in inline footnotes, within the definition. | |
| 24806 | (and (eq (org-element-property :type object) 'inline) | |
| 24807 | (< (save-excursion | |
| 24808 | (goto-char (org-element-property :begin object)) | |
| 24809 | (search-forward ":" nil t 2)) | |
| 24810 | (point)))) | |
| 24811 | (otherwise t)))) | |
| 24812 | ||
| 24813 | (defun org-mode-flyspell-verify () | |
| 24814 | "Function used for `flyspell-generic-check-word-predicate'." | |
| 24815 | (if (org-at-heading-p) | |
| 24816 | ;; At a headline or an inlinetask, check title only. This is | |
| 24817 | ;; faster than relying on `org-element-at-point'. | |
| 24818 | (and (save-excursion (beginning-of-line) | |
| 24819 | (and (let ((case-fold-search t)) | |
| 24820 | (not (looking-at-p "\\*+ END[ \t]*$"))) | |
| 24821 | (let ((case-fold-search nil)) | |
| 24822 | (looking-at org-complex-heading-regexp)))) | |
| 24823 | (match-beginning 4) | |
| 24824 | (>= (point) (match-beginning 4)) | |
| 24825 | (or (not (match-beginning 5)) | |
| 24826 | (< (point) (match-beginning 5)))) | |
| 24827 | (let* ((element (org-element-at-point)) | |
| 24828 | (post-affiliated (org-element-property :post-affiliated element))) | |
| 24829 | (cond | |
| 24830 | ;; Ignore checks in all affiliated keywords but captions. | |
| 24831 | ((< (point) post-affiliated) | |
| 24832 | (and (save-excursion | |
| 24833 | (beginning-of-line) | |
| 24834 | (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:"))) | |
| 24835 | (> (point) (match-end 0)) | |
| 24836 | (org--flyspell-object-check-p element))) | |
| 24837 | ;; Ignore checks in LOGBOOK (or equivalent) drawer. | |
| 24838 | ((let ((log (org-log-into-drawer))) | |
| 24839 | (and log | |
| 24840 | (let ((drawer (org-element-lineage element '(drawer)))) | |
| 24841 | (and drawer | |
| 24842 | (eq (compare-strings | |
| 24843 | log nil nil | |
| 24844 | (org-element-property :drawer-name drawer) nil nil t) | |
| 24845 | t))))) | |
| 24846 | nil) | |
| 24847 | (t | |
| 24848 | (cl-case (org-element-type element) | |
| 24849 | ((comment quote-section) t) | |
| 24850 | (comment-block | |
| 24851 | ;; Allow checks between block markers, not on them. | |
| 24852 | (and (> (line-beginning-position) post-affiliated) | |
| 24853 | (save-excursion | |
| 24854 | (end-of-line) | |
| 24855 | (skip-chars-forward " \r\t\n") | |
| 24856 | (< (point) (org-element-property :end element))))) | |
| 24857 | ;; Arbitrary list of keywords where checks are meaningful. | |
| 24858 | ;; Make sure point is on the value part of the element. | |
| 24859 | (keyword | |
| 24860 | (and (member (org-element-property :key element) | |
| 24861 | '("DESCRIPTION" "TITLE")) | |
| 24862 | (save-excursion | |
| 24863 | (search-backward ":" (line-beginning-position) t)))) | |
| 24864 | ;; Check is globally allowed in paragraphs verse blocks and | |
| 24865 | ;; table rows (after affiliated keywords) but some objects | |
| 24866 | ;; must not be affected. | |
| 24867 | ((paragraph table-row verse-block) | |
| 24868 | (let ((cbeg (org-element-property :contents-begin element)) | |
| 24869 | (cend (org-element-property :contents-end element))) | |
| 24870 | (and cbeg (>= (point) cbeg) (< (point) cend) | |
| 24871 | (org--flyspell-object-check-p element)))))))))) | |
| 24872 | (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) | |
| 24873 | ||
| 24874 | (defun org-remove-flyspell-overlays-in (beg end) | |
| 24875 | "Remove flyspell overlays in region." | |
| 24876 | (and (bound-and-true-p flyspell-mode) | |
| 24877 | (fboundp 'flyspell-delete-region-overlays) | |
| 24878 | (flyspell-delete-region-overlays beg end))) | |
| 24879 | ||
| 24880 | (defvar flyspell-delayed-commands) | |
| 24881 | (eval-after-load "flyspell" | |
| 24882 | '(add-to-list 'flyspell-delayed-commands 'org-self-insert-command)) | |
| 24883 | ||
| 24884 | ;; Make `bookmark-jump' shows the jump location if it was hidden. | |
| 24885 | (eval-after-load "bookmark" | |
| 24886 | '(if (boundp 'bookmark-after-jump-hook) | |
| 24887 | ;; We can use the hook | |
| 24888 | (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) | |
| 24889 | ;; Hook not available, use advice | |
| 24890 | (defadvice bookmark-jump (after org-make-visible activate) | |
| 24891 | "Make the position visible." | |
| 24892 | (org-bookmark-jump-unhide)))) | |
| 24893 | ||
| 24894 | ;; Make sure saveplace shows the location if it was hidden | |
| 24895 | (eval-after-load "saveplace" | |
| 24896 | '(defadvice save-place-find-file-hook (after org-make-visible activate) | |
| 24897 | "Make the position visible." | |
| 24898 | (org-bookmark-jump-unhide))) | |
| 24899 | ||
| 24900 | ;; Make sure ecb shows the location if it was hidden | |
| 24901 | (eval-after-load "ecb" | |
| 24902 | '(defadvice ecb-method-clicked (after esf/org-show-context activate) | |
| 24903 | "Make hierarchy visible when jumping into location from ECB tree buffer." | |
| 24904 | (when (derived-mode-p 'org-mode) | |
| 24905 | (org-show-context)))) | |
| 24906 | ||
| 24907 | (defun org-bookmark-jump-unhide () | |
| 24908 | "Unhide the current position, to show the bookmark location." | |
| 24909 | (and (derived-mode-p 'org-mode) | |
| 24910 | (or (org-invisible-p) | |
| 24911 | (save-excursion (goto-char (max (point-min) (1- (point)))) | |
| 24912 | (org-invisible-p))) | |
| 24913 | (org-show-context 'bookmark-jump))) | |
| 24914 | ||
| 24915 | (defun org-mark-jump-unhide () | |
| 24916 | "Make the point visible with `org-show-context' after jumping to the mark." | |
| 24917 | (when (and (derived-mode-p 'org-mode) | |
| 24918 | (org-invisible-p)) | |
| 24919 | (org-show-context 'mark-goto))) | |
| 24920 | ||
| 24921 | (eval-after-load "simple" | |
| 24922 | '(defadvice pop-to-mark-command (after org-make-visible activate) | |
| 24923 | "Make the point visible with `org-show-context'." | |
| 24924 | (org-mark-jump-unhide))) | |
| 24925 | ||
| 24926 | (eval-after-load "simple" | |
| 24927 | '(defadvice exchange-point-and-mark (after org-make-visible activate) | |
| 24928 | "Make the point visible with `org-show-context'." | |
| 24929 | (org-mark-jump-unhide))) | |
| 24930 | ||
| 24931 | (eval-after-load "simple" | |
| 24932 | '(defadvice pop-global-mark (after org-make-visible activate) | |
| 24933 | "Make the point visible with `org-show-context'." | |
| 24934 | (org-mark-jump-unhide))) | |
| 24935 | ||
| 24936 | ;; Make session.el ignore our circular variable | |
| 24937 | (defvar session-globals-exclude) | |
| 24938 | (eval-after-load "session" | |
| 24939 | '(add-to-list 'session-globals-exclude 'org-mark-ring)) | |
| 24940 | ||
| 24941 | ;;;; Finish up | |
| 24942 | ||
| 24943 | (provide 'org) | |
| 24944 | ||
| 24945 | (run-hooks 'org-load-hook) | |
| 24946 | ||
| 24947 | ;;; org.el ends here | |
